{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      :  ELynx.Tools.Options
-- Description :  General ELynx options
-- Copyright   :  (c) 2021 Dominik Schrempf
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Creation date: Thu Sep  2 19:17:07 2021.
module ELynx.Tools.Options
  ( -- * Command options
    SeedOpt (..),
    seedOpt,
    executionModeOpt,

    -- * Arguments
    GlobalArguments (..),
    Arguments (..),

    -- * Misc
    parseArguments,
    elynxParserInfo,
    createCommandReproducible,
    createCommand,
    elynxFooter,
  )
where

import Data.Aeson
import Data.List
import qualified Data.Vector.Unboxed as VU
import Data.Word
import ELynx.Tools.InputOutput
import ELynx.Tools.Logger
import ELynx.Tools.Misc
import ELynx.Tools.Reproduction
import Options.Applicative hiding (empty)
import Options.Applicative.Help.Pretty

-- | Seed option for MWC. Defaults to Random.
seedOpt :: Parser SeedOpt
seedOpt :: Parser SeedOpt
seedOpt = Maybe (Vector Word32) -> SeedOpt
toSeedOpt (Maybe (Vector Word32) -> SeedOpt)
-> Parser (Maybe (Vector Word32)) -> Parser SeedOpt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe (Vector Word32))
seedParser

seedParser :: Parser (Maybe (VU.Vector Word32))
seedParser :: Parser (Maybe (Vector Word32))
seedParser =
  Parser (Vector Word32) -> Parser (Maybe (Vector Word32))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser (Vector Word32) -> Parser (Maybe (Vector Word32)))
-> Parser (Vector Word32) -> Parser (Maybe (Vector Word32))
forall a b. (a -> b) -> a -> b
$
    ReadM (Vector Word32)
-> Mod OptionFields (Vector Word32) -> Parser (Vector Word32)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
      ReadM (Vector Word32)
forall a. Read a => ReadM a
auto
      ( String -> Mod OptionFields (Vector Word32)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"seed" Mod OptionFields (Vector Word32)
-> Mod OptionFields (Vector Word32)
-> Mod OptionFields (Vector Word32)
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields (Vector Word32)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'S' Mod OptionFields (Vector Word32)
-> Mod OptionFields (Vector Word32)
-> Mod OptionFields (Vector Word32)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Vector Word32)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"[INT]"
          Mod OptionFields (Vector Word32)
-> Mod OptionFields (Vector Word32)
-> Mod OptionFields (Vector Word32)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Vector Word32)
forall (f :: * -> *) a. String -> Mod f a
help
            ( String
"Seed for random number generator; "
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"list of 32 bit integers with up to 256 elements (default: random)"
            )
      )

toSeedOpt :: Maybe (VU.Vector Word32) -> SeedOpt
toSeedOpt :: Maybe (Vector Word32) -> SeedOpt
toSeedOpt Maybe (Vector Word32)
Nothing = SeedOpt
RandomUnset
toSeedOpt (Just Vector Word32
w) = Vector Word32 -> SeedOpt
Fixed Vector Word32
w

-- Execution mode option parser.
executionModeOpt :: Parser ExecutionMode
executionModeOpt :: Parser ExecutionMode
executionModeOpt =
  ExecutionMode
-> ExecutionMode
-> Mod FlagFields ExecutionMode
-> Parser ExecutionMode
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
    ExecutionMode
Fail
    ExecutionMode
Overwrite
    -- DO NOT CHANGE. This option is used by 'elynx redo'.
    ( String -> Mod FlagFields ExecutionMode
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"force" Mod FlagFields ExecutionMode
-> Mod FlagFields ExecutionMode -> Mod FlagFields ExecutionMode
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields ExecutionMode
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f'
        Mod FlagFields ExecutionMode
-> Mod FlagFields ExecutionMode -> Mod FlagFields ExecutionMode
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ExecutionMode
forall (f :: * -> *) a. String -> Mod f a
help
          String
"Ignore previous analysis and overwrite existing output files."
    )

