{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  SLynx.Simulate.PhyloModel
-- Description :  Parse and interpret the model string
-- Copyright   :  (c) Dominik Schrempf 2021
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Fri Feb  1 13:32:16 2019.
module SLynx.Simulate.PhyloModel
  ( getPhyloModel,
  )
where

import Control.Applicative
import Control.Monad (when)
import Data.Attoparsec.ByteString.Char8
import qualified Data.ByteString.Char8 as BS
import Data.Either (rights)
import Data.Maybe
import qualified Data.Vector as V
import ELynx.Data.MarkovProcess.AminoAcid
import ELynx.Data.MarkovProcess.CXXModels
import qualified ELynx.Data.MarkovProcess.MixtureModel as M
import ELynx.Data.MarkovProcess.Nucleotide
import qualified ELynx.Data.MarkovProcess.PhyloModel as P
import ELynx.Data.MarkovProcess.RateMatrix
import qualified ELynx.Data.MarkovProcess.SubstitutionModel as S
import ELynx.Import.MarkovProcess.EDMModelPhylobayes
  ( EDMComponent,
  )
import ELynx.Tools.Equality
import ELynx.Tools.InputOutput
import Numeric.LinearAlgebra
  ( norm_1,
    size,
    vector,
  )

nNuc :: Int
-- nNuc = length (alphabet :: [Nucleotide])
nNuc :: Int
nNuc = Int
4

nAA :: Int
-- nAA = length (alphabet :: [AminoAcid])
nAA :: Int
nAA = Int
20

-- Model parameters between square brackets.
paramsStart :: Char
paramsStart :: Char
paramsStart = Char
'['

paramsEnd :: Char
paramsEnd :: Char
paramsEnd = Char
']'

-- Stationary distribution between curly brackets.
sdStart :: Char
sdStart :: Char
sdStart = Char
'{'

sdEnd :: Char
sdEnd :: Char
sdEnd = Char
'}'

-- Mixture model components between round brackets.
mmStart :: Char
mmStart :: Char
mmStart = Char
'('

mmEnd :: Char
mmEnd :: Char
mmEnd = Char
')'

separator :: Char
separator :: Char
separator = Char
','

name :: Parser String
name :: Parser String
name =
  ByteString -> String
BS.unpack
    (ByteString -> String)
-> Parser ByteString ByteString -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
takeWhile1 (String -> Char -> Bool
notInClass [Char
paramsStart, Char
paramsEnd, Char
sdStart, Char
sdEnd, Char
mmStart, Char
mmEnd, Char
separator])

params :: Parser [Double]
params :: Parser [Double]
params = Char -> Parser Char
char Char
paramsStart Parser Char -> Parser [Double] -> Parser [Double]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Double
double Parser Double -> Parser Char -> Parser [Double]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Char -> Parser Char
char Char
separator Parser [Double] -> Parser Char -> Parser [Double]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
paramsEnd

stationaryDistribution :: Parser StationaryDistribution
stationaryDistribution :: Parser StationaryDistribution
stationaryDistribution = do
  Char
_ <- Char -> Parser Char
char Char
sdStart
  StationaryDistribution
f <- [Double] -> StationaryDistribution
vector ([Double] -> StationaryDistribution)
-> Parser [Double] -> Parser StationaryDistribution
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Double
double Parser Double -> Parser Char -> Parser [Double]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Char -> Parser Char
char Char
separator
  Char
_ <- Char -> Parser Char
char Char
sdEnd
  if Double -> Double -> Bool
nearlyEq (StationaryDistribution -> Double
forall a. Normed a => a -> Double
norm_1 StationaryDistribution
f) Double
1.0
    then StationaryDistribution -> Parser StationaryDistribution
forall (m :: * -> *) a. Monad m => a -> m a
return StationaryDistribution
f
    else
      String -> Parser StationaryDistribution
forall a. HasCallStack => String -> a
error (String -> Parser StationaryDistribution)
-> String -> Parser StationaryDistribution
forall a b. (a -> b) -> a -> b
$
        String
"Sum of stationary distribution is "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show (StationaryDistribution -> Double
forall a. Normed a => a -> Double
norm_1 StationaryDistribution
f)
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" but should be 1.0."

assertLength :: StationaryDistribution -> Int -> a -> a
assertLength :: StationaryDistribution -> Int -> a -> a
assertLength StationaryDistribution
d Int
n a
r =
  if StationaryDistribution -> IndexOf Vector
forall (c :: * -> *) t. Container c t => c t -> IndexOf c
size StationaryDistribution
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n
    then
      String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$
        String
"Length of stationary distribution is "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (StationaryDistribution -> IndexOf Vector
forall (c :: * -> *) t. Container c t => c t -> IndexOf c
size StationaryDistribution
d)
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" but should be "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
    else a
r

-- This is the main function that connects the model string, the parameters and
-- the stationary distribution. It should check that the model is valid.
assembleSubstitutionModel ::
  String ->
  Maybe S.Params ->
  Maybe StationaryDistribution ->
  Either String S.SubstitutionModel
-- DNA models.
assembleSubstitutionModel :: String
-> Maybe [Double]
-> Maybe StationaryDistribution
-> Either String SubstitutionModel
assembleSubstitutionModel String
"JC" Maybe [Double]
Nothing Maybe StationaryDistribution
Nothing = SubstitutionModel -> Either String SubstitutionModel
forall a b. b -> Either a b
Right SubstitutionModel
jc
assembleSubstitutionModel String
"F81" Maybe [Double]
Nothing (Just StationaryDistribution
d) =
  SubstitutionModel -> Either String SubstitutionModel
forall a b. b -> Either a b
Right (SubstitutionModel -> Either String SubstitutionModel)
-> SubstitutionModel -> Either String SubstitutionModel
forall a b. (a -> b) -> a -> b
$ StationaryDistribution
-> Int -> SubstitutionModel -> SubstitutionModel
forall a. StationaryDistribution -> Int -> a -> a
assertLength StationaryDistribution
d Int
nNuc (SubstitutionModel -> SubstitutionModel)
-> SubstitutionModel -> SubstitutionModel
forall a b. (a -> b) -> a -> b
$ StationaryDistribution -> SubstitutionModel
f81 StationaryDistribution
d
assembleSubstitutionModel String
"HKY" (Just [Double
k]) (Just StationaryDistribution
d) =
  SubstitutionModel -> Either String SubstitutionModel
forall a b. b -> Either a b
Right (SubstitutionModel -> Either String SubstitutionModel)
-> SubstitutionModel -> Either String SubstitutionModel
forall a b. (a -> b) -> a -> b
$ StationaryDistribution
-> Int -> SubstitutionModel -> SubstitutionModel
forall a. StationaryDistribution -> Int -> a -> a
assertLength StationaryDistribution
d Int
nNuc (SubstitutionModel -> SubstitutionModel)
-> SubstitutionModel -> SubstitutionModel
forall a b. (a -> b) -> a -> b
$ Double -> StationaryDistribution -> SubstitutionModel
hky Double
k StationaryDistribution
d
assembleSubstitutionModel String
"GTR4" (Just [Double]
es) (Just StationaryDistribution
d) =
  SubstitutionModel -> Either String SubstitutionModel
forall a b. b -> Either a b
Right (SubstitutionModel -> Either String SubstitutionModel)
-> SubstitutionModel -> Either String SubstitutionModel
forall a b. (a -> b) -> a -> b
$ StationaryDistribution
-> Int -> SubstitutionModel -> SubstitutionModel
forall a. StationaryDistribution -> Int -> a -> a
assertLength StationaryDistribution
d Int
nNuc (SubstitutionModel -> SubstitutionModel)
-> SubstitutionModel -> SubstitutionModel
forall a b. (a -> b) -> a -> b
$ [Double] -> StationaryDistribution -> SubstitutionModel
gtr4 [Double]
es StationaryDistribution
d
-- Protein models.
assembleSubstitutionModel String
"Poisson" Maybe [Double]
Nothing Maybe StationaryDistribution
Nothing = SubstitutionModel -> Either String SubstitutionModel
forall a b. b -> Either a b
Right SubstitutionModel
poisson
assembleSubstitutionModel String
"Poisson-Custom" Maybe [Double]
Nothing (Just StationaryDistribution
d) =
  SubstitutionModel -> Either String SubstitutionModel
forall a b. b -> Either a b
Right (SubstitutionModel -> Either String SubstitutionModel)
-> SubstitutionModel -> Either String SubstitutionModel
forall a b. (a -> b) -> a -> b
$ StationaryDistribution
-> Int -> SubstitutionModel -> SubstitutionModel
forall a. StationaryDistribution -> Int -> a -> a
assertLength StationaryDistribution
d Int
nAA (SubstitutionModel -> SubstitutionModel)
-> SubstitutionModel -> SubstitutionModel
forall a b. (a -> b) -> a -> b
$ Maybe String -> StationaryDistribution -> SubstitutionModel
poissonCustom Maybe String
forall a. Maybe a
Nothing StationaryDistribution
d
assembleSubstitutionModel String
"LG" Maybe [Double]
Nothing Maybe StationaryDistribution
Nothing = SubstitutionModel -> Either String SubstitutionModel
forall a b. b -> Either a b
Right SubstitutionModel
lg
assembleSubstitutionModel String
"LG-Custom" Maybe [Double]
Nothing (Just StationaryDistribution
d) =
  SubstitutionModel -> Either String SubstitutionModel
forall a b. b -> Either a b
Right (SubstitutionModel -> Either String SubstitutionModel)
-> SubstitutionModel -> Either String SubstitutionModel
forall a b. (a -> b) -> a -> b
$ StationaryDistribution
-> Int -> SubstitutionModel -> SubstitutionModel
forall a. StationaryDistribution -> Int -> a -> a
assertLength StationaryDistribution
d Int
nAA (SubstitutionModel -> SubstitutionModel)
-> SubstitutionModel -> SubstitutionModel
forall a b. (a -> b) -> a -> b
$ Maybe String -> StationaryDistribution -> SubstitutionModel
lgCustom Maybe String
forall a. Maybe a
Nothing StationaryDistribution
d
assembleSubstitutionModel String
"WAG" Maybe [Double]
Nothing Maybe StationaryDistribution
Nothing = SubstitutionModel -> Either String SubstitutionModel
forall a b. b -> Either a b
Right SubstitutionModel
wag
assembleSubstitutionModel String
"WAG-Custom" Maybe [Double]
Nothing (Just StationaryDistribution
d) =
  SubstitutionModel -> Either String SubstitutionModel
forall a b. b -> Either a b
Right (SubstitutionModel -> Either String SubstitutionModel)
-> SubstitutionModel -> Either String SubstitutionModel
forall a b. (a -> b) -> a -> b
$ StationaryDistribution
-> Int -> SubstitutionModel -> SubstitutionModel
forall a. StationaryDistribution -> Int -> a -> a
assertLength StationaryDistribution
d Int
nAA (SubstitutionModel -> SubstitutionModel)
-> SubstitutionModel -> SubstitutionModel
forall a b. (a -> b) -> a -> b
$ Maybe String -> StationaryDistribution -> SubstitutionModel
wagCustom Maybe String
forall a. Maybe a
Nothing StationaryDistribution
d
assembleSubstitutionModel String
"GTR20" (Just [Double]
es) (Just StationaryDistribution
d) =
  SubstitutionModel -> Either String SubstitutionModel
forall a b. b -> Either a b
Right (SubstitutionModel -> Either String SubstitutionModel)
-> SubstitutionModel -> Either String SubstitutionModel
forall a b. (a -> b) -> a -> b
$ StationaryDistribution
-> Int -> SubstitutionModel -> SubstitutionModel
forall a. StationaryDistribution -> Int -> a -> a
assertLength StationaryDistribution
d Int
nAA (SubstitutionModel -> SubstitutionModel)
-> SubstitutionModel -> SubstitutionModel
forall a b. (a -> b) -> a -> b
$ [Double] -> StationaryDistribution -> SubstitutionModel
gtr20 [Double]
es StationaryDistribution
d
-- Ohterwisse, we cannot assemble the model.
assembleSubstitutionModel String
n Maybe [Double]
mps Maybe StationaryDistribution
mf =
  String -> Either String SubstitutionModel
forall a b. a -> Either a b
Left (String -> Either String SubstitutionModel)
-> String -> Either String SubstitutionModel
forall a b. (a -> b) -> a -> b
$
    [String] -> String
unlines
      [ String
"Cannot assemble substitution model.",
        String
"Name: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
n,
        String
"Parameters: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe [Double] -> String
forall a. Show a => a -> String
show Maybe [Double]
mps,
        String
"Stationary distribution: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe StationaryDistribution -> String
forall a. Show a => a -> String
show Maybe StationaryDistribution
mf
      ]

parseSubstitutionModel :: Parser S.SubstitutionModel
parseSubstitutionModel :: Parser SubstitutionModel
parseSubstitutionModel = do
  String
n <- Parser String
name
  Maybe [Double]
mps <- Parser [Double] -> Parser ByteString (Maybe [Double])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser [Double]
params
  Maybe StationaryDistribution
mf <- Parser StationaryDistribution
-> Parser ByteString (Maybe StationaryDistribution)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser StationaryDistribution
stationaryDistribution
  let esm :: Either String SubstitutionModel
esm = String
-> Maybe [Double]
-> Maybe StationaryDistribution
-> Either String SubstitutionModel
assembleSubstitutionModel String
n Maybe [Double]
mps Maybe StationaryDistribution
mf
  case Either String SubstitutionModel
esm of
    Left String
err -> String -> Parser SubstitutionModel
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
    Right SubstitutionModel
sm -> SubstitutionModel -> Parser SubstitutionModel
forall (m :: * -> *) a. Monad m => a -> m a
return SubstitutionModel
sm

edmModel :: [EDMComponent] -> Maybe [M.Weight] -> Parser M.MixtureModel
edmModel :: [EDMComponent] -> Maybe [Double] -> Parser MixtureModel
edmModel [EDMComponent]
cs Maybe [Double]
mws = do
  ByteString
_ <- ByteString -> Parser ByteString ByteString
string ByteString
"EDM"
  Char
_ <- Char -> Parser Char
char Char
mmStart
  String
n <- Parser String
name
  Maybe [Double]
mps <- Parser [Double] -> Parser ByteString (Maybe [Double])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser [Double]
params
  Char
_ <- Char -> Parser Char
char Char
mmEnd
  Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([EDMComponent] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EDMComponent]
cs) (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ByteString ()
forall a. HasCallStack => String -> a
error String
"edmModel: no EDM components given."
  let sms :: [Either String SubstitutionModel]
sms = (EDMComponent -> Either String SubstitutionModel)
-> [EDMComponent] -> [Either String SubstitutionModel]
forall a b. (a -> b) -> [a] -> [b]
map (\EDMComponent
c -> String
-> Maybe [Double]
-> Maybe StationaryDistribution
-> Either String SubstitutionModel
assembleSubstitutionModel String
n Maybe [Double]
mps (StationaryDistribution -> Maybe StationaryDistribution
forall a. a -> Maybe a
Just (StationaryDistribution -> Maybe StationaryDistribution)
-> StationaryDistribution -> Maybe StationaryDistribution
forall a b. (a -> b) -> a -> b
$ EDMComponent -> StationaryDistribution
forall a b. (a, b) -> b
snd EDMComponent
c)) [EDMComponent]
cs
      edmName :: String
edmName = String
"EDM" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([EDMComponent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [EDMComponent]
cs)
      ws :: [Double]
ws = [Double] -> Maybe [Double] -> [Double]
forall a. a -> Maybe a -> a
fromMaybe ((EDMComponent -> Double) -> [EDMComponent] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map EDMComponent -> Double
forall a b. (a, b) -> a
fst [EDMComponent]
cs) Maybe [Double]
mws
      errs :: [String]
errs = [String
e | (Left String
e) <- [Either String SubstitutionModel]
sms]
  Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Either String SubstitutionModel] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Either String SubstitutionModel]
