From df995c01bd1cc347c9a8ec98addec6cc0b69393c Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Fri, 2 Aug 2024 08:29:56 +0300 Subject: [PATCH] wip --- hbs2-cli/app/Main.hs | 3 --- hbs2-cli/lib/Data/Config/Suckless/Script.hs | 29 ++++++++++++++++----- hbs2-cli/lib/HBS2/CLI/Run/Help.hs | 1 - 3 files changed, 23 insertions(+), 10 deletions(-) diff --git a/hbs2-cli/app/Main.hs b/hbs2-cli/app/Main.hs index 90e1d78c..c596bd43 100644 --- a/hbs2-cli/app/Main.hs +++ b/hbs2-cli/app/Main.hs @@ -19,9 +19,6 @@ import HBS2.Peer.RPC.Client.Unix import HBS2.Net.Auth.Schema() -import Data.HashMap.Strict qualified as HM -import Data.List qualified as List -import Data.Text qualified as Text import System.Environment type RefLogId = PubKey 'Sign 'HBS2Basic diff --git a/hbs2-cli/lib/Data/Config/Suckless/Script.hs b/hbs2-cli/lib/Data/Config/Suckless/Script.hs index 6d5c6f99..293f8b78 100644 --- a/hbs2-cli/lib/Data/Config/Suckless/Script.hs +++ b/hbs2-cli/lib/Data/Config/Suckless/Script.hs @@ -75,6 +75,7 @@ class ManNameOf a ann where data Man a = Man { manName :: Maybe (ManName a) + , manHidden :: Bool , manBrief :: Maybe ManBrief , manSynopsis :: [ManSynopsis] , manDesc :: Maybe ManDesc @@ -84,10 +85,11 @@ data Man a = deriving stock (Eq,Show,Generic) instance Monoid (Man a) where - mempty = Man Nothing Nothing mempty Nothing Nothing mempty + mempty = Man Nothing False Nothing mempty Nothing Nothing mempty instance Semigroup (Man a) where (<>) a b = Man (manName b <|> manName a) + (manHidden b || manHidden a) (manBrief b <|> manBrief a) (manSynopsis a <> manSynopsis b) (manDesc b <|> manDesc a) @@ -389,6 +391,9 @@ makeDict w = execWriter ( fromMakeDict w ) entry :: Dict c m -> MakeDictM c m () entry = tell +hide :: MakeDictM c m () +hide = pure () + desc :: Doc ann -> MakeDictM c m () -> MakeDictM c m () desc txt = censor (HM.map setDesc) where @@ -745,11 +750,19 @@ internalEntries = do [ ListVal es ] -> pure (head es) _ -> throwIO (TypeCheckError @C nil) - entry $ bindMatch "tail" $ \case - [] -> pure nil - [ListVal []] -> pure nil - [ListVal es] -> pure $ mkList (tail es) - _ -> throwIO (BadFormException @c nil) + brief "get tail of list" + $ args [arg "list" "list"] + $ desc "nil if the list is empty; error if not list" + $ examples [qc| + (tail [list 1 2 3]) + (2 3) + (tail [list]) + |] + $ entry $ bindMatch "tail" $ \case + [] -> pure nil + [ListVal []] -> pure nil + [ListVal es] -> pure $ mkList (tail es) + _ -> throwIO (BadFormException @c nil) entry $ bindMatch "lookup" $ \case [s, ListVal (SymbolVal "dict" : es) ] -> do @@ -851,6 +864,10 @@ internalEntries = do pure $ if a == b then mkBool True else mkBool False _ -> throwIO (BadFormException @c nil) + entry $ bindMatch "nil?" $ \case + [ListVal []] -> pure $ mkBool True + _ -> pure $ mkBool False + entry $ bindMatch "not" $ \case [w] -> do pure $ if isFalse w then mkBool True else mkBool False diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Help.hs b/hbs2-cli/lib/HBS2/CLI/Run/Help.hs index 77a92be0..4fffbcb3 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/Help.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/Help.hs @@ -26,7 +26,6 @@ helpList hasDoc p = do docDefined (Just (Bind (Just w) _)) = True docDefined _ = False - helpEntry :: MonadUnliftIO m => Id -> RunM c m () helpEntry what = do man <- ask >>= readTVarIO