{-# LANGUAGE DeriveGeneric #-}

-- |
-- Module      :  SLynx.Concatenate.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.Concatenate.Options
  ( ConcatenateArguments (..),
    concatenateArguments,
  )
where

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

-- | Arguments needed to concatenate multi sequence alignments.
data ConcatenateArguments = ConcatenateArguments
  { ConcatenateArguments -> Alphabet
ccAlphabet :: Alphabet,
    ConcatenateArguments -> [FilePath]
ccInFiles :: [FilePath]
  }
  deriving (ConcatenateArguments -> ConcatenateArguments -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConcatenateArguments -> ConcatenateArguments -> Bool
$c/= :: ConcatenateArguments -> ConcatenateArguments -> Bool
== :: ConcatenateArguments -> ConcatenateArguments -> Bool
$c== :: ConcatenateArguments -> ConcatenateArguments -> Bool
Eq, Int -> ConcatenateArguments -> ShowS
[ConcatenateArguments] -> ShowS
ConcatenateArguments -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ConcatenateArguments] -> ShowS
$cshowList :: [ConcatenateArguments] -> ShowS
show :: ConcatenateArguments -> FilePath
$cshow :: ConcatenateArguments -> FilePath
showsPrec :: Int -> ConcatenateArguments -> ShowS
$cshowsPrec :: Int -> ConcatenateArguments -> ShowS
Show, forall x. Rep ConcatenateArguments x -> ConcatenateArguments
forall x. ConcatenateArguments -> Rep ConcatenateArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConcatenateArguments x -> ConcatenateArguments
$cfrom :: forall x. ConcatenateArguments -> Rep ConcatenateArguments x
Generic)

instance Reproducible ConcatenateArguments where
  inFiles :: ConcatenateArguments -> [FilePath]
inFiles = ConcatenateArguments -> [FilePath]
ccInFiles
  outSuffixes :: ConcatenateArguments -> [FilePath]
outSuffixes ConcatenateArguments
_ = [FilePath
".fasta"]
  getSeed :: ConcatenateArguments -> Maybe SeedOpt
getSeed ConcatenateArguments
_ = forall a. Maybe a
Nothing
  setSeed :: ConcatenateArguments -> SeedOpt -> ConcatenateArguments
setSeed = forall a b. a -> b -> a
const
  parser :: Parser ConcatenateArguments
parser = Parser ConcatenateArguments
concatenateArguments
  cmdName :: FilePath
cmdName = FilePath
"concatenate"
  cmdDsc :: [FilePath]
cmdDsc = [FilePath
"Concatenate sequences found in input files."]

instance FromJSON ConcatenateArguments

instance ToJSON ConcatenateArguments

-- | Command line parser.
concatenateArguments :: Parser ConcatenateArguments
concatenateArguments :: Parser ConcatenateArguments
concatenateArguments = Alphabet -> [FilePath] -> ConcatenateArguments
ConcatenateArguments forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Alphabet
alphabetOpt forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser FilePath
inFileArg

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