sms Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
ws) (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$
    String -> Parser ByteString ()
forall a. HasCallStack => String -> a
error String
"edmModel: number of substitution models and weights differs."
  if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs
    then String -> Parser MixtureModel
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser MixtureModel) -> String -> Parser MixtureModel
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head [String]
errs
    else
      MixtureModel -> Parser MixtureModel
forall (m :: * -> *) a. Monad m => a -> m a
return (MixtureModel -> Parser MixtureModel)
-> MixtureModel -> Parser MixtureModel
forall a b. (a -> b) -> a -> b
$
        String -> Vector Double -> Vector SubstitutionModel -> MixtureModel
M.fromSubstitutionModels String
edmName ([Double] -> Vector Double
forall a. [a] -> Vector a
V.fromList [Double]
ws) ([SubstitutionModel] -> Vector SubstitutionModel
forall a. [a] -> Vector a
V.fromList ([SubstitutionModel] -> Vector SubstitutionModel)
-> [SubstitutionModel] -> Vector SubstitutionModel
forall a b. (a -> b) -> a -> b
$ [Either String SubstitutionModel] -> [SubstitutionModel]
forall a b. [Either a b] -> [b]
rights [Either String SubstitutionModel]
sms)

cxxModel :: Maybe [M.Weight] -> Parser M.MixtureModel
cxxModel :: Maybe [Double] -> Parser MixtureModel
cxxModel Maybe [Double]
mws = do
  Char
