{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module OptEnvConf.Doc
  ( renderVersionPage,
    parserDocs,
    renderHelpPage,
    renderManPage,
    renderReferenceDocumentation,
    parserOptDocs,
    renderLongOptDocs,
    renderShortOptDocs,
    parserEnvDocs,
    renderEnvDocs,
    parserConfDocs,
    renderConfDocs,

    -- * Internal
    AnyDocs (..),
    SetDoc (..),
    OptDoc (..),
    EnvDoc (..),
    ConfDoc (..),
    settingSetDoc,
    renderSetDoc,
    settingOptDoc,
    renderOptDocLong,
    settingEnvDoc,
    renderEnvDoc,
    settingConfDoc,
    renderConfDoc,
    helpLines,
  )
where

import Autodocodec.Schema
import Autodocodec.Yaml.Schema
import Control.Arrow
import Control.Monad
import Data.List (intercalate, intersperse)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import Data.Version
import OptEnvConf.Args (Dashed (..))
import qualified OptEnvConf.Args as Args
import OptEnvConf.Parser
import OptEnvConf.Setting
import Text.Colour
import Text.Colour.Layout

data SetDoc = SetDoc
  { SetDoc -> Bool
setDocTryArgument :: !Bool,
    SetDoc -> Bool
setDocTrySwitch :: !Bool,
    SetDoc -> Bool
setDocTryOption :: !Bool,
    SetDoc -> [Dashed]
setDocDasheds :: ![Dashed],
    SetDoc -> Maybe (NonEmpty [Char])
setDocEnvVars :: !(Maybe (NonEmpty String)),
    SetDoc -> Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
setDocConfKeys :: !(Maybe (NonEmpty (NonEmpty String, JSONSchema))),
    SetDoc -> Maybe [Char]
setDocDefault :: !(Maybe String),
    SetDoc -> Maybe [Char]
setDocMetavar :: !(Maybe Metavar),
    SetDoc -> Maybe [Char]
setDocHelp :: !(Maybe String)
  }
  deriving (Int -> SetDoc -> ShowS
[SetDoc] -> ShowS
SetDoc -> [Char]
(Int -> SetDoc -> ShowS)
-> (SetDoc -> [Char]) -> ([SetDoc] -> ShowS) -> Show SetDoc
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetDoc -> ShowS
showsPrec :: Int -> SetDoc -> ShowS
$cshow :: SetDoc -> [Char]
show :: SetDoc -> [Char]
$cshowList :: [SetDoc] -> ShowS
showList :: [SetDoc] -> ShowS
Show)

data OptDoc = OptDoc
  { OptDoc -> Bool
optDocTryArgument :: !Bool,
    OptDoc -> Bool
optDocTrySwitch :: !Bool,
    OptDoc -> Bool
optDocTryOption :: !Bool,
    OptDoc -> [Dashed]
optDocDasheds :: ![Dashed],
    OptDoc -> Maybe [Char]
optDocDefault :: !(Maybe String),
    OptDoc -> Maybe [Char]
optDocMetavar :: !(Maybe Metavar),
    OptDoc -> Maybe [Char]
optDocHelp :: !(Maybe String)
  }
  deriving (Int -> OptDoc -> ShowS
[OptDoc] -> ShowS
OptDoc -> [Char]
(Int -> OptDoc -> ShowS)
-> (OptDoc -> [Char]) -> ([OptDoc] -> ShowS) -> Show OptDoc
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OptDoc -> ShowS
showsPrec :: Int -> OptDoc -> ShowS
$cshow :: OptDoc -> [Char]
show :: OptDoc -> [Char]
$cshowList :: [OptDoc] -> ShowS
showList :: [OptDoc] -> ShowS
Show)

data EnvDoc = EnvDoc
  { EnvDoc -> NonEmpty [Char]
envDocVars :: !(NonEmpty String),
    EnvDoc -> Maybe [Char]
envDocDefault :: !(Maybe String),
    EnvDoc -> Maybe [Char]
envDocMetavar :: !(Maybe Metavar),
    EnvDoc -> Maybe [Char]
envDocHelp :: !(Maybe String)
  }
  deriving (Int -> EnvDoc -> ShowS
[EnvDoc] -> ShowS
EnvDoc -> [Char]
(Int -> EnvDoc -> ShowS)
-> (EnvDoc -> [Char]) -> ([EnvDoc] -> ShowS) -> Show EnvDoc
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnvDoc -> ShowS
showsPrec :: Int -> EnvDoc -> ShowS
$cshow :: EnvDoc -> [Char]
show :: EnvDoc -> [Char]
$cshowList :: [EnvDoc] -> ShowS
showList :: [EnvDoc] -> ShowS
Show)

data ConfDoc = ConfDoc
  { ConfDoc -> NonEmpty (NonEmpty [Char], JSONSchema)
confDocKeys :: !(NonEmpty (NonEmpty String, JSONSchema)),
    ConfDoc -> Maybe [Char]
confDocDefault :: !(Maybe String),
    ConfDoc -> Maybe [Char]
confDocHelp :: !(Maybe String)
  }
  deriving (Int -> ConfDoc -> ShowS
[ConfDoc] -> ShowS
ConfDoc -> [Char]
(Int -> ConfDoc -> ShowS)
-> (ConfDoc -> [Char]) -> ([ConfDoc] -> ShowS) -> Show ConfDoc
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfDoc -> ShowS
showsPrec :: Int -> ConfDoc -> ShowS
$cshow :: ConfDoc -> [Char]
show :: ConfDoc -> [Char]
$cshowList :: [ConfDoc] -> ShowS
showList :: [ConfDoc] -> ShowS
Show)

data AnyDocs a
  = AnyDocsCommands [CommandDoc a]
  | AnyDocsAnd ![AnyDocs a]
  | AnyDocsOr ![AnyDocs a]
  | AnyDocsSingle !a
  deriving (Int -> AnyDocs a -> ShowS
[AnyDocs a] -> ShowS
AnyDocs a -> [Char]
(Int -> AnyDocs a -> ShowS)
-> (AnyDocs a -> [Char])
-> ([AnyDocs a] -> ShowS)
-> Show (AnyDocs a)
forall a. Show a => Int -> AnyDocs a -> ShowS
forall a. Show a => [AnyDocs a] -> ShowS
forall a. Show a => AnyDocs a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> AnyDocs a -> ShowS
showsPrec :: Int -> AnyDocs a -> ShowS
$cshow :: forall a. Show a => AnyDocs a -> [Char]
show :: AnyDocs a -> [Char]
$cshowList :: forall a. Show a => [AnyDocs a] -> ShowS
showList :: [AnyDocs a] -> ShowS
Show)

instance Functor AnyDocs where
  fmap :: forall a b. (a -> b) -> AnyDocs a -> AnyDocs b
fmap a -> b
f = \case
    AnyDocsCommands [CommandDoc a]
cs -> [CommandDoc b] -> AnyDocs b
forall a. [CommandDoc a] -> AnyDocs a
AnyDocsCommands ([CommandDoc b] -> AnyDocs b) -> [CommandDoc b] -> AnyDocs b
forall a b. (a -> b) -> a -> b
$ (CommandDoc a -> CommandDoc b) -> [CommandDoc a] -> [CommandDoc b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> CommandDoc a -> CommandDoc b
forall a b. (a -> b) -> CommandDoc a -> CommandDoc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [CommandDoc a]
cs
    AnyDocsAnd [AnyDocs a]
as -> [AnyDocs b] -> AnyDocs b
forall a. [AnyDocs a] -> AnyDocs a
AnyDocsAnd ([AnyDocs b] -> AnyDocs b) -> [AnyDocs b] -> AnyDocs b
forall a b. (a -> b) -> a -> b
$ (AnyDocs a -> AnyDocs b) -> [AnyDocs a] -> [AnyDocs b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> AnyDocs a -> AnyDocs b
forall a b. (a -> b) -> AnyDocs a -> AnyDocs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [AnyDocs a]
as
    AnyDocsOr [AnyDocs a]
as -> [AnyDocs b] -> AnyDocs b
forall a. [AnyDocs a] -> AnyDocs a
AnyDocsOr ([AnyDocs b] -> AnyDocs b) -> [AnyDocs b] -> AnyDocs b
forall a b. (a -> b) -> a -> b
$ (AnyDocs a -> AnyDocs b) -> [AnyDocs a] -> [AnyDocs b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> AnyDocs a -> AnyDocs b
forall a b. (a -> b) -> AnyDocs a -> AnyDocs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [AnyDocs a]
as
    AnyDocsSingle a
a -> b -> AnyDocs b
forall a. a -> AnyDocs a
AnyDocsSingle (b -> AnyDocs b) -> b -> AnyDocs b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a

instance Foldable AnyDocs where
  foldMap :: forall m a. Monoid m => (a -> m) -> AnyDocs a -> m
foldMap a -> m
f = \case
    AnyDocsCommands [CommandDoc a]
cs -> (CommandDoc a -> m) -> [CommandDoc a] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> CommandDoc a -> m
forall m a. Monoid m => (a -> m) -> CommandDoc a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) [CommandDoc a]
cs
    AnyDocsAnd [AnyDocs a]
as -> (AnyDocs a -> m) -> [AnyDocs a] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> AnyDocs a -> m
forall m a. Monoid m => (a -> m) -> AnyDocs a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) [AnyDocs a]
as
    AnyDocsOr [AnyDocs a]
as -> (AnyDocs a -> m) -> [AnyDocs a] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> AnyDocs a -> m
forall m a. Monoid m => (a -> m) -> AnyDocs a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) [AnyDocs a]
as
    AnyDocsSingle a
a -> a -> m
f a
a

instance Traversable AnyDocs where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AnyDocs a -> f (AnyDocs b)
traverse a -> f b
f = \case
    AnyDocsCommands [CommandDoc a]
cs -> [CommandDoc b] -> AnyDocs b
forall a. [CommandDoc a] -> AnyDocs a
AnyDocsCommands ([CommandDoc b] -> AnyDocs b) -> f [CommandDoc b] -> f (AnyDocs b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CommandDoc a -> f (CommandDoc b))
-> [CommandDoc a] -> f [CommandDoc b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((a -> f b) -> CommandDoc a -> f (CommandDoc b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CommandDoc a -> f (CommandDoc b)
traverse a -> f b
f) [CommandDoc a]
cs
    AnyDocsAnd [AnyDocs a]
as -> [AnyDocs b] -> AnyDocs b
forall a. [AnyDocs a] -> AnyDocs a
AnyDocsAnd ([AnyDocs b] -> AnyDocs b) -> f [AnyDocs b] -> f (AnyDocs b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AnyDocs a -> f (AnyDocs b)) -> [AnyDocs a] -> f [AnyDocs b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((a -> f b) -> AnyDocs a -> f (AnyDocs b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AnyDocs a -> f (AnyDocs b)
traverse a -> f b
f) [AnyDocs a]
as
    AnyDocsOr [AnyDocs a]
as -> [AnyDocs b] -> AnyDocs b
forall a. [AnyDocs a] -> AnyDocs a
AnyDocsOr ([AnyDocs b] -> AnyDocs b) -> f [AnyDocs b] -> f (AnyDocs b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AnyDocs a -> f (AnyDocs b)) -> [AnyDocs a] -> f [AnyDocs b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((a -> f b) -> AnyDocs a -> f (AnyDocs b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AnyDocs a -> f (AnyDocs b)
traverse a -> f b
f) [AnyDocs a]
as
    AnyDocsSingle a
a -> b -> AnyDocs b
forall a. a -> AnyDocs a
AnyDocsSingle (b -> AnyDocs b) -> f b -> f (AnyDocs b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a

data CommandDoc a = CommandDoc
  { forall a. CommandDoc a -> [Char]
commandDocArgument :: String,
    forall a. CommandDoc a -> [Char]
commandDocHelp :: Help,
    forall a. CommandDoc a -> AnyDocs a
commandDocs :: AnyDocs a
  }
  deriving (Int -> CommandDoc a -> ShowS
[CommandDoc a] -> ShowS
CommandDoc a -> [Char]
(Int -> CommandDoc a -> ShowS)
-> (CommandDoc a -> [Char])
-> ([CommandDoc a] -> ShowS)
-> Show (CommandDoc a)
forall a. Show a => Int -> CommandDoc a -> ShowS
forall a. Show a => [CommandDoc a] -> ShowS
forall a. Show a => CommandDoc a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> CommandDoc a -> ShowS
showsPrec :: Int -> CommandDoc a -> ShowS
$cshow :: forall a. Show a => CommandDoc a -> [Char]
show :: CommandDoc a -> [Char]
$cshowList :: forall a. Show a => [CommandDoc a] -> ShowS
showList :: [CommandDoc a] -> ShowS
Show)

instance Functor CommandDoc where
  fmap :: forall a b. (a -> b) -> CommandDoc a -> CommandDoc b
fmap a -> b
f CommandDoc a
cd = CommandDoc a
cd {commandDocs = fmap f (commandDocs cd)}

instance Foldable CommandDoc where
  foldMap :: forall m a. Monoid m => (a -> m) -> CommandDoc a -> m
foldMap a -> m
f = (a -> m) -> AnyDocs a -> m
forall m a. Monoid m => (a -> m) -> AnyDocs a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f (AnyDocs a -> m)
-> (CommandDoc a -> AnyDocs a) -> CommandDoc a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandDoc a -> AnyDocs a
forall a. CommandDoc a -> AnyDocs a
commandDocs

instance Traversable CommandDoc where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CommandDoc a -> f (CommandDoc b)
traverse a -> f b
f CommandDoc a
cd = (\AnyDocs b
d -> CommandDoc a
cd {commandDocs = d}) (AnyDocs b -> CommandDoc b) -> f (AnyDocs b) -> f (CommandDoc b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> AnyDocs a -> f (AnyDocs b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AnyDocs a -> f (AnyDocs b)
traverse a -> f b
f (CommandDoc a -> AnyDocs a
forall a. CommandDoc a -> AnyDocs a
commandDocs CommandDoc a
cd)

mapMaybeDocs :: (a -> Maybe b) -> AnyDocs a -> AnyDocs b
mapMaybeDocs :: forall a b. (a -> Maybe b) -> AnyDocs a -> AnyDocs b
mapMaybeDocs a -> Maybe b
func = AnyDocs b -> AnyDocs b
forall a. AnyDocs a -> AnyDocs a
simplifyAnyDocs (AnyDocs b -> AnyDocs b)
-> (AnyDocs a -> AnyDocs b) -> AnyDocs a -> AnyDocs b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyDocs a -> AnyDocs b
go
  where
    go :: AnyDocs a -> AnyDocs b
go = \case
      AnyDocsCommands [CommandDoc a]
cs -> [CommandDoc b] -> AnyDocs b
forall a. [CommandDoc a] -> AnyDocs a
AnyDocsCommands ([CommandDoc b] -> AnyDocs b) -> [CommandDoc b] -> AnyDocs b
forall a b. (a -> b) -> a -> b
$ (CommandDoc a -> CommandDoc b) -> [CommandDoc a] -> [CommandDoc b]
forall a b. (a -> b) -> [a] -> [b]
map CommandDoc a -> CommandDoc b
goCommandDoc [CommandDoc a]
cs
      AnyDocsAnd [AnyDocs a]
ds -> [AnyDocs b] -> AnyDocs b
forall a. [AnyDocs a] -> AnyDocs a
AnyDocsAnd ([AnyDocs b] -> AnyDocs b) -> [AnyDocs b] -> AnyDocs b
forall a b. (a -> b) -> a -> b
$ (AnyDocs a -> AnyDocs b) -> [AnyDocs a] -> [AnyDocs b]
forall a b. (a -> b) -> [a] -> [b]
map AnyDocs a -> AnyDocs b
go [AnyDocs a]
ds
      AnyDocsOr [AnyDocs a]
ds -> [AnyDocs b] -> AnyDocs b
forall a. [AnyDocs a] -> AnyDocs a
AnyDocsOr ([AnyDocs b] -> AnyDocs b) -> [AnyDocs b] -> AnyDocs b
forall a b. (a -> b) -> a -> b
$ (AnyDocs a -> AnyDocs b) -> [AnyDocs a] -> [AnyDocs b]
forall a b. (a -> b) -> [a] -> [b]
map AnyDocs a -> AnyDocs b
go [AnyDocs a]
ds
      AnyDocsSingle a
d -> AnyDocs b -> (b -> AnyDocs b) -> Maybe b -> AnyDocs b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([AnyDocs b] -> AnyDocs b
forall a. [AnyDocs a] -> AnyDocs a
AnyDocsAnd []) b -> AnyDocs b
forall a. a -> AnyDocs a
AnyDocsSingle (Maybe b -> AnyDocs b) -> Maybe b -> AnyDocs b
forall a b. (a -> b) -> a -> b
$ a -> Maybe b
func a
d

    goCommandDoc :: CommandDoc a -> CommandDoc b
goCommandDoc CommandDoc a
cd = CommandDoc a
cd {commandDocs = go (commandDocs cd)}

simplifyAnyDocs :: AnyDocs a -> AnyDocs a
simplifyAnyDocs :: forall a. AnyDocs a -> AnyDocs a
simplifyAnyDocs = AnyDocs a -> AnyDocs a
forall a. AnyDocs a -> AnyDocs a
go
  where
    go :: AnyDocs a -> AnyDocs a
go = \case
      AnyDocsCommands [CommandDoc a]
cs -> [CommandDoc a] -> AnyDocs a
forall a. [CommandDoc a] -> AnyDocs a
AnyDocsCommands ([CommandDoc a] -> AnyDocs a) -> [CommandDoc a] -> AnyDocs a
forall a b. (a -> b) -> a -> b
$ (CommandDoc a -> CommandDoc a) -> [CommandDoc a] -> [CommandDoc a]
forall a b. (a -> b) -> [a] -> [b]
map CommandDoc a -> CommandDoc a
goDoc [CommandDoc a]
cs
      AnyDocsAnd [AnyDocs a]
ds -> case (AnyDocs a -> [AnyDocs a]) -> [AnyDocs a] -> [AnyDocs a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AnyDocs a -> [AnyDocs a]
goAnd [AnyDocs a]
ds of
        [AnyDocs a
a] -> AnyDocs a
a
        [AnyDocs a]
as -> [AnyDocs a] -> AnyDocs a
forall a. [AnyDocs a] -> AnyDocs a
AnyDocsAnd [AnyDocs a]
as
      AnyDocsOr [AnyDocs a]
ds -> case (AnyDocs a -> [AnyDocs a]) -> [AnyDocs a] -> [AnyDocs a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AnyDocs a -> [AnyDocs a]
goOr [AnyDocs a]
ds of
        [AnyDocs a
a] -> AnyDocs a
a
        [AnyDocs a]
as -> [AnyDocs a] -> AnyDocs a
forall a. [AnyDocs a] -> AnyDocs a
AnyDocsOr [AnyDocs a]
as
      AnyDocsSingle a
v -> a -> AnyDocs a
forall a. a -> AnyDocs a
AnyDocsSingle a
v

    goDoc :: CommandDoc a -> CommandDoc a
goDoc CommandDoc a
cd = CommandDoc a
cd {commandDocs = go (commandDocs cd)}

    goAnd :: AnyDocs a -> [AnyDocs a]
goAnd = \case
      AnyDocsCommands [CommandDoc a]
c -> [[CommandDoc a] -> AnyDocs a
forall a. [CommandDoc a] -> AnyDocs a
AnyDocsCommands ([CommandDoc a] -> AnyDocs a) -> [CommandDoc a] -> AnyDocs a
forall a b. (a -> b) -> a -> b
$ (CommandDoc a -> CommandDoc a) -> [CommandDoc a] -> [CommandDoc a]
forall a b. (a -> b) -> [a] -> [b]
map CommandDoc a -> CommandDoc a
goDoc [CommandDoc a]
c]
      AnyDocsAnd [AnyDocs a]
ds -> (AnyDocs a -> [AnyDocs a]) -> [AnyDocs a] -> [AnyDocs a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (AnyDocs a -> [AnyDocs a]
goAnd (AnyDocs a -> [AnyDocs a])
-> (AnyDocs a -> AnyDocs a) -> AnyDocs a -> [AnyDocs a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyDocs a -> AnyDocs a
go) [AnyDocs a]
ds
      AnyDocsOr [] -> []
      AnyDocs a
ds -> [AnyDocs a -> AnyDocs a
go AnyDocs a
ds]

    goOr :: AnyDocs a -> [AnyDocs a]
goOr = \case
      AnyDocsCommands [CommandDoc a]
c -> [[CommandDoc a] -> AnyDocs a
forall a. [CommandDoc a] -> AnyDocs a
AnyDocsCommands ([CommandDoc a] -> AnyDocs a) -> [CommandDoc a] -> AnyDocs a
forall a b. (a -> b) -> a -> b
$ (CommandDoc a -> CommandDoc a) -> [CommandDoc a] -> [CommandDoc a]
forall a b. (a -> b) -> [a] -> [b]
map CommandDoc a -> CommandDoc a
goDoc [CommandDoc a]
c]
      AnyDocsOr [AnyDocs a]
ds -> (AnyDocs a -> [AnyDocs a]) -> [AnyDocs a] -> [AnyDocs a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (AnyDocs a -> [AnyDocs a]
goOr (AnyDocs a -> [AnyDocs a])
-> (AnyDocs a -> AnyDocs a) -> AnyDocs a -> [AnyDocs a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyDocs a -> AnyDocs a
go) [AnyDocs a]
ds
      AnyDocsAnd [] -> []
      AnyDocs a
ds -> [AnyDocs a -> AnyDocs a
go AnyDocs a
ds]

-- | Derive parser documentation
parserDocs :: Parser a -> AnyDocs SetDoc
parserDocs :: forall a. Parser a -> AnyDocs SetDoc
parserDocs = AnyDocs SetDoc -> AnyDocs SetDoc
forall a. AnyDocs a -> AnyDocs a
simplifyAnyDocs (AnyDocs SetDoc -> AnyDocs SetDoc)
-> (Parser a -> AnyDocs SetDoc) -> Parser a -> AnyDocs SetDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> AnyDocs SetDoc
forall a. Parser a -> AnyDocs SetDoc
go
  where
    noDocs :: AnyDocs a
noDocs = [AnyDocs a] -> AnyDocs a
forall a. [AnyDocs a] -> AnyDocs a
AnyDocsAnd []
    go :: Parser a -> AnyDocs SetDoc
    go :: forall a. Parser a -> AnyDocs SetDoc
go = \case
      ParserPure a
_ -> AnyDocs SetDoc
forall {a}. AnyDocs a
noDocs
      ParserAp Parser (a1 -> a)
pf Parser a1
pa -> [AnyDocs SetDoc] -> AnyDocs SetDoc
forall a. [AnyDocs a] -> AnyDocs a
AnyDocsAnd [Parser (a1 -> a) -> AnyDocs SetDoc
forall a. Parser a -> AnyDocs SetDoc
go Parser (a1 -> a)
pf, Parser a1 -> AnyDocs SetDoc
forall a. Parser a -> AnyDocs SetDoc
go Parser a1
pa]
      ParserSelect Parser (Either a1 a)
p1 Parser (a1 -> a)
p2 -> [AnyDocs SetDoc] -> AnyDocs SetDoc
forall a. [AnyDocs a] -> AnyDocs a
AnyDocsAnd [Parser (Either a1 a) -> AnyDocs SetDoc
forall a. Parser a -> AnyDocs SetDoc
go Parser (Either a1 a)
p1, Parser (a1 -> a) -> AnyDocs SetDoc
forall a. Parser a -> AnyDocs SetDoc
go Parser (a1 -> a)
p2]
      ParserEmpty Maybe SrcLoc
_ -> [AnyDocs SetDoc] -> AnyDocs SetDoc
forall a. [AnyDocs a] -> AnyDocs a
AnyDocsOr []
      ParserAlt Parser a
p1 Parser a
p2 -> [AnyDocs SetDoc] -> AnyDocs SetDoc
forall a. [AnyDocs a] -> AnyDocs a
AnyDocsOr [Parser a -> AnyDocs SetDoc
forall a. Parser a -> AnyDocs SetDoc
go Parser a
p1, Parser a -> AnyDocs SetDoc
forall a. Parser a -> AnyDocs SetDoc
go Parser a
p2]
      ParserMany Parser a1
p -> Parser a1 -> AnyDocs SetDoc
forall a. Parser a -> AnyDocs SetDoc
go Parser a1
p -- TODO: is this right?
      ParserAllOrNothing Maybe SrcLoc
_ Parser a
p -> Parser a -> AnyDocs SetDoc
forall a. Parser a -> AnyDocs SetDoc
go Parser a
p
      ParserCheck Maybe SrcLoc
_ Bool
_ a1 -> IO (Either [Char] a)
_ Parser a1
p -> Parser a1 -> AnyDocs SetDoc
forall a. Parser a -> AnyDocs SetDoc
go Parser a1
p
      ParserCommands Maybe SrcLoc
_ [Command a]
cs -> [CommandDoc SetDoc] -> AnyDocs SetDoc
forall a. [CommandDoc a] -> AnyDocs a
AnyDocsCommands ([CommandDoc SetDoc] -> AnyDocs SetDoc)
-> [CommandDoc SetDoc] -> AnyDocs SetDoc
forall a b. (a -> b) -> a -> b
$ (Command a -> CommandDoc SetDoc)
-> [Command a] -> [CommandDoc SetDoc]
forall a b. (a -> b) -> [a] -> [b]
map Command a -> CommandDoc SetDoc
forall a. Command a -> CommandDoc SetDoc
goCommand [Command a]
cs
      ParserWithConfig Parser (Maybe Object)
p1 Parser a
p2 -> [AnyDocs SetDoc] -> AnyDocs SetDoc
forall a. [AnyDocs a] -> AnyDocs a
AnyDocsAnd [Parser (Maybe Object) -> AnyDocs SetDoc
forall a. Parser a -> AnyDocs SetDoc
go Parser (Maybe Object)
p1, Parser a -> AnyDocs SetDoc
forall a. Parser a -> AnyDocs SetDoc
go Parser a
p2] -- TODO: is this right? Maybe we want to document that it's not a pure parser?
      ParserSetting Maybe SrcLoc
_ Setting a
set -> AnyDocs SetDoc
-> (SetDoc -> AnyDocs SetDoc) -> Maybe SetDoc -> AnyDocs SetDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AnyDocs SetDoc
forall {a}. AnyDocs a
noDocs SetDoc -> AnyDocs SetDoc
forall a. a -> AnyDocs a
AnyDocsSingle (Maybe SetDoc -> AnyDocs SetDoc) -> Maybe SetDoc -> AnyDocs SetDoc
forall a b. (a -> b) -> a -> b
$ Setting a -> Maybe SetDoc
forall a. Setting a -> Maybe SetDoc
settingSetDoc Setting a
set
    goCommand :: Command a -> CommandDoc SetDoc
    goCommand :: forall a. Command a -> CommandDoc SetDoc
goCommand Command {[Char]
Maybe SrcLoc
Parser a
commandSrcLoc :: Maybe SrcLoc
commandArg :: [Char]
commandHelp :: [Char]
commandParser :: Parser a
commandSrcLoc :: forall a. Command a -> Maybe SrcLoc
commandArg :: forall a. Command a -> [Char]
commandHelp :: forall a. Command a -> [Char]
commandParser :: forall a. Command a -> Parser a
..} =
      CommandDoc
        { commandDocArgument :: [Char]
commandDocArgument = [Char]
commandArg,
          commandDocHelp :: [Char]
commandDocHelp = [Char]
commandHelp,
          commandDocs :: AnyDocs SetDoc
commandDocs = Parser a -> AnyDocs SetDoc
forall a. Parser a -> AnyDocs SetDoc
go Parser a
commandParser
        }

settingSetDoc :: Setting a -> Maybe SetDoc
settingSetDoc :: forall a. Setting a -> Maybe SetDoc
settingSetDoc Setting {Bool
[[Char]]
[Dashed]
[Reader a]
Maybe a
Maybe [Char]
Maybe (NonEmpty [Char])
Maybe (NonEmpty (NonEmpty [Char], DecodingCodec a))
Maybe (a, [Char])
settingDasheds :: [Dashed]
settingReaders :: [Reader a]
settingTryArgument :: Bool
settingSwitchValue :: Maybe a
settingTryOption :: Bool
settingEnvVars :: Maybe (NonEmpty [Char])
settingConfigVals :: Maybe (NonEmpty (NonEmpty [Char], DecodingCodec a))
settingDefaultValue :: Maybe (a, [Char])
settingExamples :: [[Char]]
settingHidden :: Bool
settingMetavar :: Maybe [Char]
settingHelp :: Maybe [Char]
settingDasheds :: forall a. Setting a -> [Dashed]
settingReaders :: forall a. Setting a -> [Reader a]
settingTryArgument :: forall a. Setting a -> Bool
settingSwitchValue :: forall a. Setting a -> Maybe a
settingTryOption :: forall a. Setting a -> Bool
settingEnvVars :: forall a. Setting a -> Maybe (NonEmpty [Char])
settingConfigVals :: forall a.
Setting a -> Maybe (NonEmpty (NonEmpty [Char], DecodingCodec a))
settingDefaultValue :: forall a. Setting a -> Maybe (a, [Char])
settingExamples :: forall a. Setting a -> [[Char]]
settingHidden :: forall a. Setting a -> Bool
settingMetavar :: forall a. Setting a -> Maybe [Char]
settingHelp :: forall a. Setting a -> Maybe [Char]
..} = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
settingHidden
  let setDocDasheds :: [Dashed]
setDocDasheds = [Dashed]
settingDasheds
  let setDocTryArgument :: Bool
setDocTryArgument = Bool
settingTryArgument
  let setDocTrySwitch :: Bool
setDocTrySwitch = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
settingSwitchValue
  let setDocTryOption :: Bool
setDocTryOption = Bool
settingTryOption
  let setDocEnvVars :: Maybe (NonEmpty [Char])
setDocEnvVars = Maybe (NonEmpty [Char])
settingEnvVars
  let setDocConfKeys :: Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
setDocConfKeys = ((NonEmpty [Char], DecodingCodec a)
 -> (NonEmpty [Char], JSONSchema))
-> NonEmpty (NonEmpty [Char], DecodingCodec a)
-> NonEmpty (NonEmpty [Char], JSONSchema)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map ((DecodingCodec a -> JSONSchema)
-> (NonEmpty [Char], DecodingCodec a)
-> (NonEmpty [Char], JSONSchema)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (\(DecodingCodec ValueCodec void (Maybe a)
c) -> ValueCodec void (Maybe a) -> JSONSchema
forall input output. ValueCodec input output -> JSONSchema
jsonSchemaVia ValueCodec void (Maybe a)
c)) (NonEmpty (NonEmpty [Char], DecodingCodec a)
 -> NonEmpty (NonEmpty [Char], JSONSchema))
-> Maybe (NonEmpty (NonEmpty [Char], DecodingCodec a))
-> Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty (NonEmpty [Char], DecodingCodec a))
settingConfigVals
  let setDocDefault :: Maybe [Char]
setDocDefault = (a, [Char]) -> [Char]
forall a b. (a, b) -> b
snd ((a, [Char]) -> [Char]) -> Maybe (a, [Char]) -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (a, [Char])
settingDefaultValue
  let setDocMetavar :: Maybe [Char]
setDocMetavar = Maybe [Char]
settingMetavar
  let setDocHelp :: Maybe [Char]
setDocHelp = Maybe [Char]
settingHelp
  pure SetDoc {Bool
[Dashed]
Maybe [Char]
Maybe (NonEmpty [Char])
Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
setDocTryArgument :: Bool
setDocTrySwitch :: Bool
setDocTryOption :: Bool
setDocDasheds :: [Dashed]
setDocEnvVars :: Maybe (NonEmpty [Char])
setDocConfKeys :: Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
setDocDefault :: Maybe [Char]
setDocMetavar :: Maybe [Char]
setDocHelp :: Maybe [Char]
setDocDasheds :: [Dashed]
setDocTryArgument :: Bool
setDocTrySwitch :: Bool
setDocTryOption :: Bool
setDocEnvVars :: Maybe (NonEmpty [Char])
setDocConfKeys :: Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
setDocDefault :: Maybe [Char]
setDocMetavar :: Maybe [Char]
setDocHelp :: Maybe [Char]
..}

settingOptDoc :: Setting a -> Maybe OptDoc
settingOptDoc :: forall a. Setting a -> Maybe OptDoc
settingOptDoc = Setting a -> Maybe SetDoc
forall a. Setting a -> Maybe SetDoc
settingSetDoc (Setting a -> Maybe SetDoc)
-> (SetDoc -> Maybe OptDoc) -> Setting a -> Maybe OptDoc
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> SetDoc -> Maybe OptDoc
setDocOptDoc

renderSetDoc :: SetDoc -> [[Chunk]]
renderSetDoc :: SetDoc -> [[Chunk]]
renderSetDoc SetDoc
setDoc =
  [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Maybe [Char] -> [[Chunk]]
renderSetDocHeader (SetDoc -> Maybe [Char]
setDocHelp SetDoc
setDoc),
      SetDoc -> [[Chunk]]
renderSetDocWithoutHeader SetDoc
setDoc,
      [[]]
    ]

renderSetDocHeader :: Maybe Help -> [[Chunk]]
renderSetDocHeader :: Maybe [Char] -> [[Chunk]]
renderSetDocHeader = [[Chunk]] -> ([Char] -> [[Chunk]]) -> Maybe [Char] -> [[Chunk]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [[Colour -> Chunk -> Chunk
fore Colour
red Chunk
"undocumented"]] [Char] -> [[Chunk]]
helpLines

renderSetDocWithoutHeader :: SetDoc -> [[Chunk]]
renderSetDocWithoutHeader :: SetDoc -> [[Chunk]]
renderSetDocWithoutHeader SetDoc {Bool
[Dashed]
Maybe [Char]
Maybe (NonEmpty [Char])
Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
setDocTryArgument :: SetDoc -> Bool
setDocTrySwitch :: SetDoc -> Bool
setDocTryOption :: SetDoc -> Bool
setDocDasheds :: SetDoc -> [Dashed]
setDocEnvVars :: SetDoc -> Maybe (NonEmpty [Char])
setDocConfKeys :: SetDoc -> Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
setDocDefault :: SetDoc -> Maybe [Char]
setDocMetavar :: SetDoc -> Maybe [Char]
setDocHelp :: SetDoc -> Maybe [Char]
setDocTryArgument :: Bool
setDocTrySwitch :: Bool
setDocTryOption :: Bool
setDocDasheds :: [Dashed]
setDocEnvVars :: Maybe (NonEmpty [Char])
setDocConfKeys :: Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
setDocDefault :: Maybe [Char]
setDocMetavar :: Maybe [Char]
setDocHelp :: Maybe [Char]
..} =
  [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [ [[Chunk]] -> [Chunk]
unwordsChunks
          [ [Chunk
"argument:"],
            [Maybe [Char] -> Chunk
mMetavarChunk Maybe [Char]
setDocMetavar]
          ]
        | Bool
setDocTryArgument
      ],
      [ [[Chunk]] -> [Chunk]
unwordsChunks
          [ [Chunk
"switch:"],
            NonEmpty Dashed -> [Chunk]
dashedChunksNE NonEmpty Dashed
dasheds
          ]
        | Bool
setDocTrySwitch,
          NonEmpty Dashed
dasheds <- Maybe (NonEmpty Dashed) -> [NonEmpty Dashed]
forall a. Maybe a -> [a]
maybeToList ([Dashed] -> Maybe (NonEmpty Dashed)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Dashed]
setDocDasheds)
      ],
      [ [[Chunk]] -> [Chunk]
unwordsChunks
          [ [Chunk
"option:"],
            NonEmpty Dashed -> [Chunk]
dashedChunksNE NonEmpty Dashed
dasheds
              [Chunk] -> [Chunk] -> [Chunk]
forall a. [a] -> [a] -> [a]
++ [Chunk
" ", Maybe [Char] -> Chunk
mMetavarChunk Maybe [Char]
setDocMetavar]
          ]
        | Bool
setDocTryOption,
          NonEmpty Dashed
dasheds <- Maybe (NonEmpty Dashed) -> [NonEmpty Dashed]
forall a. Maybe a -> [a]
maybeToList ([Dashed] -> Maybe (NonEmpty Dashed)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Dashed]
setDocDasheds)
      ],
      [ [[Chunk]] -> [Chunk]
unwordsChunks
          [ [Chunk
"env:"],
            NonEmpty [Char] -> [Chunk]
envVarChunksNE NonEmpty [Char]
vars
              [Chunk] -> [Chunk] -> [Chunk]
forall a. [a] -> [a] -> [a]
++ [Chunk
" ", Maybe [Char] -> Chunk
mMetavarChunk Maybe [Char]
setDocMetavar]
          ]
        | NonEmpty [Char]
vars <- Maybe (NonEmpty [Char]) -> [NonEmpty [Char]]
forall a. Maybe a -> [a]
maybeToList Maybe (NonEmpty [Char])
setDocEnvVars
      ],
      [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ ((NonEmpty [Char], JSONSchema) -> [[Chunk]])
-> [(NonEmpty [Char], JSONSchema)] -> [[Chunk]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
            ( \(NonEmpty [Char]
key, JSONSchema
schema) ->
                case JSONSchema -> [[Chunk]]
jsonSchemaChunkLines JSONSchema
schema of
                  [[Chunk]
line] ->
                    [[Chunk
"config: ", NonEmpty [Char] -> Chunk
confValChunk NonEmpty [Char]
key, Chunk
": "] [Chunk] -> [Chunk] -> [Chunk]
forall a. [a] -> [a] -> [a]
++ [Chunk]
line]
                  [[Chunk]]
ls ->
                    [Chunk
"config:"]
                      [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: [[Chunk]] -> [[Chunk]]
indent
                        ( case [[Chunk]]
ls of
                            [] -> [[Chunk
"TODO"]]
                            ([Chunk]
l : [[Chunk]]
ll) ->
                              ([NonEmpty [Char] -> Chunk
confValChunk NonEmpty [Char]
key, Chunk
": "] [Chunk] -> [Chunk] -> [Chunk]
forall a. [a] -> [a] -> [a]
++ [Chunk]
l)
                                [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: [[Chunk]] -> [[Chunk]]
indent [[Chunk]]
ll
                        )
            )
            (NonEmpty (NonEmpty [Char], JSONSchema)
-> [(NonEmpty [Char], JSONSchema)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (NonEmpty [Char], JSONSchema)
confs)
          | NonEmpty (NonEmpty [Char], JSONSchema)
confs <- Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
-> [NonEmpty (NonEmpty [Char], JSONSchema)]
forall a. Maybe a -> [a]
maybeToList Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
setDocConfKeys
        ]
    ]

helpLines :: Help -> [[Chunk]]
helpLines :: [Char] -> [[Chunk]]
helpLines = ([Chunk] -> [Chunk]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map ((Chunk -> Chunk) -> [Chunk] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map (Colour -> Chunk -> Chunk
fore Colour
blue)) ([[Chunk]] -> [[Chunk]])
-> ([Char] -> [[Chunk]]) -> [Char] -> [[Chunk]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Chunk]]
stringLines

progDescLines :: String -> [[Chunk]]
progDescLines :: [Char] -> [[Chunk]]
progDescLines = [Char] -> [[Chunk]]
stringLines

stringLines :: String -> [[Chunk]]
stringLines :: [Char] -> [[Chunk]]
stringLines [Char]
s =
  let ls :: [Text]
ls = Text -> [Text]
T.lines ([Char] -> Text
T.pack [Char]
s)
   in (Text -> [Chunk]) -> [Text] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map (Chunk -> [Chunk]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chunk -> [Chunk]) -> (Text -> Chunk) -> Text -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk
chunk) [Text]
ls

-- | Render the output of `--render-man-page` for reading with @man@
renderManPage ::
  String ->
  Version ->
  String ->
  AnyDocs SetDoc ->
  [Chunk]
renderManPage :: [Char] -> Version -> [Char] -> AnyDocs SetDoc -> [Chunk]
renderManPage [Char]
progname Version
version [Char]
progDesc AnyDocs SetDoc
docs =
  let optDocs :: AnyDocs OptDoc
optDocs = AnyDocs SetDoc -> AnyDocs OptDoc
docsToOptDocs AnyDocs SetDoc
docs
      envDocs :: AnyDocs EnvDoc
envDocs = AnyDocs SetDoc -> AnyDocs EnvDoc
docsToEnvDocs AnyDocs SetDoc
docs
      confDocs :: AnyDocs ConfDoc
confDocs = AnyDocs SetDoc -> AnyDocs ConfDoc
docsToConfDocs AnyDocs SetDoc
docs
   in [[Chunk]] -> [Chunk]
unlinesChunks ([[Chunk]] -> [Chunk]) -> [[Chunk]] -> [Chunk]
forall a b. (a -> b) -> a -> b
$
        -- See https://man.openbsd.org/mdoc#MACRO_OVERVIEW
        [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ [ -- Document date
              [Chunk
".Dd $Mdocdate$"],
              -- Document title
              [Chunk
".Dt ", [Char] -> Chunk
progNameChunk [Char]
progname, Chunk
" 1"],
              -- Operating system footer
              [Chunk
".Os"],
              -- Section header
              [Chunk
".Sh ", Chunk
"NAME"],
              [Chunk
".Nm ", [Char] -> Chunk
progNameChunk [Char]
progname],
              [Chunk
".Nd ", Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
progDesc],
              [Chunk
".Sh ", Chunk
"VERSION"],
              [Version -> Chunk
versionChunk Version
version],
              [Chunk
".Sh ", Chunk
"SYNOPSIS"],
              [Char] -> AnyDocs OptDoc -> [Chunk]
renderShortOptDocs [Char]
progname AnyDocs OptDoc
optDocs,
              [Chunk
".Sh ", Chunk
"SETTINGS"],
              AnyDocs SetDoc -> [Chunk]
renderSetDocs AnyDocs SetDoc
docs
            ],
            [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ [ [Chunk
".Sh ", Chunk
"OPTIONS"],
                  AnyDocs OptDoc -> [Chunk]
renderLongOptDocs AnyDocs OptDoc
optDocs
                ]
                | Bool -> Bool
not (AnyDocs OptDoc -> Bool
forall a. AnyDocs a -> Bool
nullDocs AnyDocs OptDoc
optDocs)
              ],
            [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ [ [Chunk
".Sh ", Chunk
"ENVIRONMENT VARIABLES"],
                  AnyDocs EnvDoc -> [Chunk]
renderEnvDocs AnyDocs EnvDoc
envDocs
                ]
                | Bool -> Bool
not (AnyDocs EnvDoc -> Bool
forall a. AnyDocs a -> Bool
nullDocs AnyDocs EnvDoc
envDocs)
              ],
            [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ [ [Chunk
".Sh ", Chunk
"CONFIGURATION VALUES"],
                  AnyDocs ConfDoc -> [Chunk]
renderConfDocs AnyDocs ConfDoc
confDocs
                ]
                | Bool -> Bool
not (AnyDocs ConfDoc -> Bool
forall a. AnyDocs a -> Bool
nullDocs AnyDocs ConfDoc
confDocs)
              ]
          ]

-- | Render reference documentation
renderReferenceDocumentation :: String -> AnyDocs SetDoc -> [Chunk]
renderReferenceDocumentation :: [Char] -> AnyDocs SetDoc -> [Chunk]
renderReferenceDocumentation [Char]
progname AnyDocs SetDoc
docs =
  let optDocs :: AnyDocs OptDoc
optDocs = AnyDocs SetDoc -> AnyDocs OptDoc
docsToOptDocs AnyDocs SetDoc
docs
      envDocs :: AnyDocs EnvDoc
envDocs = AnyDocs SetDoc -> AnyDocs EnvDoc
docsToEnvDocs AnyDocs SetDoc
docs
      confDocs :: AnyDocs ConfDoc
confDocs = AnyDocs SetDoc -> AnyDocs ConfDoc
docsToConfDocs AnyDocs SetDoc
docs
   in [[Chunk]] -> [Chunk]
unlinesChunks ([[Chunk]] -> [Chunk]) -> [[Chunk]] -> [Chunk]
forall a b. (a -> b) -> a -> b
$
        [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ [ Chunk
usageChunk Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [Char] -> AnyDocs OptDoc -> [Chunk]
renderShortOptDocs [Char]
progname AnyDocs OptDoc
optDocs,
              [],
              Text -> [Chunk]
headerChunks Text
"All settings",
              AnyDocs SetDoc -> [Chunk]
renderSetDocs AnyDocs SetDoc
docs
            ],
            [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ [ Text -> [Chunk]
headerChunks Text
"Options",
                  AnyDocs OptDoc -> [Chunk]
renderLongOptDocs AnyDocs OptDoc
optDocs
                ]
                | Bool -> Bool
not (AnyDocs OptDoc -> Bool
forall a. AnyDocs a -> Bool
nullDocs AnyDocs OptDoc
optDocs)
              ],
            [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ [ Text -> [Chunk]
headerChunks Text
"Environment Variables",
                  AnyDocs EnvDoc -> [Chunk]
renderEnvDocs AnyDocs EnvDoc
envDocs
                ]
                | Bool -> Bool
not (AnyDocs EnvDoc -> Bool
forall a. AnyDocs a -> Bool
nullDocs AnyDocs EnvDoc
envDocs)
              ],
            [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ [ Text -> [Chunk]
headerChunks Text
"Configuration Values",
                  AnyDocs ConfDoc -> [Chunk]
renderConfDocs AnyDocs ConfDoc
confDocs
                ]
                | Bool -> Bool
not (AnyDocs ConfDoc -> Bool
forall a. AnyDocs a -> Bool
nullDocs AnyDocs ConfDoc
confDocs)
              ]
          ]

nullDocs :: AnyDocs a -> Bool
nullDocs :: forall a. AnyDocs a -> Bool
nullDocs = \case
  AnyDocsCommands [CommandDoc a]
cs -> (CommandDoc a -> Bool) -> [CommandDoc a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all CommandDoc a -> Bool
forall a. CommandDoc a -> Bool
nullCommandDoc [CommandDoc a]
cs
  AnyDocsOr [] -> Bool
True
  AnyDocsOr [AnyDocs a]
_ -> Bool
False
  AnyDocsAnd [] -> Bool
True
  AnyDocsAnd [AnyDocs a]
_ -> Bool
False
  AnyDocsSingle a
_ -> Bool
False
  where
    nullCommandDoc :: CommandDoc a -> Bool
    nullCommandDoc :: forall a. CommandDoc a -> Bool
nullCommandDoc = AnyDocs a -> Bool
forall a. AnyDocs a -> Bool
nullDocs (AnyDocs a -> Bool)
-> (CommandDoc a -> AnyDocs a) -> CommandDoc a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandDoc a -> AnyDocs a
forall a. CommandDoc a -> AnyDocs a
commandDocs

-- | Render the output of @--version@
renderVersionPage :: String -> Version -> [Chunk]
renderVersionPage :: [Char] -> Version -> [Chunk]
renderVersionPage [Char]
progname Version
version =
  [[Chunk]] -> [Chunk]
unwordsChunks
    [ [[Char] -> Chunk
progNameChunk [Char]
progname],
      [Version -> Chunk
versionChunk Version
version],
      [Chunk
"\n"]
    ]

-- | Render the output of @--help@
renderHelpPage :: String -> String -> AnyDocs SetDoc -> [Chunk]
renderHelpPage :: [Char] -> [Char] -> AnyDocs SetDoc -> [Chunk]
renderHelpPage [Char]
progname [Char]
progDesc AnyDocs SetDoc
docs =
  [[Chunk]] -> [Chunk]
unlinesChunks
    [ Chunk
usageChunk Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [Char] -> AnyDocs OptDoc -> [Chunk]
renderShortOptDocs [Char]
progname (AnyDocs SetDoc -> AnyDocs OptDoc
docsToOptDocs AnyDocs SetDoc
docs),
      [],
      [[Chunk]] -> [Chunk]
unlinesChunks ([[Chunk]] -> [Chunk]) -> [[Chunk]] -> [Chunk]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Chunk]]
progDescLines [Char]
progDesc,
      Text -> [Chunk]
headerChunks Text
"Available settings",
      AnyDocs SetDoc -> [Chunk]
renderSetDocs AnyDocs SetDoc
docs
    ]

renderSetDocs :: AnyDocs SetDoc -> [Chunk]
renderSetDocs :: AnyDocs SetDoc -> [Chunk]
renderSetDocs = [[Chunk]] -> [Chunk]
unlinesChunks ([[Chunk]] -> [Chunk])
-> (AnyDocs SetDoc -> [[Chunk]]) -> AnyDocs SetDoc -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyDocs SetDoc -> [[Chunk]]
go
  where
    go :: AnyDocs SetDoc -> [[Chunk]]
    go :: AnyDocs SetDoc -> [[Chunk]]
go = \case
      AnyDocsCommands [CommandDoc SetDoc]
cs -> (CommandDoc SetDoc -> [[Chunk]])
-> [CommandDoc SetDoc] -> [[Chunk]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CommandDoc SetDoc -> [[Chunk]]
goCommand [CommandDoc SetDoc]
cs
      AnyDocsAnd [AnyDocs SetDoc]
ds -> (AnyDocs SetDoc -> [[Chunk]]) -> [AnyDocs SetDoc] -> [[Chunk]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AnyDocs SetDoc -> [[Chunk]]
go [AnyDocs SetDoc]
ds
      AnyDocsOr [AnyDocs SetDoc]
ds -> [AnyDocs SetDoc] -> [[Chunk]]
goOr [AnyDocs SetDoc]
ds
      AnyDocsSingle SetDoc
d -> [[Chunk]] -> [[Chunk]]
indent (SetDoc -> [[Chunk]]
renderSetDoc SetDoc
d)

    goCommand :: CommandDoc SetDoc -> [[Chunk]]
    goCommand :: CommandDoc SetDoc -> [[Chunk]]
goCommand CommandDoc {[Char]
AnyDocs SetDoc
commandDocArgument :: forall a. CommandDoc a -> [Char]
commandDocHelp :: forall a. CommandDoc a -> [Char]
commandDocs :: forall a. CommandDoc a -> AnyDocs a
commandDocArgument :: [Char]
commandDocHelp :: [Char]
commandDocs :: AnyDocs SetDoc
..} =
      [[Chunk]] -> [[Chunk]]
indent ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$
        [[Char] -> Chunk
helpChunk [Char]
commandDocHelp]
          [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: [Chunk
"command: ", [Char] -> Chunk
commandChunk [Char]
commandDocArgument]
          [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: AnyDocs SetDoc -> [[Chunk]]
go AnyDocs SetDoc
commandDocs
          [[Chunk]] -> [[Chunk]] -> [[Chunk]]
forall a. [a] -> [a] -> [a]
++ [[]]

    -- Group together settings with the same help (produced by combinators like enableDisableSwitch)
    goOr :: [AnyDocs SetDoc] -> [[Chunk]]
    goOr :: [AnyDocs SetDoc] -> [[Chunk]]
goOr = \case
      [] -> []
      [AnyDocs SetDoc
d] -> AnyDocs SetDoc -> [[Chunk]]
go AnyDocs SetDoc
d
      (AnyDocsSingle SetDoc
d : [AnyDocs SetDoc]
ds) ->
        case SetDoc -> Maybe [Char]
setDocHelp SetDoc
d of
          Maybe [Char]
Nothing -> AnyDocs SetDoc -> [[Chunk]]
go (SetDoc -> AnyDocs SetDoc
forall a. a -> AnyDocs a
AnyDocsSingle SetDoc
d) [[Chunk]] -> [[Chunk]] -> [[Chunk]]
forall a. [a] -> [a] -> [a]
++ [AnyDocs SetDoc] -> [[Chunk]]
goOr [AnyDocs SetDoc]
ds
          Just [Char]
h ->
            let ([SetDoc]
sds, [AnyDocs SetDoc]
rest) = [Char] -> [AnyDocs SetDoc] -> ([SetDoc], [AnyDocs SetDoc])
goSameHelp [Char]
h [AnyDocs SetDoc]
ds
             in [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                  [ [[Chunk]] -> [[Chunk]]
indent ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ Maybe [Char] -> [[Chunk]]
renderSetDocHeader ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
h),
                    [[Chunk]] -> [[Chunk]]
indent ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ (SetDoc -> [[Chunk]]) -> [SetDoc] -> [[Chunk]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SetDoc -> [[Chunk]]
renderSetDocWithoutHeader ([SetDoc] -> [[Chunk]]) -> [SetDoc] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ SetDoc
d SetDoc -> [SetDoc] -> [SetDoc]
forall a. a -> [a] -> [a]
: [SetDoc]
sds,
                    [[]],
                    [AnyDocs SetDoc] -> [[Chunk]]
goOr [AnyDocs SetDoc]
rest
                  ]
      (AnyDocs SetDoc
d : [AnyDocs SetDoc]
ds) -> AnyDocs SetDoc -> [[Chunk]]
go AnyDocs SetDoc
d [[Chunk]] -> [[Chunk]] -> [[Chunk]]
forall a. [a] -> [a] -> [a]
++ [AnyDocs SetDoc] -> [[Chunk]]
goOr [AnyDocs SetDoc]
ds

    goSameHelp :: Help -> [AnyDocs SetDoc] -> ([SetDoc], [AnyDocs SetDoc])
    goSameHelp :: [Char] -> [AnyDocs SetDoc] -> ([SetDoc], [AnyDocs SetDoc])
goSameHelp [Char]
h = \case
      [] -> ([], [])
      (AnyDocsSingle SetDoc
d : [AnyDocs SetDoc]
ds) ->
        if SetDoc -> Maybe [Char]
setDocHelp SetDoc
d Maybe [Char] -> Maybe [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
h
          then
            let ([SetDoc]
sds, [AnyDocs SetDoc]
rest) = [Char] -> [AnyDocs SetDoc] -> ([SetDoc], [AnyDocs SetDoc])
goSameHelp [Char]
h [AnyDocs SetDoc]
ds
             in (SetDoc
d SetDoc -> [SetDoc] -> [SetDoc]
forall a. a -> [a] -> [a]
: [SetDoc]
sds, [AnyDocs SetDoc]
rest)
          else ([], SetDoc -> AnyDocs SetDoc
forall a. a -> AnyDocs a
AnyDocsSingle SetDoc
d AnyDocs SetDoc -> [AnyDocs SetDoc] -> [AnyDocs SetDoc]
forall a. a -> [a] -> [a]
: [AnyDocs SetDoc]
ds)
      [AnyDocs SetDoc]
ds -> ([], [AnyDocs SetDoc]
ds)

parserOptDocs :: Parser a -> AnyDocs OptDoc
parserOptDocs :: forall a. Parser a -> AnyDocs OptDoc
parserOptDocs = AnyDocs SetDoc -> AnyDocs OptDoc
docsToOptDocs (AnyDocs SetDoc -> AnyDocs OptDoc)
-> (Parser a -> AnyDocs SetDoc) -> Parser a -> AnyDocs OptDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> AnyDocs SetDoc
forall a. Parser a -> AnyDocs SetDoc
parserDocs

docsToOptDocs :: AnyDocs SetDoc -> AnyDocs OptDoc
docsToOptDocs :: AnyDocs SetDoc -> AnyDocs OptDoc
docsToOptDocs = (SetDoc -> Maybe OptDoc) -> AnyDocs SetDoc -> AnyDocs OptDoc
forall a b. (a -> Maybe b) -> AnyDocs a -> AnyDocs b
mapMaybeDocs SetDoc -> Maybe OptDoc
setDocOptDoc

setDocOptDoc :: SetDoc -> Maybe OptDoc
setDocOptDoc :: SetDoc -> Maybe OptDoc
setDocOptDoc SetDoc {Bool
[Dashed]
Maybe [Char]
Maybe (NonEmpty [Char])
Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
setDocTryArgument :: SetDoc -> Bool
setDocTrySwitch :: SetDoc -> Bool
setDocTryOption :: SetDoc -> Bool
setDocDasheds :: SetDoc -> [Dashed]
setDocEnvVars :: SetDoc -> Maybe (NonEmpty [Char])
setDocConfKeys :: SetDoc -> Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
setDocDefault :: SetDoc -> Maybe [Char]
setDocMetavar :: SetDoc -> Maybe [Char]
setDocHelp :: SetDoc -> Maybe [Char]
setDocTryArgument :: Bool
setDocTrySwitch :: Bool
setDocTryOption :: Bool
setDocDasheds :: [Dashed]
setDocEnvVars :: Maybe (NonEmpty [Char])
setDocConfKeys :: Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
setDocDefault :: Maybe [Char]
setDocMetavar :: Maybe [Char]
setDocHelp :: Maybe [Char]
..} = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool
setDocTryArgument Bool -> Bool -> Bool
|| Bool
setDocTrySwitch Bool -> Bool -> Bool
|| Bool
setDocTryOption
  let optDocTryArgument :: Bool
optDocTryArgument = Bool
setDocTryArgument
      optDocTrySwitch :: Bool
optDocTrySwitch = Bool
setDocTrySwitch
      optDocTryOption :: Bool
optDocTryOption = Bool
setDocTryOption
      optDocDasheds :: [Dashed]
optDocDasheds = [Dashed]
setDocDasheds
      optDocDefault :: Maybe [Char]
optDocDefault = Maybe [Char]
setDocDefault
      optDocMetavar :: Maybe [Char]
optDocMetavar = Maybe [Char]
setDocMetavar
      optDocHelp :: Maybe [Char]
optDocHelp = Maybe [Char]
setDocHelp
  pure OptDoc {Bool
[Dashed]
Maybe [Char]
optDocTryArgument :: Bool
optDocTrySwitch :: Bool
optDocTryOption :: Bool
optDocDasheds :: [Dashed]
optDocDefault :: Maybe [Char]
optDocMetavar :: Maybe [Char]
optDocHelp :: Maybe [Char]
optDocTryArgument :: Bool
optDocTrySwitch :: Bool
optDocTryOption :: Bool
optDocDasheds :: [Dashed]
optDocDefault :: Maybe [Char]
optDocMetavar :: Maybe [Char]
optDocHelp :: Maybe [Char]
..}

-- | Render short-form documentation of options
renderShortOptDocs :: String -> AnyDocs OptDoc -> [Chunk]
renderShortOptDocs :: [Char] -> AnyDocs OptDoc -> [Chunk]
renderShortOptDocs [Char]
progname = [[Chunk]] -> [Chunk]
unwordsChunks ([[Chunk]] -> [Chunk])
-> (AnyDocs OptDoc -> [[Chunk]]) -> AnyDocs OptDoc -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[Chunk]
cs -> [[[Char] -> Chunk
progNameChunk [Char]
progname], [Chunk]
cs]) ([Chunk] -> [[Chunk]])
-> (AnyDocs OptDoc -> [Chunk]) -> AnyDocs OptDoc -> [[Chunk]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyDocs OptDoc -> [Chunk]
go
  where
    go :: AnyDocs OptDoc -> [Chunk]
    go :: AnyDocs OptDoc -> [Chunk]
go = \case
      AnyDocsCommands [CommandDoc OptDoc]
cs ->
        [[Chunk]] -> [Chunk]
unwordsChunks ([[Chunk]] -> [Chunk]) -> [[Chunk]] -> [Chunk]
forall a b. (a -> b) -> a -> b
$
          [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
intersperse [Chunk
orChunk] ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$
            (CommandDoc OptDoc -> [Chunk]) -> [CommandDoc OptDoc] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map
              ( \CommandDoc {[Char]
AnyDocs OptDoc
commandDocArgument :: forall a. CommandDoc a -> [Char]
commandDocHelp :: forall a. CommandDoc a -> [Char]
commandDocs :: forall a. CommandDoc a -> AnyDocs a
commandDocArgument :: [Char]
commandDocHelp :: [Char]
commandDocs :: AnyDocs OptDoc
..} ->
                  if AnyDocs OptDoc -> Bool
forall a. AnyDocs a -> Bool
nullDocs AnyDocs OptDoc
commandDocs
                    then [[Char] -> Chunk
commandChunk [Char]
commandDocArgument]
                    else
                      [Char] -> Chunk
commandChunk [Char]
commandDocArgument
                        Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: Chunk
" "
                        Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: AnyDocs OptDoc -> [Chunk]
go AnyDocs OptDoc
commandDocs
              )
              [CommandDoc OptDoc]
cs
      AnyDocsAnd [AnyDocs OptDoc]
ds -> [[Chunk]] -> [Chunk]
unwordsChunks ([[Chunk]] -> [Chunk]) -> [[Chunk]] -> [Chunk]
forall a b. (a -> b) -> a -> b
$ (AnyDocs OptDoc -> [Chunk]) -> [AnyDocs OptDoc] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map AnyDocs OptDoc -> [Chunk]
go [AnyDocs OptDoc]
ds
      AnyDocsOr [AnyDocs OptDoc]
ds -> [[Chunk]] -> [Chunk]
renderOrChunks ((AnyDocs OptDoc -> [Chunk]) -> [AnyDocs OptDoc] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map AnyDocs OptDoc -> [Chunk]
go [AnyDocs OptDoc]
ds)
      AnyDocsSingle OptDoc {Bool
[Dashed]
Maybe [Char]
optDocTryArgument :: OptDoc -> Bool
optDocTrySwitch :: OptDoc -> Bool
optDocTryOption :: OptDoc -> Bool
optDocDasheds :: OptDoc -> [Dashed]
optDocDefault :: OptDoc -> Maybe [Char]
optDocMetavar :: OptDoc -> Maybe [Char]
optDocHelp :: OptDoc -> Maybe [Char]
optDocTryArgument :: Bool
optDocTrySwitch :: Bool
optDocTryOption :: Bool
optDocDasheds :: [Dashed]
optDocDefault :: Maybe [Char]
optDocMetavar :: Maybe [Char]
optDocHelp :: Maybe [Char]
..} ->
        [[Chunk]] -> [Chunk]
unwordsChunks ([[Chunk]] -> [Chunk]) -> [[Chunk]] -> [Chunk]
forall a b. (a -> b) -> a -> b
$
          [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [ [Maybe [Char] -> Chunk
mMetavarChunk Maybe [Char]
optDocMetavar]
                | Bool
optDocTryArgument
              ],
              [ [[Chunk]] -> [Chunk]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Chunk]] -> [Chunk]) -> [[Chunk]] -> [Chunk]
forall a b. (a -> b) -> a -> b
$ Maybe [Chunk] -> [[Chunk]]
forall a. Maybe a -> [a]
maybeToList (Maybe [Chunk] -> [[Chunk]]) -> Maybe [Chunk] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ [Dashed] -> Maybe [Chunk]
dashedChunks [Dashed]
optDocDasheds
                | Bool
optDocTrySwitch
              ],
              [ [[Chunk]] -> [Chunk]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                  [ [[Chunk]] -> [Chunk]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Chunk]] -> [Chunk]) -> [[Chunk]] -> [Chunk]
forall a b. (a -> b) -> a -> b
$ Maybe [Chunk] -> [[Chunk]]
forall a. Maybe a -> [a]
maybeToList (Maybe [Chunk] -> [[Chunk]]) -> Maybe [Chunk] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ [Dashed] -> Maybe [Chunk]
dashedChunks [Dashed]
optDocDasheds,
                    [Chunk
" ", Maybe [Char] -> Chunk
mMetavarChunk Maybe [Char]
optDocMetavar]
                  ]
                | Bool
optDocTryOption
              ]
            ]

renderOrChunks :: [[Chunk]] -> [Chunk]
renderOrChunks :: [[Chunk]] -> [Chunk]
renderOrChunks [[Chunk]]
os =
  [[Chunk]] -> [Chunk]
unwordsChunks ([[Chunk]] -> [Chunk]) -> [[Chunk]] -> [Chunk]
forall a b. (a -> b) -> a -> b
$
    [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
intersperse [Chunk
orChunk] ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$
      ([Chunk] -> [Chunk]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map [Chunk] -> [Chunk]
parenthesise [[Chunk]]
os
  where
    parenthesise :: [Chunk] -> [Chunk]
    parenthesise :: [Chunk] -> [Chunk]
parenthesise [Chunk
c] = [Chunk
c]
    parenthesise [Chunk]
cs = Colour -> Chunk -> Chunk
fore Colour
cyan Chunk
"(" Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [Chunk]
cs [Chunk] -> [Chunk] -> [Chunk]
forall a. [a] -> [a] -> [a]
++ [Colour -> Chunk -> Chunk
fore Colour
cyan Chunk
")"]

orChunk :: Chunk
orChunk :: Chunk
orChunk = Colour -> Chunk -> Chunk
fore Colour
cyan Chunk
"|"

-- | Render long-form documentation of options
renderLongOptDocs :: AnyDocs OptDoc -> [Chunk]
renderLongOptDocs :: AnyDocs OptDoc -> [Chunk]
renderLongOptDocs = [[Chunk]] -> [Chunk]
unlinesChunks ([[Chunk]] -> [Chunk])
-> (AnyDocs OptDoc -> [[Chunk]]) -> AnyDocs OptDoc -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyDocs OptDoc -> [[Chunk]]
go
  where
    go :: AnyDocs OptDoc -> [[Chunk]]
    go :: AnyDocs OptDoc -> [[Chunk]]
go = \case
      AnyDocsCommands [CommandDoc OptDoc]
cs ->
        (CommandDoc OptDoc -> [[Chunk]])
-> [CommandDoc OptDoc] -> [[Chunk]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
          ( \CommandDoc {[Char]
AnyDocs OptDoc
commandDocArgument :: forall a. CommandDoc a -> [Char]
commandDocHelp :: forall a. CommandDoc a -> [Char]
commandDocs :: forall a. CommandDoc a -> AnyDocs a
commandDocArgument :: [Char]
commandDocHelp :: [Char]
commandDocs :: AnyDocs OptDoc
..} ->
              [[Chunk]] -> [[Chunk]]
indent ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$
                [[Chunk]] -> [Chunk]
unwordsChunks [[[Char] -> Chunk
commandChunk [Char]
commandDocArgument], [[Char] -> Chunk
helpChunk [Char]
commandDocHelp]]
                  [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: [[Chunk]] -> [[Chunk]]
indent (AnyDocs OptDoc -> [[Chunk]]
go AnyDocs OptDoc
commandDocs)
          )
          [CommandDoc OptDoc]
cs
      AnyDocsAnd [AnyDocs OptDoc]
ds -> case AnyDocs OptDoc -> Maybe [[[Chunk]]]
goTable ([AnyDocs OptDoc] -> AnyDocs OptDoc
forall a. [AnyDocs a] -> AnyDocs a
AnyDocsAnd [AnyDocs OptDoc]
ds) of
        Maybe [[[Chunk]]]
Nothing -> (AnyDocs OptDoc -> [[Chunk]]) -> [AnyDocs OptDoc] -> [[Chunk]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AnyDocs OptDoc -> [[Chunk]]
go [AnyDocs OptDoc]
ds
        Just [[[Chunk]]]
csss -> [[Chunk]] -> [[Chunk]]
indent ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ [[[Chunk]]] -> [[Chunk]]
layoutAsTableLines [[[Chunk]]]
csss
      AnyDocsOr [AnyDocs OptDoc]
ds -> case AnyDocs OptDoc -> Maybe [[[Chunk]]]
goTable ([AnyDocs OptDoc] -> AnyDocs OptDoc
forall a. [AnyDocs a] -> AnyDocs a
AnyDocsOr [AnyDocs OptDoc]
ds) of
        Maybe [[[Chunk]]]
Nothing -> (AnyDocs OptDoc -> [[Chunk]]) -> [AnyDocs OptDoc] -> [[Chunk]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AnyDocs OptDoc -> [[Chunk]]
go [AnyDocs OptDoc]
ds
        Just [[[Chunk]]]
csss -> [[Chunk]] -> [[Chunk]]
indent ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ [[[Chunk]]] -> [[Chunk]]
layoutAsTableLines [[[Chunk]]]
csss
      AnyDocsSingle OptDoc
vs -> [[Chunk]] -> [[Chunk]]
indent ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ [[[Chunk]]] -> [[Chunk]]
layoutAsTableLines [OptDoc -> [[Chunk]]
renderOptDocLong OptDoc
vs]

    goTable :: AnyDocs OptDoc -> Maybe [[[Chunk]]]
    goTable :: AnyDocs OptDoc -> Maybe [[[Chunk]]]
goTable = \case
      AnyDocsCommands [CommandDoc OptDoc]
_ -> Maybe [[[Chunk]]]
forall a. Maybe a
Nothing
      AnyDocsAnd [AnyDocs OptDoc]
ds -> [[[[Chunk]]]] -> [[[Chunk]]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[[Chunk]]]] -> [[[Chunk]]])
-> Maybe [[[[Chunk]]]] -> Maybe [[[Chunk]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AnyDocs OptDoc -> Maybe [[[Chunk]]])
-> [AnyDocs OptDoc] -> Maybe [[[[Chunk]]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AnyDocs OptDoc -> Maybe [[[Chunk]]]
goTable [AnyDocs OptDoc]
ds
      AnyDocsOr [AnyDocs OptDoc]
ds -> [[[[Chunk]]]] -> [[[Chunk]]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[[Chunk]]]] -> [[[Chunk]]])
-> Maybe [[[[Chunk]]]] -> Maybe [[[Chunk]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AnyDocs OptDoc -> Maybe [[[Chunk]]])
-> [AnyDocs OptDoc] -> Maybe [[[[Chunk]]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AnyDocs OptDoc -> Maybe [[[Chunk]]]
goTable [AnyDocs OptDoc]
ds
      AnyDocsSingle OptDoc
od -> [[[Chunk]]] -> Maybe [[[Chunk]]]
forall a. a -> Maybe a
Just [OptDoc -> [[Chunk]]
renderOptDocLong OptDoc
od]

renderOptDocLong :: OptDoc -> [[Chunk]]
renderOptDocLong :: OptDoc -> [[Chunk]]
renderOptDocLong OptDoc {Bool
[Dashed]
Maybe [Char]
optDocTryArgument :: OptDoc -> Bool
optDocTrySwitch :: OptDoc -> Bool
optDocTryOption :: OptDoc -> Bool
optDocDasheds :: OptDoc -> [Dashed]
optDocDefault :: OptDoc -> Maybe [Char]
optDocMetavar :: OptDoc -> Maybe [Char]
optDocHelp :: OptDoc -> Maybe [Char]
optDocTryArgument :: Bool
optDocTrySwitch :: Bool
optDocTryOption :: Bool
optDocDasheds :: [Dashed]
optDocDefault :: Maybe [Char]
optDocMetavar :: Maybe [Char]
optDocHelp :: Maybe [Char]
..} =
  [ [[Chunk]] -> [Chunk]
unwordsChunks ([[Chunk]] -> [Chunk]) -> [[Chunk]] -> [Chunk]
forall a b. (a -> b) -> a -> b
$
      [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ Maybe [Chunk] -> [[Chunk]]
forall a. Maybe a -> [a]
maybeToList (Maybe [Chunk] -> [[Chunk]]) -> Maybe [Chunk] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ [Dashed] -> Maybe [Chunk]
dashedChunks [Dashed]
optDocDasheds,
          [ [ Maybe [Char] -> Chunk
mMetavarChunk Maybe [Char]
optDocMetavar
            ]
            | Bool
optDocTryArgument
          ]
        ],
    [Maybe [Char] -> Chunk
mHelpChunk Maybe [Char]
optDocHelp],
    [[Chunk]] -> [Chunk]
unwordsChunks [[Char] -> [Chunk]
defaultValueChunks [Char]
d | [Char]
d <- Maybe [Char] -> [[Char]]
forall a. Maybe a -> [a]
maybeToList Maybe [Char]
optDocDefault]
  ]

parserEnvDocs :: Parser a -> AnyDocs EnvDoc
parserEnvDocs :: forall a. Parser a -> AnyDocs EnvDoc
parserEnvDocs = AnyDocs SetDoc -> AnyDocs EnvDoc
docsToEnvDocs (AnyDocs SetDoc -> AnyDocs EnvDoc)
-> (Parser a -> AnyDocs SetDoc) -> Parser a -> AnyDocs EnvDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> AnyDocs SetDoc
forall a. Parser a -> AnyDocs SetDoc
parserDocs

docsToEnvDocs :: AnyDocs SetDoc -> AnyDocs EnvDoc
docsToEnvDocs :: AnyDocs SetDoc -> AnyDocs EnvDoc
docsToEnvDocs = (SetDoc -> Maybe EnvDoc) -> AnyDocs SetDoc -> AnyDocs EnvDoc
forall a b. (a -> Maybe b) -> AnyDocs a -> AnyDocs b
mapMaybeDocs SetDoc -> Maybe EnvDoc
setDocEnvDoc

setDocEnvDoc :: SetDoc -> Maybe EnvDoc
setDocEnvDoc :: SetDoc -> Maybe EnvDoc
setDocEnvDoc SetDoc {Bool
[Dashed]
Maybe [Char]
Maybe (NonEmpty [Char])
Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
setDocTryArgument :: SetDoc -> Bool
setDocTrySwitch :: SetDoc -> Bool
setDocTryOption :: SetDoc -> Bool
setDocDasheds :: SetDoc -> [Dashed]
setDocEnvVars :: SetDoc -> Maybe (NonEmpty [Char])
setDocConfKeys :: SetDoc -> Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
setDocDefault :: SetDoc -> Maybe [Char]
setDocMetavar :: SetDoc -> Maybe [Char]
setDocHelp :: SetDoc -> Maybe [Char]
setDocTryArgument :: Bool
setDocTrySwitch :: Bool
setDocTryOption :: Bool
setDocDasheds :: [Dashed]
setDocEnvVars :: Maybe (NonEmpty [Char])
setDocConfKeys :: Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
setDocDefault :: Maybe [Char]
setDocMetavar :: Maybe [Char]
setDocHelp :: Maybe [Char]
..} = do
  NonEmpty [Char]
envDocVars <- Maybe (NonEmpty [Char])
setDocEnvVars
  let envDocDefault :: Maybe [Char]
envDocDefault = Maybe [Char]
setDocDefault
  let envDocMetavar :: Maybe [Char]
envDocMetavar = Maybe [Char]
setDocMetavar
  let envDocHelp :: Maybe [Char]
envDocHelp = Maybe [Char]
setDocHelp
  pure EnvDoc {Maybe [Char]
NonEmpty [Char]
envDocVars :: NonEmpty [Char]
envDocDefault :: Maybe [Char]
envDocMetavar :: Maybe [Char]
envDocHelp :: Maybe [Char]
envDocVars :: NonEmpty [Char]
envDocDefault :: Maybe [Char]
envDocMetavar :: Maybe [Char]
envDocHelp :: Maybe [Char]
..}

settingEnvDoc :: Setting a -> Maybe EnvDoc
settingEnvDoc :: forall a. Setting a -> Maybe EnvDoc
settingEnvDoc = Setting a -> Maybe SetDoc
forall a. Setting a -> Maybe SetDoc
settingSetDoc (Setting a -> Maybe SetDoc)
-> (SetDoc -> Maybe EnvDoc) -> Setting a -> Maybe EnvDoc
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> SetDoc -> Maybe EnvDoc
setDocEnvDoc

-- | Render documentation of envionment variables
renderEnvDocs :: AnyDocs EnvDoc -> [Chunk]
renderEnvDocs :: AnyDocs EnvDoc -> [Chunk]
renderEnvDocs = [[[Chunk]]] -> [Chunk]
layoutAsTable ([[[Chunk]]] -> [Chunk])
-> (AnyDocs EnvDoc -> [[[Chunk]]]) -> AnyDocs EnvDoc -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyDocs EnvDoc -> [[[Chunk]]]
go
  where
    go :: AnyDocs EnvDoc -> [[[Chunk]]]
    go :: AnyDocs EnvDoc -> [[[Chunk]]]
go = \case
      AnyDocsCommands [CommandDoc EnvDoc]
cs -> (CommandDoc EnvDoc -> [[[Chunk]]])
-> [CommandDoc EnvDoc] -> [[[Chunk]]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (AnyDocs EnvDoc -> [[[Chunk]]]
go (AnyDocs EnvDoc -> [[[Chunk]]])
-> (CommandDoc EnvDoc -> AnyDocs EnvDoc)
-> CommandDoc EnvDoc
-> [[[Chunk]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandDoc EnvDoc -> AnyDocs EnvDoc
forall a. CommandDoc a -> AnyDocs a
commandDocs) [CommandDoc EnvDoc]
cs
      AnyDocsAnd [AnyDocs EnvDoc]
ds -> (AnyDocs EnvDoc -> [[[Chunk]]]) -> [AnyDocs EnvDoc] -> [[[Chunk]]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AnyDocs EnvDoc -> [[[Chunk]]]
go [AnyDocs EnvDoc]
ds
      AnyDocsOr [AnyDocs EnvDoc]
ds -> (AnyDocs EnvDoc -> [[[Chunk]]]) -> [AnyDocs EnvDoc] -> [[[Chunk]]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AnyDocs EnvDoc -> [[[Chunk]]]
go [AnyDocs EnvDoc]
ds
      AnyDocsSingle EnvDoc
ed -> [[[Chunk]] -> [[Chunk]]
indent ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ EnvDoc -> [[Chunk]]
renderEnvDoc EnvDoc
ed]

renderEnvDoc :: EnvDoc -> [[Chunk]]
renderEnvDoc :: EnvDoc -> [[Chunk]]
renderEnvDoc EnvDoc {Maybe [Char]
NonEmpty [Char]
envDocVars :: EnvDoc -> NonEmpty [Char]
envDocDefault :: EnvDoc -> Maybe [Char]
envDocMetavar :: EnvDoc -> Maybe [Char]
envDocHelp :: EnvDoc -> Maybe [Char]
envDocVars :: NonEmpty [Char]
envDocDefault :: Maybe [Char]
envDocMetavar :: Maybe [Char]
envDocHelp :: Maybe [Char]
..} =
  [ [[Chunk]] -> [Chunk]
unwordsChunks
      [ NonEmpty [Char] -> [Chunk]
envVarChunksNE NonEmpty [Char]
envDocVars,
        [ Maybe [Char] -> Chunk
mMetavarChunk Maybe [Char]
envDocMetavar
        ]
      ],
    [Maybe [Char] -> Chunk
mHelpChunk Maybe [Char]
envDocHelp]
  ]

parserConfDocs :: Parser a -> AnyDocs ConfDoc
parserConfDocs :: forall a. Parser a -> AnyDocs ConfDoc
parserConfDocs = AnyDocs SetDoc -> AnyDocs ConfDoc
docsToConfDocs (AnyDocs SetDoc -> AnyDocs ConfDoc)
-> (Parser a -> AnyDocs SetDoc) -> Parser a -> AnyDocs ConfDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> AnyDocs SetDoc
forall a. Parser a -> AnyDocs SetDoc
parserDocs

docsToConfDocs :: AnyDocs SetDoc -> AnyDocs ConfDoc
docsToConfDocs :: AnyDocs SetDoc -> AnyDocs ConfDoc
docsToConfDocs = (SetDoc -> Maybe ConfDoc) -> AnyDocs SetDoc -> AnyDocs ConfDoc
forall a b. (a -> Maybe b) -> AnyDocs a -> AnyDocs b
mapMaybeDocs SetDoc -> Maybe ConfDoc
setDocConfDoc

setDocConfDoc :: SetDoc -> Maybe ConfDoc
setDocConfDoc :: SetDoc -> Maybe ConfDoc
setDocConfDoc SetDoc {Bool
[Dashed]
Maybe [Char]
Maybe (NonEmpty [Char])
Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
setDocTryArgument :: SetDoc -> Bool
setDocTrySwitch :: SetDoc -> Bool
setDocTryOption :: SetDoc -> Bool
setDocDasheds :: SetDoc -> [Dashed]
setDocEnvVars :: SetDoc -> Maybe (NonEmpty [Char])
setDocConfKeys :: SetDoc -> Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
setDocDefault :: SetDoc -> Maybe [Char]
setDocMetavar :: SetDoc -> Maybe [Char]
setDocHelp :: SetDoc -> Maybe [Char]
setDocTryArgument :: Bool
setDocTrySwitch :: Bool
setDocTryOption :: Bool
setDocDasheds :: [Dashed]
setDocEnvVars :: Maybe (NonEmpty [Char])
setDocConfKeys :: Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
setDocDefault :: Maybe [Char]
setDocMetavar :: Maybe [Char]
setDocHelp :: Maybe [Char]
..} = do
  NonEmpty (NonEmpty [Char], JSONSchema)
confDocKeys <- Maybe (NonEmpty (NonEmpty [Char], JSONSchema))
setDocConfKeys
  let confDocDefault :: Maybe [Char]
confDocDefault = Maybe [Char]
setDocDefault
  let confDocHelp :: Maybe [Char]
confDocHelp = Maybe [Char]
setDocHelp
  pure ConfDoc {Maybe [Char]
NonEmpty (NonEmpty [Char], JSONSchema)
confDocKeys :: NonEmpty (NonEmpty [Char], JSONSchema)
confDocDefault :: Maybe [Char]
confDocHelp :: Maybe [Char]
confDocKeys :: NonEmpty (NonEmpty [Char], JSONSchema)
confDocDefault :: Maybe [Char]
confDocHelp :: Maybe [Char]
..}

settingConfDoc :: Setting a -> Maybe ConfDoc
settingConfDoc :: forall a. Setting a -> Maybe ConfDoc
settingConfDoc = Setting a -> Maybe SetDoc
forall a. Setting a -> Maybe SetDoc
settingSetDoc (Setting a -> Maybe SetDoc)
-> (SetDoc -> Maybe ConfDoc) -> Setting a -> Maybe ConfDoc
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> SetDoc -> Maybe ConfDoc
setDocConfDoc

-- | Render documentation of configuration values
renderConfDocs :: AnyDocs ConfDoc -> [Chunk]
renderConfDocs :: AnyDocs ConfDoc -> [Chunk]
renderConfDocs = [[Chunk]] -> [Chunk]
unlinesChunks ([[Chunk]] -> [Chunk])
-> (AnyDocs ConfDoc -> [[Chunk]]) -> AnyDocs ConfDoc -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyDocs ConfDoc -> [[Chunk]]
go
  where
    go :: AnyDocs ConfDoc -> [[Chunk]]
    go :: AnyDocs ConfDoc -> [[Chunk]]
go = \case
      AnyDocsCommands [CommandDoc ConfDoc]
cs -> (CommandDoc ConfDoc -> [[Chunk]])
-> [CommandDoc ConfDoc] -> [[Chunk]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (AnyDocs ConfDoc -> [[Chunk]]
go (AnyDocs ConfDoc -> [[Chunk]])
-> (CommandDoc ConfDoc -> AnyDocs ConfDoc)
-> CommandDoc ConfDoc
-> [[Chunk]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandDoc ConfDoc -> AnyDocs ConfDoc
forall a. CommandDoc a -> AnyDocs a
commandDocs) [CommandDoc ConfDoc]
cs
      AnyDocsAnd [AnyDocs ConfDoc]
ds -> (AnyDocs ConfDoc -> [[Chunk]]) -> [AnyDocs ConfDoc] -> [[Chunk]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AnyDocs ConfDoc -> [[Chunk]]
go [AnyDocs ConfDoc]
ds
      AnyDocsOr [AnyDocs ConfDoc]
ds -> (AnyDocs ConfDoc -> [[Chunk]]) -> [AnyDocs ConfDoc] -> [[Chunk]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AnyDocs ConfDoc -> [[Chunk]]
go [AnyDocs ConfDoc]
ds
      AnyDocsSingle ConfDoc
ed -> [[Chunk]] -> [[Chunk]]
indent (ConfDoc -> [[Chunk]]
renderConfDoc ConfDoc
ed)

renderConfDoc :: ConfDoc -> [[Chunk]]
renderConfDoc :: ConfDoc -> [[Chunk]]
renderConfDoc ConfDoc {Maybe [Char]
NonEmpty (NonEmpty [Char], JSONSchema)
confDocKeys :: ConfDoc -> NonEmpty (NonEmpty [Char], JSONSchema)
confDocDefault :: ConfDoc -> Maybe [Char]
confDocHelp :: ConfDoc -> Maybe [Char]
confDocKeys :: NonEmpty (NonEmpty [Char], JSONSchema)
confDocDefault :: Maybe [Char]
confDocHelp :: Maybe [Char]
..} =
  [Maybe [Char] -> Chunk
mHelpChunk Maybe [Char]
confDocHelp]
    [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: ((NonEmpty [Char], JSONSchema) -> [[Chunk]])
-> [(NonEmpty [Char], JSONSchema)] -> [[Chunk]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
      ( \(NonEmpty [Char]
key, JSONSchema
schema) ->
          case JSONSchema -> [[Chunk]]
jsonSchemaChunkLines JSONSchema
schema of
            [[Chunk]
line] ->
              [[NonEmpty [Char] -> Chunk
confValChunk NonEmpty [Char]
key, Chunk
": "] [Chunk] -> [Chunk] -> [Chunk]
forall a. [a] -> [a] -> [a]
++ [Chunk]
line]
            [[Chunk]]
ls ->
              [NonEmpty [Char] -> Chunk
confValChunk NonEmpty [Char]
key, Chunk
":"] [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: [[Chunk]] -> [[Chunk]]
indent [[Chunk]]
ls
      )
      (NonEmpty (NonEmpty [Char], JSONSchema)
-> [(NonEmpty [Char], JSONSchema)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (NonEmpty [Char], JSONSchema)
confDocKeys)

progNameChunk :: String -> Chunk
progNameChunk :: [Char] -> Chunk
progNameChunk = Colour -> Chunk -> Chunk
fore Colour
yellow (Chunk -> Chunk) -> ([Char] -> Chunk) -> [Char] -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk
chunk (Text -> Chunk) -> ([Char] -> Text) -> [Char] -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

versionChunk :: Version -> Chunk
versionChunk :: Version -> Chunk
versionChunk = Text -> Chunk
chunk (Text -> Chunk) -> (Version -> Text) -> Version -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text) -> (Version -> [Char]) -> Version -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Char]
showVersion

usageChunk :: Chunk
usageChunk :: Chunk
usageChunk = Colour -> Chunk -> Chunk
fore Colour
cyan Chunk
"Usage: "

commandChunk :: String -> Chunk
commandChunk :: [Char] -> Chunk
commandChunk = Colour -> Chunk -> Chunk
fore Colour
magenta (Chunk -> Chunk) -> ([Char] -> Chunk) -> [Char] -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk
chunk (Text -> Chunk) -> ([Char] -> Text) -> [Char] -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

mMetavarChunk :: Maybe Metavar -> Chunk
mMetavarChunk :: Maybe [Char] -> Chunk
mMetavarChunk = [Char] -> Chunk
metavarChunk ([Char] -> Chunk)
-> (Maybe [Char] -> [Char]) -> Maybe [Char] -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"METAVAR"

metavarChunk :: Metavar -> Chunk
metavarChunk :: [Char] -> Chunk
metavarChunk = Colour -> Chunk -> Chunk
fore Colour
yellow (Chunk -> Chunk) -> ([Char] -> Chunk) -> [Char] -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk
chunk (Text -> Chunk) -> ([Char] -> Text) -> [Char] -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

dashedChunks :: [Dashed] -> Maybe [Chunk]
dashedChunks :: [Dashed] -> Maybe [Chunk]
dashedChunks = (NonEmpty Dashed -> [Chunk])
-> Maybe (NonEmpty Dashed) -> Maybe [Chunk]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Dashed -> [Chunk]
dashedChunksNE (Maybe (NonEmpty Dashed) -> Maybe [Chunk])
-> ([Dashed] -> Maybe (NonEmpty Dashed))
-> [Dashed]
-> Maybe [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Dashed] -> Maybe (NonEmpty Dashed)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty

dashedChunksNE :: NonEmpty Dashed -> [Chunk]
dashedChunksNE :: NonEmpty Dashed -> [Chunk]
dashedChunksNE = Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
intersperse (Colour -> Chunk -> Chunk
fore Colour
cyan Chunk
"|") ([Chunk] -> [Chunk])
-> (NonEmpty Dashed -> [Chunk]) -> NonEmpty Dashed -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dashed -> Chunk) -> [Dashed] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map Dashed -> Chunk
dashedChunk ([Dashed] -> [Chunk])
-> (NonEmpty Dashed -> [Dashed]) -> NonEmpty Dashed -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Dashed -> [Dashed]
forall a. NonEmpty a -> [a]
NE.toList

dashedChunk :: Dashed -> Chunk
dashedChunk :: Dashed -> Chunk
dashedChunk = Colour -> Chunk -> Chunk
fore Colour
white (Chunk -> Chunk) -> (Dashed -> Chunk) -> Dashed -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk
chunk (Text -> Chunk) -> (Dashed -> Text) -> Dashed -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text) -> (Dashed -> [Char]) -> Dashed -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dashed -> [Char]
Args.renderDashed

envVarChunksNE :: NonEmpty String -> [Chunk]
envVarChunksNE :: NonEmpty [Char] -> [Chunk]
envVarChunksNE = Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
intersperse (Colour -> Chunk -> Chunk
fore Colour
cyan Chunk
"|") ([Chunk] -> [Chunk])
-> (NonEmpty [Char] -> [Chunk]) -> NonEmpty [Char] -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Chunk) -> [[Char]] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Chunk
envVarChunk ([[Char]] -> [Chunk])
-> (NonEmpty [Char] -> [[Char]]) -> NonEmpty [Char] -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty [Char] -> [[Char]]
forall a. NonEmpty a -> [a]
NE.toList

envVarChunk :: String -> Chunk
envVarChunk :: [Char] -> Chunk
envVarChunk = Colour -> Chunk -> Chunk
fore Colour
white (Chunk -> Chunk) -> ([Char] -> Chunk) -> [Char] -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk
chunk (Text -> Chunk) -> ([Char] -> Text) -> [Char] -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

confValChunk :: NonEmpty String -> Chunk
confValChunk :: NonEmpty [Char] -> Chunk
confValChunk = Colour -> Chunk -> Chunk
fore Colour
white (Chunk -> Chunk)
-> (NonEmpty [Char] -> Chunk) -> NonEmpty [Char] -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk
chunk (Text -> Chunk)
-> (NonEmpty [Char] -> Text) -> NonEmpty [Char] -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text)
-> (NonEmpty [Char] -> [Char]) -> NonEmpty [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"." ([[Char]] -> [Char])
-> (NonEmpty [Char] -> [[Char]]) -> NonEmpty [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty [Char] -> [[Char]]
forall a. NonEmpty a -> [a]
NE.toList

defaultValueChunks :: String -> [Chunk]
defaultValueChunks :: [Char] -> [Chunk]
defaultValueChunks [Char]
val = [Chunk
"default: ", Colour -> Chunk -> Chunk
fore Colour
yellow (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
val]

mHelpChunk :: Maybe Help -> Chunk
mHelpChunk :: Maybe [Char] -> Chunk
mHelpChunk = Chunk -> ([Char] -> Chunk) -> Maybe [Char] -> Chunk
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Colour -> Chunk -> Chunk
fore Colour
red Chunk
"undocumented") [Char] -> Chunk
helpChunk

helpChunk :: Help -> Chunk
helpChunk :: [Char] -> Chunk
helpChunk = Colour -> Chunk -> Chunk
fore Colour
blue (Chunk -> Chunk) -> ([Char] -> Chunk) -> [Char] -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk
chunk (Text -> Chunk) -> ([Char] -> Text) -> [Char] -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

headerChunks :: Text -> [Chunk]
headerChunks :: Text -> [Chunk]
headerChunks Text
t = [Colour -> Chunk -> Chunk
fore Colour
cyan (Text -> Chunk
chunk Text
t), Chunk
":"]

indent :: [[Chunk]] -> [[Chunk]]
indent :: [[Chunk]] -> [[Chunk]]
indent = ([Chunk] -> [Chunk]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map (Chunk
"  " Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
:)