{-# LANGUAGE DeriveGeneric #-}

-- |
-- Module      :  TLynx.Options
-- Description :  TLynx general options
-- Copyright   :  (c) Dominik Schrempf 2021
-- 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 TLynx.Options
  ( Arguments (..),
    CommandArguments (..),
    parseArguments,
  )
where

import ELynx.Tools
import Options.Applicative
import TLynx.Compare.Options
import TLynx.Connect.Options
import TLynx.Distance.Options
import TLynx.Examine.Options
import TLynx.Parsers (newickHelp)
import TLynx.Shuffle.Options
import TLynx.Simulate.Options

-- | The different TLynx commands and their arguments.
data CommandArguments
  = Compare CompareArguments
  | Connect ConnectArguments
  | Distance DistanceArguments
  | Examine ExamineArguments
  | Shuffle ShuffleArguments
  | Simulate SimulateArguments
  deriving (CommandArguments -> CommandArguments -> Bool
(CommandArguments -> CommandArguments -> Bool)
-> (CommandArguments -> CommandArguments -> Bool)
-> Eq CommandArguments
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
(Int -> CommandArguments -> ShowS)
-> (CommandArguments -> String)
-> ([CommandArguments] -> ShowS)
-> Show CommandArguments
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. CommandArguments -> Rep CommandArguments x)
-> (forall x. Rep CommandArguments x -> CommandArguments)
-> Generic CommandArguments
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 (Compare CompareArguments
a) = CompareArguments -> [String]
forall a. Reproducible a => a -> [String]
inFiles CompareArguments
a
  inFiles (Connect ConnectArguments
a) = ConnectArguments -> [String]
forall a. Reproducible a => a -> [String]
inFiles ConnectArguments
a
  inFiles (Distance DistanceArguments
a) = DistanceArguments -> [String]
forall a. Reproducible a => a -> [String]
inFiles DistanceArguments
a
  inFiles (Examine ExamineArguments
a) = ExamineArguments -> [String]
forall a. Reproducible a => a -> [String]
inFiles ExamineArguments
a
  inFiles (Shuffle ShuffleArguments
a) = ShuffleArguments -> [String]
forall a. Reproducible a => a -> [String]
inFiles ShuffleArguments
a
  inFiles (Simulate SimulateArguments
a) = SimulateArguments -> [String]
forall a. Reproducible a => a -> [String]
inFiles SimulateArguments
a

  outSuffixes :: CommandArguments -> [String]
outSuffixes (Compare CompareArguments
a) = CompareArguments -> [String]
forall a. Reproducible a => a -> [String]
outSuffixes CompareArguments
a
  outSuffixes (Connect ConnectArguments
a) = ConnectArguments -> [String]
forall a. Reproducible a => a -> [String]
outSuffixes ConnectArguments
a
  outSuffixes (Distance DistanceArguments
a) = DistanceArguments -> [String]
forall a. Reproducible a => a -> [String]
outSuffixes DistanceArguments
a
  outSuffixes (Examine ExamineArguments
a) = ExamineArguments -> [String]
forall a. Reproducible a => a -> [String]
outSuffixes ExamineArguments
a
  outSuffixes (Shuffle ShuffleArguments
a) = ShuffleArguments -> [String]
forall a. Reproducible a => a -> [String]
outSuffixes ShuffleArguments
a
  outSuffixes (Simulate SimulateArguments
a) = SimulateArguments -> [String]
forall a. Reproducible a => a -> [String]
outSuffixes SimulateArguments
a

  getSeed :: CommandArguments -> Maybe SeedOpt
getSeed (Compare CompareArguments
a) = CompareArguments -> Maybe SeedOpt
forall a. Reproducible a => a -> Maybe SeedOpt
getSeed CompareArguments
a
  getSeed (Connect ConnectArguments
a) = ConnectArguments -> Maybe SeedOpt
forall a. Reproducible a => a -> Maybe SeedOpt
getSeed ConnectArguments
a
  getSeed (Distance DistanceArguments
a) = DistanceArguments -> Maybe SeedOpt
forall a. Reproducible a => a -> Maybe SeedOpt
getSeed DistanceArguments
a
  getSeed (Examine ExamineArguments
a) = ExamineArguments -> Maybe SeedOpt
forall a. Reproducible a => a -> Maybe SeedOpt
getSeed ExamineArguments
a
  getSeed (Shuffle ShuffleArguments
a) = ShuffleArguments -> Maybe SeedOpt
forall a. Reproducible a => a -> Maybe SeedOpt
getSeed ShuffleArguments
a
  getSeed (Simulate SimulateArguments
a) = SimulateArguments -> Maybe SeedOpt
forall a. Reproducible a => a -> Maybe SeedOpt
getSeed SimulateArguments
a

  setSeed :: CommandArguments -> SeedOpt -> CommandArguments
setSeed (Compare CompareArguments
a) = CompareArguments -> CommandArguments
Compare (CompareArguments -> CommandArguments)
-> (SeedOpt -> CompareArguments) -> SeedOpt -> CommandArguments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompareArguments -> SeedOpt -> CompareArguments
forall a. Reproducible a => a -> SeedOpt -> a
setSeed CompareArguments
a
  setSeed (Connect ConnectArguments
a) = ConnectArguments -> CommandArguments
Connect (ConnectArguments -> CommandArguments)
-> (SeedOpt -> ConnectArguments) -> SeedOpt -> CommandArguments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectArguments -> SeedOpt -> ConnectArguments
forall a. Reproducible a => a -> SeedOpt -> a
setSeed ConnectArguments
a
  setSeed (Distance DistanceArguments
a) = DistanceArguments -> CommandArguments
Distance (DistanceArguments -> CommandArguments)
-> (SeedOpt -> DistanceArguments) -> SeedOpt -> CommandArguments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DistanceArguments -> SeedOpt -> DistanceArguments
forall a. Reproducible a => a -> SeedOpt -> a
setSeed DistanceArguments
a
  setSeed (Examine ExamineArguments
a) = ExamineArguments -> CommandArguments
Examine (ExamineArguments -> CommandArguments)
-> (SeedOpt -> ExamineArguments) -> SeedOpt -> CommandArguments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExamineArguments -> SeedOpt -> ExamineArguments
forall a. Reproducible a => a -> SeedOpt -> a
setSeed ExamineArguments
a
  setSeed (Shuffle ShuffleArguments
a) = ShuffleArguments -> CommandArguments
Shuffle (ShuffleArguments -> CommandArguments)
-> (SeedOpt -> ShuffleArguments) -> SeedOpt -> CommandArguments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShuffleArguments -> SeedOpt -> ShuffleArguments
forall a. Reproducible a => a -> SeedOpt -> a
setSeed ShuffleArguments
a
  setSeed (Simulate SimulateArguments
a) = SimulateArguments -> CommandArguments
Simulate (SimulateArguments -> CommandArguments)
-> (SeedOpt -> SimulateArguments) -> SeedOpt -> CommandArguments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimulateArguments -> SeedOpt -> SimulateArguments
forall a. Reproducible a => a -> SeedOpt -> a
setSeed SimulateArguments
a

  parser :: Parser CommandArguments
parser = Parser CommandArguments
commandArguments

  cmdName :: String
cmdName = String
"tlynx"

  cmdDsc :: [String]
cmdDsc = [String
"Compare, examine, and simulate phylogenetic trees."]

  cmdFtr :: [String]
cmdFtr = String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"Available tree file formats:" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
indent [String]
newickHelp
    where
      indent :: [String] -> [String]
indent = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++)