_ <- Char -> Parser Char
char Char
'C'
  Int
n <- Parser Int
forall a. Integral a => Parser a
decimal :: Parser Int
  MixtureModel -> Parser MixtureModel
forall (m :: * -> *) a. Monad m => a -> m a
return (MixtureModel -> Parser MixtureModel)
-> MixtureModel -> Parser MixtureModel
forall a b. (a -> b) -> a -> b
$ Int -> Maybe [Double] -> MixtureModel
cxx Int
n Maybe [Double]
mws

standardMixtureModel :: [M.Weight] -> Parser M.MixtureModel
standardMixtureModel :: [Double] -> Parser MixtureModel
standardMixtureModel [Double]
ws = do
  ByteString
_ <- ByteString -> Parser ByteString ByteString
string ByteString
"MIXTURE"
  Char
_ <- Char -> Parser Char
char Char
mmStart
  [SubstitutionModel]
sms <- Parser SubstitutionModel
parseSubstitutionModel Parser SubstitutionModel
-> Parser Char -> Parser ByteString [SubstitutionModel]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Char -> Parser Char
char Char
separator
  Char
_ <- Char -> Parser Char
char Char
mmEnd
  -- XXX: The use of `Data.List.NonEmpty.fromList` leads to uninformative error messages.
  MixtureModel -> Parser MixtureModel
