suckless-conf, hide entries

hbs2-git3/lib/HBS2/Git3/Repo.hs

@@ -107,7 +107,8 @@ initRepo syn = do
       callRpcWaitMay @RpcPollAdd (TimeoutSec 1) peerAPI (reflog, "reflog", 17)
          >>= orThrowUser "rpc timeout"
 
-      liftIO $ print $ pretty repo
+      -- FIXME: remove-this
+      liftIO $ print $ pretty $ mkForm "manifest" repo
 
     CreateRepoDefBlock pk  -> do
 

hbs2-git3/lib/HBS2/Git3/Run.hs

@@ -47,19 +47,26 @@ theDict :: forall m . ( HBS2GitPerks m
 theDict = do
   makeDict @C do
     -- TODO: write-man-entries
-    myHelpEntry
+    myEntries
     entry $ bindValue "best" (mkInt 22)
-    internalEntries
+    hidden $ internalEntries
 
   where
 
-    myHelpEntry = do
+    myEntries = hidePrefix "test:" do
         entry $ bindMatch "--help" $ nil_ $ \case
           HelpEntryBound what -> do
             helpEntry what
             quit
 
-          _ -> helpList False Nothing >> quit
+          [ StringLike x ] -> helpList True (Just x) >> quit
+
+          _ -> helpList True Nothing >> quit
+
+        hidden do
+          entry $ bindMatch "--help-all" $ nil_ $ \case
+            [ StringLike x ] -> helpList False (Just x) >> quit
+            _ -> helpList False Nothing >> quit
 
         entry $ bindMatch "compression" $ nil_ $ \case
           [ LitIntVal n ] -> lift do
@@ -90,6 +97,8 @@ theDict = do
         entry $ bindMatch "debug" $ nil_ $ const do
          setLogging @DEBUG  $ toStderr . logPrefix "[debug] "
 
+        -- hidden do
+
         entry $ bindMatch "test:git:normalize-ref" $ nil_  \case
           [ StringLike s ] -> display $ mkStr @C (show $ pretty $ gitNormaliseRef (fromString s))
           _ -> throwIO (BadFormException @C nil)

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

@@ -1,5 +1,6 @@
 {-# Language UndecidableInstances #-}
 {-# Language PatternSynonyms #-}
+{-# Language RecordWildCards #-}
 module Data.Config.Suckless.Script
   ( module Exported
   , module Data.Config.Suckless.Script
@@ -29,13 +30,13 @@ helpList hasDoc p = do
   d <- ask >>= readTVarIO
   let ks = [k | Id k <- List.sort (HM.keys d)
            , match k
-           , not hasDoc || docDefined (HM.lookup (Id k) d)
+           , docDefined (HM.lookup (Id k) d) || not hasDoc
            ]
 
   display_ $ vcat (fmap pretty ks)
 
   where
-    docDefined (Just (Bind (Just w) _)) = True
+    docDefined (Just (Bind (Just Man{..}) _)) | not manHidden  = True
     docDefined _ = False
 
 helpEntry :: MonadUnliftIO m => Id -> RunM c m ()
@@ -50,7 +51,6 @@ pattern HelpEntryBound :: forall {c}. Id -> [Syntax c]
 pattern HelpEntryBound what <- [ListVal (SymbolVal "builtin:lambda" : SymbolVal what : _ )]
 
 
--- FIXME: move-to-suckless-script
 splitOpts :: [(Id,Int)]
           -> [Syntax C]
           -> ([Syntax C], [Syntax C])

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

@@ -23,6 +23,8 @@ import Data.Data
 import Data.Function as Export
 import Data.Functor as Export
 import Data.Hashable
+import Data.HashSet (HashSet)
+import Data.HashSet qualified as HS
 import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HM
 import Data.Kind
@@ -393,8 +395,20 @@ makeDict w = execWriter ( fromMakeDict w )
 entry :: Dict c m  -> MakeDictM c m ()
 entry = tell
 
-hide :: MakeDictM c m ()
+hide ::  Bind c m -> Bind c m
-hide = pure ()
+hide (Bind w x) = Bind (Just updatedMan) x
+  where
+    updatedMan = case w of
+      Nothing -> mempty { manHidden = True }
+      Just man -> man { manHidden = True }
+
+hidden :: MakeDictM c m () -> MakeDictM c m ()
+hidden = censor (HM.map hide)
+
+hidePrefix :: Id -> MakeDictM c m () -> MakeDictM c m ()
+hidePrefix (Id p) = censor (HM.filterWithKey exclude)
+  where
+    exclude (Id k) _ = not (Text.isPrefixOf p k)
 
 desc :: Doc ann -> MakeDictM c m () -> MakeDictM c m ()
 desc txt = censor (HM.map setDesc)
@@ -414,7 +428,6 @@ returns tp txt = censor (HM.map setReturns)
     w0 = mempty { manReturns = Just (ManReturns tp txt) }
     setReturns (Bind w x) = Bind (Just (maybe w0 (<>w0) w)) x
 
-
 addSynopsis :: ManSynopsis -> Bind c m -> Bind c m
 addSynopsis synopsis (Bind w x) = Bind (Just updatedMan) x
   where