module Options.Applicative.Help.Core (
cmdDesc,
briefDesc,
missingDesc,
fullDesc,
ParserHelp(..),
errorHelp,
headerHelp,
suggestionsHelp,
usageHelp,
bodyHelp,
footerHelp,
parserHelp,
parserUsage,
) where
import Control.Applicative
import Control.Monad (guard)
import Data.Function (on)
import Data.List (sort, intersperse, groupBy)
import Data.Foldable (any)
import Data.Maybe (maybeToList, catMaybes, fromMaybe)
import Data.Monoid (mempty)
import Data.Semigroup (Semigroup (..))
import Prelude hiding (any)
import Options.Applicative.Common
import Options.Applicative.Types
import Options.Applicative.Help.Pretty
import Options.Applicative.Help.Chunk
data OptDescStyle = OptDescStyle
{ OptDescStyle -> Doc
descSep :: Doc
, OptDescStyle -> Bool
descHidden :: Bool }
safelast :: [a] -> Maybe a
safelast :: [a] -> Maybe a
safelast = (Maybe a -> a -> Maybe a) -> Maybe a -> [a] -> Maybe a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((a -> Maybe a) -> Maybe a -> a -> Maybe a
forall a b. a -> b -> a
const a -> Maybe a
forall a. a -> Maybe a
Just) Maybe a
forall a. Maybe a
Nothing
optDesc :: ParserPrefs -> OptDescStyle -> OptHelpInfo -> Option a -> (Chunk Doc, Wrapping)
optDesc :: ParserPrefs
-> OptDescStyle -> OptHelpInfo -> Option a -> (Chunk Doc, Wrapping)
optDesc ParserPrefs
pprefs OptDescStyle
style OptHelpInfo
info Option a
opt =
let names :: [OptName]
names
= [OptName] -> [OptName]
forall a. Ord a => [a] -> [a]
sort ([OptName] -> [OptName])
-> (Option a -> [OptName]) -> Option a -> [OptName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptReader a -> [OptName]
forall a. OptReader a -> [OptName]
optionNames (OptReader a -> [OptName])
-> (Option a -> OptReader a) -> Option a -> [OptName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option a -> OptReader a
forall a. Option a -> OptReader a
optMain (Option a -> [OptName]) -> Option a -> [OptName]
forall a b. (a -> b) -> a -> b
$ Option a
opt
meta :: Chunk Doc
meta
= String -> Chunk Doc
stringChunk (String -> Chunk Doc) -> String -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ Option a -> String
forall a. Option a -> String
optMetaVar Option a
opt
descs :: [Doc]
descs
= (OptName -> Doc) -> [OptName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
string (String -> Doc) -> (OptName -> String) -> OptName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptName -> String
showOption) [OptName]
names
descriptions :: Chunk Doc
descriptions
= [Doc] -> Chunk Doc
forall a. Semigroup a => [a] -> Chunk a
listToChunk (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (OptDescStyle -> Doc
descSep OptDescStyle
style) [Doc]
descs)
desc :: Chunk Doc
desc
| ParserPrefs -> Bool
prefHelpLongEquals ParserPrefs
pprefs Bool -> Bool -> Bool
&& Bool -> Bool
not (Chunk Doc -> Bool
forall a. Chunk a -> Bool
isEmpty Chunk Doc
meta) Bool -> Bool -> Bool
&& (OptName -> Bool) -> Maybe OptName -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any OptName -> Bool
isLongName ([OptName] -> Maybe OptName
forall a. [a] -> Maybe a
safelast [OptName]
names)
= Chunk Doc
descriptions Chunk Doc -> Chunk Doc -> Chunk Doc
forall a. Semigroup a => a -> a -> a
<> String -> Chunk Doc
stringChunk String
"=" Chunk Doc -> Chunk Doc -> Chunk Doc
forall a. Semigroup a => a -> a -> a
<> Chunk Doc
meta
| Bool
otherwise
= Chunk Doc
descriptions Chunk Doc -> Chunk Doc -> Chunk Doc
<<+>> Chunk Doc
meta
show_opt :: Bool
show_opt
| Option a -> OptVisibility
forall a. Option a -> OptVisibility
optVisibility Option a
opt OptVisibility -> OptVisibility -> Bool
forall a. Eq a => a -> a -> Bool
== OptVisibility
Hidden
= OptDescStyle -> Bool
descHidden OptDescStyle
style
| Bool
otherwise
= Option a -> OptVisibility
forall a. Option a -> OptVisibility
optVisibility Option a
opt OptVisibility -> OptVisibility -> Bool
forall a. Eq a => a -> a -> Bool
== OptVisibility
Visible
suffix :: Chunk Doc
suffix
| OptHelpInfo -> Bool
hinfoMulti OptHelpInfo
info
= String -> Chunk Doc
stringChunk (String -> Chunk Doc)
-> (ParserPrefs -> String) -> ParserPrefs -> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserPrefs -> String
prefMultiSuffix (ParserPrefs -> Chunk Doc) -> ParserPrefs -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ ParserPrefs
pprefs
| Bool
otherwise
= Chunk Doc
forall a. Monoid a => a
mempty
wrapping :: Wrapping
wrapping
= Bool -> Wrapping
wrapIf ([OptName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [OptName]
names Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1)
rendered :: Chunk Doc
rendered
| Bool -> Bool
not Bool
show_opt
= Chunk Doc
forall a. Monoid a => a
mempty
| Bool
otherwise
= Chunk Doc
desc Chunk Doc -> Chunk Doc -> Chunk Doc
forall a. Semigroup a => a -> a -> a
<> Chunk Doc
suffix
modified :: Chunk Doc
modified
= (Chunk Doc -> Chunk Doc)
-> ((Doc -> Doc) -> Chunk Doc -> Chunk Doc)
-> Maybe (Doc -> Doc)
-> Chunk Doc
-> Chunk Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Chunk Doc -> Chunk Doc
forall a. a -> a
id (Doc -> Doc) -> Chunk Doc -> Chunk Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Option a -> Maybe (Doc -> Doc)
forall a. Option a -> Maybe (Doc -> Doc)
optDescMod Option a
opt) Chunk Doc
rendered
in (Chunk Doc
modified, Wrapping
wrapping)
cmdDesc :: Parser a -> [(Maybe String, Chunk Doc)]
cmdDesc :: Parser a -> [(Maybe String, Chunk Doc)]
cmdDesc = (forall x. OptHelpInfo -> Option x -> (Maybe String, Chunk Doc))
-> Parser a -> [(Maybe String, Chunk Doc)]
forall b a.
(forall x. OptHelpInfo -> Option x -> b) -> Parser a -> [b]
mapParser forall x. OptHelpInfo -> Option x -> (Maybe String, Chunk Doc)
forall p a. p -> Option a -> (Maybe String, Chunk Doc)
desc
where
desc :: p -> Option a -> (Maybe String, Chunk Doc)
desc p
_ Option a
opt =
case Option a -> OptReader a
forall a. Option a -> OptReader a
optMain Option a
opt of
CmdReader Maybe String
gn [String]
cmds String -> Maybe (ParserInfo a)
p -> (,) Maybe String
gn (Chunk Doc -> (Maybe String, Chunk Doc))
-> Chunk Doc -> (Maybe String, Chunk Doc)
forall a b. (a -> b) -> a -> b
$
[(Doc, Doc)] -> Chunk Doc
tabulate [(String -> Doc
string String
cmd, Doc -> Doc
align (Chunk Doc -> Doc
forall a. Monoid a => Chunk a -> a
extractChunk Chunk Doc
d))
| String
cmd <- [String] -> [String]
forall a. [a] -> [a]
reverse [String]
cmds
, Chunk Doc
d <- Maybe (Chunk Doc) -> [Chunk Doc]
forall a. Maybe a -> [a]
maybeToList (Maybe (Chunk Doc) -> [Chunk Doc])
-> (Maybe (ParserInfo a) -> Maybe (Chunk Doc))
-> Maybe (ParserInfo a)
-> [Chunk Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParserInfo a -> Chunk Doc)
-> Maybe (ParserInfo a) -> Maybe (Chunk Doc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParserInfo a -> Chunk Doc
forall a. ParserInfo a -> Chunk Doc
infoProgDesc (Maybe (ParserInfo a) -> [Chunk Doc])
-> Maybe (ParserInfo a) -> [Chunk Doc]
forall a b. (a -> b) -> a -> b
$ String -> Maybe (ParserInfo a)
p String
cmd ]
OptReader a
_ -> (Maybe String, Chunk Doc)
forall a. Monoid a => a
mempty
briefDesc :: ParserPrefs -> Parser a -> Chunk Doc
briefDesc :: ParserPrefs -> Parser a -> Chunk Doc
briefDesc = Bool -> ParserPrefs -> Parser a -> Chunk Doc
forall a. Bool -> ParserPrefs -> Parser a -> Chunk Doc
briefDesc' Bool
True
missingDesc :: ParserPrefs -> Parser a -> Chunk Doc
missingDesc :: ParserPrefs -> Parser a -> Chunk Doc
missingDesc = Bool -> ParserPrefs -> Parser a -> Chunk Doc
forall a. Bool -> ParserPrefs -> Parser a -> Chunk Doc
briefDesc' Bool
False
briefDesc' :: Bool -> ParserPrefs -> Parser a -> Chunk Doc
briefDesc' :: Bool -> ParserPrefs -> Parser a -> Chunk Doc
briefDesc' Bool
showOptional ParserPrefs
pprefs
= AltNodeType -> (Chunk Doc, Wrapping) -> Chunk Doc
wrap AltNodeType
NoDefault ((Chunk Doc, Wrapping) -> Chunk Doc)
-> (Parser a -> (Chunk Doc, Wrapping)) -> Parser a -> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptTree (Chunk Doc, Wrapping) -> (Chunk Doc, Wrapping)
foldTree (OptTree (Chunk Doc, Wrapping) -> (Chunk Doc, Wrapping))
-> (Parser a -> OptTree (Chunk Doc, Wrapping))
-> Parser a
-> (Chunk Doc, Wrapping)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptTree (Chunk Doc, Wrapping) -> OptTree (Chunk Doc, Wrapping)
forall a. OptTree a -> OptTree a
mfilterOptional (OptTree (Chunk Doc, Wrapping) -> OptTree (Chunk Doc, Wrapping))
-> (Parser a -> OptTree (Chunk Doc, Wrapping))
-> Parser a
-> OptTree (Chunk Doc, Wrapping)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. OptHelpInfo -> Option x -> (Chunk Doc, Wrapping))
-> Parser a -> OptTree (Chunk Doc, Wrapping)
forall b a.
(forall x. OptHelpInfo -> Option x -> b) -> Parser a -> OptTree b
treeMapParser (ParserPrefs
-> OptDescStyle -> OptHelpInfo -> Option x -> (Chunk Doc, Wrapping)
forall a.
ParserPrefs
-> OptDescStyle -> OptHelpInfo -> Option a -> (Chunk Doc, Wrapping)
optDesc ParserPrefs
pprefs OptDescStyle
style)
where
mfilterOptional :: OptTree a -> OptTree a
mfilterOptional
| Bool
showOptional
= OptTree a -> OptTree a
forall a. a -> a
id
| Bool
otherwise
= OptTree a -> OptTree a
forall a. OptTree a -> OptTree a
filterOptional
style :: OptDescStyle
style = OptDescStyle :: Doc -> Bool -> OptDescStyle
OptDescStyle
{ descSep :: Doc
descSep = String -> Doc
string String
"|"
, descHidden :: Bool
descHidden = Bool
False }
wrap :: AltNodeType -> (Chunk Doc, Wrapping) -> Chunk Doc
wrap :: AltNodeType -> (Chunk Doc, Wrapping) -> Chunk Doc
wrap AltNodeType
altnode (Chunk Doc
chunk, Wrapping
wrapping)
| AltNodeType
altnode AltNodeType -> AltNodeType -> Bool
forall a. Eq a => a -> a -> Bool
== AltNodeType
MarkDefault
= (Doc -> Doc) -> Chunk Doc -> Chunk Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Doc
brackets Chunk Doc
chunk
| Wrapping -> Bool
needsWrapping Wrapping
wrapping
= (Doc -> Doc) -> Chunk Doc -> Chunk Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Doc
parens Chunk Doc
chunk
| Bool
otherwise
= Chunk Doc
chunk
foldTree :: OptTree (Chunk Doc, Wrapping) -> (Chunk Doc, Wrapping)
foldTree :: OptTree (Chunk Doc, Wrapping) -> (Chunk Doc, Wrapping)
foldTree (Leaf (Chunk Doc, Wrapping)
x)
= (Chunk Doc, Wrapping)
x
foldTree (MultNode [OptTree (Chunk Doc, Wrapping)]
xs)
= ((OptTree (Chunk Doc, Wrapping) -> Chunk Doc -> Chunk Doc)
-> Chunk Doc -> [OptTree (Chunk Doc, Wrapping)] -> Chunk Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Chunk Doc -> Chunk Doc -> Chunk Doc
(<</>>) (Chunk Doc -> Chunk Doc -> Chunk Doc)
-> (OptTree (Chunk Doc, Wrapping) -> Chunk Doc)
-> OptTree (Chunk Doc, Wrapping)
-> Chunk Doc
-> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AltNodeType -> (Chunk Doc, Wrapping) -> Chunk Doc
wrap AltNodeType
NoDefault ((Chunk Doc, Wrapping) -> Chunk Doc)
-> (OptTree (Chunk Doc, Wrapping) -> (Chunk Doc, Wrapping))
-> OptTree (Chunk Doc, Wrapping)
-> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptTree (Chunk Doc, Wrapping) -> (Chunk Doc, Wrapping)
foldTree) Chunk Doc
forall a. Monoid a => a
mempty [OptTree (Chunk Doc, Wrapping)]
xs, Wrapping
Bare)
foldTree (AltNode AltNodeType
b [OptTree (Chunk Doc, Wrapping)]
xs)
= (\Chunk Doc
x -> (Chunk Doc
x, Wrapping
Bare))
(Chunk Doc -> (Chunk Doc, Wrapping))
-> ([OptTree (Chunk Doc, Wrapping)] -> Chunk Doc)
-> [OptTree (Chunk Doc, Wrapping)]
-> (Chunk Doc, Wrapping)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc) -> Chunk Doc -> Chunk Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Doc
groupOrNestLine
(Chunk Doc -> Chunk Doc)
-> ([OptTree (Chunk Doc, Wrapping)] -> Chunk Doc)
-> [OptTree (Chunk Doc, Wrapping)]
-> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AltNodeType -> (Chunk Doc, Wrapping) -> Chunk Doc
wrap AltNodeType
b
((Chunk Doc, Wrapping) -> Chunk Doc)
-> ([OptTree (Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping))
-> [OptTree (Chunk Doc, Wrapping)]
-> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping)
alt_node
([(Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping))
-> ([OptTree (Chunk Doc, Wrapping)] -> [(Chunk Doc, Wrapping)])
-> [OptTree (Chunk Doc, Wrapping)]
-> (Chunk Doc, Wrapping)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Chunk Doc, Wrapping) -> Bool)
-> [(Chunk Doc, Wrapping)] -> [(Chunk Doc, Wrapping)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Chunk Doc, Wrapping) -> Bool) -> (Chunk Doc, Wrapping) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk Doc -> Bool
forall a. Chunk a -> Bool
isEmpty (Chunk Doc -> Bool)
-> ((Chunk Doc, Wrapping) -> Chunk Doc)
-> (Chunk Doc, Wrapping)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chunk Doc, Wrapping) -> Chunk Doc
forall a b. (a, b) -> a
fst)
([(Chunk Doc, Wrapping)] -> [(Chunk Doc, Wrapping)])
-> ([OptTree (Chunk Doc, Wrapping)] -> [(Chunk Doc, Wrapping)])
-> [OptTree (Chunk Doc, Wrapping)]
-> [(Chunk Doc, Wrapping)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OptTree (Chunk Doc, Wrapping) -> (Chunk Doc, Wrapping))
-> [OptTree (Chunk Doc, Wrapping)] -> [(Chunk Doc, Wrapping)]
forall a b. (a -> b) -> [a] -> [b]
map OptTree (Chunk Doc, Wrapping) -> (Chunk Doc, Wrapping)
foldTree ([OptTree (Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping))
-> [OptTree (Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping)
forall a b. (a -> b) -> a -> b
$ [OptTree (Chunk Doc, Wrapping)]
xs
where
alt_node :: [(Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping)
alt_node :: [(Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping)
alt_node [(Chunk Doc, Wrapping)
n] = (Chunk Doc, Wrapping)
n
alt_node [(Chunk Doc, Wrapping)]
ns = (\Chunk Doc
y -> (Chunk Doc
y, Wrapping
Wrapped))
(Chunk Doc -> (Chunk Doc, Wrapping))
-> ([(Chunk Doc, Wrapping)] -> Chunk Doc)
-> [(Chunk Doc, Wrapping)]
-> (Chunk Doc, Wrapping)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Chunk Doc, Wrapping) -> Chunk Doc -> Chunk Doc)
-> Chunk Doc -> [(Chunk Doc, Wrapping)] -> Chunk Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Doc -> Doc -> Doc) -> Chunk Doc -> Chunk Doc -> Chunk Doc
forall a. (a -> a -> a) -> Chunk a -> Chunk a -> Chunk a
chunked Doc -> Doc -> Doc
altSep (Chunk Doc -> Chunk Doc -> Chunk Doc)
-> ((Chunk Doc, Wrapping) -> Chunk Doc)
-> (Chunk Doc, Wrapping)
-> Chunk Doc
-> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AltNodeType -> (Chunk Doc, Wrapping) -> Chunk Doc
wrap AltNodeType
NoDefault) Chunk Doc
forall a. Monoid a => a
mempty
([(Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping))
-> [(Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping)
forall a b. (a -> b) -> a -> b
$ [(Chunk Doc, Wrapping)]
ns
fullDesc :: ParserPrefs -> Parser a -> Chunk Doc
fullDesc :: ParserPrefs -> Parser a -> Chunk Doc
fullDesc ParserPrefs
pprefs = [(Doc, Doc)] -> Chunk Doc
tabulate ([(Doc, Doc)] -> Chunk Doc)
-> (Parser a -> [(Doc, Doc)]) -> Parser a -> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Doc, Doc)] -> [(Doc, Doc)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Doc, Doc)] -> [(Doc, Doc)])
-> (Parser a -> [Maybe (Doc, Doc)]) -> Parser a -> [(Doc, Doc)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. OptHelpInfo -> Option x -> Maybe (Doc, Doc))
-> Parser a -> [Maybe (Doc, Doc)]
forall b a.
(forall x. OptHelpInfo -> Option x -> b) -> Parser a -> [b]
mapParser forall x. OptHelpInfo -> Option x -> Maybe (Doc, Doc)
forall (m :: * -> *) a.
(Monad m, Alternative m) =>
OptHelpInfo -> Option a -> m (Doc, Doc)
doc
where
doc :: OptHelpInfo -> Option a -> m (Doc, Doc)
doc OptHelpInfo
info Option a
opt = do
Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> (Chunk Doc -> Bool) -> Chunk Doc -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (Chunk Doc -> Bool) -> Chunk Doc -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk Doc -> Bool
forall a. Chunk a -> Bool
isEmpty (Chunk Doc -> m ()) -> Chunk Doc -> m ()
forall a b. (a -> b) -> a -> b
$ Chunk Doc
n
Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> (Chunk Doc -> Bool) -> Chunk Doc -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (Chunk Doc -> Bool) -> Chunk Doc -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk Doc -> Bool
forall a. Chunk a -> Bool
isEmpty (Chunk Doc -> m ()) -> Chunk Doc -> m ()
forall a b. (a -> b) -> a -> b
$ Chunk Doc
h
(Doc, Doc) -> m (Doc, Doc)
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunk Doc -> Doc
forall a. Monoid a => Chunk a -> a
extractChunk Chunk Doc
n, Doc -> Doc
align (Doc -> Doc) -> (Chunk Doc -> Doc) -> Chunk Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk Doc -> Doc
forall a. Monoid a => Chunk a -> a
extractChunk (Chunk Doc -> Doc) -> Chunk Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Chunk Doc
h Chunk Doc -> Chunk Doc -> Chunk Doc
<<+>> Chunk Doc
hdef)
where
n :: Chunk Doc
n = (Chunk Doc, Wrapping) -> Chunk Doc
forall a b. (a, b) -> a
fst ((Chunk Doc, Wrapping) -> Chunk Doc)
-> (Chunk Doc, Wrapping) -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ ParserPrefs
-> OptDescStyle -> OptHelpInfo -> Option a -> (Chunk Doc, Wrapping)
forall a.
ParserPrefs
-> OptDescStyle -> OptHelpInfo -> Option a -> (Chunk Doc, Wrapping)
optDesc ParserPrefs
pprefs OptDescStyle
style OptHelpInfo
info Option a
opt
h :: Chunk Doc
h = Option a -> Chunk Doc
forall a. Option a -> Chunk Doc
optHelp Option a
opt
hdef :: Chunk Doc
hdef = Maybe Doc -> Chunk Doc
forall a. Maybe a -> Chunk a
Chunk (Maybe Doc -> Chunk Doc)
-> (Option a -> Maybe Doc) -> Option a -> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> Maybe String -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Doc
show_def (Maybe String -> Maybe Doc)
-> (Option a -> Maybe String) -> Option a -> Maybe Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option a -> Maybe String
forall a. Option a -> Maybe String
optShowDefault (Option a -> Chunk Doc) -> Option a -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ Option a
opt
show_def :: String -> Doc
show_def String
s = Doc -> Doc
parens (String -> Doc
string String
"default:" Doc -> Doc -> Doc
<+> String -> Doc
string String
s)
style :: OptDescStyle
style = OptDescStyle :: Doc -> Bool -> OptDescStyle
OptDescStyle
{ descSep :: Doc
descSep = String -> Doc
string String
","
, descHidden :: Bool
descHidden = Bool
True }
errorHelp :: Chunk Doc -> ParserHelp
errorHelp :: Chunk Doc -> ParserHelp
errorHelp Chunk Doc
chunk = ParserHelp
forall a. Monoid a => a
mempty { helpError :: Chunk Doc
helpError = Chunk Doc
chunk }
headerHelp :: Chunk Doc -> ParserHelp
Chunk Doc
chunk = ParserHelp
forall a. Monoid a => a
mempty { helpHeader :: Chunk Doc
helpHeader = Chunk Doc
chunk }
suggestionsHelp :: Chunk Doc -> ParserHelp
suggestionsHelp :: Chunk Doc -> ParserHelp
suggestionsHelp Chunk Doc
chunk = ParserHelp
forall a. Monoid a => a
mempty { helpSuggestions :: Chunk Doc
helpSuggestions = Chunk Doc
chunk }
usageHelp :: Chunk Doc -> ParserHelp
usageHelp :: Chunk Doc -> ParserHelp
usageHelp Chunk Doc
chunk = ParserHelp
forall a. Monoid a => a
mempty { helpUsage :: Chunk Doc
helpUsage = Chunk Doc
chunk }
bodyHelp :: Chunk Doc -> ParserHelp
bodyHelp :: Chunk Doc -> ParserHelp
bodyHelp Chunk Doc
chunk = ParserHelp
forall a. Monoid a => a
mempty { helpBody :: Chunk Doc
helpBody = Chunk Doc
chunk }
footerHelp :: Chunk Doc -> ParserHelp
Chunk Doc
chunk = ParserHelp
forall a. Monoid a => a
mempty { helpFooter :: Chunk Doc
helpFooter = Chunk Doc
chunk }
parserHelp :: ParserPrefs -> Parser a -> ParserHelp
parserHelp :: ParserPrefs -> Parser a -> ParserHelp
parserHelp ParserPrefs
pprefs Parser a
p = Chunk Doc -> ParserHelp
bodyHelp (Chunk Doc -> ParserHelp)
-> ([Chunk Doc] -> Chunk Doc) -> [Chunk Doc] -> ParserHelp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Chunk Doc] -> Chunk Doc
vsepChunks
([Chunk Doc] -> ParserHelp) -> [Chunk Doc] -> ParserHelp
forall a b. (a -> b) -> a -> b
$ String -> Chunk Doc -> Chunk Doc
with_title String
"Available options:" (ParserPrefs -> Parser a -> Chunk Doc
forall a. ParserPrefs -> Parser a -> Chunk Doc
fullDesc ParserPrefs
pprefs Parser a
p)
Chunk Doc -> [Chunk Doc] -> [Chunk Doc]
forall a. a -> [a] -> [a]
: ([(Maybe String, Chunk Doc)] -> Chunk Doc
group_title ([(Maybe String, Chunk Doc)] -> Chunk Doc)
-> [[(Maybe String, Chunk Doc)]] -> [Chunk Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[(Maybe String, Chunk Doc)]]
cs)
where
def :: String
def = String
"Available commands:"
cs :: [[(Maybe String, Chunk Doc)]]
cs = ((Maybe String, Chunk Doc) -> (Maybe String, Chunk Doc) -> Bool)
-> [(Maybe String, Chunk Doc)] -> [[(Maybe String, Chunk Doc)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe String -> Maybe String -> Bool)
-> ((Maybe String, Chunk Doc) -> Maybe String)
-> (Maybe String, Chunk Doc)
-> (Maybe String, Chunk Doc)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Maybe String, Chunk Doc) -> Maybe String
forall a b. (a, b) -> a
fst) ([(Maybe String, Chunk Doc)] -> [[(Maybe String, Chunk Doc)]])
-> [(Maybe String, Chunk Doc)] -> [[(Maybe String, Chunk Doc)]]
forall a b. (a -> b) -> a -> b
$ Parser a -> [(Maybe String, Chunk Doc)]
forall a. Parser a -> [(Maybe String, Chunk Doc)]
cmdDesc Parser a
p
group_title :: [(Maybe String, Chunk Doc)] -> Chunk Doc
group_title a :: [(Maybe String, Chunk Doc)]
a@((Maybe String
n,Chunk Doc
_):[(Maybe String, Chunk Doc)]
_) = String -> Chunk Doc -> Chunk Doc
with_title (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
def Maybe String
n) (Chunk Doc -> Chunk Doc) -> Chunk Doc -> Chunk Doc
forall a b. (a -> b) -> a -> b
$
[Chunk Doc] -> Chunk Doc
vcatChunks ((Maybe String, Chunk Doc) -> Chunk Doc
forall a b. (a, b) -> b
snd ((Maybe String, Chunk Doc) -> Chunk Doc)
-> [(Maybe String, Chunk Doc)] -> [Chunk Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe String, Chunk Doc)]
a)
group_title [(Maybe String, Chunk Doc)]
_ = Chunk Doc
forall a. Monoid a => a
mempty
with_title :: String -> Chunk Doc -> Chunk Doc
with_title :: String -> Chunk Doc -> Chunk Doc
with_title String
title = (Doc -> Doc) -> Chunk Doc -> Chunk Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Doc
string String
title Doc -> Doc -> Doc
.$.)
parserUsage :: ParserPrefs -> Parser a -> String -> Doc
parserUsage :: ParserPrefs -> Parser a -> String -> Doc
parserUsage ParserPrefs
pprefs Parser a
p String
progn = [Doc] -> Doc
hsep
[ String -> Doc
string String
"Usage:"
, String -> Doc
string String
progn
, Doc -> Doc
align (Chunk Doc -> Doc
forall a. Monoid a => Chunk a -> a
extractChunk (ParserPrefs -> Parser a -> Chunk Doc
forall a. ParserPrefs -> Parser a -> Chunk Doc
briefDesc ParserPrefs
pprefs Parser a
p)) ]
data Wrapping
= Bare
| Wrapped
deriving (Wrapping -> Wrapping -> Bool
(Wrapping -> Wrapping -> Bool)
-> (Wrapping -> Wrapping -> Bool) -> Eq Wrapping
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Wrapping -> Wrapping -> Bool
$c/= :: Wrapping -> Wrapping -> Bool
== :: Wrapping -> Wrapping -> Bool
$c== :: Wrapping -> Wrapping -> Bool
Eq, Int -> Wrapping -> ShowS
[Wrapping] -> ShowS
Wrapping -> String
(Int -> Wrapping -> ShowS)
-> (Wrapping -> String) -> ([Wrapping] -> ShowS) -> Show Wrapping
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Wrapping] -> ShowS
$cshowList :: [Wrapping] -> ShowS
show :: Wrapping -> String
$cshow :: Wrapping -> String
showsPrec :: Int -> Wrapping -> ShowS
$cshowsPrec :: Int -> Wrapping -> ShowS
Show)
wrapIf :: Bool -> Wrapping
wrapIf :: Bool -> Wrapping
wrapIf Bool
b = if Bool
b then Wrapping
Wrapped else Wrapping
Bare
needsWrapping :: Wrapping -> Bool
needsWrapping :: Wrapping -> Bool
needsWrapping = Wrapping -> Wrapping -> Bool
forall a. Eq a => a -> a -> Bool
(==) Wrapping
Wrapped