forall (m :: * -> *) a. Monad m => a -> m a
return (MixtureModel -> Parser MixtureModel)
-> MixtureModel -> Parser MixtureModel
forall a b. (a -> b) -> a -> b
$ String -> Vector Double -> Vector SubstitutionModel -> MixtureModel
M.fromSubstitutionModels String
"MIXTURE" ([Double] -> Vector Double
forall a. [a] -> Vector a
V.fromList [Double]
ws) ([SubstitutionModel] -> Vector SubstitutionModel
forall a. [a] -> Vector a
V.fromList [SubstitutionModel]
sms)

mixtureModel ::
  Maybe [EDMComponent] -> Maybe [M.Weight] -> Parser M.MixtureModel
mixtureModel :: Maybe [EDMComponent] -> Maybe [Double] -> Parser MixtureModel
mixtureModel Maybe [EDMComponent]
Nothing Maybe [Double]
Nothing =
  Parser MixtureModel -> Parser MixtureModel
forall i a. Parser i a -> Parser i a
try (Maybe [Double] -> Parser MixtureModel
cxxModel Maybe [Double]
forall a. Maybe a
Nothing) Parser MixtureModel -> Parser MixtureModel -> Parser MixtureModel
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser MixtureModel
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No weights provided."
mixtureModel Maybe [EDMComponent]
Nothing mws :: Maybe [Double]
mws@(Just [Double]
ws) =
  Parser MixtureModel -> Parser MixtureModel
