diff --git a/Makefile b/Makefile index ae4264c4..847f0c4b 100644 --- a/Makefile +++ b/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 diff --git a/bf6/hbs23 b/bf6/hbs23 new file mode 100755 index 00000000..2d38b0a6 --- /dev/null +++ b/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) +) + diff --git a/hbs2-cli/app/Main.hs b/hbs2-cli/app/Main.hs index ab86d2e6..c511c759 100644 --- a/hbs2-cli/app/Main.hs +++ b/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 diff --git a/hbs2/Main.hs b/hbs2/Main.hs index a69d55ee..4c36d57f 100644 --- a/hbs2/Main.hs +++ b/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 diff --git a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs index 1fad7108..db8e576b 100644 --- a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs +++ b/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 - if a == b then pure b else pure nil + [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