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

-- |
-- Module      :  ELynx.Tools.Options
-- Description :  General ELynx options
-- Copyright   :  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,
    executionModeOpt,

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

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

import Data.Aeson
import Data.List
import ELynx.Tools.InputOutput
import ELynx.Tools.Logger
import ELynx.Tools.Reproduction
import GHC.Generics
import Options.Applicative hiding (empty)
import Options.Applicative.Help.Pretty

-- | Seed option. Defaults to random.
seedOpt :: Parser SeedOpt
seedOpt :: Parser SeedOpt
seedOpt = Maybe Int -> SeedOpt
toSeedOpt (Maybe Int -> SeedOpt) -> Parser (Maybe Int) -> Parser SeedOpt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Int)
seedParser

seedParser :: Parser (Maybe Int)
seedParser :: Parser (Maybe Int)
seedParser =
  Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
    (Parser Int -> Parser (Maybe Int))
-> Parser Int -> Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$ ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
      ReadM Int
forall a. Read a => ReadM a
auto
    (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"seed"
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'S'
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT"
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help (String
"Seed for random number generator (default: random)")

toSeedOpt :: Maybe Int -> SeedOpt
toSeedOpt :: Maybe Int -> SeedOpt
toSeedOpt Maybe Int
Nothing = SeedOpt
RandomUnset
toSeedOpt (Just Int
w) = Int -> SeedOpt
Fixed Int
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 -> ShowS
[GlobalArguments] -> ShowS
GlobalArguments -> String
(Int -> GlobalArguments -> ShowS)
-> (GlobalArguments -> String)
-> ([GlobalArguments] -> ShowS)
-> Show GlobalArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobalArguments] -> ShowS
$cshowList :: [GlobalArguments] -> ShowS
show :: GlobalArguments -> String
$cshow :: GlobalArguments -> String
showsPrec :: Int -> GlobalArguments -> ShowS
$cshowsPrec :: Int -> GlobalArguments -> ShowS
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 -> ShowS
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 => a
minBound ..] :: [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 -> ShowS
[Arguments a] -> ShowS
Arguments a -> String
(Int -> Arguments a -> ShowS)
-> (Arguments a -> String)
-> ([Arguments a] -> ShowS)
-> Show (Arguments a)
forall a. Show a => Int -> Arguments a -> ShowS
forall a. Show a => [Arguments a] -> ShowS
forall a. Show a => Arguments a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Arguments a] -> ShowS
$cshowList :: forall a. Show a => [Arguments a] -> ShowS
show :: Arguments a -> String
$cshow :: forall a. Show a => Arguments a -> String
showsPrec :: Int -> Arguments a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Arguments a -> ShowS
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

-- | Global ELynx footer.
elynxFooter :: [Doc]
elynxFooter :: [Doc]
elynxFooter =
  [ Doc
empty,
    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 commands:",
    String -> Doc
text String
"  slynx --help",
    Doc
empty,
    String -> Doc
text String
"Get help for sub commands:",
    String -> Doc
text String
"  slynx examine --help"
  ]