forall i a. Parser i a -> Parser i a
try (Maybe [Double] -> Parser MixtureModel
cxxModel Maybe [Double]
mws) Parser MixtureModel -> Parser MixtureModel -> Parser MixtureModel
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Double] -> Parser MixtureModel
standardMixtureModel [Double]
ws
mixtureModel (Just [EDMComponent]
cs) Maybe [Double]
mws = [EDMComponent] -> Maybe [Double] -> Parser MixtureModel
edmModel [EDMComponent]
cs Maybe [Double]
mws

-- | Parse the phylogenetic model string. The argument list is somewhat long,
-- but models can have many parameters and we have to check for redundant
-- parameters.
--
-- @
-- getPhyloModel maybeSubstitutionModelString maybeMixtureModelString maybeEDMComponents
-- @
getPhyloModel ::
  Maybe String ->
  Maybe String ->
  Maybe [M.Weight] ->
  Maybe [EDMComponent] ->
  Either String P.PhyloModel
getPhyloModel :: Maybe String
-> Maybe String
-> Maybe [Double]
-> Maybe [EDMComponent]
-> Either String PhyloModel
getPhyloModel Maybe String
Nothing Maybe String
Nothing Maybe [Double]
_ Maybe [EDMComponent]
_ = String -> Either String PhyloModel
forall a b. a -> Either a b
Left String
"No model was given. See help."
getPhyloModel (Just String
_) (Just String
_) Maybe [Double]
_ Maybe [EDMComponent]
_ =
  String -> Either String PhyloModel
