{-# LANGUAGE DeriveGeneric #-}

-- |
-- Module      :  SLynx.Filter.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.Filter.Options
  ( FilterRowsArguments (..),
    FilterColsArguments (..),
    filterRowsArguments,
    filterColsArguments,
  )
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 for filtering sequences.
data FilterRowsArguments = FilterRowsArguments
  { FilterRowsArguments -> Alphabet
frAlphabet :: Alphabet,
    FilterRowsArguments -> FilePath
frInFile :: FilePath,
    FilterRowsArguments -> Maybe Int
frLonger :: Maybe Int,
    FilterRowsArguments -> Maybe Int
frShorter :: Maybe Int,
    FilterRowsArguments -> Bool
frStandard :: Bool
  }
  deriving (FilterRowsArguments -> FilterRowsArguments -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterRowsArguments -> FilterRowsArguments -> Bool
$c/= :: FilterRowsArguments -> FilterRowsArguments -> Bool
== :: FilterRowsArguments -> FilterRowsArguments -> Bool
$c== :: FilterRowsArguments -> FilterRowsArguments -> Bool
Eq, Int -> FilterRowsArguments -> ShowS
[FilterRowsArguments] -> ShowS
FilterRowsArguments -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FilterRowsArguments] -> ShowS
$cshowList :: [FilterRowsArguments] -> ShowS
show :: FilterRowsArguments -> FilePath
$cshow :: FilterRowsArguments -> FilePath
showsPrec :: Int -> FilterRowsArguments -> ShowS
$cshowsPrec :: Int -> FilterRowsArguments -> ShowS
Show, forall x. Rep FilterRowsArguments x -> FilterRowsArguments
forall x. FilterRowsArguments -> Rep FilterRowsArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FilterRowsArguments x -> FilterRowsArguments
$cfrom :: forall x. FilterRowsArguments -> Rep FilterRowsArguments x
Generic)

instance Reproducible FilterRowsArguments where
  inFiles :: FilterRowsArguments -> [FilePath]
inFiles = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilterRowsArguments -> FilePath
frInFile
  outSuffixes :: FilterRowsArguments -> [FilePath]
outSuffixes FilterRowsArguments
_ = [FilePath
".fasta"]
  getSeed :: FilterRowsArguments -> Maybe SeedOpt
getSeed FilterRowsArguments
_ = forall a. Maybe a
Nothing
  setSeed :: FilterRowsArguments -> SeedOpt -> FilterRowsArguments
setSeed = forall a b. a -> b -> a
const
  parser :: Parser FilterRowsArguments
parser = Parser FilterRowsArguments
filterRowsArguments
  cmdName :: FilePath
cmdName = FilePath
"filter-rows"
  cmdDsc :: [FilePath]
cmdDsc = [FilePath
"Filter rows (or sequences) found in input files."]

instance FromJSON FilterRowsArguments

instance ToJSON FilterRowsArguments

-- | Arguments needed for filtering columns of a multi sequence alignment.
data FilterColsArguments = FilterColsArguments
  { FilterColsArguments -> Alphabet
fcAlphabet :: Alphabet,
    FilterColsArguments -> FilePath
fcInFile :: FilePath,
    FilterColsArguments -> Maybe Double
fcStandard :: Maybe Double
  }
  deriving (FilterColsArguments -> FilterColsArguments -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterColsArguments -> FilterColsArguments -> Bool
$c/= :: FilterColsArguments -> FilterColsArguments -> Bool
== :: FilterColsArguments -> FilterColsArguments -> Bool
$c== :: FilterColsArguments -> FilterColsArguments -> Bool
Eq, Int -> FilterColsArguments -> ShowS
[FilterColsArguments] -> ShowS
FilterColsArguments -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FilterColsArguments] -> ShowS
$cshowList :: [FilterColsArguments] -> ShowS
show :: FilterColsArguments -> FilePath
$cshow :: FilterColsArguments -> FilePath
showsPrec :: Int -> FilterColsArguments -> ShowS
$cshowsPrec :: Int -> FilterColsArguments -> ShowS
Show, forall x. Rep FilterColsArguments x -> FilterColsArguments
forall x. FilterColsArguments -> Rep FilterColsArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FilterColsArguments x -> FilterColsArguments
$cfrom :: forall x. FilterColsArguments -> Rep FilterColsArguments x
Generic)

instance Reproducible FilterColsArguments where
  inFiles :: FilterColsArguments -> [FilePath]
inFiles = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilterColsArguments -> FilePath
fcInFile
  outSuffixes :: FilterColsArguments -> [FilePath]
outSuffixes FilterColsArguments
_ = [FilePath
".fasta"]
  getSeed :: FilterColsArguments -> Maybe SeedOpt
getSeed FilterColsArguments
_ = forall a. Maybe a
Nothing
  setSeed :: FilterColsArguments -> SeedOpt -> FilterColsArguments
setSeed = forall a b. a -> b -> a
const
  parser :: Parser FilterColsArguments
parser = Parser FilterColsArguments
filterColsArguments
  cmdName :: FilePath
cmdName = FilePath
"filter-columns"
  cmdDsc :: [FilePath]
cmdDsc = [FilePath
"Filter columns of multi sequence alignments."]

instance FromJSON FilterColsArguments

instance ToJSON FilterColsArguments

-- | Command line parser.
filterRowsArguments :: Parser FilterRowsArguments
filterRowsArguments :: Parser FilterRowsArguments
filterRowsArguments =
  Alphabet
-> FilePath
-> Maybe Int
-> Maybe Int
-> Bool
-> FilterRowsArguments
FilterRowsArguments
    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
<*> Parser FilePath
inFileArg
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Int)
filterLongerThanOpt
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Int)
filterShorterThanOpt
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
filterStandardChars

filterLongerThanOpt :: Parser (Maybe Int)
filterLongerThanOpt :: Parser (Maybe Int)
filterLongerThanOpt =
  forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$
    forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto forall a b. (a -> b) -> a -> b
$
      forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"longer-than"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"LENGTH"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help
          FilePath
"Only keep sequences longer than LENGTH"

filterShorterThanOpt :: Parser (Maybe Int)
filterShorterThanOpt :: Parser (Maybe Int)
filterShorterThanOpt =
  forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$
    forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto forall a b. (a -> b) -> a -> b
$
      forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"shorter-than"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"LENGTH"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help
          FilePath
"Only keep sequences shorter than LENGTH"

filterStandardChars :: Parser Bool
filterStandardChars :: Parser Bool
filterStandardChars =
  Mod FlagFields Bool -> Parser Bool
switch forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"standard-characters"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help
        FilePath
"Only keep sequences containing at least one standard (i.e., non-IUPAC) character"

-- | Command line parser.
filterColsArguments :: Parser FilterColsArguments
filterColsArguments :: Parser FilterColsArguments
filterColsArguments =
  Alphabet -> FilePath -> Maybe Double -> FilterColsArguments
FilterColsArguments 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
<*> Parser FilePath
inFileArg forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Double)
filterStandardOpt

filterStandardOpt :: Parser (Maybe Double)
filterStandardOpt :: Parser (Maybe Double)
filterStandardOpt =
  forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$
    forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto forall a b. (a -> b) -> a -> b
$
      forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"standard-chars"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DOUBLE"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help
          FilePath
"Keep columns with a proportion standard (non-IUPAC) characters larger than DOUBLE in [0,1]"

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"