{-# LANGUAGE DeriveGeneric #-}

-- |
-- Module      :  SLynx.Examine.Options
-- Description :  ELynxSeq argument parsing
-- Copyright   :  2021 Dominik Schrempf
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Sun Oct  7 17:29:45 2018.
module SLynx.Examine.Options
  ( ExamineArguments (..),
    examineArguments,
  )
where

import Data.Aeson
import ELynx.Alphabet.Alphabet
import ELynx.Tools.Reproduction
import GHC.Generics
import Options.Applicative
import SLynx.Tools

-- | Arguments needed to examine sequences.
data ExamineArguments = ExamineArguments
  { ExamineArguments -> Alphabet
exAlphabet :: Alphabet,
    ExamineArguments -> FilePath
exInFile :: FilePath,
    ExamineArguments -> Bool
exPerSite :: Bool,
    ExamineArguments -> Bool
exDivergence :: Bool
  }
  deriving (ExamineArguments -> ExamineArguments -> Bool
(ExamineArguments -> ExamineArguments -> Bool)
-> (ExamineArguments -> ExamineArguments -> Bool)
-> Eq ExamineArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExamineArguments -> ExamineArguments -> Bool
$c/= :: ExamineArguments -> ExamineArguments -> Bool
== :: ExamineArguments -> ExamineArguments -> Bool
$c== :: ExamineArguments -> ExamineArguments -> Bool
Eq, Int -> ExamineArguments -> ShowS
[ExamineArguments] -> ShowS
ExamineArguments -> FilePath
(Int -> ExamineArguments -> ShowS)
-> (ExamineArguments -> FilePath)
-> ([ExamineArguments] -> ShowS)
-> Show ExamineArguments
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ExamineArguments] -> ShowS
$cshowList :: [ExamineArguments] -> ShowS
show :: ExamineArguments -> FilePath
$cshow :: ExamineArguments -> FilePath
showsPrec :: Int -> ExamineArguments -> ShowS
$cshowsPrec :: Int -> ExamineArguments -> ShowS
Show, (forall x. ExamineArguments -> Rep ExamineArguments x)
-> (forall x. Rep ExamineArguments x -> ExamineArguments)
-> Generic ExamineArguments
forall x. Rep ExamineArguments x -> ExamineArguments
forall x. ExamineArguments -> Rep ExamineArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExamineArguments x -> ExamineArguments
$cfrom :: forall x. ExamineArguments -> Rep ExamineArguments x
Generic)

instance Reproducible ExamineArguments where
  inFiles :: ExamineArguments -> [FilePath]
inFiles = FilePath -> [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> [FilePath])
-> (ExamineArguments -> FilePath) -> ExamineArguments -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExamineArguments -> FilePath
exInFile
  outSuffixes :: ExamineArguments -> [FilePath]
outSuffixes ExamineArguments
args = if ExamineArguments -> Bool
exDivergence ExamineArguments
args then [FilePath
".out", FilePath
".div"] else [FilePath
".out"]
  getSeed :: ExamineArguments -> Maybe SeedOpt
getSeed ExamineArguments
_ = Maybe SeedOpt
forall a. Maybe a
Nothing

  -- XXX: Probably throw error when seed is set.
  setSeed :: ExamineArguments -> SeedOpt -> ExamineArguments
setSeed = ExamineArguments -> SeedOpt -> ExamineArguments
forall a b. a -> b -> a
const
  parser :: Parser ExamineArguments
parser = Parser ExamineArguments
examineArguments
  cmdName :: FilePath
cmdName = FilePath
"examine"
  cmdDsc :: [FilePath]
cmdDsc =
    [ FilePath
"Examine sequences. If data is a multi sequence alignment, additionally analyze columns."
    ]

instance FromJSON ExamineArguments

instance ToJSON ExamineArguments

-- | Command line parser.
examineArguments :: Parser ExamineArguments
examineArguments :: Parser ExamineArguments
examineArguments =
  Alphabet -> FilePath -> Bool -> Bool -> ExamineArguments
ExamineArguments (Alphabet -> FilePath -> Bool -> Bool -> ExamineArguments)
-> Parser Alphabet
-> Parser (FilePath -> Bool -> Bool -> ExamineArguments)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Alphabet
alphabetOpt Parser (FilePath -> Bool -> Bool -> ExamineArguments)
-> Parser FilePath -> Parser (Bool -> Bool -> ExamineArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath
filePathArg Parser (Bool -> Bool -> ExamineArguments)
-> Parser Bool -> Parser (Bool -> ExamineArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
examinePerSiteOpt Parser (Bool -> ExamineArguments)
-> Parser Bool -> Parser ExamineArguments
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
examineDivergence

examinePerSiteOpt :: Parser Bool
examinePerSiteOpt :: Parser Bool
examinePerSiteOpt =
  Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"per-site" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Report per site summary statistics"

examineDivergence :: Parser Bool
examineDivergence :: Parser Bool
examineDivergence =
  Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"divergence" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Compute pairwise divergence matrices"

filePathArg :: Parser FilePath
filePathArg :: Parser FilePath
filePathArg =
  Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (Mod ArgumentFields FilePath -> Parser FilePath)
-> Mod ArgumentFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"INPUT-FILE" Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Read sequences from INPUT-FILE"