wip

hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs

@@ -142,8 +142,8 @@ metaDataEntries = do
            )
     $ examples [qc|
 
-(hbs2:tree:metadata:get :parsed 7J2BZYskBjmDsWZHvVoGGorZDrFYkbbQweRauaYGSTNd)
-(dict (mime-type: "text/plain; charset=us-ascii") (file-name: "qqq.txt"))
+(hbs2:tree:metadata:get 7J2BZYskBjmDsWZHvVoGGorZDrFYkbbQweRauaYGSTNd)
+((mime-type: "text/plain; charset=us-ascii") (file-name: "qqq.txt"))
 
 (hbs2:tree:metadata:get :raw 7J2BZYskBjmDsWZHvVoGGorZDrFYkbbQweRauaYGSTNd
 mime-type: "text/plain; charset=us-ascii"
@@ -151,7 +151,7 @@ file-name: "qqq.txt"
     |]
     $ entry $ bindMatch "hbs2:tree:metadata:get"
     $ \case
-      [ SymbolVal how, StringLike hash ] -> do
+     [ StringLike hash ] -> do
 
         r <- flip runContT pure do
 
@@ -187,18 +187,17 @@ file-name: "qqq.txt"
 
               _ -> mzero
 
-        case (how, r) of
-          ("parsed", Just (LitStrVal r0)) -> do
-
+        maybe1 r (pure nil) $ \case
+          TextLike r0 -> do
 
             let xs = parseTop r0
                        & either mempty (fmap fixContext)
 
-            pure $ mkForm  "dict" xs
+            pure $ mkList xs
 
           _ -> pure $ fromMaybe nil r
 
-      _ -> throwIO (BadFormException @c nil)
+     _ -> throwIO (BadFormException @c nil)
 
   brief "creates a merkle tree with metadata"
     $ returns "string" "hash"
@@ -220,23 +219,22 @@ $ echo TEST | hbs2-cli hbs2:tree:metadata:create :stdin
 
 ;; empty metadata
 
-hbs2-cli hbs2:tree:metadata:get :raw 7dGqTtoehsgn7bADcVTyp93tq2FfuQgtBuVvYL46jdyz
+hbs2-cli hbs2:tree:metadata:get 7dGqTtoehsgn7bADcVTyp93tq2FfuQgtBuVvYL46jdyz
 
 Create merkle tree with custom metadata
 
 $ echo TEST | hbs2-cli hbs2:tree:metadata:create :stdin [kw hello world]
 2ASBLBPRUMrHoSkNYsRWwJQiiXuSGDZTaCXAdDTdeJY6
 
-$ hbs2-cli hbs2:tree:metadata:get :raw 2ASBLBPRUMrHoSkNYsRWwJQiiXuSGDZTaCXAdDTdeJY6
+$ hbs2-cli hbs2:tree:metadata:get  2ASBLBPRUMrHoSkNYsRWwJQiiXuSGDZTaCXAdDTdeJY6
 hello: "world"
 
+$ hbs2-cli  hbs2:tree:metadata:get 7YyWZ44sWpHvrqnFxL8G8HJo4o4p659diusZoHyhXCTx
+((mime-type: "text/plain; charset=us-ascii") (file-name: "MetaData.hs"))
+
 $ hbs2-cli hbs2:tree:metadata:create :auto ./lambda.svg
 3fv5ym8NhY8zat37NaTvY9PDcwJqMLUD73ewHxtHysWg
 
-$ hbs2-cli hbs2:tree:metadata:get :raw 3fv5ym8NhY8zat37NaTvY9PDcwJqMLUD73ewHxtHysWg
-mime-type: "image/svg+xml; charset=us-ascii"
-file-name: "lambda.svg"
-
 Create encrypted tree metadata with a new groupkey
 
 $ hbs2-cli [define pks [list EiwWxY3xwTfnLKJdzzxNMZgA2ZvYAZd9e8B8pFeCtnrn]] \
@@ -253,7 +251,7 @@ GixS4wssCD4x7LzvHve2JhFCghW1Hwia2tiGTfTTef1u
 
 Check metadata
 
-$ hbs2-cli hbs2:tree:metadata:get :raw BFLcbpNEqngsJ8gzx3ps4ETXfpUMGgjEETNEVgR18KG4y
+$ hbs2-cli hbs2:tree:metadata:get BFLcbpNEqngsJ8gzx3ps4ETXfpUMGgjEETNEVgR18KG4y
 
 mime-type: "image/svg+xml; charset=us-ascii"
 file-name: "lambda.svg"
@@ -272,12 +270,12 @@ $ hbs2-cli hbs2:groupkey:list-public-keys [hbs2:groupkey:load GixS4wssCD4x7LzvHv
 
               SymbolVal "auto"      -> pure [Auto]
 
-              ListVal (SymbolVal "dict" : [ListVal [SymbolVal "encrypted", StringLike key]])
+              ListVal [ListVal [SymbolVal "encrypted", StringLike key]]
                 -> do
                   pure [Encrypted key]
 
-              ListVal (SymbolVal "dict" : w)  -> do
-                pure [MetaDataEntry x y | ListVal [SymbolVal x, StringLike y] <- w ]
+              ListVal ws  -> do
+                pure [MetaDataEntry x y | ListVal [SymbolVal x, StringLike y] <- ws ]
 
               StringLike rest  -> do
                 pure [MetaDataFile rest]

hbs2-cli/lib/HBS2/CLI/Run/Tree.hs

@@ -7,6 +7,8 @@ import HBS2.CLI.Run.Internal
 import HBS2.CLI.Run.Internal.GroupKey as G
 import HBS2.CLI.Run.Internal.Merkle
 
+import HBS2.Defaults
+
 import HBS2.Data.Types.Refs
 import HBS2.Merkle
 import HBS2.System.Dir
@@ -45,3 +47,18 @@ treeEntries = do
        _ -> throwIO (BadFormException @c nil)
 
 
+  brief "reads merkle tree data from storage"
+    $ args [arg "list of hashes" "trees"]
+    $ desc [qc|hbs2:grove creates a 'grove' - merkle tree of list of hashes of merkle trees
+It's just an easy way to create a such thing, you may browse it by hbs2 cat -H
+|]
+    $ returns "hash" "string"
+    $ entry $ bindMatch "hbs2:grove" $ \case
+        HashLikeList hashes@(x:_) -> lift do
+          sto <- getStorage
+          let pt = toPTree (MaxSize defHashListChunk) (MaxNum defTreeChildNum) hashes
+          mkSym . show . pretty <$> liftIO (makeMerkle 0 pt $ \(_,_,bss) -> do
+                  void $ putBlock sto bss)
+
+        _ -> throwIO (BadFormException @c nil)
+

hbs2-core/lib/HBS2/Data/Types/Refs.hs

@@ -18,6 +18,7 @@ import Codec.Serialise(serialise)
 import Data.Map (Map)
 import Data.Map qualified as Map
 import Data.Data
+import Data.Maybe
 import Data.Text qualified as Text
 
 class RefMetaData a where
@@ -144,5 +145,15 @@ pattern HashLike x <- (
     _                -> Nothing
       -> Just x )
 
+pattern HashLikeList :: forall {c} . [HashRef] -> [Syntax c]
+pattern HashLikeList e <- (hashLikeList -> e)
+
+hashLikeList :: [Syntax c] -> [HashRef]
+hashLikeList syn = [ hashLike s | s <- syn ] & takeWhile isJust & catMaybes
+
+hashLike :: Syntax c -> Maybe HashRef
+hashLike = \case
+  HashLike x -> Just x
+  _          -> Nothing
 
 

miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs

@@ -1439,8 +1439,7 @@ internalEntries = do
       _ -> pure $ mkBool False
 
     entry $ bindMatch "not" $ \case
-      [w] -> do
-        pure $ if isFalse w then mkBool True else mkBool False
+      [w] -> pure (mkBool (isTrue w))
       _ -> throwIO (BadFormException @c nil)
 
     brief "get system environment"