hexagoxel
/
butcher
1
0
Fork 0
Code Issues 2 Pull Requests Packages Projects Releases Wiki Activity

Make help print subcommand help as well (addHelpCommand)

pull/5/head
Lennart Spitzner 2016-12-30 22:15:10 +01:00
parent 046812cecb
commit 76e3baad76
1 changed files with 10 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/UI/Butcher/Monadic/IO.hs
View File

@ -19,6 +19,7 @@ import Data.HList.ContainsType
import UI.Butcher.Monadic.Types import UI.Butcher.Monadic.Types
import UI.Butcher.Monadic.Core import UI.Butcher.Monadic.Core
import UI.Butcher.Monadic.Pretty import UI.Butcher.Monadic.Pretty
import UI.Butcher.Monadic.Param
import System.IO import System.IO
@ -57,8 +58,16 @@ mainFromCmdParser cmd = do
addHelpCommand :: Applicative f => CmdParser f (IO ()) () addHelpCommand :: Applicative f => CmdParser f (IO ()) ()
addHelpCommand = addCmd "help" $ do addHelpCommand = addCmd "help" $ do
desc <- peekCmdDesc desc <- peekCmdDesc
rest <- addRestOfInputStringParam "SUBCOMMAND(s)" mempty
addCmdImpl $ do addCmdImpl $ do
print $ ppHelpShallow $ maybe undefined snd (_cmd_mParent desc) let parentDesc = maybe undefined snd (_cmd_mParent desc)
let restWords = List.words rest
let descent :: [String] -> CommandDesc a -> CommandDesc a
descent [] curDesc = curDesc
descent (w:wr) curDesc = case List.lookup w $ _cmd_children curDesc of
Nothing -> curDesc
Just child -> descent wr child
print $ ppHelpShallow $ descent restWords parentDesc
addButcherDebugCommand :: Applicative f => CmdParser f (IO ()) () addButcherDebugCommand :: Applicative f => CmdParser f (IO ()) ()
addButcherDebugCommand = addCmd "butcherdebug" $ do addButcherDebugCommand = addCmd "butcherdebug" $ do