module UI.Butcher.Monadic.Pretty
( ppUsage
, ppUsageShortSub
, ppUsageAt
, ppHelpShallow
, ppHelpDepthOne
, ppUsageWithHelp
, ppPartDescUsage
, ppPartDescHeader
, parsingErrorString
, descendDescTo
)
where
#include "prelude.inc"
import Control.Monad.Free
import qualified Control.Monad.Trans.MultiRWS.Strict
as MultiRWSS
import qualified Control.Monad.Trans.MultiState.Strict
as MultiStateS
import qualified Text.PrettyPrint as PP
import Text.PrettyPrint ( (<+>)
, ($$)
, ($+$)
)
import Data.HList.ContainsType
import UI.Butcher.Monadic.Internal.Types
import UI.Butcher.Monadic.Internal.Core
ppUsage :: CommandDesc a -> PP.Doc
ppUsage :: CommandDesc a -> Doc
ppUsage (CommandDesc mParent :: Maybe (Maybe String, CommandDesc a)
mParent _syn :: Maybe Doc
_syn _help :: Maybe Doc
_help parts :: [PartDesc]
parts out :: Maybe a
out children :: Deque (Maybe String, CommandDesc a)
children _hidden :: Visibility
_hidden) =
Maybe (Maybe String, CommandDesc a) -> Doc
forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents Maybe (Maybe String, CommandDesc a)
mParent Doc -> Doc -> Doc
<+> [Doc] -> Doc
PP.sep [[Doc] -> Doc
PP.fsep [Doc]
partDocs, Doc
subsDoc]
where
pparents :: Maybe (Maybe String, CommandDesc out) -> PP.Doc
pparents :: Maybe (Maybe String, CommandDesc out) -> Doc
pparents Nothing = Doc
PP.empty
pparents (Just (Just n :: String
n , cd :: CommandDesc out
cd)) = Maybe (Maybe String, CommandDesc out) -> Doc
forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents (CommandDesc out -> Maybe (Maybe String, CommandDesc out)
forall out.
CommandDesc out -> Maybe (Maybe String, CommandDesc out)
_cmd_mParent CommandDesc out
cd) Doc -> Doc -> Doc
<+> String -> Doc
PP.text String
n
pparents (Just (Nothing, cd :: CommandDesc out
cd)) = Maybe (Maybe String, CommandDesc out) -> Doc
forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents (CommandDesc out -> Maybe (Maybe String, CommandDesc out)
forall out.
CommandDesc out -> Maybe (Maybe String, CommandDesc out)
_cmd_mParent CommandDesc out
cd)
partDocs :: [Doc]
partDocs = (PartDesc -> Maybe Doc) -> [PartDesc] -> [Doc]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe PartDesc -> Maybe Doc
ppPartDescUsage [PartDesc]
parts
visibleChildren :: Deque (String, CommandDesc a)
visibleChildren =
[ (String
n, CommandDesc a
c) | (Just n :: String
n, c :: CommandDesc a
c) <- Deque (Maybe String, CommandDesc a)
children, CommandDesc a -> Visibility
forall out. CommandDesc out -> Visibility
_cmd_visibility CommandDesc a
c Visibility -> Visibility -> Bool
forall a. Eq a => a -> a -> Bool
== Visibility
Visible ]
subsDoc :: Doc
subsDoc = case Maybe a
out of
_ | Deque (String, CommandDesc a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Deque (String, CommandDesc a)
visibleChildren -> Doc
PP.empty
Nothing | [PartDesc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PartDesc]
parts -> Doc
subDoc
| Bool
otherwise -> Doc -> Doc
PP.parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
subDoc
Just{} -> Doc -> Doc
PP.brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
subDoc
subDoc :: Doc
subDoc =
[Doc] -> Doc
PP.fcat
([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
PP.punctuate (String -> Doc
PP.text " | ")
([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ Deque Doc -> [Doc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList
(Deque Doc -> [Doc]) -> Deque Doc -> [Doc]
forall a b. (a -> b) -> a -> b
$ (String -> Doc
PP.text (String -> Doc)
-> ((String, CommandDesc a) -> String)
-> (String, CommandDesc a)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, CommandDesc a) -> String
forall a b. (a, b) -> a
fst)
((String, CommandDesc a) -> Doc)
-> Deque (String, CommandDesc a) -> Deque Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Deque (String, CommandDesc a)
visibleChildren
ppUsageShortSub :: CommandDesc a -> PP.Doc
ppUsageShortSub :: CommandDesc a -> Doc
ppUsageShortSub (CommandDesc mParent :: Maybe (Maybe String, CommandDesc a)
mParent _syn :: Maybe Doc
_syn _help :: Maybe Doc
_help parts :: [PartDesc]
parts out :: Maybe a
out children :: Deque (Maybe String, CommandDesc a)
children _hidden :: Visibility
_hidden) =
Maybe (Maybe String, CommandDesc a) -> Doc
forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents Maybe (Maybe String, CommandDesc a)
mParent Doc -> Doc -> Doc
<+> [Doc] -> Doc
PP.sep [[Doc] -> Doc
PP.fsep [Doc]
partDocs, Doc
subsDoc]
where
pparents :: Maybe (Maybe String, CommandDesc out) -> PP.Doc
pparents :: Maybe (Maybe String, CommandDesc out) -> Doc
pparents Nothing = Doc
PP.empty
pparents (Just (Just n :: String
n , cd :: CommandDesc out
cd)) = Maybe (Maybe String, CommandDesc out) -> Doc
forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents (CommandDesc out -> Maybe (Maybe String, CommandDesc out)
forall out.
CommandDesc out -> Maybe (Maybe String, CommandDesc out)
_cmd_mParent CommandDesc out
cd) Doc -> Doc -> Doc
<+> String -> Doc
PP.text String
n
pparents (Just (Nothing, cd :: CommandDesc out
cd)) = Maybe (Maybe String, CommandDesc out) -> Doc
forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents (CommandDesc out -> Maybe (Maybe String, CommandDesc out)
forall out.
CommandDesc out -> Maybe (Maybe String, CommandDesc out)
_cmd_mParent CommandDesc out
cd)
partDocs :: [Doc]
partDocs = (PartDesc -> Maybe Doc) -> [PartDesc] -> [Doc]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe PartDesc -> Maybe Doc
ppPartDescUsage [PartDesc]
parts
visibleChildren :: Deque (String, CommandDesc a)
visibleChildren =
[ (String
n, CommandDesc a
c) | (Just n :: String
n, c :: CommandDesc a
c) <- Deque (Maybe String, CommandDesc a)
children, CommandDesc a -> Visibility
forall out. CommandDesc out -> Visibility
_cmd_visibility CommandDesc a
c Visibility -> Visibility -> Bool
forall a. Eq a => a -> a -> Bool
== Visibility
Visible ]
subsDoc :: Doc
subsDoc = case Maybe a
out of
_ | Deque (String, CommandDesc a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Deque (String, CommandDesc a)
visibleChildren -> Doc
PP.empty
Nothing -> Doc
subDoc
Just{} -> Doc -> Doc
PP.brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
subDoc
subDoc :: Doc
subDoc = if Deque (String, CommandDesc a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Deque (String, CommandDesc a)
visibleChildren then Doc
PP.empty else String -> Doc
PP.text "<command>"
ppUsageWithHelp :: CommandDesc a -> PP.Doc
ppUsageWithHelp :: CommandDesc a -> Doc
ppUsageWithHelp (CommandDesc mParent :: Maybe (Maybe String, CommandDesc a)
mParent _syn :: Maybe Doc
_syn help :: Maybe Doc
help parts :: [PartDesc]
parts out :: Maybe a
out children :: Deque (Maybe String, CommandDesc a)
children _hidden :: Visibility
_hidden) =
Maybe (Maybe String, CommandDesc a) -> Doc
forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents Maybe (Maybe String, CommandDesc a)
mParent Doc -> Doc -> Doc
<+> [Doc] -> Doc
PP.fsep ([Doc]
partDocs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
subsDoc]) Doc -> Doc -> Doc
PP.<> Doc
helpDoc
where
pparents :: Maybe (Maybe String, CommandDesc out) -> PP.Doc
pparents :: Maybe (Maybe String, CommandDesc out) -> Doc
pparents Nothing = Doc
PP.empty
pparents (Just (Just n :: String
n , cd :: CommandDesc out
cd)) = Maybe (Maybe String, CommandDesc out) -> Doc
forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents (CommandDesc out -> Maybe (Maybe String, CommandDesc out)
forall out.
CommandDesc out -> Maybe (Maybe String, CommandDesc out)
_cmd_mParent CommandDesc out
cd) Doc -> Doc -> Doc
<+> String -> Doc
PP.text String
n
pparents (Just (Nothing, cd :: CommandDesc out
cd)) = Maybe (Maybe String, CommandDesc out) -> Doc
forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents (CommandDesc out -> Maybe (Maybe String, CommandDesc out)
forall out.
CommandDesc out -> Maybe (Maybe String, CommandDesc out)
_cmd_mParent CommandDesc out
cd)
partDocs :: [Doc]
partDocs = (PartDesc -> Maybe Doc) -> [PartDesc] -> [Doc]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe PartDesc -> Maybe Doc
ppPartDescUsage [PartDesc]
parts
subsDoc :: Doc
subsDoc = case Maybe a
out of
_ | Deque (Maybe String, CommandDesc a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Deque (Maybe String, CommandDesc a)
children -> Doc
PP.empty
Nothing | [PartDesc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PartDesc]
parts -> Doc
subDoc
| Bool
otherwise -> Doc -> Doc
PP.parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
subDoc
Just{} -> Doc -> Doc
PP.brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
subDoc
subDoc :: Doc
subDoc =
[Doc] -> Doc
PP.fcat
([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
PP.punctuate (String -> Doc
PP.text " | ")
([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ Deque Doc -> [Doc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList
(Deque Doc -> [Doc]) -> Deque Doc -> [Doc]
forall a b. (a -> b) -> a -> b
$ [ String -> Doc
PP.text String
n | (Just n :: String
n, c :: CommandDesc a
c) <- Deque (Maybe String, CommandDesc a)
children, CommandDesc a -> Visibility
forall out. CommandDesc out -> Visibility
_cmd_visibility CommandDesc a
c Visibility -> Visibility -> Bool
forall a. Eq a => a -> a -> Bool
== Visibility
Visible ]
helpDoc :: Doc
helpDoc = case Maybe Doc
help of
Nothing -> Doc
PP.empty
Just h :: Doc
h -> String -> Doc
PP.text ":" Doc -> Doc -> Doc
PP.<+> Doc
h
ppUsageAt
:: [String]
-> CommandDesc a
-> Maybe PP.Doc
ppUsageAt :: [String] -> CommandDesc a -> Maybe Doc
ppUsageAt strings :: [String]
strings desc :: CommandDesc a
desc = CommandDesc a -> Doc
forall a. CommandDesc a -> Doc
ppUsage (CommandDesc a -> Doc) -> Maybe (CommandDesc a) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> CommandDesc a -> Maybe (CommandDesc a)
forall a. [String] -> CommandDesc a -> Maybe (CommandDesc a)
descendDescTo [String]
strings CommandDesc a
desc
descendDescTo :: [String] -> CommandDesc a -> Maybe (CommandDesc a)
descendDescTo :: [String] -> CommandDesc a -> Maybe (CommandDesc a)
descendDescTo strings :: [String]
strings desc :: CommandDesc a
desc = case [String]
strings of
[] -> CommandDesc a -> Maybe (CommandDesc a)
forall a. a -> Maybe a
Just CommandDesc a
desc
(s :: String
s : sr :: [String]
sr) -> do
(_, childDesc :: CommandDesc a
childDesc) <- ((Maybe String, CommandDesc a) -> Bool)
-> Deque (Maybe String, CommandDesc a)
-> Maybe (Maybe String, CommandDesc a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String -> Maybe String
forall a. a -> Maybe a
Just String
s Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe String -> Bool)
-> ((Maybe String, CommandDesc a) -> Maybe String)
-> (Maybe String, CommandDesc a)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe String, CommandDesc a) -> Maybe String
forall a b. (a, b) -> a
fst) (CommandDesc a -> Deque (Maybe String, CommandDesc a)
forall out.
CommandDesc out -> Deque (Maybe String, CommandDesc out)
_cmd_children CommandDesc a
desc)
[String] -> CommandDesc a -> Maybe (CommandDesc a)
forall a. [String] -> CommandDesc a -> Maybe (CommandDesc a)
descendDescTo [String]
sr CommandDesc a
childDesc
ppHelpShallow :: CommandDesc a -> PP.Doc
ppHelpShallow :: CommandDesc a -> Doc
ppHelpShallow desc :: CommandDesc a
desc =
Doc
nameSection
Doc -> Doc -> Doc
$+$ Doc
usageSection
Doc -> Doc -> Doc
$+$ Doc
descriptionSection
Doc -> Doc -> Doc
$+$ Doc
partsSection
Doc -> Doc -> Doc
$+$ String -> Doc
PP.text ""
where
CommandDesc mParent :: Maybe (Maybe String, CommandDesc a)
mParent syn :: Maybe Doc
syn help :: Maybe Doc
help parts :: [PartDesc]
parts _out :: Maybe a
_out _children :: Deque (Maybe String, CommandDesc a)
_children _hidden :: Visibility
_hidden = CommandDesc a
desc
nameSection :: Doc
nameSection = case Maybe (Maybe String, CommandDesc a)
mParent of
Nothing -> Doc
PP.empty
Just{} ->
String -> Doc
PP.text "NAME"
Doc -> Doc -> Doc
$+$ String -> Doc
PP.text ""
Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
PP.nest
2
(case Maybe Doc
syn of
Nothing -> Maybe (Maybe String, CommandDesc a) -> Doc
forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents Maybe (Maybe String, CommandDesc a)
mParent
Just s :: Doc
s -> Maybe (Maybe String, CommandDesc a) -> Doc
forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents Maybe (Maybe String, CommandDesc a)
mParent Doc -> Doc -> Doc
<+> String -> Doc
PP.text "-" Doc -> Doc -> Doc
<+> Doc
s
)
Doc -> Doc -> Doc
$+$ String -> Doc
PP.text ""
pparents :: Maybe (Maybe String, CommandDesc out) -> PP.Doc
pparents :: Maybe (Maybe String, CommandDesc out) -> Doc
pparents Nothing = Doc
PP.empty
pparents (Just (Just n :: String
n , cd :: CommandDesc out
cd)) = Maybe (Maybe String, CommandDesc out) -> Doc
forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents (CommandDesc out -> Maybe (Maybe String, CommandDesc out)
forall out.
CommandDesc out -> Maybe (Maybe String, CommandDesc out)
_cmd_mParent CommandDesc out
cd) Doc -> Doc -> Doc
PP.<+> String -> Doc
PP.text String
n
pparents (Just (Nothing, cd :: CommandDesc out
cd)) = Maybe (Maybe String, CommandDesc out) -> Doc
forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents (CommandDesc out -> Maybe (Maybe String, CommandDesc out)
forall out.
CommandDesc out -> Maybe (Maybe String, CommandDesc out)
_cmd_mParent CommandDesc out
cd)
usageSection :: Doc
usageSection = String -> Doc
PP.text "USAGE" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text "" Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
PP.nest 2 (CommandDesc a -> Doc
forall a. CommandDesc a -> Doc
ppUsage CommandDesc a
desc)
descriptionSection :: Doc
descriptionSection = case Maybe Doc
help of
Nothing -> Doc
PP.empty
Just h :: Doc
h ->
String -> Doc
PP.text "" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text "DESCRIPTION" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text "" Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
PP.nest 2 Doc
h
partsSection :: Doc
partsSection = if [Doc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
partsTuples
then Doc
PP.empty
else String -> Doc
PP.text "" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text "ARGUMENTS" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text "" Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
PP.nest
2
([Doc] -> Doc
PP.vcat [Doc]
partsTuples)
partsTuples :: [PP.Doc]
partsTuples :: [Doc]
partsTuples = [PartDesc]
parts [PartDesc] -> (PartDesc -> [Doc]) -> [Doc]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PartDesc -> [Doc]
go
where
go :: PartDesc -> [Doc]
go = \case
PartLiteral{} -> []
PartVariable{} -> []
PartOptional p :: PartDesc
p -> PartDesc -> [Doc]
go PartDesc
p
PartAlts ps :: [PartDesc]
ps -> [PartDesc]
ps [PartDesc] -> (PartDesc -> [Doc]) -> [Doc]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PartDesc -> [Doc]
go
PartSeq ps :: [PartDesc]
ps -> [PartDesc]
ps [PartDesc] -> (PartDesc -> [Doc]) -> [Doc]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PartDesc -> [Doc]
go
PartDefault _ p :: PartDesc
p -> PartDesc -> [Doc]
go PartDesc
p
PartSuggestion _ p :: PartDesc
p -> PartDesc -> [Doc]
go PartDesc
p
PartRedirect s :: String
s p :: PartDesc
p ->
[String -> Doc
PP.text String
s Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
PP.nest 20 (Doc -> Maybe Doc -> Doc
forall a. a -> Maybe a -> a
Maybe.fromMaybe Doc
PP.empty (Maybe Doc -> Doc) -> Maybe Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PartDesc -> Maybe Doc
ppPartDescUsage PartDesc
p)]
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Int -> Doc -> Doc
PP.nest 2 (Doc -> Doc) -> [Doc] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PartDesc -> [Doc]
go PartDesc
p)
PartReorder ps :: [PartDesc]
ps -> [PartDesc]
ps [PartDesc] -> (PartDesc -> [Doc]) -> [Doc]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PartDesc -> [Doc]
go
PartMany p :: PartDesc
p -> PartDesc -> [Doc]
go PartDesc
p
PartWithHelp doc :: Doc
doc p :: PartDesc
p -> [PartDesc -> Doc
ppPartDescHeader PartDesc
p Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
PP.nest 20 Doc
doc] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ PartDesc -> [Doc]
go PartDesc
p
PartHidden{} -> []
ppHelpDepthOne :: CommandDesc a -> PP.Doc
ppHelpDepthOne :: CommandDesc a -> Doc
ppHelpDepthOne desc :: CommandDesc a
desc =
Doc
nameSection
Doc -> Doc -> Doc
$+$ Doc
usageSection
Doc -> Doc -> Doc
$+$ Doc
descriptionSection
Doc -> Doc -> Doc
$+$ Doc
commandSection
Doc -> Doc -> Doc
$+$ Doc
partsSection
Doc -> Doc -> Doc
$+$ String -> Doc
PP.text ""
where
CommandDesc mParent :: Maybe (Maybe String, CommandDesc a)
mParent syn :: Maybe Doc
syn help :: Maybe Doc
help parts :: [PartDesc]
parts _out :: Maybe a
_out children :: Deque (Maybe String, CommandDesc a)
children _hidden :: Visibility
_hidden = CommandDesc a
desc
nameSection :: Doc
nameSection = case Maybe (Maybe String, CommandDesc a)
mParent of
Nothing -> Doc
PP.empty
Just{} ->
String -> Doc
PP.text "NAME"
Doc -> Doc -> Doc
$+$ String -> Doc
PP.text ""
Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
PP.nest
2
(case Maybe Doc
syn of
Nothing -> Maybe (Maybe String, CommandDesc a) -> Doc
forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents Maybe (Maybe String, CommandDesc a)
mParent
Just s :: Doc
s -> Maybe (Maybe String, CommandDesc a) -> Doc
forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents Maybe (Maybe String, CommandDesc a)
mParent Doc -> Doc -> Doc
<+> String -> Doc
PP.text "-" Doc -> Doc -> Doc
<+> Doc
s
)
Doc -> Doc -> Doc
$+$ String -> Doc
PP.text ""
pparents :: Maybe (Maybe String, CommandDesc out) -> PP.Doc
pparents :: Maybe (Maybe String, CommandDesc out) -> Doc
pparents Nothing = Doc
PP.empty
pparents (Just (Just n :: String
n , cd :: CommandDesc out
cd)) = Maybe (Maybe String, CommandDesc out) -> Doc
forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents (CommandDesc out -> Maybe (Maybe String, CommandDesc out)
forall out.
CommandDesc out -> Maybe (Maybe String, CommandDesc out)
_cmd_mParent CommandDesc out
cd) Doc -> Doc -> Doc
PP.<+> String -> Doc
PP.text String
n
pparents (Just (Nothing, cd :: CommandDesc out
cd)) = Maybe (Maybe String, CommandDesc out) -> Doc
forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents (CommandDesc out -> Maybe (Maybe String, CommandDesc out)
forall out.
CommandDesc out -> Maybe (Maybe String, CommandDesc out)
_cmd_mParent CommandDesc out
cd)
usageSection :: Doc
usageSection =
String -> Doc
PP.text "USAGE" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text "" Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
PP.nest 2 (CommandDesc a -> Doc
forall a. CommandDesc a -> Doc
ppUsageShortSub CommandDesc a
desc)
descriptionSection :: Doc
descriptionSection = case Maybe Doc
help of
Nothing -> Doc
PP.empty
Just h :: Doc
h ->
String -> Doc
PP.text "" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text "DESCRIPTION" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text "" Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
PP.nest 2 Doc
h
visibleChildren :: Deque (String, CommandDesc a)
visibleChildren =
[ (String
n, CommandDesc a
c) | (Just n :: String
n, c :: CommandDesc a
c) <- Deque (Maybe String, CommandDesc a)
children, CommandDesc a -> Visibility
forall out. CommandDesc out -> Visibility
_cmd_visibility CommandDesc a
c Visibility -> Visibility -> Bool
forall a. Eq a => a -> a -> Bool
== Visibility
Visible ]
childDescs :: Deque Doc
childDescs = Deque (String, CommandDesc a)
visibleChildren Deque (String, CommandDesc a)
-> ((String, CommandDesc a) -> Doc) -> Deque Doc
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(n :: String
n, c :: CommandDesc a
c) ->
String -> Doc
PP.text String
n Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
PP.nest 20 (Doc -> Maybe Doc -> Doc
forall a. a -> Maybe a -> a
Maybe.fromMaybe Doc
PP.empty (CommandDesc a -> Maybe Doc
forall out. CommandDesc out -> Maybe Doc
_cmd_synopsis CommandDesc a
c))
commandSection :: Doc
commandSection = if Deque (String, CommandDesc a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Deque (String, CommandDesc a)
visibleChildren
then Doc
PP.empty
else String -> Doc
PP.text "" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text "COMMANDS" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text "" Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
PP.nest
2
([Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Deque Doc -> [Doc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Deque Doc
childDescs)
partsSection :: Doc
partsSection = if [Doc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
partsTuples
then Doc
PP.empty
else String -> Doc
PP.text "" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text "ARGUMENTS" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text "" Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
PP.nest
2
([Doc] -> Doc
PP.vcat [Doc]
partsTuples)
partsTuples :: [PP.Doc]
partsTuples :: [Doc]
partsTuples = [PartDesc]
parts [PartDesc] -> (PartDesc -> [Doc]) -> [Doc]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PartDesc -> [Doc]
go
where
go :: PartDesc -> [Doc]
go = \case
PartLiteral{} -> []
PartVariable{} -> []
PartOptional p :: PartDesc
p -> PartDesc -> [Doc]
go PartDesc
p
PartAlts ps :: [PartDesc]
ps -> [PartDesc]
ps [PartDesc] -> (PartDesc -> [Doc]) -> [Doc]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PartDesc -> [Doc]
go
PartSeq ps :: [PartDesc]
ps -> [PartDesc]
ps [PartDesc] -> (PartDesc -> [Doc]) -> [Doc]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PartDesc -> [Doc]
go
PartDefault _ p :: PartDesc
p -> PartDesc -> [Doc]
go PartDesc
p
PartSuggestion _ p :: PartDesc
p -> PartDesc -> [Doc]
go PartDesc
p
PartRedirect s :: String
s p :: PartDesc
p ->
[String -> Doc
PP.text String
s Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
PP.nest 20 (Doc -> Maybe Doc -> Doc
forall a. a -> Maybe a -> a
Maybe.fromMaybe Doc
PP.empty (Maybe Doc -> Doc) -> Maybe Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PartDesc -> Maybe Doc
ppPartDescUsage PartDesc
p)]
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Int -> Doc -> Doc
PP.nest 2 (Doc -> Doc) -> [Doc] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PartDesc -> [Doc]
go PartDesc
p)
PartReorder ps :: [PartDesc]
ps -> [PartDesc]
ps [PartDesc] -> (PartDesc -> [Doc]) -> [Doc]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PartDesc -> [Doc]
go
PartMany p :: PartDesc
p -> PartDesc -> [Doc]
go PartDesc
p
PartWithHelp doc :: Doc
doc p :: PartDesc
p -> [PartDesc -> Doc
ppPartDescHeader PartDesc
p Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
PP.nest 20 Doc
doc] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ PartDesc -> [Doc]
go PartDesc
p
PartHidden{} -> []
ppPartDescUsage :: PartDesc -> Maybe PP.Doc
ppPartDescUsage :: PartDesc -> Maybe Doc
ppPartDescUsage = \case
PartLiteral s :: String
s -> Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
PP.text String
s
PartVariable s :: String
s -> Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
PP.text String
s
PartOptional p :: PartDesc
p -> Doc -> Doc
PP.brackets (Doc -> Doc) -> Maybe Doc -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PartDesc -> Maybe Doc
rec PartDesc
p
PartAlts ps :: [PartDesc]
ps ->
[ [Doc] -> Doc
PP.fcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
PP.punctuate (String -> Doc
PP.text ",") [Doc]
ds
| let ds :: [Doc]
ds = (PartDesc -> Maybe Doc) -> [PartDesc] -> [Doc]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe PartDesc -> Maybe Doc
rec [PartDesc]
ps
, Bool -> Bool
not ([Doc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
ds)
]
PartSeq ps :: [PartDesc]
ps -> [ [Doc] -> Doc
PP.fsep [Doc]
ds | let ds :: [Doc]
ds = (PartDesc -> Maybe Doc) -> [PartDesc] -> [Doc]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe PartDesc -> Maybe Doc
rec [PartDesc]
ps, Bool -> Bool
not ([Doc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
ds) ]
PartDefault _ p :: PartDesc
p -> Doc -> Doc
PP.brackets (Doc -> Doc) -> Maybe Doc -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PartDesc -> Maybe Doc
rec PartDesc
p
PartSuggestion sgs :: [CompletionItem]
sgs p :: PartDesc
p -> PartDesc -> Maybe Doc
rec PartDesc
p Maybe Doc -> (Doc -> Doc) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \d :: Doc
d ->
case [ String -> Doc
PP.text String
s | CompletionString s :: String
s <- [CompletionItem]
sgs ] of
[] -> Doc
d
sgsDocs :: [Doc]
sgsDocs ->
Doc -> Doc
PP.parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
PP.fcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
PP.punctuate (String -> Doc
PP.text "|") ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [Doc]
sgsDocs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
d]
PartRedirect s :: String
s _ -> Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
PP.text String
s
PartMany p :: PartDesc
p -> PartDesc -> Maybe Doc
rec PartDesc
p Maybe Doc -> (Doc -> Doc) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Doc -> Doc -> Doc
PP.<> String -> Doc
PP.text "+")
PartWithHelp _ p :: PartDesc
p -> PartDesc -> Maybe Doc
rec PartDesc
p
PartReorder ps :: [PartDesc]
ps ->
let flags :: [PartDesc]
flags = [ PartDesc
d | PartMany d :: PartDesc
d <- [PartDesc]
ps ]
params :: [PartDesc]
params = (PartDesc -> Bool) -> [PartDesc] -> [PartDesc]
forall a. (a -> Bool) -> [a] -> [a]
filter
(\case
PartMany{} -> Bool
False
_ -> Bool
True
)
[PartDesc]
ps
in Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
PP.sep
[ ([Doc] -> Doc
PP.fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
PP.brackets (Doc -> Doc) -> [Doc] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PartDesc -> Maybe Doc) -> [PartDesc] -> [Doc]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe PartDesc -> Maybe Doc
rec [PartDesc]
flags)
, [Doc] -> Doc
PP.fsep ((PartDesc -> Maybe Doc) -> [PartDesc] -> [Doc]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe PartDesc -> Maybe Doc
rec [PartDesc]
params)
]
PartHidden{} -> Maybe Doc
forall a. Maybe a
Nothing
where rec :: PartDesc -> Maybe Doc
rec = PartDesc -> Maybe Doc
ppPartDescUsage
ppPartDescHeader :: PartDesc -> PP.Doc
= \case
PartLiteral s :: String
s -> String -> Doc
PP.text String
s
PartVariable s :: String
s -> String -> Doc
PP.text String
s
PartOptional ds' :: PartDesc
ds' -> PartDesc -> Doc
rec PartDesc
ds'
PartAlts alts :: [PartDesc]
alts -> [Doc] -> Doc
PP.hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
List.intersperse (String -> Doc
PP.text ",") ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ PartDesc -> Doc
rec (PartDesc -> Doc) -> [PartDesc] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PartDesc]
alts
PartDefault _ d :: PartDesc
d -> PartDesc -> Doc
rec PartDesc
d
PartSuggestion _ d :: PartDesc
d -> PartDesc -> Doc
rec PartDesc
d
PartRedirect s :: String
s _ -> String -> Doc
PP.text String
s
PartMany ds :: PartDesc
ds -> PartDesc -> Doc
rec PartDesc
ds
PartWithHelp _ d :: PartDesc
d -> PartDesc -> Doc
rec PartDesc
d
PartSeq ds :: [PartDesc]
ds -> [Doc] -> Doc
PP.hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ PartDesc -> Doc
rec (PartDesc -> Doc) -> [PartDesc] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PartDesc]
ds
PartReorder ds :: [PartDesc]
ds -> [Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ PartDesc -> Doc
rec (PartDesc -> Doc) -> [PartDesc] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PartDesc]
ds
PartHidden d :: PartDesc
d -> PartDesc -> Doc
rec PartDesc
d
where rec :: PartDesc -> Doc
rec = PartDesc -> Doc
ppPartDescHeader
parsingErrorString :: ParsingError -> String
parsingErrorString :: ParsingError -> String
parsingErrorString (ParsingError mess :: [String]
mess remaining :: Input
remaining) =
"error parsing arguments: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
messStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
remainingStr
where
messStr :: String
messStr = case [String]
mess of
[] -> ""
(m :: String
m : _) -> String
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ " "
remainingStr :: String
remainingStr = case Input
remaining of
InputString "" -> "at the end of input."
InputString str :: String
str -> case String -> String
forall a. Show a => a -> String
show String
str of
s :: String
s | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 42 -> "at: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ "."
s :: String
s -> "at: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
take 40 String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ "..\"."
InputArgs [] -> "at the end of input"
InputArgs xs :: [String]
xs -> case [String] -> String
List.unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
xs of
s :: String
s | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 42 -> "at: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ "."
s :: String
s -> "at: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
take 40 String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ "..\"."