{-# LANGUAGE DeriveGeneric #-}

-- |
-- Module      :  SLynx.Simulate.Options
-- Description :  ELynxSim argument parsing
-- Copyright   :  (c) Dominik Schrempf 2021
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Sun Oct  7 17:29:45 2018.
--
-- Available options:
--   -h,--help                Show this help text
--   -v,--version             Show version
--   -t,--tree-file NAME      Specify tree file NAME
--   -s,--substitution-model MODEL
--                            Set the phylogenetic substitution model; available
--                            models are shown below
--   -m,--mixture-model MODEL Set the phylogenetic mixture model; available models
--                            are shown below
--   -l,--length NUMBER       Set alignment length to NUMBER
--   -e,--edm-file NAME       empirical distribution model file NAME in Phylobayes
--                            format
--   -w,--mixture-model-weights [DOUBLE,DOUBLE,...]
--                            weights of mixture model components
--   -g,--gamma-rate-heterogeneity (NCAT, SHAPE)
--                            number of gamma rate categories and shape parameter
--   -e,--seed [INT]            Set seed for the random number generator; list of 32
--                            bit integers with up to 256 elements (default: [0])
--   -q,--quiet               Be quiet
--   -o,--output-file NAME    Specify output file NAME
module SLynx.Simulate.Options
  ( GammaRateHeterogeneityParams,
    SimulateArguments (..),
    simulateArguments,
    simulateFooter,
  )
where

import Data.Aeson
import Data.Maybe
  ( fromMaybe,
    maybeToList,
  )
import ELynx.Tools.Options
import ELynx.Tools.Reproduction
import GHC.Generics
import Options.Applicative

-- | Number of gamma rate categories and alpha parameter.
type GammaRateHeterogeneityParams = (Int, Double)

-- | Arguments needed to simulate sequences.
data SimulateArguments = SimulateArguments
  { SimulateArguments -> FilePath
argsTreeFile :: FilePath,
    SimulateArguments -> Maybe FilePath
argsSubstitutionModelString :: Maybe String,
    SimulateArguments -> Maybe FilePath
argsMixtureModelString :: Maybe String,
    SimulateArguments -> Maybe FilePath
argsEDMFile :: Maybe FilePath,
    SimulateArguments -> Maybe [FilePath]
argsSiteprofilesFiles :: Maybe [FilePath],
    SimulateArguments -> Maybe [Double]
argsMixtureWeights :: Maybe [Double],
    SimulateArguments -> Maybe GammaRateHeterogeneityParams
argsGammaParams :: Maybe GammaRateHeterogeneityParams,
    SimulateArguments -> Int
argsLength :: Int,
    SimulateArguments -> SeedOpt
argsSeed :: SeedOpt
  }
  deriving (SimulateArguments -> SimulateArguments -> Bool
(SimulateArguments -> SimulateArguments -> Bool)
-> (SimulateArguments -> SimulateArguments -> Bool)
-> Eq SimulateArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimulateArguments -> SimulateArguments -> Bool
$c/= :: SimulateArguments -> SimulateArguments -> Bool
== :: SimulateArguments -> SimulateArguments -> Bool
$c== :: SimulateArguments -> SimulateArguments -> Bool
Eq, Int -> SimulateArguments -> ShowS
[SimulateArguments] -> ShowS
SimulateArguments -> FilePath
(Int -> SimulateArguments -> ShowS)
-> (SimulateArguments -> FilePath)
-> ([SimulateArguments] -> ShowS)
-> Show SimulateArguments
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SimulateArguments] -> ShowS
$cshowList :: [SimulateArguments] -> ShowS
show :: SimulateArguments -> FilePath
$cshow :: SimulateArguments -> FilePath
showsPrec :: Int -> SimulateArguments -> ShowS
$cshowsPrec :: Int -> SimulateArguments -> ShowS
Show, (forall x. SimulateArguments -> Rep SimulateArguments x)
-> (forall x. Rep SimulateArguments x -> SimulateArguments)
-> Generic SimulateArguments
forall x. Rep SimulateArguments x -> SimulateArguments
forall x. SimulateArguments -> Rep SimulateArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SimulateArguments x -> SimulateArguments
$cfrom :: forall x. SimulateArguments -> Rep SimulateArguments x
Generic)

instance Reproducible SimulateArguments where
  inFiles :: SimulateArguments -> [FilePath]
inFiles SimulateArguments
a =
    SimulateArguments -> FilePath
argsTreeFile SimulateArguments
a FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:
    (Maybe FilePath -> [FilePath]
forall a. Maybe a -> [a]
maybeToList (SimulateArguments -> Maybe FilePath
argsEDMFile SimulateArguments
a) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath] -> Maybe [FilePath] -> [FilePath]
forall a. a -> Maybe a -> a
fromMaybe [] (SimulateArguments -> Maybe [FilePath]
argsSiteprofilesFiles SimulateArguments
a))
  outSuffixes :: SimulateArguments -> [FilePath]
