mirror of https://github.com/voidlizard/hbs2
607 lines
18 KiB
Haskell
607 lines
18 KiB
Haskell
{-# Language AllowAmbiguousTypes #-}
|
|
{-# Language UndecidableInstances #-}
|
|
module Main where
|
|
|
|
import HBS2.Prelude.Plated
|
|
import HBS2.OrDie
|
|
|
|
import HBS2.Data.Types.Refs
|
|
import HBS2.Merkle
|
|
import HBS2.Misc.PrettyStuff as All
|
|
import HBS2.System.Logger.Simple.ANSI as All
|
|
|
|
import HBS2.Storage
|
|
import HBS2.Storage.Operations.ByteString
|
|
import HBS2.Peer.CLI.Detect
|
|
import HBS2.Peer.RPC.Client.Unix
|
|
import HBS2.Peer.RPC.API.Peer
|
|
import HBS2.Peer.RPC.API.Storage
|
|
import HBS2.Peer.RPC.Client.StorageClient
|
|
|
|
import HBS2.Peer.Proto hiding (request)
|
|
import HBS2.Peer.Proto.RefLog
|
|
import HBS2.Base58
|
|
import HBS2.Net.Auth.Credentials
|
|
import HBS2.Net.Auth.Schema()
|
|
import HBS2.Net.Auth.Credentials
|
|
import HBS2.Net.Auth.Credentials.Sigil
|
|
import HBS2.Data.Types.SignedBox
|
|
|
|
|
|
import HBS2.KeyMan.Keys.Direct
|
|
import HBS2.KeyMan.State
|
|
import HBS2.KeyMan.App.Types
|
|
|
|
import Data.Coerce
|
|
import Data.Config.Suckless
|
|
import Data.HashMap.Strict (HashMap)
|
|
import Data.HashMap.Strict qualified as HM
|
|
import Data.Kind
|
|
import Data.List (isPrefixOf)
|
|
import Data.List qualified as List
|
|
import Data.ByteString qualified as BS
|
|
import Data.ByteString.Char8 qualified as BS8
|
|
import Data.ByteString (ByteString)
|
|
import Data.ByteString.Lazy qualified as LBS
|
|
import Data.ByteString.Lazy.Char8 qualified as LBS8
|
|
import Data.Text qualified as Text
|
|
import Data.Text.Encoding qualified as TE
|
|
import Data.Text.IO qualified as TIO
|
|
import Data.Either
|
|
import Data.Maybe
|
|
import Codec.Serialise
|
|
import Control.Monad.Reader
|
|
import Control.Monad.Writer
|
|
import Control.Monad.Identity
|
|
import Control.Monad.Trans.Maybe
|
|
import UnliftIO
|
|
import System.Environment
|
|
import System.IO (hPrint)
|
|
|
|
import Streaming.Prelude qualified as S
|
|
import Prettyprinter
|
|
|
|
type RefLogId = PubKey 'Sign 'HBS2Basic
|
|
|
|
pattern StringLike :: forall {c} . String -> Syntax c
|
|
pattern StringLike e <- (stringLike -> Just e)
|
|
|
|
pattern StringLikeList :: forall {c} . [String] -> [Syntax c]
|
|
pattern StringLikeList e <- (stringLikeList -> e)
|
|
|
|
class OptionalVal c b where
|
|
optional :: b -> Syntax c -> b
|
|
|
|
instance IsContext c => OptionalVal c Int where
|
|
optional d = \case
|
|
LitIntVal x -> fromIntegral x
|
|
_ -> d
|
|
|
|
stringLike :: Syntax c -> Maybe String
|
|
stringLike = \case
|
|
LitStrVal s -> Just $ Text.unpack s
|
|
SymbolVal (Id s) -> Just $ Text.unpack s
|
|
_ -> Nothing
|
|
|
|
stringLikeList :: [Syntax c] -> [String]
|
|
stringLikeList syn = [ stringLike s | s <- syn ] & takeWhile isJust & catMaybes
|
|
|
|
data BindAction c ( m :: Type -> Type) =
|
|
BindLambda { fromLambda :: [Syntax c] -> RunM c m (Syntax c) }
|
|
| BindValue (Syntax c)
|
|
|
|
data Bind c ( m :: Type -> Type) = Bind
|
|
{ bindAction :: BindAction c m
|
|
, bindName :: Id
|
|
, bindDescShort :: Text
|
|
} deriving (Generic)
|
|
|
|
deriving newtype instance Hashable Id
|
|
|
|
newtype NameNotBoundException = NameNotBound Id
|
|
deriving stock Show
|
|
deriving newtype (Generic,Typeable)
|
|
|
|
|
|
newtype NotLambda = NotLambda Id
|
|
deriving stock Show
|
|
deriving newtype (Generic,Typeable)
|
|
|
|
instance Exception NotLambda
|
|
|
|
data BadFormException c = BadFormException (Syntax c)
|
|
|
|
newtype TypeCheckError c = TypeCheckError (Syntax c)
|
|
|
|
instance Exception (TypeCheckError C)
|
|
|
|
newtype BadValueException = BadValueException String
|
|
deriving stock Show
|
|
deriving newtype (Generic,Typeable)
|
|
|
|
instance Exception NameNotBoundException
|
|
|
|
instance IsContext c => Show (BadFormException c) where
|
|
show (BadFormException sy) = show $ "BadFormException" <+> pretty sy
|
|
|
|
instance IsContext c => Show (TypeCheckError c) where
|
|
show (TypeCheckError sy) = show $ "TypeCheckError" <+> pretty sy
|
|
|
|
instance Exception (BadFormException C)
|
|
|
|
instance Exception BadValueException
|
|
|
|
newtype Dict c m = Dict { fromDict :: HashMap Id (Bind c m) }
|
|
deriving newtype (Semigroup, Monoid)
|
|
|
|
newtype RunM c m a = RunM { fromRunM :: ReaderT (TVar (Dict c m)) m a }
|
|
deriving newtype ( Applicative
|
|
, Functor
|
|
, Monad
|
|
, MonadIO
|
|
, MonadUnliftIO
|
|
, MonadReader (TVar (Dict c m))
|
|
)
|
|
|
|
|
|
splitForms :: [String] -> [[String]]
|
|
splitForms s0 = runIdentity $ S.toList_ (go mempty s0)
|
|
where
|
|
go acc ( "then" : rest ) = emit acc >> go mempty rest
|
|
go acc ( "and" : rest ) = emit acc >> go mempty rest
|
|
go acc ( x : rest ) | isPrefixOf "-" x = go ( x : acc ) rest
|
|
go acc ( x : rest ) | isPrefixOf "--" x = go ( x : acc ) rest
|
|
go acc ( x : rest ) = go ( x : acc ) rest
|
|
go acc [] = emit acc
|
|
|
|
emit = S.yield . reverse
|
|
|
|
apply :: forall c m . ( IsContext c
|
|
, MonadUnliftIO m
|
|
, Exception (BadFormException c)
|
|
)
|
|
=> Id
|
|
-> [Syntax c]
|
|
-> RunM c m (Syntax c)
|
|
apply name args' = do
|
|
what <- ask >>= readTVarIO <&> HM.lookup name . fromDict
|
|
case bindAction <$> what of
|
|
Just (BindLambda e) -> mapM runExpr args' >>= e
|
|
Just (BindValue v) -> throwIO (NotLambda name)
|
|
Nothing -> throwIO (NameNotBound name)
|
|
|
|
|
|
runExpr :: forall c m . ( IsContext c
|
|
, MonadUnliftIO m
|
|
, Exception (BadFormException c)
|
|
) => Syntax c -> RunM c m (Syntax c)
|
|
runExpr syn = handle (handleForm syn) $ case syn of
|
|
|
|
ListVal [ w, SymbolVal ".", b] -> do
|
|
pure $ mkList [w, b]
|
|
|
|
ListVal (SymbolVal name : args') -> do
|
|
apply name args'
|
|
|
|
SymbolVal (Id s) | Text.isPrefixOf ":" s -> do
|
|
pure (mkSym @c (Text.drop 1 s))
|
|
|
|
SymbolVal name -> do
|
|
what <- ask >>= readTVarIO
|
|
<&> HM.lookup name . fromDict
|
|
<&> maybe (BindValue (mkSym name)) bindAction
|
|
|
|
case what of
|
|
BindValue e -> pure e
|
|
BindLambda e -> pure $ mkForm "lambda" [mkSym name, mkSym "..."]
|
|
|
|
e -> pure e
|
|
|
|
where
|
|
handleForm syn = \case
|
|
(BadFormException _ :: BadFormException c) -> do
|
|
throwIO (BadFormException syn)
|
|
|
|
run :: forall c m . ( IsContext c
|
|
, MonadUnliftIO m
|
|
, Exception (BadFormException c)
|
|
) => Dict c m -> [Syntax c] -> m (Syntax c)
|
|
run d sy = do
|
|
tvd <- newTVarIO d
|
|
lastDef nil <$> runReaderT (fromRunM (mapM runExpr sy)) tvd
|
|
|
|
bindMatch :: Id -> ([Syntax c] -> RunM c m (Syntax c)) -> Dict c m
|
|
bindMatch n fn = Dict (HM.singleton n (Bind (BindLambda fn) n ""))
|
|
|
|
nil :: forall c . IsContext c => Syntax c
|
|
nil = List noContext []
|
|
|
|
nil_ :: (IsContext c, MonadIO m) => (a -> RunM c m b) -> a -> RunM c m (Syntax c)
|
|
nil_ m w = m w >> pure (List noContext [])
|
|
|
|
bind :: (MonadUnliftIO m, IsContext c) => Id -> Syntax c -> RunM c m (Syntax c)
|
|
bind name expr = do
|
|
tv <- ask -- >>= readTVarIO
|
|
atomically do
|
|
w@(Dict x) <- readTVar tv
|
|
writeTVar tv w
|
|
pure nil
|
|
|
|
setupLogger :: MonadIO m => m ()
|
|
setupLogger = do
|
|
-- setLogging @DEBUG $ toStderr . logPrefix "[debug] "
|
|
setLogging @ERROR $ toStderr . logPrefix "[error] "
|
|
setLogging @WARN $ toStderr . logPrefix "[warn] "
|
|
setLogging @NOTICE $ toStdout . logPrefix ""
|
|
pure ()
|
|
|
|
flushLoggers :: MonadIO m => m ()
|
|
flushLoggers = do
|
|
silence
|
|
|
|
silence :: MonadIO m => m ()
|
|
silence = do
|
|
setLoggingOff @DEBUG
|
|
setLoggingOff @ERROR
|
|
setLoggingOff @WARN
|
|
setLoggingOff @NOTICE
|
|
|
|
class Display a where
|
|
display :: MonadIO m => a -> m ()
|
|
|
|
instance {-# OVERLAPPABLE #-} Pretty w => Display w where
|
|
display = liftIO . print . pretty
|
|
|
|
instance Display (Syntax c) where
|
|
display = \case
|
|
LitStrVal s -> liftIO $ TIO.putStr s
|
|
x -> liftIO $ putStr (show $ pretty x)
|
|
|
|
instance Display Text where
|
|
display = liftIO . TIO.putStr
|
|
|
|
instance Display String where
|
|
display = liftIO . putStr
|
|
|
|
display_ :: (MonadIO m, Show a) => a -> m ()
|
|
display_ = liftIO . print
|
|
|
|
{- HLINT ignore "Functor law" -}
|
|
|
|
class IsContext c => MkSym c a where
|
|
mkSym :: a -> Syntax c
|
|
|
|
instance IsContext c => MkSym c String where
|
|
mkSym s = Symbol noContext (Id $ Text.pack s)
|
|
|
|
instance IsContext c => MkSym c Text where
|
|
mkSym s = Symbol noContext (Id s)
|
|
|
|
instance IsContext c => MkSym c Id where
|
|
mkSym = Symbol noContext
|
|
|
|
class IsContext c => MkStr c s where
|
|
mkStr :: s -> Syntax c
|
|
|
|
instance IsContext c => MkStr c String where
|
|
mkStr s = Literal noContext $ LitStr (Text.pack s)
|
|
|
|
instance IsContext c => MkStr c Text where
|
|
mkStr s = Literal noContext $ LitStr s
|
|
|
|
mkForm :: forall c . IsContext c => String -> [Syntax c] -> Syntax c
|
|
mkForm s sy = List noContext ( mkSym s : sy )
|
|
|
|
mkList :: forall c. IsContext c => [Syntax c] -> Syntax c
|
|
mkList = List noContext
|
|
|
|
getCredentialsForReflog :: MonadUnliftIO m => String -> m (PeerCredentials 'HBS2Basic)
|
|
getCredentialsForReflog reflog = do
|
|
puk <- orThrow (BadValueException reflog) (fromStringMay @(RefLogKey HBS2Basic) reflog)
|
|
runKeymanClient (loadCredentials puk)
|
|
>>= orThrowUser "credentials not found"
|
|
|
|
mkRefLogUpdateFrom :: MonadUnliftIO m => m ByteString -> String -> m (Syntax C)
|
|
mkRefLogUpdateFrom mbs reflog = do
|
|
what <- getCredentialsForReflog reflog
|
|
let puk = view peerSignPk what
|
|
let privk = view peerSignSk what
|
|
txraw <- mbs
|
|
w <- makeRefLogUpdate @L4Proto @'HBS2Basic (coerce puk) privk txraw
|
|
let s = show $ pretty $ AsBase58 (serialise w)
|
|
pure $ mkForm "cbor:base58" [ mkStr s ]
|
|
|
|
|
|
metaFromSyntax :: [Syntax c] -> HashMap Text Text
|
|
metaFromSyntax syn =
|
|
HM.fromList [ (t k, t v) | (ListVal [ k, v ]) <- syn ]
|
|
where
|
|
t x = Text.pack (show $ pretty x)
|
|
|
|
createTreeWithMetadata :: (MonadUnliftIO m)
|
|
=> HashMap Text Text
|
|
-> LBS.ByteString
|
|
-> m HashRef
|
|
createTreeWithMetadata meta lbs = do
|
|
debug "create fucking metadata"
|
|
-- TODO: set-hbs2-peer
|
|
so <- detectRPC `orDie` "hbs2-peer not found"
|
|
|
|
let mt = vcat [ pretty k <> ":" <+> pretty v | (k,v) <- HM.toList meta ]
|
|
& show & Text.pack
|
|
|
|
withRPC2 @StorageAPI @UNIX so $ \caller -> do
|
|
let sto = AnyStorage (StorageClient caller)
|
|
|
|
t0 <- writeAsMerkle sto lbs
|
|
>>= getBlock sto
|
|
>>= orThrowUser "can't read merkle tree just written"
|
|
<&> deserialiseOrFail @(MTree [HashRef])
|
|
>>= orThrowUser "merkle tree corrupted/invalid"
|
|
|
|
-- FIXME: support-encryption
|
|
let mann = MTreeAnn (ShortMetadata mt) NullEncryption t0
|
|
|
|
putBlock sto (serialise mann)
|
|
>>= orThrowUser "can't write tree"
|
|
<&> HashRef
|
|
|
|
|
|
helpList :: MonadUnliftIO m => Maybe String -> RunM c m ()
|
|
helpList p = do
|
|
|
|
let match = maybe (const True) (Text.isPrefixOf . Text.pack) p
|
|
|
|
d <- ask >>= readTVarIO <&> fromDict
|
|
let ks = [k | Id k <- List.sort (HM.keys d)
|
|
, match k
|
|
]
|
|
|
|
display_ $ vcat (fmap pretty ks)
|
|
|
|
main :: IO ()
|
|
main = do
|
|
|
|
setupLogger
|
|
|
|
cli <- getArgs <&> unlines . fmap unwords . splitForms
|
|
>>= either (error.show) pure . parseTop
|
|
|
|
let dict = execWriter do
|
|
|
|
tell $ bindMatch "help" $ nil_ $ \syn -> do
|
|
|
|
display_ $ "hbs2-cli tool" <> line
|
|
|
|
case syn of
|
|
(StringLike p : _) -> do
|
|
helpList (Just p)
|
|
|
|
[ListVal (SymbolVal "lambda" : SymbolVal what : _ )] -> do
|
|
liftIO $ hPutDoc stdout $
|
|
"function" <+> ul (pretty what)
|
|
<> line
|
|
|
|
_ -> helpList Nothing
|
|
|
|
|
|
tell $ bindMatch "concat" $ \syn -> do
|
|
|
|
case syn of
|
|
[ListVal (StringLikeList xs)] -> do
|
|
pure $ mkStr @C ( mconcat xs )
|
|
|
|
StringLikeList xs -> do
|
|
pure $ mkStr ( mconcat xs )
|
|
|
|
_ -> throwIO (BadFormException @C nil)
|
|
|
|
tell $ bindMatch "list" $ \case
|
|
es -> do
|
|
pure $ mkList @C es
|
|
|
|
tell $ bindMatch "dict" $ \case
|
|
es -> do
|
|
pure $ mkForm "dict" es
|
|
|
|
|
|
tell $ bindMatch "map" $ \syn -> do
|
|
case syn of
|
|
[ListVal (SymbolVal "lambda" : SymbolVal fn : _), ListVal rs] -> do
|
|
mapM (apply fn . List.singleton) rs
|
|
<&> mkList
|
|
|
|
w -> do
|
|
throwIO (BadFormException @C nil)
|
|
|
|
tell $ bindMatch "head" $ \case
|
|
[ ListVal es ] -> pure (head es)
|
|
_ -> throwIO (TypeCheckError @C nil)
|
|
|
|
tell $ bindMatch "tail" $ \case
|
|
[] -> pure nil
|
|
[ListVal []] -> pure nil
|
|
[ListVal es] -> pure $ mkList @C (tail es)
|
|
_ -> throwIO (BadFormException @C nil)
|
|
|
|
tell $ bindMatch "lookup" $ \case
|
|
[s, ListVal (SymbolVal "dict" : es) ] -> do
|
|
let val = headDef nil [ v | ListVal [k, v] <- es, k == s ]
|
|
pure val
|
|
|
|
[StringLike s, ListVal [] ] -> do
|
|
pure nil
|
|
|
|
_ -> throwIO (BadFormException @C nil)
|
|
|
|
tell $ bindMatch "display" $ nil_ \case
|
|
[ sy ] -> display sy
|
|
ss -> display (mkList ss)
|
|
|
|
tell $ bindMatch "debug:show-cli" $ nil_ \case
|
|
_ -> display cli
|
|
|
|
tell $ bindMatch "hbs2:peer:detect" $ nil_ \case
|
|
_ -> do
|
|
so <- detectRPC
|
|
display so
|
|
|
|
tell $ bindMatch "hbs2:peer:poke" $ \case
|
|
_ -> do
|
|
so <- detectRPC `orDie` "hbs2-peer not found"
|
|
r <- newTVarIO nil
|
|
withRPC2 @PeerAPI @UNIX so $ \caller -> do
|
|
|
|
what <- callRpcWaitMay @RpcPoke (TimeoutSec 1) caller ()
|
|
<&> fromMaybe ""
|
|
<&> parseTop
|
|
<&> either (const nil) (mkForm "dict")
|
|
|
|
atomically $ writeTVar r what
|
|
|
|
readTVarIO r
|
|
|
|
tell $ bindMatch "hbs2:keyring:list-encryption" $ \syn -> do
|
|
lbs <- case syn of
|
|
|
|
[ ListVal [ SymbolVal "file", StringLike fn ] ] -> do
|
|
liftIO $ BS.readFile fn
|
|
|
|
[ LitStrVal s ] -> do
|
|
pure (BS8.pack (Text.unpack s))
|
|
|
|
_ -> throwIO (BadFormException @C nil)
|
|
|
|
cred <- pure (parseCredentials @'HBS2Basic (AsCredFile lbs))
|
|
`orDie` "bad keyring file"
|
|
|
|
let e = [ mkStr @C (show (pretty (AsBase58 p))) | KeyringEntry p _ _ <- view peerKeyring cred ]
|
|
|
|
pure $ mkList @C e
|
|
|
|
tell $ bindMatch "hbs2:keyring:new" $ \syn -> do
|
|
n <- case syn of
|
|
[LitIntVal k] -> pure k
|
|
[] -> pure 1
|
|
_ -> throwIO (BadFormException @C nil)
|
|
|
|
cred0 <- newCredentials @'HBS2Basic
|
|
cred <- foldM (\cred _ -> addKeyPair Nothing cred) cred0 [1..n]
|
|
pure $ mkStr @C $ show $ pretty $ AsCredFile $ AsBase58 cred
|
|
|
|
tell $ bindMatch "hbs2:keyman:list" $ nil_ \case
|
|
_ -> do
|
|
void $ runKeymanClient $ KeyManClient $ do
|
|
k <- listKeys
|
|
display_ $ vcat (fmap pretty k)
|
|
|
|
tell $ bindMatch "hbs2:reflog:tx:create-raw" $ \case
|
|
[SymbolVal "stdin", StringLike reflog] -> do
|
|
mkRefLogUpdateFrom ( liftIO BS.getContents ) reflog
|
|
|
|
[LitStrVal s, StringLike reflog] -> do
|
|
mkRefLogUpdateFrom ( pure (TE.encodeUtf8 s) ) reflog
|
|
|
|
_ -> throwIO (BadFormException @C nil)
|
|
|
|
tell $ bindMatch "str:read-stdin" $ \case
|
|
[] -> liftIO getContents <&> mkStr @C
|
|
|
|
_ -> throwIO (BadFormException @C nil)
|
|
|
|
tell $ bindMatch "str:read-file" $ \case
|
|
[StringLike fn] -> liftIO (readFile fn) <&> mkStr @C
|
|
|
|
_ -> throwIO (BadFormException @C nil)
|
|
|
|
tell $ bindMatch "str:save" $ nil_ \case
|
|
[StringLike fn, StringLike what] ->
|
|
liftIO (writeFile fn what)
|
|
|
|
_ -> throwIO (BadFormException @C nil)
|
|
|
|
|
|
tell $ bindMatch "hbs2:tree:metadata:get" $ \case
|
|
[ SymbolVal how, StringLike hash ] -> do
|
|
|
|
-- FIXME: put-to-the-state
|
|
so <- detectRPC `orDie` "hbs2-peer not found"
|
|
|
|
r <- withRPC2 @StorageAPI @UNIX so $ \caller -> do
|
|
let sto = AnyStorage (StorageClient caller)
|
|
|
|
runMaybeT do
|
|
|
|
headBlock <- getBlock sto (fromString hash)
|
|
>>= toMPlus
|
|
<&> deserialiseOrFail @(MTreeAnn [HashRef])
|
|
>>= toMPlus
|
|
|
|
case headBlock of
|
|
MTreeAnn { _mtaMeta = ShortMetadata s } -> do
|
|
pure $ mkStr @C s
|
|
|
|
MTreeAnn { _mtaMeta = AnnHashRef h } -> do
|
|
getBlock sto h
|
|
>>= toMPlus
|
|
<&> LBS.toStrict
|
|
<&> TE.decodeUtf8
|
|
<&> mkStr @C
|
|
|
|
_ -> mzero
|
|
|
|
|
|
case (how, r) of
|
|
("parsed", Just (LitStrVal r0)) -> do
|
|
|
|
|
|
let xs = parseTop r0
|
|
& fromRight mempty
|
|
|
|
pure $ mkForm @C "dict" xs
|
|
|
|
_ -> pure $ fromMaybe nil r
|
|
|
|
_ -> throwIO (BadFormException @C nil)
|
|
|
|
tell $ bindMatch "hbs2:tree:metadata:create" $ \syn -> do
|
|
|
|
case syn of
|
|
|
|
(LitStrVal s : meta) -> do
|
|
let lbs = fromString (Text.unpack s) :: LBS.ByteString
|
|
h <- createTreeWithMetadata (metaFromSyntax meta) lbs
|
|
pure $ mkStr (show $ pretty h)
|
|
|
|
(ListVal [SymbolVal "from-file", StringLike fn ] : meta) -> do
|
|
lbs <- liftIO $ LBS.readFile fn
|
|
h <- createTreeWithMetadata (metaFromSyntax meta) lbs
|
|
pure $ mkStr (show $ pretty h)
|
|
|
|
(ListVal [SymbolVal "from-stdin"] : meta) -> do
|
|
lbs <- liftIO $ LBS.getContents
|
|
h <- createTreeWithMetadata (metaFromSyntax meta) lbs
|
|
pure $ mkStr (show $ pretty h)
|
|
|
|
_ -> throwIO (BadFormException @C nil)
|
|
|
|
tell $ bindMatch "cbor:base58" $ \case
|
|
[ LitStrVal x ] -> do
|
|
pure $ mkForm "cbor:base58" [mkStr x]
|
|
|
|
_ -> throwIO (BadFormException @C nil)
|
|
|
|
|
|
case cli of
|
|
[ListVal [SymbolVal "stdin"]] -> do
|
|
what <- getContents
|
|
>>= either (error.show) pure . parseTop
|
|
void $ run dict what
|
|
|
|
[] -> do
|
|
void $ run dict [mkForm "help" []]
|
|
|
|
_ -> do
|
|
void $ run dict cli
|
|
|