-- | A set of global arguments used by all programs. The idea is to provide a
-- common framework for shared arguments.
data GlobalArguments = GlobalArguments
  { GlobalArguments -> Verbosity
verbosity :: Verbosity,
    GlobalArguments -> Maybe String
outFileBaseName :: Maybe FilePath,
    GlobalArguments -> ExecutionMode
executionMode :: ExecutionMode,
    GlobalArguments -> Bool
writeElynxFile :: Bool
  }
  deriving (GlobalArguments -> GlobalArguments -> Bool
(GlobalArguments -> GlobalArguments -> Bool)
-> (GlobalArguments -> GlobalArguments -> Bool)
-> Eq GlobalArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobalArguments -> GlobalArguments -> Bool
$c/= :: GlobalArguments -> GlobalArguments -> Bool
== :: GlobalArguments -> GlobalArguments -> Bool
$c== :: GlobalArguments -> GlobalArguments -> Bool
Eq, Int -> GlobalArguments -> String -> String
[GlobalArguments] -> String -> String
GlobalArguments -> String
(Int -> GlobalArguments -> String -> String)
-> (GlobalArguments -> String)
-> ([GlobalArguments] -> String -> String)
-> Show GlobalArguments
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GlobalArguments] -> String -> String
$cshowList :: [GlobalArguments] -> String -> String
show :: GlobalArguments -> String
$cshow :: GlobalArguments -> String
showsPrec :: Int -> GlobalArguments -> String -> String
$cshowsPrec :: Int -> GlobalArguments -> String -> String
Show, (forall x. GlobalArguments -> Rep GlobalArguments x)
-> (forall x. Rep GlobalArguments x -> GlobalArguments)
-> Generic GlobalArguments
forall x. Rep GlobalArguments x -> GlobalArguments
forall x. GlobalArguments -> Rep GlobalArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlobalArguments x -> GlobalArguments
$cfrom :: forall x. GlobalArguments -> Rep GlobalArguments x
Generic)

instance FromJSON GlobalArguments

instance ToJSON GlobalArguments

-- | See 'GlobalArguments', parser function.
globalArguments :: Parser GlobalArguments
globalArguments :: Parser GlobalArguments
globalArguments =
  Verbosity
-> Maybe String -> ExecutionMode -> Bool -> GlobalArguments
GlobalArguments
    (Verbosity
 -> Maybe String -> ExecutionMode -> Bool -> GlobalArguments)
-> Parser Verbosity
-> Parser
     (Maybe String -> ExecutionMode -> Bool -> GlobalArguments)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Verbosity
verbosityOpt Parser (Maybe String -> ExecutionMode -> Bool -> GlobalArguments)
-> Parser (Maybe String)
-> Parser (ExecutionMode -> Bool -> GlobalArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
outFileBaseNameOpt Parser (ExecutionMode -> Bool -> GlobalArguments)
-> Parser ExecutionMode -> Parser (Bool -> GlobalArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ExecutionMode
executionModeOpt Parser (Bool -> GlobalArguments)
-> Parser Bool -> Parser GlobalArguments
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
writeELynxOpt

-- Boolean option; be verbose; default NO.
verbosityOpt :: Parser Verbosity
verbosityOpt :: Parser Verbosity
verbosityOpt =
  ReadM Verbosity -> Mod OptionFields Verbosity -> Parser Verbosity
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM Verbosity
forall a. Read a => ReadM a
auto
    ( String -> Mod OptionFields Verbosity
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"verbosity"
        Mod OptionFields Verbosity
-> Mod OptionFields Verbosity -> Mod OptionFields Verbosity
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Verbosity
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v'
        Mod OptionFields Verbosity
-> Mod OptionFields Verbosity -> Mod OptionFields Verbosity
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Verbosity
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"VALUE"
        Mod OptionFields Verbosity
-> Mod OptionFields Verbosity -> Mod OptionFields Verbosity
forall a. Semigroup a => a -> a -> a
<> Verbosity -> Mod OptionFields Verbosity
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Verbosity
Info
        Mod OptionFields Verbosity
-> Mod OptionFields Verbosity -> Mod OptionFields Verbosity
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Verbosity
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields Verbosity
-> Mod OptionFields Verbosity -> Mod OptionFields Verbosity
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Verbosity
forall (f :: * -> *) a. String -> Mod f a
help (String
"Be verbose; one of: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((Verbosity -> String) -> [Verbosity] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Verbosity -> String
forall a. Show a => a -> String
show [Verbosity]
vs))
    )
  where
    vs :: [Verbosity]
vs = [Verbosity]
forall a. (Bounded a, Enum a) => [a]
allValues :: [Verbosity]

-- Output filename.
outFileBaseNameOpt :: Parser FilePath
outFileBaseNameOpt :: Parser String
outFileBaseNameOpt =
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"output-file-basename" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'o' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NAME"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help
          String
"Specify base name of output file"
    )

