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 :: forall a. CommandDesc a -> Doc
ppUsage (CommandDesc Maybe (Maybe String, CommandDesc a)
mParent Maybe Doc
_syn Maybe Doc
_help [PartDesc]
parts Maybe a
out Deque (Maybe String, CommandDesc a)
children 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 :: forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents Maybe (Maybe String, CommandDesc out)
Nothing = Doc
PP.empty
pparents (Just (Just String
n , 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 (Maybe String
Nothing, 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 String
n, 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
Maybe a
_ | Deque (String, CommandDesc a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Deque (String, CommandDesc a)
visibleChildren -> Doc
PP.empty
Maybe a
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 String
" | ")
([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 :: forall a. CommandDesc a -> Doc
ppUsageShortSub (CommandDesc Maybe (Maybe String, CommandDesc a)
mParent Maybe Doc
_syn Maybe Doc
_help [PartDesc]
parts Maybe a
out Deque (Maybe String, CommandDesc a)
children 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 :: forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents Maybe (Maybe String, CommandDesc out)
Nothing = Doc
PP.empty
pparents (Just (Just String
n , 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 (Maybe String
Nothing, 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 String
n, 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
Maybe a
_ | Deque (String, CommandDesc a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Deque (String, CommandDesc a)
visibleChildren -> Doc
PP.empty
Maybe a
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 String
"<command>"
ppUsageWithHelp :: CommandDesc a -> PP.Doc
ppUsageWithHelp :: forall a. CommandDesc a -> Doc
ppUsageWithHelp (CommandDesc Maybe (Maybe String, CommandDesc a)
mParent Maybe Doc
_syn Maybe Doc
help [PartDesc]
parts Maybe a
out Deque (Maybe String, CommandDesc a)
children 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 :: forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents Maybe (Maybe String, CommandDesc out)
Nothing = Doc
PP.empty
pparents (Just (Just String
n , 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 (Maybe String
Nothing, 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
Maybe a
_ | Deque (Maybe String, CommandDesc a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Deque (Maybe String, CommandDesc a)
children -> Doc
PP.empty
Maybe a
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 String
" | ")
([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 String
n, 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
Maybe Doc
Nothing -> Doc
PP.empty
Just Doc
h -> String -> Doc
PP.text String
":" Doc -> Doc -> Doc
PP.<+> Doc
h
ppUsageAt
:: [String]
-> CommandDesc a
-> Maybe PP.Doc
ppUsageAt :: forall a. [String] -> CommandDesc a -> Maybe Doc
ppUsageAt [String]
strings 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 :: forall a. [String] -> CommandDesc a -> Maybe (CommandDesc a)
descendDescTo [String]
strings CommandDesc a
desc = case [String]
strings of
[] -> CommandDesc a -> Maybe (CommandDesc a)
forall a. a -> Maybe a
Just CommandDesc a
desc
(String
s : [String]
sr) -> do
(Maybe String
_, 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 :: forall a. CommandDesc a -> Doc
ppHelpShallow 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 String
""
where
CommandDesc Maybe (Maybe String, CommandDesc a)
mParent Maybe Doc
syn Maybe Doc
help [PartDesc]
parts Maybe a
_out Deque (Maybe String, CommandDesc a)
_children Visibility
_hidden = CommandDesc a
desc
nameSection :: Doc
nameSection = case Maybe (Maybe String, CommandDesc a)
mParent of
Maybe (Maybe String, CommandDesc a)
Nothing -> Doc
PP.empty
Just{} ->
String -> Doc
PP.text String
"NAME"
Doc -> Doc -> Doc
$+$ String -> Doc
PP.text String
""
Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
PP.nest
Int
2
(case Maybe Doc
syn of
Maybe Doc
Nothing -> Maybe (Maybe String, CommandDesc a) -> Doc
forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents Maybe (Maybe String, CommandDesc a)
mParent
Just 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 String
"-" Doc -> Doc -> Doc
<+> Doc
s
)
Doc -> Doc -> Doc
$+$ String -> Doc
PP.text String
""
pparents :: Maybe (Maybe String, CommandDesc out) -> PP.Doc
pparents :: forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents Maybe (Maybe String, CommandDesc out)
Nothing = Doc
PP.empty
pparents (Just (Just String
n , 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 (Maybe String
Nothing, 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 String
"USAGE" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text String
"" Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
PP.nest Int
2 (CommandDesc a -> Doc
forall a. CommandDesc a -> Doc
ppUsage CommandDesc a
desc)
descriptionSection :: Doc
descriptionSection = case Maybe Doc
help of
Maybe Doc
Nothing -> Doc
PP.empty
Just Doc
h ->
String -> Doc
PP.text String
"" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text String
"DESCRIPTION" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text String
"" Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
PP.nest Int
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 String
"" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text String
"ARGUMENTS" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text String
"" Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
PP.nest
Int
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 PartDesc
p -> PartDesc -> [Doc]
go PartDesc
p
PartAlts [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 [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 String
_ PartDesc
p -> PartDesc -> [Doc]
go PartDesc
p
PartSuggestion [CompletionItem]
_ PartDesc
p -> PartDesc -> [Doc]
go PartDesc
p
PartRedirect String
s PartDesc
p ->
[String -> Doc
PP.text String
s Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
PP.nest Int
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 Int
2 (Doc -> Doc) -> [Doc] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PartDesc -> [Doc]
go PartDesc
p)
PartReorder [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 PartDesc
p -> PartDesc -> [Doc]
go PartDesc
p
PartWithHelp Doc
doc PartDesc
p -> [PartDesc -> Doc
ppPartDescHeader PartDesc
p Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
PP.nest Int
20 Doc
doc] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ PartDesc -> [Doc]
go PartDesc
p
PartHidden{} -> []
ppHelpDepthOne :: CommandDesc a -> PP.Doc
ppHelpDepthOne :: forall a. CommandDesc a -> Doc
ppHelpDepthOne 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 String
""
where
CommandDesc Maybe (Maybe String, CommandDesc a)
mParent Maybe Doc
syn Maybe Doc
help [PartDesc]
parts Maybe a
_out Deque (Maybe String, CommandDesc a)
children Visibility
_hidden = CommandDesc a
desc
nameSection :: Doc
nameSection = case Maybe (Maybe String, CommandDesc a)
mParent of
Maybe (Maybe String, CommandDesc a)
Nothing -> Doc
PP.empty
Just{} ->
String -> Doc
PP.text String
"NAME"
Doc -> Doc -> Doc
$+$ String -> Doc
PP.text String
""
Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
PP.nest
Int
2
(case Maybe Doc
syn of
Maybe Doc
Nothing -> Maybe (Maybe String, CommandDesc a) -> Doc
forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents Maybe (Maybe String, CommandDesc a)
mParent
Just 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 String
"-" Doc -> Doc -> Doc
<+> Doc
s
)
Doc -> Doc -> Doc
$+$ String -> Doc
PP.text String
""
pparents :: Maybe (Maybe String, CommandDesc out) -> PP.Doc
pparents :: forall out. Maybe (Maybe String, CommandDesc out) -> Doc
pparents Maybe (Maybe String, CommandDesc out)
Nothing = Doc
PP.empty
pparents (Just (Just String
n , 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 (Maybe String
Nothing, 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 String
"USAGE" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text String
"" Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
PP.nest Int
2 (CommandDesc a -> Doc
forall a. CommandDesc a -> Doc
ppUsageShortSub CommandDesc a
desc)
descriptionSection :: Doc
descriptionSection = case Maybe Doc
help of
Maybe Doc
Nothing -> Doc
PP.empty
Just Doc
h ->
String -> Doc
PP.text String
"" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text String
"DESCRIPTION" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text String
"" Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
PP.nest Int
2 Doc
h
visibleChildren :: Deque (String, CommandDesc a)
visibleChildren =
[ (String
n, CommandDesc a
c) | (Just String
n, 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
<&> \(String
n, CommandDesc a
c) ->
String -> Doc
PP.text String
n Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
PP.nest Int
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 String
"" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text String
"COMMANDS" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text String
"" Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
PP.nest
Int
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 String
"" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text String
"ARGUMENTS" Doc -> Doc -> Doc
$+$ String -> Doc
PP.text String
"" Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
PP.nest
Int
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 PartDesc
p -> PartDesc -> [Doc]
go PartDesc
p
PartAlts [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 [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 String
_ PartDesc
p -> PartDesc -> [Doc]
go PartDesc
p
PartSuggestion [CompletionItem]
_ PartDesc
p -> PartDesc -> [Doc]
go PartDesc
p
PartRedirect String
s PartDesc
p ->
[String -> Doc
PP.text String
s Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
PP.nest Int
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 Int
2 (Doc -> Doc) -> [Doc] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PartDesc -> [Doc]
go PartDesc
p)
PartReorder [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 PartDesc
p -> PartDesc -> [Doc]
go PartDesc
p
PartWithHelp Doc
doc PartDesc
p -> [PartDesc -> Doc
ppPartDescHeader PartDesc
p Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
PP.nest Int
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 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 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 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 [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 String
",") [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 [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 String
_ 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 [CompletionItem]
sgs 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
d ->
case [ String -> Doc
PP.text String
s | CompletionString String
s <- [CompletionItem]
sgs ] of
[] -> Doc
d
[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 String
"|") ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [Doc]
sgsDocs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
d]
PartRedirect String
s PartDesc
_ -> 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 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 String
"+")
PartWithHelp Doc
_ PartDesc
p -> PartDesc -> Maybe Doc
rec PartDesc
p
PartReorder [PartDesc]
ps ->
let flags :: [PartDesc]
flags = [ PartDesc
d | PartMany PartDesc
d <- [PartDesc]
ps ]
params :: [PartDesc]
params = (PartDesc -> Bool) -> [PartDesc] -> [PartDesc]
forall a. (a -> Bool) -> [a] -> [a]
filter
(\case
PartMany{} -> Bool
False
PartDesc
_ -> 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 String
s -> String -> Doc
PP.text String
s
PartVariable String
s -> String -> Doc
PP.text String
s
PartOptional PartDesc
ds' -> PartDesc -> Doc
rec PartDesc
ds'
PartAlts [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 String
",") ([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 String
_ PartDesc
d -> PartDesc -> Doc
rec PartDesc
d
PartSuggestion [CompletionItem]
_ PartDesc
d -> PartDesc -> Doc
rec PartDesc
d
PartRedirect String
s PartDesc
_ -> String -> Doc
PP.text String
s
PartMany PartDesc
ds -> PartDesc -> Doc
rec PartDesc
ds
PartWithHelp Doc
_ PartDesc
d -> PartDesc -> Doc
rec PartDesc
d
PartSeq [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 [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 PartDesc
d -> PartDesc -> Doc
rec PartDesc
d
where rec :: PartDesc -> Doc
rec = PartDesc -> Doc
ppPartDescHeader
parsingErrorString :: ParsingError -> String
parsingErrorString :: ParsingError -> String
parsingErrorString (ParsingError [String]
mess Input
remaining) =
String
"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
[] -> String
""
(String
m : [String]
_) -> String
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
remainingStr :: String
remainingStr = case Input
remaining of
InputString String
"" -> String
"at the end of input."
InputString String
str -> case String -> String
forall a. Show a => a -> String
show String
str of
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
< Int
42 -> String
"at: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
String
s -> String
"at: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
40 String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..\"."
InputArgs [] -> String
"at the end of input"
InputArgs [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
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
< Int
42 -> String
"at: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
String
s -> String
"at: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
40 String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..\"."