{-# LANGUAGE DeriveGeneric #-}

-- |
-- Module      :  SLynx.SubSample.Options
-- Description :  ELynxSeq argument parsing
-- Copyright   :  (c) Dominik Schrempf 2021
-- 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.SubSample.Options
  ( SubSampleArguments (..),
    subSampleArguments,
    getOutSuffixes,
  )
where

import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Builder as LT
import qualified Data.Text.Lazy.Builder.Int as LT
import ELynx.Data.Alphabet.Alphabet
import ELynx.Tools
import Options.Applicative
import SLynx.Tools

-- | Data structure holding the Command line arguments.
data SubSampleArguments = SubSampleArguments
  { SubSampleArguments -> Alphabet
ssAlphabet :: Alphabet,
    SubSampleArguments -> FilePath
ssInFile :: FilePath,
    SubSampleArguments -> Int
ssNSites :: Int,
    SubSampleArguments -> Int
ssNAlignments :: Int,
    SubSampleArguments -> SeedOpt
ssMbSeed :: SeedOpt
  }
  deriving (SubSampleArguments -> SubSampleArguments -> Bool
(SubSampleArguments -> SubSampleArguments -> Bool)
-> (SubSampleArguments -> SubSampleArguments -> Bool)
-> Eq SubSampleArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubSampleArguments -> SubSampleArguments -> Bool
$c/= :: SubSampleArguments -> SubSampleArguments -> Bool
== :: SubSampleArguments -> SubSampleArguments -> Bool
$c== :: SubSampleArguments -> SubSampleArguments -> Bool
Eq, Int -> SubSampleArguments -> ShowS
[SubSampleArguments] -> ShowS
SubSampleArguments -> FilePath
(Int -> SubSampleArguments -> ShowS)
-> (SubSampleArguments -> FilePath)
-> ([SubSampleArguments] -> ShowS)
-> Show SubSampleArguments
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SubSampleArguments] -> ShowS
$cshowList :: [SubSampleArguments] -> ShowS
show :: SubSampleArguments -> FilePath
$cshow :: SubSampleArguments -> FilePath
showsPrec :: Int -> SubSampleArguments -> ShowS
$cshowsPrec :: Int -> SubSampleArguments -> ShowS
Show, (forall x. SubSampleArguments -> Rep SubSampleArguments x)
-> (forall x. Rep SubSampleArguments x -> SubSampleArguments)
-> Generic SubSampleArguments
forall x. Rep SubSampleArguments x -> SubSampleArguments
forall x. SubSampleArguments -> Rep SubSampleArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubSampleArguments x -> SubSampleArguments
$cfrom :: forall x. SubSampleArguments -> Rep SubSampleArguments x
Generic)

-- | Get a given number of output file suffixes.
--
-- > getOutSuffixes 11 "fasta"
--
-- Will result in @.00.fasta@ up to @.10.fasta@.
getOutSuffixes :: Int -> String -> [String]
getOutSuffixes :: Int -> FilePath -> [FilePath]
getOutSuffixes Int
n FilePath
suffix =
  [FilePath
"." FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Integral a => a -> FilePath
digitStr Int
i FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
suffix | Int
i <- [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
  where
    nDigits :: Int
nDigits = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase (Double
10 :: Double) (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
    digitStr :: a -> FilePath
digitStr a
i =
      Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$
        Int -> Char -> Text -> Text
T.justifyRight Int
nDigits Char
'0' (Text -> Text
LT.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
LT.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ a -> Builder
forall a. Integral a => a -> Builder
LT.decimal a
i)

instance Reproducible SubSampleArguments where
  inFiles :: SubSampleArguments -> [FilePath]
inFiles = FilePath -> [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> [FilePath])
-> (SubSampleArguments -> FilePath)
-> SubSampleArguments
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubSampleArguments -> FilePath
ssInFile
  outSuffixes :: SubSampleArguments -> [FilePath]
outSuffixes SubSampleArguments
a = Int -> FilePath -> [FilePath]
getOutSuffixes (SubSampleArguments -> Int
ssNAlignments SubSampleArguments
a) FilePath
"fasta"
  getSeed :: SubSampleArguments -> Maybe SeedOpt
getSeed = SeedOpt -> Maybe SeedOpt
forall a. a -> Maybe a
Just (SeedOpt -> Maybe SeedOpt)
-> (SubSampleArguments -> SeedOpt)
-> SubSampleArguments
-> Maybe SeedOpt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubSampleArguments -> SeedOpt
ssMbSeed
  setSeed :: SubSampleArguments -> SeedOpt -> SubSampleArguments
setSeed SubSampleArguments
a SeedOpt
s = SubSampleArguments
a {ssMbSeed :: SeedOpt
ssMbSeed = SeedOpt
s}
  parser :: Parser SubSampleArguments
parser = Parser SubSampleArguments
subSampleArguments
  cmdName :: FilePath
cmdName = FilePath
"sub-sample"
  cmdDsc :: [FilePath]
cmdDsc = [FilePath
"Sub-sample columns from multi sequence alignments."]
  cmdFtr :: [FilePath]
cmdFtr =
    [ FilePath
"Create a given number of multi sequence alignments, each of which contains a given number of random sites drawn from the original multi sequence alignment."
    ]

instance FromJSON SubSampleArguments

instance ToJSON SubSampleArguments

-- | Sub command parser.
subSampleArguments :: Parser SubSampleArguments
subSampleArguments :: Parser SubSampleArguments
subSampleArguments =
  Alphabet -> FilePath -> Int -> Int -> SeedOpt -> SubSampleArguments
SubSampleArguments
    (Alphabet
 -> FilePath -> Int -> Int -> SeedOpt -> SubSampleArguments)
-> Parser Alphabet
-> Parser (FilePath -> Int -> Int -> SeedOpt -> SubSampleArguments)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Alphabet
alphabetOpt
    Parser (FilePath -> Int -> Int -> SeedOpt -> SubSampleArguments)
-> Parser FilePath
-> Parser (Int -> Int -> SeedOpt -> SubSampleArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath
filePathArg
    Parser (Int -> Int -> SeedOpt -> SubSampleArguments)
-> Parser Int -> Parser (Int -> SeedOpt -> SubSampleArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int
subSampleNSitesOpt
    Parser (Int -> SeedOpt -> SubSampleArguments)
-> Parser Int -> Parser (SeedOpt -> SubSampleArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int
subSampleNAlignmentsOpt
    Parser (SeedOpt -> SubSampleArguments)
-> Parser SeedOpt -> Parser SubSampleArguments
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SeedOpt
seedOpt

subSampleNSitesOpt :: Parser Int
subSampleNSitesOpt :: Parser Int
subSampleNSitesOpt =
  ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int -> Parser Int
forall a b. (a -> b) -> a -> b
$
    FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"number-of-sites" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'n' Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"INT"
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. FilePath -> Mod f a
help
        FilePath
"Number of sites randomly drawn with replacement"

subSampleNAlignmentsOpt :: Parser Int
subSampleNAlignmentsOpt :: Parser Int
subSampleNAlignmentsOpt =
  ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int -> Parser Int
forall a b. (a -> b) -> a -> b
$
    FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"number-of-alignments"
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'm'
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"INT"
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Number of multi sequence alignments to be created"

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"