wip

hbs2-cli/lib/HBS2/CLI/Prelude.hs

@@ -7,6 +7,7 @@ module HBS2.CLI.Prelude
   , module Control.Monad.Reader
   , module HBS2.System.Logger.Simple.ANSI
   , module HBS2.Misc.PrettyStuff
+  , qc,qq,q
   , Generic
   ) where
 
@@ -21,4 +22,5 @@ import Data.Config.Suckless
 import Control.Monad.Reader
 import UnliftIO
 
+import Text.InterpolatedString.Perl6 (qc,q,qq)
 

hbs2-cli/lib/HBS2/CLI/Run/Internal.hs

@@ -103,6 +103,9 @@ instance Pretty ManDesc where
   pretty = \case
     ManDescRaw t -> pretty t
 
+instance IsString ManDesc where
+  fromString s = ManDescRaw (Text.pack s)
+
 instance Pretty (Man a) where
   pretty e =   "NAME"
              <> line
@@ -122,8 +125,7 @@ instance Pretty (Man a) where
       Just (ManReturns t s) ->
         line <> "RETURN VALUE" <> line
         <> indent 8 (
-            pretty t <> line
+            pretty t <> hsep ["","-",""] <> pretty s) <> line
-            <> pretty s) <> line
 
     fmtDescription = line
       <> "DESCRIPTION" <> line
@@ -155,6 +157,9 @@ instance Pretty (Man a) where
       indent 8 do
         parens (pretty (manName e) <+>
          hsep [ pretty n | ManApplyArg t n <- xs ]  )
+         <> line
+         <> line
+         <> vcat [ pretty n <+> ":" <+> pretty t | ManApplyArg t n <- xs ]
 
 pattern StringLike :: forall {c} . String -> Syntax c
 pattern StringLike e <- (stringLike -> Just e)
@@ -398,6 +403,11 @@ makeDict w = execWriter ( fromMakeDict w )
 entry :: Dict c m  -> MakeDictM c m ()
 entry = tell
 
+desc :: Doc ann -> MakeDictM c m () -> MakeDictM c m ()
+desc txt = censor (HM.map setDesc)
+  where
+    w0 = mempty { manDesc = Just (ManDescRaw $ Text.pack $ show txt) }
+    setDesc (Bind w x) = Bind (Just (maybe w0 (<> w0) w)) x
 
 brief :: ManBrief -> MakeDictM c m () -> MakeDictM c m ()
 brief txt = censor (HM.map setBrief)
@@ -680,9 +690,32 @@ internalEntries = do
         pure $ mkForm "dict" [ mkList [a, b] ]
       _ -> throwIO (BadFormException @C nil)
 
-    entry $ bindMatch "kw" $ \syn -> do
+    brief "creates a dict from a linear list of string-like items"
-      let wat = [ mkList @c [mkSym i, e] | (i,e) <- optlist syn ]
+      $ args [arg "list-of-terms" "..."]
-      pure $ mkForm "dict" wat
+      $ desc (    "macro; syntax sugar" <> line
+               <> "useful for creating function args" <> line
+               <> "leftover records are skipped"
+             )
+      $ returns "dict" ""
+      $ examples [qc|
+[kw a 1 b 2 c 3]
+(dict (a 1) (b 2) (c 3))
+
+[kw a]
+(dict (a ()))
+
+[kw a b]
+(dict (a b))
+
+[kw 1 2 3]
+(dict)
+
+[kw a b c]
+(dict (a b) (c ()))
+      |]
+      $ entry $ bindMatch "kw" $ \syn -> do
+         let wat = [ mkList @c [mkSym i, e] | (i,e) <- optlist syn ]
+         pure $ mkForm "dict" wat
 
     entry $ bindMatch "iterate" $ nil_ $ \syn -> do
       case syn of

hbs2-cli/lib/HBS2/CLI/Run/LWWRef.hs

@@ -26,84 +26,109 @@ import Control.Monad.Trans.Cont
 lwwRefEntries :: forall c m . (c ~ C, IsContext c, MonadUnliftIO m) => MakeDictM  c m ()
 lwwRefEntries = do
 
