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

Add ppUsageWithHelp

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

25
src/UI/Butcher/Monadic/Pretty.hs
View File

@ -16,6 +16,7 @@ module UI.Butcher.Monadic.Pretty
, ppHelpShallow
, ppPartDescUsage
, ppPartDescHeader
, ppUsageWithHelp
)
where
@ -47,11 +48,31 @@ ppUsage (CommandDesc mParent _help _syn parts out children) =
partDocs = parts <&> ppPartDescUsage
subsDoc = case out of
_ | null children -> PP.empty -- TODO: remove debug
Nothing -> PP.parens $ subDoc
Just{} -> PP.brackets $ subDoc
Nothing | null parts -> subDoc
| otherwise -> PP.parens $ subDoc
Just{} -> PP.brackets $ subDoc
subDoc = PP.fcat $ PP.punctuate (PP.text " | ") $ children <&> \(n, _) ->
PP.text n
ppUsageWithHelp :: CommandDesc a -> PP.Doc
ppUsageWithHelp (CommandDesc mParent help _syn parts out children) =
pparents mParent <+> PP.fsep (partDocs ++ [subsDoc]) PP.<> helpDoc
where
pparents :: Maybe (String, CommandDesc out) -> PP.Doc
pparents Nothing = PP.empty
pparents (Just (n, cd)) = pparents (_cmd_mParent cd) <+> PP.text n
partDocs = parts <&> ppPartDescUsage
subsDoc = case out of
_ | null children -> PP.empty -- TODO: remove debug
Nothing | null parts -> subDoc
| otherwise -> PP.parens $ subDoc
Just{} -> PP.brackets $ subDoc
subDoc = PP.fcat $ PP.punctuate (PP.text " | ") $ children <&> \(n, _) ->
PP.text n
helpDoc = case help of
Nothing -> PP.empty
Just h -> PP.text ":" PP.<+> h
ppUsageAt :: [String] -- (sub)command sequence
-> CommandDesc a
-> Maybe PP.Doc