forall a b. a -> Either a b
Left String
"Both, substitution and mixture model string given; use only one."
getPhyloModel (Just String
s) Maybe String
Nothing Maybe [Double]
Nothing Maybe [EDMComponent]
Nothing =
  PhyloModel -> Either String PhyloModel
forall a b. b -> Either a b
Right (PhyloModel -> Either String PhyloModel)
-> PhyloModel -> Either String PhyloModel
forall a b. (a -> b) -> a -> b
$
    SubstitutionModel -> PhyloModel
P.SubstitutionModel (SubstitutionModel -> PhyloModel)
-> SubstitutionModel -> PhyloModel
forall a b. (a -> b) -> a -> b
$
      Parser SubstitutionModel -> String -> SubstitutionModel
forall a. Parser a -> String -> a
parseStringWith
        Parser SubstitutionModel
parseSubstitutionModel
        String
s
getPhyloModel (Just String
_) Maybe String
Nothing (Just [Double]
_) Maybe [EDMComponent]
_ =
  String -> Either String PhyloModel
forall a b. a -> Either a b
Left String
"Weights given; but cannot be used with substitution model."
getPhyloModel (Just String
_) Maybe String
Nothing Maybe [Double]
_ (Just [EDMComponent]
_) =
  String -> Either String PhyloModel
forall a b. a -> Either a b
Left
    String
"Empirical distribution mixture model components given; but cannot be used with substitution model."
getPhyloModel Maybe String
Nothing (Just String
m) Maybe [Double]
mws Maybe [EDMComponent]
mcs =
  PhyloModel -> Either String PhyloModel
forall a b. b -> Either a b
Right (PhyloModel -> Either String PhyloModel)
-> PhyloModel -> Either String PhyloModel
forall a b. (a -> b) -> a -> b
$
    MixtureModel -> PhyloModel
P.MixtureModel (MixtureModel -> PhyloModel) -> MixtureModel -> PhyloModel
forall a b. (a -> b) -> a -> b
$
      Parser MixtureModel -> String -> MixtureModel
forall a. Parser a -> String -> a
parseStringWith
        (Maybe [EDMComponent] -> Maybe [Double] -> Parser MixtureModel
mixtureModel Maybe [EDMComponent]
mcs Maybe [Double]
mws)
        String
m