-  entry $ bindMatch "hbs2:lwwref:create" $ \case
+  brief "creates a new lwwref"
-    [] -> do
+    $ desc "Creates a new keyring; adds it to keyman and subsribes hbs2-peer to listen this lwwref"
-      reflog <- keymanNewCredentials (Just "lwwref") 0
+    $ returns "string" "lwwref public key"
+    $ entry $ bindMatch "hbs2:lwwref:create" $ \case
+        [] -> do
+          reflog <- keymanNewCredentials (Just "lwwref") 0
 
-      flip runContT pure do
+          flip runContT pure do
-        so <- detectRPC `orDie` "rpc not found"
+            so <- detectRPC `orDie` "rpc not found"
-        api <- ContT $ withRPC2 @PeerAPI  @UNIX so
+            api <- ContT $ withRPC2 @PeerAPI  @UNIX so
-        void $ callService @RpcPollAdd api (reflog, "lwwref", 31)
+            void $ callService @RpcPollAdd api (reflog, "lwwref", 31)
-        pure $ mkStr (show $ pretty (AsBase58 reflog))
+            pure $ mkStr (show $ pretty (AsBase58 reflog))
 
-    _ -> throwIO (BadFormException @C nil)
+        _ -> throwIO (BadFormException @C nil)
 
-  entry $ bindMatch "hbs2:lwwref:list" $ \case
+  brief "lists all lwwref that hbs2-peer is subscribed to"
-    [] -> do
+    $ noArgs
-      flip runContT pure do
+    $ returns "list of string" "lwwref list"
-        so <- detectRPC `orDie` "rpc not found"
+    $ entry $ bindMatch "hbs2:lwwref:list" $ \case
-        api <- ContT $ withRPC2 @PeerAPI @UNIX so
+      [] -> do
-        r <- callService @RpcPollList2 api (Just "lwwref", Nothing)
+        flip runContT pure do
-               >>= orThrowUser "can't get lwwref list"
+          so <- detectRPC `orDie` "rpc not found"
-        pure $ mkList $ fmap (mkStr . show . pretty . AsBase58 . view _1) r
+          api <- ContT $ withRPC2 @PeerAPI @UNIX so
+          r <- callService @RpcPollList2 api (Just "lwwref", Nothing)
+                 >>= orThrowUser "can't get lwwref list"
+          pure $ mkList $ fmap (mkStr . show . pretty . AsBase58 . view _1) r
 
-    _ -> throwIO (BadFormException @C nil)
+      _ -> throwIO (BadFormException @C nil)
 
 
-  entry $ bindMatch "hbs2:lwwref:fetch" $ \case
+  brief "fetches lwwref value"
-    [StringLike puk] -> do
+    $ desc "makes peer to request lwwref from neighbors"
-      flip runContT pure do
+    $ args [arg "string" "lwwref"]
-        lww <- orThrowUser "bad lwwref key" (fromStringMay puk)
+    $ returns "atom" "okay"
-        so <- detectRPC `orDie` "rpc not found"
+    $ entry $ bindMatch "hbs2:lwwref:fetch" $ \case
-        api <- ContT $ withRPC2 @LWWRefAPI @UNIX so
+      [StringLike puk] -> do
-        void $ callService @RpcLWWRefFetch api lww
+        flip runContT pure do
-        pure $ mkStr "okay"
+          lww <- orThrowUser "bad lwwref key" (fromStringMay puk)
+          so <- detectRPC `orDie` "rpc not found"
+          api <- ContT $ withRPC2 @LWWRefAPI @UNIX so
+          void $ callService @RpcLWWRefFetch api lww
+          pure $ mkStr "okay"
 
