{-# LANGUAGE DeriveGeneric #-}

-- |
-- Module      :  SLynx.Options
-- Description :  SLynx general options
-- Copyright   :  2021 Dominik Schrempf
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Sat Sep  7 18:55:03 2019.
module SLynx.Options (CommandArguments (..)) where

import Data.Aeson
import ELynx.Alphabet.Alphabet
import ELynx.Tools.Options
import ELynx.Tools.Reproduction
import GHC.Generics
import Options.Applicative
import SLynx.Concatenate.Options
import SLynx.Examine.Options
import SLynx.Filter.Options
import SLynx.Simulate.Options
import SLynx.SubSample.Options
import SLynx.Translate.Options

-- | The different SLynx commands and their arguments.
data CommandArguments
  = Concatenate ConcatenateArguments
  | Examine ExamineArguments
  | FilterCols FilterColsArguments
  | FilterRows FilterRowsArguments
  | Simulate SimulateArguments
  | SubSample SubSampleArguments
  | Translate TranslateArguments
  deriving (CommandArguments -> CommandArguments -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandArguments -> CommandArguments -> Bool
$c/= :: CommandArguments -> CommandArguments -> Bool
== :: CommandArguments -> CommandArguments -> Bool
$c== :: CommandArguments -> CommandArguments -> Bool
Eq, Int -> CommandArguments -> ShowS
[CommandArguments] -> ShowS
CommandArguments -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommandArguments] -> ShowS
$cshowList :: [CommandArguments] -> ShowS
show :: CommandArguments -> String
$cshow :: CommandArguments -> String
showsPrec :: Int -> CommandArguments -> ShowS
$cshowsPrec :: Int -> CommandArguments -> ShowS
Show, forall x. Rep CommandArguments x -> CommandArguments
forall x. CommandArguments -> Rep CommandArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CommandArguments x -> CommandArguments
$cfrom :: forall x. CommandArguments -> Rep CommandArguments x
Generic)

instance Reproducible CommandArguments where
  inFiles :: CommandArguments -> [String]
inFiles (Concatenate ConcatenateArguments
a) = forall a. Reproducible a => a -> [String]
inFiles ConcatenateArguments
a
  inFiles (Examine ExamineArguments
a) = forall a. Reproducible a => a -> [String]
inFiles ExamineArguments
a
  inFiles (FilterCols FilterColsArguments
a) = forall a. Reproducible a => a -> [String]
inFiles FilterColsArguments
a
  inFiles (FilterRows FilterRowsArguments
a) = forall a. Reproducible a => a -> [String]
inFiles FilterRowsArguments
a
  inFiles (Simulate SimulateArguments
a) = forall a. Reproducible a => a -> [String]
inFiles SimulateArguments
a
  inFiles (SubSample SubSampleArguments
a) = forall a. Reproducible a => a -> [String]
inFiles SubSampleArguments
a
  inFiles (Translate TranslateArguments
a) = forall a. Reproducible a => a -> [String]
inFiles TranslateArguments
a

  outSuffixes :: CommandArguments -> [String]
outSuffixes (Concatenate ConcatenateArguments
a) = forall a. Reproducible a => a -> [String]
outSuffixes ConcatenateArguments
a
  outSuffixes (Examine ExamineArguments
a) = forall a. Reproducible a => a -> [String]
outSuffixes ExamineArguments
a
  outSuffixes (FilterCols FilterColsArguments
a) = forall a. Reproducible a => a -> [String]
outSuffixes FilterColsArguments
a
  outSuffixes (FilterRows FilterRowsArguments
a) = forall a. Reproducible a => a -> [String]
outSuffixes FilterRowsArguments
a
  outSuffixes (Simulate SimulateArguments
a) = forall a. Reproducible a => a -> [String]
outSuffixes SimulateArguments
a
  outSuffixes (SubSample SubSampleArguments
a) = forall a. Reproducible a => a -> [String]
outSuffixes SubSampleArguments
a
  outSuffixes (Translate TranslateArguments
a) = forall a. Reproducible a => a -> [String]
outSuffixes TranslateArguments
a

  getSeed :: CommandArguments -> Maybe SeedOpt
getSeed (Concatenate ConcatenateArguments
a) = forall a. Reproducible a => a -> Maybe SeedOpt
getSeed ConcatenateArguments
a
  getSeed (Examine ExamineArguments
a) = forall a. Reproducible a => a -> Maybe SeedOpt
getSeed ExamineArguments
a
  getSeed (FilterCols FilterColsArguments
a) = forall a. Reproducible a => a -> Maybe SeedOpt
getSeed FilterColsArguments
a
  getSeed (FilterRows FilterRowsArguments
a) = forall a. Reproducible a => a -> Maybe SeedOpt
getSeed FilterRowsArguments
a
  getSeed (Simulate SimulateArguments
a) = forall a. Reproducible a => a -> Maybe SeedOpt
getSeed SimulateArguments
a
  getSeed (SubSample SubSampleArguments
a) = forall a. Reproducible a => a -> Maybe SeedOpt
getSeed SubSampleArguments
a
  getSeed (Translate TranslateArguments
a) = forall a. Reproducible a => a -> Maybe SeedOpt
getSeed TranslateArguments
a

  setSeed :: CommandArguments -> SeedOpt -> CommandArguments