outSuffixes SimulateArguments
_ = [FilePath
".model.gz", FilePath
".fasta"]
  getSeed :: SimulateArguments -> Maybe SeedOpt
getSeed = SeedOpt -> Maybe SeedOpt
forall a. a -> Maybe a
Just (SeedOpt -> Maybe SeedOpt)
-> (SimulateArguments -> SeedOpt)
-> SimulateArguments
-> Maybe SeedOpt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimulateArguments -> SeedOpt
argsSeed
  setSeed :: SimulateArguments -> SeedOpt -> SimulateArguments
setSeed SimulateArguments
a SeedOpt
s = SimulateArguments
a {argsSeed :: SeedOpt
argsSeed = SeedOpt
s}
  parser :: Parser SimulateArguments
parser = Parser SimulateArguments
simulateArguments
  cmdName :: FilePath
cmdName = FilePath
"simulate"
  cmdDsc :: [FilePath]
cmdDsc = [FilePath
"Simulate multi sequence alignments."]
  cmdFtr :: [FilePath]
cmdFtr = [FilePath]
simulateFooter

instance FromJSON SimulateArguments

instance ToJSON SimulateArguments

-- | Sub command parser.
simulateArguments :: Parser SimulateArguments
simulateArguments :: Parser SimulateArguments
simulateArguments =
  FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Maybe [FilePath]
-> Maybe [Double]
-> Maybe GammaRateHeterogeneityParams
-> Int
-> SeedOpt
-> SimulateArguments
SimulateArguments
    (FilePath
 -> Maybe FilePath
 -> Maybe FilePath
 -> Maybe FilePath
 -> Maybe [FilePath]
 -> Maybe [Double]
 -> Maybe GammaRateHeterogeneityParams
 -> Int
 -> SeedOpt
 -> SimulateArguments)
-> Parser FilePath
-> Parser
     (Maybe FilePath
      -> Maybe FilePath
      -> Maybe FilePath
      -> Maybe [FilePath]
      -> Maybe [Double]
      -> Maybe GammaRateHeterogeneityParams
      -> Int
      -> SeedOpt
      -> SimulateArguments)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath
treeFileOpt
    Parser
  (Maybe FilePath
   -> Maybe FilePath
   -> Maybe FilePath
   -> Maybe [FilePath]
   -> Maybe [Double]
   -> Maybe GammaRateHeterogeneityParams
   -> Int
   -> SeedOpt
   -> SimulateArguments)
-> Parser (Maybe FilePath)
-> Parser
     (Maybe FilePath
      -> Maybe FilePath
      -> Maybe [FilePath]
      -> Maybe [Double]
      -> Maybe GammaRateHeterogeneityParams
      -> Int
      -> SeedOpt
      -> SimulateArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe FilePath)
phyloSubstitutionModelOpt
    Parser
  (Maybe FilePath
   -> Maybe FilePath
   -> Maybe [FilePath]
   -> Maybe [Double]
   -> Maybe GammaRateHeterogeneityParams
   -> Int
   -> SeedOpt
   -> SimulateArguments)
-> Parser (Maybe FilePath)
-> Parser
     (Maybe FilePath
      -> Maybe [FilePath]
      -> Maybe [Double]
      -> Maybe GammaRateHeterogeneityParams
      -> Int
      -> SeedOpt
      -> SimulateArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe FilePath)
phyloMixtureModelOpt
    Parser
  (Maybe FilePath
   -> Maybe [FilePath]
   -> Maybe [Double]
   -> Maybe GammaRateHeterogeneityParams
   -> Int
   -> SeedOpt
   -> SimulateArguments)
-> Parser (Maybe FilePath)
-> Parser
     (Maybe [FilePath]
      -> Maybe [Double]
      -> Maybe GammaRateHeterogeneityParams
      -> Int
      -> SeedOpt
      -> SimulateArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe FilePath)
maybeEDMFileOpt
    Parser
  (Maybe [FilePath]
   -> Maybe [Double]
   -> Maybe GammaRateHeterogeneityParams
   -> Int
   -> SeedOpt
   -> SimulateArguments)
-> Parser (Maybe [FilePath])
-> Parser
     (Maybe [Double]
      -> Maybe GammaRateHeterogeneityParams
      -> Int
      -> SeedOpt
      -> SimulateArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe [FilePath])
maybeSiteprofilesFilesOpt
    Parser
  (Maybe [Double]
   -> Maybe GammaRateHeterogeneityParams
   -> Int
   -> SeedOpt
   -> SimulateArguments)
