bf6, fixed pm

Makefile

@@ -71,6 +71,7 @@ symlinks: $(BIN_DIR)
 >	done
 > ln -sfn ../hbs2-git3/bf6/git-hbs2 bin/git-hbs2
 > ln -sfn ../hbs2-git3/bf6/hbs2-git bin/hbs2-git
+> ln -sfn ../bf6/hbs23 bin/hbs23
 
 
 .PHONY: build

bf6/hbs23

@@ -0,0 +1,20 @@
+#! /usr/bin/env -S hbs2-cli file
+
+; println *args
+
+(match *args
+  ( (list? store)
+    (display (hbs2:tree:metadata:stdin [kw])) )
+
+  ( (list? store  [? fn [sym? _]])
+    (println "PIZDA") )
+
+    ; (display (hbs2:tree:metadata:file [kw] fn))  )
+    ; (display (hbs2:tree:metadata:file [kw] fn))  )
+
+  ( (list? cat [? hash [sym? _]])
+    (hbs2:tree:read:stdout hash) )
+
+  ( _ nil)
+)
+

hbs2-cli/app/Main.hs

@@ -59,6 +59,12 @@ main = do
   cli <- getArgs <&> unlines . fmap unwords . splitForms
            >>= either (error.show) pure . parseTop
 
+  let runScript dict argz what = liftIO do
+        script <- either (error.show) pure $ parseTop what
+        runHBS2Cli $ recover $ runM dict do
+          bindCliArgs argz
+          void $ evalTop script
+
   let dict = makeDict do
 
         internalEntries
@@ -85,15 +91,21 @@ main = do
         entry $ bindMatch "debug:cli:show" $ nil_ \case
           _ -> display cli
 
+        entry $ bindMatch "#!" $ nil_ $ const none
+
+        entry $ bindMatch "stdin" $ nil_ $ \case
+          argz  -> do
+            liftIO getContents >>= runScript dict argz
+
+        entry $ bindMatch "file" $ nil_ $ \case
+          ( StringLike fn : argz ) -> do
+            liftIO (readFile fn) >>= runScript dict argz
+
+          e -> error (show $ pretty $ mkList e)
+
   runHBS2Cli do
 
-
     case cli of
-      [ListVal [SymbolVal "stdin"]] -> do
-        what <- liftIO getContents
-                  >>= either (error.show) pure . parseTop
-
-        recover $ run dict what >>= eatNil display
 
       [] -> do
         eof <- liftIO IO.isEOF

hbs2/Main.hs

@@ -274,7 +274,7 @@ runCat opts ss = do
             Right lbs -> LBS.putStr lbs
             Left e    -> die (show e)
 
-        MerkleAnn ann -> die "asymmetric group encryption is deprecated"
+        MerkleAnn _ -> die "asymmetric group encryption is deprecated"
 
         -- FIXME: what-if-multiple-seq-ref-?
         SeqRef (SequentialRef _ (AnnotatedHashRef _ h)) -> do

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

@@ -1796,17 +1796,27 @@ internalEntries = do
       let ref = "bf6:" <> pred
 
       entry $ bindMatch pred $ \case
-        [a]   -> pure $ mkForm "builtin:closure" [mkSym ref,  a]
+        [a]   -> do
+          -- error $ show $ "FUCK!" <+> pretty a
+          pure $ mkForm "builtin:closure" [mkSym ref,  a]
+
         e -> throwIO (BadFormException @c (mkList e))
 
       entry $ bindMatch ref $ \case
         [SymbolVal "_", b] ->do
           if bf6TypeOfPred pred == bf6TypeOf b then pure  b else pure nil
 
-        [a@(Literal _ _), b] | bf6TypeOfPred pred == bf6TypeOf b -> do
+        [a@(SymbolVal e), b] -> do
           if a == b then pure  b else pure nil
 
+        [a@(Literal _ _), b] -> do
+          if bf6TypeOfPred pred == bf6TypeOf b then
+            if a == b then pure b else pure nil
+          else
+            pure nil
+
         [a,b] -> do
+          error $ show $ "FUCKED RIGH HERE" <+> pretty a <+> pretty b
           apply_ a [b] >>= \w -> do
             if isFalse w then pure nil else pure b