diff --git a/bf6/hbs23 b/bf6/hbs23 index 37f42e59..af019442 100755 --- a/bf6/hbs23 +++ b/bf6/hbs23 @@ -4,6 +4,18 @@ ; # (println (grep (sym "-g") *args)) +(define (--help) + (begin + (println [concat + +"hbs2-cli wrapper" chr:lf +"supported commands list:" chr:lf +" " + + ]) + ) +) + (match *args ( (list? [sym? store] ...) @@ -30,10 +42,102 @@ ) ) + ( (list? [sym? has] hash) + (begin + (local s (hbs2:peer:storage:block:size hash)) + (cond + ( (eq? :no-block s) (die)) + ( _ (print s)) + )) + ) ( (list? [sym? cat] ...) - (begin - (println "FUCKING CAT" space ...)) + + (begin + + (local optdef `( [-H 0 HASHES] + [--raw 0 RAW] + [--metadata 0 META] + [--m 0 META] + )) + + (local parsed (cli:split optdef ...)) + (local opts (nth 0 parsed)) + (local hash (head (nth 1 parsed))) + + (if (@? HASHES opts) + (begin + (iterate [fn x . println x] [tail [hbs2:tree:scan:deep hash]]) + (quit) + )) + + + (if (@? RAW opts) + (begin + (bytes:put (hbs2:peer:storage:block:get hash)) + (quit) + ) + ) + + (if (@? META opts) + (begin + (display (hbs2:tree:metadata:get hash)) + (quit) + ) + ) + + (hbs2:tree:read:stdout hash) + + ) + ) + + ( (list? [sym? del] ...) + + (begin + + (local optdef `( [-y 0 YES] + [-r 0 REC] + )) + + (local parsed (cli:split optdef ...)) + (local opts (nth 0 parsed)) + (local hash (head (nth 1 parsed))) + + (local hashes + (cond + ( (@? REC opts) (hbs2:tree:scan:deep hash) ) + ( _ (hbs2:tree:scan hash) ) + ) + ) + + (define (ask ha) + (if (@? YES opts) true + (begin + (print "deleting " ha " ") + (print "sure [y/n]? ") (flush:stdout) + (local answ (str:getchar:stdin)) + (newline) + (eq? (upper answ) "Y") + )) + ) + + (cond + ( (and (@? YES opts) (@? REC opts)) (hbs2:tree:delete hash)) + ( _ + (for (reverse hashes) + [fn ha . + [begin + (local y (or (@? YES opts) (ask ha))) + (if y + (begin + (hbs2:peer:storage:block:del ha) + )) + ]]) + ) + ) + + + ) ) @@ -50,8 +154,23 @@ ) ) + ( (list? [sym? reflog] [sym? get] hash) + (display (hbs2:reflog:get hash)) + ) + + ( (list? [sym? reflog] [sym? fetch] hash) + (hbs2:reflog:fetch hash) + ) + + ( (list? [sym? metadata] [sym? dump] hash) + (display (hbs2:tree:metadata:get hash)) + ) + + ( (list? [sym? deps] hash) + (iterate println (hbs2:tree:scan:deep hash) ) + ) + ( _ (--help) ) ) -; vim: filetype=lisp - +; vim: filetype=scheme syntax=scheme diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Peer.hs b/hbs2-cli/lib/HBS2/CLI/Run/Peer.hs index 2d14f551..4fd1b9e9 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/Peer.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/Peer.hs @@ -66,7 +66,16 @@ peerEntries = do lbs <- getBlock sto (fromHashRef ha) `orDie` show ("missed-block" <+> pretty ha) - pure $ mkForm "blob" [mkStr (LBS8.unpack lbs)] + mkOpaque lbs + + _ -> throwIO $ BadFormException @c nil + + entry $ bindMatch "hbs2:peer:storage:block:del" $ \case + [HashLike ha] -> do + flip runContT pure do + sto <- getStorage + delBlock sto (fromHashRef ha) + pure nil _ -> throwIO $ BadFormException @c nil diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Tree.hs b/hbs2-cli/lib/HBS2/CLI/Run/Tree.hs index f60d1961..1614831e 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/Tree.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/Tree.hs @@ -157,6 +157,20 @@ It's just an easy way to create a such thing, you may browse it by hbs2 cat -H _ -> throwIO (BadFormException @c nil) + brief "delete tree" $ + entry $ bindMatch "hbs2:tree:delete" $ nil_ \case + [HashLike href] -> do + sto <- getStorage + + what <- S.toList_ $ deepScan ScanDeep (const none) (coerce href) (getBlock sto) $ \ha -> do + S.yield ha + + for_ (reverse what) $ \ha -> do + display_ $ "deleting" <+> pretty ha + delBlock sto ha + + _ -> throwIO (BadFormException @c nil) + brief "shallow scan of a block/tree" $ entry $ bindMatch "hbs2:tree:scan:deep" $ \case 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 b7e3a8ec..fcf0dde6 100644 --- a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs +++ b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs @@ -1168,6 +1168,12 @@ internalEntries = do _ -> do throwIO (BadFormException @C nil) + entry $ bindMatch "for" $ nil_ $ \case + [ ListVal es, what ] -> do + mapM_ (apply_ what . List.singleton) es + + _ -> do + throwIO (BadFormException @C nil) entry $ bindMatch "replicate" $ \case [LitIntVal n, e] -> pure $ mkList (replicate (fromIntegral n) e) @@ -1615,6 +1621,19 @@ internalEntries = do [ sy ] -> display sy >> liftIO (putStrLn "") ss -> mapM_ display ss >> liftIO (putStrLn "") + entry $ bindMatch "flush:stdout" $ nil_ $ \case + [] -> liftIO do + hFlush stdout + + _ -> throwIO (BadFormException @c nil) + + entry $ bindMatch "str:getchar:stdin" $ \case + [] -> liftIO do + hSetBuffering stdin NoBuffering + mkStr . List.singleton <$> getChar + + _ -> throwIO (BadFormException @c nil) + entry $ bindMatch "str:stdin" $ \case [] -> liftIO getContents <&> mkStr @c @@ -2099,8 +2118,13 @@ internalEntries = do _ -> throwIO $ BadFormException @c nil + entry $ bindMatch "quit" $ nil_ $ \case + [] -> liftIO $ Exit.exitSuccess + _ -> throwIO $ BadFormException @c nil + entry $ bindMatch "die" $ nil_ $ \case - e -> liftIO $ Exit.die (show $ foldMap asSym e) + [] -> liftIO $ Exit.exitFailure + e -> liftIO $ Exit.die (show $ foldMap asSym e) entry $ bindMatch "cp" $ nil_ $ \case (StringLikeList p) -> liftIO do