-> Parser (Maybe [Double])
-> Parser
     (Maybe GammaRateHeterogeneityParams
      -> Int -> SeedOpt -> SimulateArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe [Double])
maybeMixtureWeights
    Parser
  (Maybe GammaRateHeterogeneityParams
   -> Int -> SeedOpt -> SimulateArguments)
-> Parser (Maybe GammaRateHeterogeneityParams)
-> Parser (Int -> SeedOpt -> SimulateArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe GammaRateHeterogeneityParams)
maybeGammaParams
    Parser (Int -> SeedOpt -> SimulateArguments)
-> Parser Int -> Parser (SeedOpt -> SimulateArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int
lengthOpt
    Parser (SeedOpt -> SimulateArguments)
-> Parser SeedOpt -> Parser SimulateArguments
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SeedOpt
seedOpt

treeFileOpt :: Parser FilePath
treeFileOpt :: Parser FilePath
treeFileOpt =
  Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$
    FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"tree-file" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
't' Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"Name"
      Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help
        FilePath
"Read tree from Newick file NAME"

phyloSubstitutionModelOpt :: Parser (Maybe String)
phyloSubstitutionModelOpt :: Parser (Maybe FilePath)
phyloSubstitutionModelOpt =
  Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser FilePath -> Parser (Maybe FilePath))
-> Parser FilePath -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$
    Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$
      FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"substitution-model"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
's'
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"MODEL"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help
          FilePath
"Set the phylogenetic substitution model; available models are shown below (mutually exclusive with -m option)"

phyloMixtureModelOpt :: Parser (Maybe String)
phyloMixtureModelOpt :: Parser (Maybe FilePath)
phyloMixtureModelOpt =
  Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser FilePath -> Parser (Maybe FilePath))
-> Parser FilePath -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$
    Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"mixture-model"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'm'
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"MODEL"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help
            FilePath
"Set the phylogenetic mixture model; available models are shown below (mutually exclusive with -s option)"
      )

maybeEDMFileOpt :: Parser (Maybe FilePath)
maybeEDMFileOpt :: Parser (Maybe FilePath)
maybeEDMFileOpt =
  Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser FilePath -> Parser (Maybe FilePath))
-> Parser FilePath -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$
    Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"edm-file" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'e' Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NAME"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help
            FilePath
"Empirical distribution model file NAME in Phylobayes format"
      )

maybeSiteprofilesFilesOpt :: Parser (Maybe [FilePath])
maybeSiteprofilesFilesOpt :: Parser (Maybe [FilePath])
maybeSiteprofilesFilesOpt =
  Parser [FilePath] -> Parser (Maybe [FilePath])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser [FilePath] -> Parser (Maybe [FilePath]))
-> Parser [FilePath] -> Parser (Maybe [FilePath])
forall a b. (a -> b) -> a -> b
$
    FilePath -> [FilePath]
words
      (FilePath -> [FilePath]) -> Parser FilePath -> Parser [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"siteprofile-files" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p' Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NAMES"
            Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help
              FilePath
"File names of site profiles in Phylobayes format"
        )

maybeMixtureWeights :: Parser (Maybe [Double])
maybeMixtureWeights :: Parser (Maybe [Double])
maybeMixtureWeights =
  Parser [Double] -> Parser (Maybe [Double])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser [Double] -> Parser (Maybe [Double]))
-> Parser [Double] -> Parser (Maybe [Double])
forall a b. (a -> b) -> a -> b
$
    ReadM [Double] -> Mod OptionFields [Double] -> Parser [Double]
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
      ReadM [Double]
forall a. Read a => ReadM a
auto
      ( FilePath -> Mod OptionFields [Double]
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"mixture-model-weights"
          Mod OptionFields [Double]
-> Mod OptionFields [Double] -> Mod OptionFields [Double]
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields [Double]
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'w'
          Mod OptionFields [Double]
-> Mod OptionFields [Double] -> Mod OptionFields [Double]
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields [Double]
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"\"[DOUBLE,DOUBLE,...]\""
          Mod OptionFields [Double]
-> Mod OptionFields [Double] -> Mod OptionFields [Double]
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields [Double]
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Weights of mixture model components"
      )

maybeGammaParams :: Parser (Maybe GammaRateHeterogeneityParams)
maybeGammaParams :: Parser (Maybe GammaRateHeterogeneityParams)
maybeGammaParams =
  Parser GammaRateHeterogeneityParams
-> Parser (Maybe GammaRateHeterogeneityParams)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser GammaRateHeterogeneityParams
 -> Parser (Maybe GammaRateHeterogeneityParams))