-- Write ELynx file at the end.
writeELynxOpt :: Parser Bool
writeELynxOpt :: Parser Bool
writeELynxOpt =
  Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
    Bool
True
    Bool
False
    ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-elynx-file"
        Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Do not write data required to reproduce an analysis."
    )

-- | Argument skeleton to be used with all commands.
data Arguments a = Arguments
  { Arguments a -> GlobalArguments
global :: GlobalArguments,
    Arguments a -> a
local :: a
  }
  deriving (Arguments a -> Arguments a -> Bool
(Arguments a -> Arguments a -> Bool)
-> (Arguments a -> Arguments a -> Bool) -> Eq (Arguments a)
forall a. Eq a => Arguments a -> Arguments a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Arguments a -> Arguments a -> Bool
$c/= :: forall a. Eq a => Arguments a -> Arguments a -> Bool
== :: Arguments a -> Arguments a -> Bool
$c== :: forall a. Eq a => Arguments a -> Arguments a -> Bool
Eq, Int -> Arguments a -> String -> String
[Arguments a] -> String -> String
Arguments a -> String
(Int -> Arguments a -> String -> String)
-> (Arguments a -> String)
-> ([Arguments a] -> String -> String)
-> Show (Arguments a)
forall a. Show a => Int -> Arguments a -> String -> String
forall a. Show a => [Arguments a] -> String -> String
forall a. Show a => Arguments a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Arguments a] -> String -> String
$cshowList :: forall a. Show a => [Arguments a] -> String -> String
show :: Arguments a -> String
$cshow :: forall a. Show a => Arguments a -> String
showsPrec :: Int -> Arguments a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> Arguments a -> String -> String
Show, (forall x. Arguments a -> Rep (Arguments a) x)
-> (forall x. Rep (Arguments a) x -> Arguments a)
-> Generic (Arguments a)
forall x. Rep (Arguments a) x -> Arguments a
forall x. Arguments a -> Rep (Arguments a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Arguments a) x -> Arguments a
forall a x. Arguments a -> Rep (Arguments a) x
$cto :: forall a x. Rep (Arguments a) x -> Arguments a
$cfrom :: forall a x. Arguments a -> Rep (Arguments a) x
Generic)

instance FromJSON a => FromJSON (Arguments a)

instance ToJSON a => ToJSON (Arguments a)

instance Reproducible a => Reproducible (Arguments a) where
  inFiles :: Arguments a -> [String]
inFiles = a -> [String]
forall a. Reproducible a => a -> [String]
inFiles (a -> [String]) -> (Arguments a -> a) -> Arguments a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments a -> a
forall a. Arguments a -> a
local
  outSuffixes :: Arguments a -> [String]
outSuffixes = a -> [String]
forall a. Reproducible a => a -> [String]
outSuffixes (a -> [String]) -> (Arguments a -> a) -> Arguments a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments a -> a
forall a. Arguments a -> a
local
  getSeed :: Arguments a -> Maybe SeedOpt
getSeed = a -> Maybe SeedOpt
forall a. Reproducible a => a -> Maybe SeedOpt
getSeed (a -> Maybe SeedOpt)
-> (Arguments a -> a) -> Arguments a -> Maybe SeedOpt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments a -> a
forall a. Arguments a -> a
local
  setSeed :: Arguments a -> SeedOpt -> Arguments a
setSeed (Arguments GlobalArguments
g a
l) SeedOpt
s = GlobalArguments -> a -> Arguments a
forall a. GlobalArguments -> a -> Arguments a
Arguments GlobalArguments
g (a -> Arguments a) -> a -> Arguments a
forall a b. (a -> b) -> a -> b
$ a -> SeedOpt -> a
forall a. Reproducible a => a -> SeedOpt -> a
setSeed a
l SeedOpt
s
  parser :: Parser (Arguments a)
parser = Parser a -> Parser (Arguments a)
forall a. Parser a -> Parser (Arguments a)
argumentsParser (Reproducible a => Parser a
forall a. Reproducible a => Parser a
parser @a)
  cmdName :: String
cmdName = Reproducible a => String
forall a. Reproducible a => String
cmdName @a
  cmdDsc :: [String]
cmdDsc = Reproducible a => [String]
forall a. Reproducible a => [String]
cmdDsc @a
  cmdFtr :: [String]
cmdFtr = Reproducible a => [String]
forall a. Reproducible a => [String]
cmdFtr @a

