Add the descendDescTo function, minor formatting

src/UI/Butcher/Monadic/Pretty.hs

@@ -36,6 +36,7 @@ module UI.Butcher.Monadic.Pretty
   , ppPartDescUsage
   , ppPartDescHeader
   , parsingErrorString
+  , descendDescTo
   )
 where
 
@@ -43,11 +44,16 @@ where
 
 #include "prelude.inc"
 import           Control.Monad.Free
-import qualified Control.Monad.Trans.MultiRWS.Strict as MultiRWSS
+import qualified Control.Monad.Trans.MultiRWS.Strict
-import qualified Control.Monad.Trans.MultiState.Strict as MultiStateS
+                                               as MultiRWSS
+import qualified Control.Monad.Trans.MultiState.Strict
+                                               as MultiStateS
 
 import qualified Text.PrettyPrint              as PP
-import           Text.PrettyPrint ( (<+>), ($$), ($+$) )
+import           Text.PrettyPrint               ( (<+>)
+                                                , ($$)
+                                                , ($+$)
+                                                )
 
 import           Data.HList.ContainsType
 
@@ -79,7 +85,8 @@ ppUsage (CommandDesc mParent _syn _help parts out children _hidden) =
     PP.fcat
       $   PP.punctuate (PP.text " | ")
       $   Data.Foldable.toList
-      $ (PP.text . fst) <$> visibleChildren
+      $   (PP.text . fst)
+      <$> visibleChildren
 
 -- | ppUsageShortSub exampleDesc yields:
 --
@@ -138,13 +145,19 @@ ppUsageWithHelp (CommandDesc mParent _syn help parts out children _hidden) =
 -- fromJust $ ppUsageAt ["version"] exampleDesc yields:
 --
 -- > example version [--porcelain]
-ppUsageAt :: [String] -- (sub)command sequence
+ppUsageAt
+  :: [String] -- (sub)command sequence
   -> CommandDesc a
   -> Maybe PP.Doc
-ppUsageAt strings desc =
+ppUsageAt strings desc = ppUsage <$> descendDescTo strings desc
-  case strings of
+
-    [] -> Just $ ppUsage desc
+-- | Access a child command's CommandDesc.
-    (s:sr) -> find ((Just s==) . fst) (_cmd_children desc) >>= ppUsageAt sr . snd
+descendDescTo :: [String] -> CommandDesc a -> Maybe (CommandDesc a)
+descendDescTo strings desc = case strings of
+  [] -> Just desc
+  (s : sr) -> do -- Maybe
+    (_, childDesc) <- find ((Just s ==) . fst) (_cmd_children desc)
+    descendDescTo sr childDesc
 
 -- | ppHelpShallow exampleDesc yields:
 --
@@ -180,7 +193,7 @@ ppHelpShallow desc =
         $+$ PP.text ""
         $+$ PP.nest
               2
-              ( case syn of
+              (case syn of
                 Nothing -> pparents mParent
                 Just s  -> pparents mParent <+> PP.text "-" <+> s
               )
@@ -258,7 +271,7 @@ ppHelpDepthOne desc =
         $+$ PP.text ""
         $+$ PP.nest
               2
-              ( case syn of
+              (case syn of
                 Nothing -> pparents mParent
                 Just s  -> pparents mParent <+> PP.text "-" <+> s
               )
@@ -330,7 +343,7 @@ ppPartDescUsage = \case
   PartReorder ps ->
     let flags  = [ d | PartMany d <- ps ]
         params = filter
-          ( \case
+          (\case
             PartMany{} -> False
             _          -> True
           )
@@ -366,7 +379,7 @@ parsingErrorString (ParsingError mess remaining) =
  where
   messStr = case mess of
     []      -> ""
-    (m:_) -> m ++ " "
+    (m : _) -> m ++ " "
   remainingStr = case remaining of
     InputString ""  -> "at the end of input."
     InputString str -> case show str of