-> Parser GammaRateHeterogeneityParams
-> Parser (Maybe GammaRateHeterogeneityParams)
forall a b. (a -> b) -> a -> b
$
    ReadM GammaRateHeterogeneityParams
-> Mod OptionFields GammaRateHeterogeneityParams
-> Parser GammaRateHeterogeneityParams
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
      ReadM GammaRateHeterogeneityParams
forall a. Read a => ReadM a
auto
      ( FilePath -> Mod OptionFields GammaRateHeterogeneityParams
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"gamma-rate-heterogeneity"
          Mod OptionFields GammaRateHeterogeneityParams
-> Mod OptionFields GammaRateHeterogeneityParams
-> Mod OptionFields GammaRateHeterogeneityParams
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields GammaRateHeterogeneityParams
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'g'
          Mod OptionFields GammaRateHeterogeneityParams
-> Mod OptionFields GammaRateHeterogeneityParams
-> Mod OptionFields GammaRateHeterogeneityParams
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields GammaRateHeterogeneityParams
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"\"(NCAT,SHAPE)\""
          Mod OptionFields GammaRateHeterogeneityParams
-> Mod OptionFields GammaRateHeterogeneityParams
-> Mod OptionFields GammaRateHeterogeneityParams
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields GammaRateHeterogeneityParams
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Number of gamma rate categories and shape parameter"
      )

lengthOpt :: Parser Int
lengthOpt :: Parser Int
lengthOpt =
  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
    ( FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"length" 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
'l' Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NUMBER"
        Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. FilePath -> Mod f a
help
          FilePath
"Set alignment length to NUMBER"
    )

-- | The model specification is somewhat complicated, so we need to provide
-- additional help.
simulateFooter :: [String]
simulateFooter :: [FilePath]
simulateFooter = [FilePath]
sms [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
mms
  where
    sms :: [FilePath]
sms =
      [ FilePath
"Substitution models:",
        FilePath
"-s \"MODEL[PARAMETER,PARAMETER,...]{STATIONARY_DISTRIBUTION}\"",
        FilePath
"   Supported DNA models: JC, F81, HKY, GTR4.",
        FilePath
"     For example,",
        FilePath
"       -s HKY[KAPPA]{DOUBLE,DOUBLE,DOUBLE,DOUBLE}",
        FilePath
"       -s GTR4[e_AC,e_AG,e_AT,e_CG,e_CT,e_GT]{DOUBLE,DOUBLE,DOUBLE,DOUBLE}",
        FilePath
"          where the 'e_XY' are the exchangeabilities from nucleotide X to Y.",
        FilePath
"   Supported Protein models: Poisson, Poisson-Custom, LG, LG-Custom, WAG, WAG-Custom, GTR20.",
        FilePath
"     MODEL-Custom means that only the exchangeabilities of MODEL are used,",
        FilePath
"     and a custom stationary distribution is provided.",
        FilePath
"     For example,",
        FilePath
"       -s LG",
        FilePath
"       -s LG-Custom{...}",
        FilePath
"       -s GTR20[e_AR,e_AN,...]{...}",
        FilePath
"          the 'e_XY' are the exchangeabilities from amino acid X to Y (alphabetical order).",
        FilePath
"   Notes: The F81 model for DNA is equivalent to the Poisson-Custom for proteins.",
        FilePath
"          The GTR4 model for DNA is equivalent to the GTR20 for proteins."
      ]
    mms :: [FilePath]
mms =
      [ FilePath
"",
        FilePath
"Mixture models:",
        FilePath
"-m \"MIXTURE(SUBSTITUTION_MODEL_1,SUBSTITUTION_MODEL_2[PARAMETERS]{STATIONARY_DISTRIBUTION},...)\"",
        FilePath
"   For example,",
        FilePath
"     -m \"MIXTURE(JC,HKY[6.0]{0.3,0.2,0.2,0.3})\"",
        FilePath
"Mixture weights have to be provided with the -w option.",
        FilePath
"",
        FilePath
"Special mixture models:",
        FilePath
"-m CXX",
        FilePath
"   where XX is 10, 20, 30, 40, 50, or 60; CXX models, Quang et al., 2008.",
        FilePath
"-m \"EDM(EXCHANGEABILITIES)\"",
        FilePath
"   Arbitrary empirical distribution mixture (EDM) models.",
        FilePath
"   Stationary distributions have to be provided with the -e or -p option.",
        FilePath
"   For example,",
        FilePath
"     LG exchangeabilities with stationary distributions given in FILE.",
        FilePath
"     -m \"EDM(LG-Custom)\" -e FILE",
        FilePath
"     LG exchangeabilities with site profiles (Phylobayes) given in FILES.",
        FilePath
"     -m \"EDM(LG-Custom)\" -p FILES",
        FilePath
"For special mixture models, mixture weights are optional."
      ]