argumentsParser :: Parser a -> Parser (Arguments a)
argumentsParser :: Parser a -> Parser (Arguments a)
argumentsParser Parser a
p = GlobalArguments -> a -> Arguments a
forall a. GlobalArguments -> a -> Arguments a
Arguments (GlobalArguments -> a -> Arguments a)
-> Parser GlobalArguments -> Parser (a -> Arguments a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GlobalArguments
globalArguments Parser (a -> Arguments a) -> Parser a -> Parser (Arguments a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
p

versionOpt :: Parser (a -> a)
versionOpt :: Parser (a -> a)
versionOpt =
  String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
    (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [String]
logHeader)
    ( String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"version"
        -- Lower case 'v' clashes with verbosity.
        Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'V'
        Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
help String
"Show version"
        Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields (a -> a)
forall (f :: * -> *) a. Mod f a
hidden
    )

elynxParser :: Parser a -> Parser a
elynxParser :: Parser a -> Parser a
elynxParser Parser a
p = Parser ((a -> a) -> a -> a)
forall a. Parser (a -> a)
helper Parser ((a -> a) -> a -> a) -> Parser (a -> a) -> Parser (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (a -> a)
forall a. Parser (a -> a)
versionOpt Parser (a -> a) -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
p

-- | Parse arguments. Provide a global description, header, footer, and so on.
-- Custom additional description (first argument) and footer (second argument)
-- can be provided. print help if needed.
parseArguments :: forall a. Reproducible a => IO (Arguments a)
parseArguments :: IO (Arguments a)
parseArguments =
  ParserInfo (Arguments a) -> IO (Arguments a)
forall a. ParserInfo a -> IO a
execParser (ParserInfo (Arguments a) -> IO (Arguments a))
-> ParserInfo (Arguments a) -> IO (Arguments a)
forall a b. (a -> b) -> a -> b
$
    [String]
-> [String] -> Parser (Arguments a) -> ParserInfo (Arguments a)
forall a. [String] -> [String] -> Parser a -> ParserInfo a
elynxParserInfo (Reproducible a => [String]
forall a. Reproducible a => [String]
cmdDsc @a) (Reproducible a => [String]
forall a. Reproducible a => [String]
cmdFtr @a) (Parser a -> Parser (Arguments a)
forall a. Parser a -> Parser (Arguments a)
argumentsParser (Parser a -> Parser (Arguments a))
-> Parser a -> Parser (Arguments a)
forall a b. (a -> b) -> a -> b
$ Reproducible a => Parser a
forall a. Reproducible a => Parser a
parser @a)

-- | ELynx parser info; convenience function.
elynxParserInfo :: [String] -> [String] -> Parser a -> ParserInfo a
elynxParserInfo :: [String] -> [String] -> Parser a -> ParserInfo a
elynxParserInfo [String]
dsc [String]
ftr = Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a
forall a. Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a
parserInfo Maybe Doc
dsc' Maybe Doc
ftr'
  where
    dsc' :: Maybe Doc
dsc' = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
dsc then Maybe Doc
forall a. Maybe a
Nothing else Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
forall a. Pretty a => a -> Doc
pretty [String]
dsc
    ftr' :: Maybe Doc
ftr' = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> ([Doc] -> Doc) -> [Doc] -> Maybe Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vsep ([Doc] -> Maybe Doc) -> [Doc] -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
forall a. Pretty a => a -> Doc
pretty [String]
ftr [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
elynxFooter

-- Short version of ELynx parser info for sub commands.
parserInfo :: Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a
parserInfo :: Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a
parserInfo Maybe Doc
dsc Maybe Doc
ftr Parser a
p =
  Parser a -> InfoMod a -> ParserInfo a
forall a. Parser a -> InfoMod a -> ParserInfo a
info
    (Parser a -> Parser a
forall a. Parser a -> Parser a
elynxParser Parser a
p)
    (InfoMod a
forall a. InfoMod a
fullDesc InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> InfoMod a
forall a. Maybe Doc -> InfoMod a
headerDoc (Doc -> Maybe Doc
forall a. a -> Maybe a
Just Doc
hdr') InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> InfoMod a
forall a. Maybe Doc -> InfoMod a
progDescDoc Maybe Doc
dsc InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> InfoMod a
forall a. Maybe Doc -> InfoMod a
footerDoc Maybe Doc
ftr)
  where
    hdr' :: Doc
hdr' = [Doc] -> Doc
vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
forall a. Pretty a => a -> Doc
pretty [String]
logHeader

-- | Create a command; convenience function.
createCommandReproducible ::
  forall a b. Reproducible a => (a -> b) -> Mod CommandFields b
createCommandReproducible :: (a -> b) -> Mod CommandFields b
createCommandReproducible a -> b
f =
  String -> ParserInfo b -> Mod CommandFields b
forall a. String -> ParserInfo a -> Mod CommandFields a
command (Reproducible a => String
forall a. Reproducible a => String
cmdName @a) (ParserInfo b -> Mod CommandFields b)
-> ParserInfo b -> Mod CommandFields b
forall a b. (a -> b) -> a -> b
$
    a -> b
f
      (a -> b) -> ParserInfo a -> ParserInfo b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a
forall a. Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a
parserInfo
        Maybe Doc
dsc'
        Maybe Doc
ftr'
        (Reproducible a => Parser a
forall a. Reproducible a => Parser a
parser @a)
  where
    dsc :: [String]
dsc = Reproducible a => [String]
forall a. Reproducible a => [String]
cmdDsc @a
    ftr :: [String]
ftr = Reproducible a => [String]
forall a. Reproducible a => [String]
cmdFtr @a
    dsc' :: Maybe Doc
dsc' = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
dsc then Maybe Doc
forall a. Maybe a
Nothing else Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
forall a. Pretty a => a -> Doc
pretty [String]
dsc
    ftr' :: Maybe Doc
ftr' = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ftr then Maybe Doc
forall a. Maybe a
Nothing else Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
forall a. Pretty a => a -> Doc
pretty [String]
ftr

-- | Create a command; convenience function.
createCommand ::
  String ->
  [String] ->
  [String] ->
  Parser a ->
  (a -> b) ->
  Mod CommandFields b
createCommand :: String
-> [String]
-> [String]
-> Parser a
-> (a -> b)
-> Mod CommandFields b
createCommand String
nm [String]
dsc [String]
ftr Parser a
p a -> b
f = String -> ParserInfo b -> Mod CommandFields b
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
nm (ParserInfo b -> Mod CommandFields b)
-> ParserInfo b -> Mod CommandFields b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> ParserInfo a -> ParserInfo b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a
forall a. Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a
parserInfo Maybe Doc
dsc' Maybe Doc
ftr' Parser a
p
  where
    dsc' :: Maybe Doc
dsc' = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
dsc then Maybe Doc
forall a. Maybe a
Nothing else Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
forall a. Pretty a => a -> Doc
pretty [String]
dsc
    ftr' :: Maybe Doc
ftr' = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ftr then Maybe Doc
forall a. Maybe a
Nothing else Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
forall a. Pretty a => a -> Doc
pretty [String]
ftr

-- Fill a string so that it becomes a paragraph with line breaks. Useful for
-- descriptions, headers and footers.
fillParagraph :: String -> Doc
fillParagraph :: String -> Doc
fillParagraph = [Doc] -> Doc
fillSep ([Doc] -> Doc) -> (String -> [Doc]) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text ([String] -> [Doc]) -> (String -> [String]) -> String -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words

elynxFooter :: [Doc]
elynxFooter :: [Doc]
elynxFooter =
  [ String -> Doc
text String
"ELynx",
    String -> Doc
text String
"-----",
    String -> Doc
fillParagraph
      String
"A Haskell library and tool set for computational biology. The goal of ELynx is reproducible research. Evolutionary sequences and phylogenetic trees can be read, viewed, modified and simulated. The command line with all arguments is logged consistently, and automatically. Data integrity is verified using SHA256 sums so that validation of past analyses is possible without the need to recompute the result.",
    Doc
empty,
    Int -> Doc -> Doc
fill Int
9 (String -> Doc
text String
"slynx")
      Doc -> Doc -> Doc
<+> String -> Doc
text String
"Analyze, modify, and simulate evolutionary sequences.",
    Int -> Doc -> Doc
fill Int
9 (String -> Doc
text String
"tlynx")
      Doc -> Doc -> Doc
<+> String -> Doc
text String
"Analyze, modify, and simulate phylogenetic trees.",
    Int -> Doc -> Doc
fill Int
9 (String -> Doc
text String
"elynx") Doc -> Doc -> Doc
<+> String -> Doc
text String
"Validate and redo past analyses.",
    Doc
empty,
    String -> Doc
text String
"Get help for sub commands:",
    String -> Doc
text String
"  slynx examine --help"
  ]