instance FromJSON CommandArguments

instance ToJSON CommandArguments

compareCommand :: Mod CommandFields CommandArguments
compareCommand :: Mod CommandFields CommandArguments
compareCommand = (CompareArguments -> CommandArguments)
-> Mod CommandFields CommandArguments
forall a b. Reproducible a => (a -> b) -> Mod CommandFields b
createCommandReproducible CompareArguments -> CommandArguments
Compare

connectCommand :: Mod CommandFields CommandArguments
connectCommand :: Mod CommandFields CommandArguments
connectCommand = (ConnectArguments -> CommandArguments)
-> Mod CommandFields CommandArguments
forall a b. Reproducible a => (a -> b) -> Mod CommandFields b
createCommandReproducible ConnectArguments -> CommandArguments
Connect

distanceCommand :: Mod CommandFields CommandArguments
distanceCommand :: Mod CommandFields CommandArguments
distanceCommand = (DistanceArguments -> CommandArguments)
-> Mod CommandFields CommandArguments
forall a b. Reproducible a => (a -> b) -> Mod CommandFields b
createCommandReproducible DistanceArguments -> CommandArguments
Distance

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

shuffleCommand :: Mod CommandFields CommandArguments
shuffleCommand :: Mod CommandFields CommandArguments
shuffleCommand = (ShuffleArguments -> CommandArguments)
-> Mod CommandFields CommandArguments
forall a b. Reproducible a => (a -> b) -> Mod CommandFields b
createCommandReproducible ShuffleArguments -> CommandArguments
Shuffle

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

commandArguments :: Parser CommandArguments
commandArguments :: Parser CommandArguments
commandArguments =
  Mod CommandFields CommandArguments -> Parser CommandArguments
forall a. Mod CommandFields a -> Parser a
hsubparser (Mod CommandFields CommandArguments -> Parser CommandArguments)
-> Mod CommandFields CommandArguments -> Parser CommandArguments
forall a b. (a -> b) -> a -> b
$
    Mod CommandFields CommandArguments
compareCommand
      Mod CommandFields CommandArguments
-> Mod CommandFields CommandArguments
-> Mod CommandFields CommandArguments
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields CommandArguments
connectCommand
      Mod CommandFields CommandArguments
-> Mod CommandFields CommandArguments
-> Mod CommandFields CommandArguments
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields CommandArguments
distanceCommand
      Mod CommandFields CommandArguments
-> Mod CommandFields CommandArguments
-> Mod CommandFields CommandArguments
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields CommandArguments
examineCommand
      Mod CommandFields CommandArguments
-> Mod CommandFields CommandArguments
-> Mod CommandFields CommandArguments
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields CommandArguments
shuffleCommand
      Mod CommandFields CommandArguments
-> Mod CommandFields CommandArguments
-> Mod CommandFields CommandArguments
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields CommandArguments
simulateCommand