-    _ -> throwIO (BadFormException @C nil)
+      _ -> throwIO (BadFormException @C nil)
 
 
-  entry $ bindMatch "hbs2:lwwref:get" $ \case
+  brief "get lwwref value"
-    [StringLike puk] -> do
+    $ args [arg "string" "lwwref"]
+    $ returns "string" "hashref"
+    $ examples [qc|
 
-      flip runContT pure do
+(hbs2:lwwref:get BTThPdHKF8XnEq4m6wzbKHKA6geLFK4ydYhBXAqBdHSP)
-        ref <- orThrowUser "bad lwwref key" (fromStringMay puk)
+(lwwref
-        so <- detectRPC `orDie` "rpc not found"
+  (seq 4)
-        api <- ContT $ withRPC2 @LWWRefAPI  @UNIX so
+  (value "74vDGwBYebH3oM6xPXC7kqpgu6deqi7E549QpvHvvQKf")
-        what <- callService @RpcLWWRefGet api ref
+  )
-                  >>= orThrowUser "can't get lwwref value"
+    |]
-        pure $ mkStr (show $ pretty what)
+    $ entry $ bindMatch "hbs2:lwwref:get" $ \case
+      [StringLike puk] -> do
 
-    _ -> throwIO (BadFormException @C nil)
+        flip runContT pure do
+          ref <- orThrowUser "bad lwwref key" (fromStringMay puk)
+          so <- detectRPC `orDie` "rpc not found"
+          api <- ContT $ withRPC2 @LWWRefAPI  @UNIX so
+          what <- callService @RpcLWWRefGet api ref
+                    >>= orThrowUser "can't get lwwref value"
+          pure $ mkStr (show $ pretty what)
+
+      _ -> throwIO (BadFormException @C nil)
 
 
-  entry $ bindMatch "hbs2:lwwref:update" $ \case
+  brief "updates lwwref"
-    [StringLike puks, HashLike new] -> do
+    $ desc "updates lwwref value and increments it's counter"
+    $ args [arg "string" "lwwref", arg "string" "hash"]
+    $ returns "nil" ""
+    $ entry $ bindMatch "hbs2:lwwref:update" $ \case
+      [StringLike puks, HashLike new] -> do
 
-      flip runContT pure do
+        flip runContT pure do
-        puk <- orThrowUser "bad lwwref key" (fromStringMay  puks)
+          puk <- orThrowUser "bad lwwref key" (fromStringMay  puks)
-        so <- detectRPC `orDie` "rpc not found"
+          so <- detectRPC `orDie` "rpc not found"
-        api <- ContT $ withRPC2 @LWWRefAPI  @UNIX so
+          api <- ContT $ withRPC2 @LWWRefAPI  @UNIX so
 
-        (sk,pk) <- liftIO $ runKeymanClient do
+          (sk,pk) <- liftIO $ runKeymanClient do
-                     creds  <- loadCredentials puk
+                       creds  <- loadCredentials puk
-                                 >>= orThrowUser "can't load credentials"
+                                   >>= orThrowUser "can't load credentials"
-                     pure ( view peerSignSk  creds, view peerSignPk creds )
+                       pure ( view peerSignSk  creds, view peerSignPk creds )
 
-        what <- callService @RpcLWWRefGet api puk
+          what <- callService @RpcLWWRefGet api puk
-                  >>= orThrowUser "can't get lwwref value"
+                    >>= orThrowUser "can't get lwwref value"
 
-        sno' <- case what of
+          sno' <- case what of
-                 Nothing    -> pure 0
+                   Nothing    -> pure 0
-                 Just lwwv  -> pure (lwwSeq lwwv)
+                   Just lwwv  -> pure (lwwSeq lwwv)
 
-        let sno =  succ sno'
+          let sno =  succ sno'
 
-        let box =  makeSignedBox pk sk (LWWRef sno new Nothing)
+          let box =  makeSignedBox pk sk (LWWRef sno new Nothing)
 
-        callService @RpcLWWRefUpdate api box
+          callService @RpcLWWRefUpdate api box
-          >>= orThrowUser "lww ref update error"
+            >>= orThrowUser "lww ref update error"
 
-        pure nil
+          pure nil
 
-    _ -> throwIO (BadFormException @C nil)
+      _ -> throwIO (BadFormException @C nil)