setSeed (Concatenate ConcatenateArguments
a) = ConcatenateArguments -> CommandArguments
Concatenate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Reproducible a => a -> SeedOpt -> a
setSeed ConcatenateArguments
a
  setSeed (Examine ExamineArguments
a) = ExamineArguments -> CommandArguments
Examine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Reproducible a => a -> SeedOpt -> a
setSeed ExamineArguments
a
  setSeed (FilterCols FilterColsArguments
a) = FilterColsArguments -> CommandArguments
FilterCols forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Reproducible a => a -> SeedOpt -> a
setSeed FilterColsArguments
a
  setSeed (FilterRows FilterRowsArguments
a) = FilterRowsArguments -> CommandArguments
FilterRows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Reproducible a => a -> SeedOpt -> a
setSeed FilterRowsArguments
a
  setSeed (Simulate SimulateArguments
a) = SimulateArguments -> CommandArguments
Simulate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Reproducible a => a -> SeedOpt -> a
setSeed SimulateArguments
a
  setSeed (SubSample SubSampleArguments
a) = SubSampleArguments -> CommandArguments
SubSample forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Reproducible a => a -> SeedOpt -> a
setSeed SubSampleArguments
a
  setSeed (Translate TranslateArguments
a) = TranslateArguments -> CommandArguments
Translate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Reproducible a => a -> SeedOpt -> a
setSeed TranslateArguments
a

  parser :: Parser CommandArguments
parser = Parser CommandArguments
commandArguments

  cmdName :: String
cmdName = String
"slynx"

  cmdDsc :: [String]
cmdDsc = [String
"Analyze, and simulate multi sequence alignments."]

  cmdFtr :: [String]
cmdFtr =
    [ String
"",
      String
"Available sequence file formats:"
    ]
      forall a. [a] -> [a] -> [a]
++ [String]
fs
      forall a. [a] -> [a] -> [a]
++ [String
"", String
"Available alphabets:"]
      forall a. [a] -> [a] -> [a]
++ [String]
as
    where
      toListItem :: ShowS
toListItem = (String
"  - " forall a. [a] -> [a] -> [a]
++)
      fs :: [String]
fs = forall a b. (a -> b) -> [a] -> [b]
map ShowS
toListItem [String
"FASTA"]
      as :: [String]
as = forall a b. (a -> b) -> [a] -> [b]
map (ShowS
toListItem forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alphabet -> String
alphabetDescription) ([forall a. Bounded a => a
minBound ..] :: [Alphabet])

instance FromJSON CommandArguments

instance ToJSON CommandArguments

concatenateCommand :: Mod CommandFields CommandArguments
concatenateCommand :: Mod CommandFields CommandArguments
concatenateCommand = forall a b. Reproducible a => (a -> b) -> Mod CommandFields b
createCommandReproducible ConcatenateArguments -> CommandArguments
Concatenate

examineCommand :: Mod CommandFields CommandArguments
examineCommand :: Mod CommandFields CommandArguments
examineCommand = forall a b. Reproducible a => (a -> b) -> Mod CommandFields b
createCommandReproducible ExamineArguments -> CommandArguments
Examine

filterColumnsCommand :: Mod CommandFields CommandArguments
filterColumnsCommand :: Mod CommandFields CommandArguments
filterColumnsCommand = forall a b. Reproducible a => (a -> b) -> Mod CommandFields b
createCommandReproducible FilterColsArguments -> CommandArguments
FilterCols

filterRowsCommand :: Mod CommandFields CommandArguments
filterRowsCommand :: Mod CommandFields CommandArguments
filterRowsCommand = forall a b. Reproducible a => (a -> b) -> Mod CommandFields b
createCommandReproducible FilterRowsArguments -> CommandArguments
FilterRows

simulateCommand :: Mod CommandFields CommandArguments
simulateCommand :: Mod CommandFields CommandArguments
simulateCommand = forall a b. Reproducible a => (a -> b) -> Mod CommandFields b
createCommandReproducible SimulateArguments -> CommandArguments
Simulate

subSampleCommand :: Mod CommandFields CommandArguments
subSampleCommand :: Mod CommandFields CommandArguments
subSampleCommand = forall a b. Reproducible a => (a -> b) -> Mod CommandFields b
createCommandReproducible SubSampleArguments -> CommandArguments
SubSample

translateCommand :: Mod CommandFields CommandArguments
translateCommand :: Mod CommandFields CommandArguments
translateCommand = forall a b. Reproducible a => (a -> b) -> Mod CommandFields b
createCommandReproducible TranslateArguments -> CommandArguments
Translate

commandArguments :: Parser CommandArguments
commandArguments :: Parser CommandArguments
commandArguments =
  forall a. Mod CommandFields a -> Parser a
hsubparser forall a b. (a -> b) -> a -> b
$
    Mod CommandFields CommandArguments
concatenateCommand
      forall a. Semigroup a => a -> a -> a
<> Mod CommandFields CommandArguments
examineCommand
      forall a. Semigroup a => a -> a -> a
<> Mod CommandFields CommandArguments
filterColumnsCommand
      forall a. Semigroup a => a -> a -> a
<> Mod CommandFields CommandArguments
filterRowsCommand
      forall a. Semigroup a => a -> a -> a
<> Mod CommandFields CommandArguments
simulateCommand
      forall a. Semigroup a => a -> a -> a
<> Mod CommandFields CommandArguments
subSampleCommand
      forall a. Semigroup a => a -> a -> a
<> Mod CommandFields CommandArguments
translateCommand