{-# LANGUAGE DeriveGeneric #-}

-- |
-- Module      :  TLynx.Connect.Options
-- Description :  Options for the connect subcommand
-- Copyright   :  (c) Dominik Schrempf 2021
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Thu Sep 19 15:02:21 2019.
module TLynx.Connect.Options
  ( ConnectArguments (..),
    connectArguments,
  )
where

import Data.Aeson
import ELynx.Tools.Reproduction
import GHC.Generics
import Options.Applicative
import TLynx.Parsers

-- | Arguments of connect command.
data ConnectArguments = ConnectArguments
  { ConnectArguments -> NewickFormat
nwFormat :: NewickFormat,
    ConnectArguments -> Maybe FilePath
constraints :: Maybe FilePath,
    ConnectArguments -> FilePath
inFileA :: FilePath,
    ConnectArguments -> FilePath
inFileB :: FilePath
  }
  deriving (ConnectArguments -> ConnectArguments -> Bool
(ConnectArguments -> ConnectArguments -> Bool)
-> (ConnectArguments -> ConnectArguments -> Bool)
-> Eq ConnectArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectArguments -> ConnectArguments -> Bool
$c/= :: ConnectArguments -> ConnectArguments -> Bool
== :: ConnectArguments -> ConnectArguments -> Bool
$c== :: ConnectArguments -> ConnectArguments -> Bool
Eq, Int -> ConnectArguments -> ShowS
[ConnectArguments] -> ShowS
ConnectArguments -> FilePath
(Int -> ConnectArguments -> ShowS)
-> (ConnectArguments -> FilePath)
-> ([ConnectArguments] -> ShowS)
-> Show ConnectArguments
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ConnectArguments] -> ShowS
$cshowList :: [ConnectArguments] -> ShowS
show :: ConnectArguments -> FilePath
$cshow :: ConnectArguments -> FilePath
showsPrec :: Int -> ConnectArguments -> ShowS
$cshowsPrec :: Int -> ConnectArguments -> ShowS
Show, (forall x. ConnectArguments -> Rep ConnectArguments x)
-> (forall x. Rep ConnectArguments x -> ConnectArguments)
-> Generic ConnectArguments
forall x. Rep ConnectArguments x -> ConnectArguments
forall x. ConnectArguments -> Rep ConnectArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConnectArguments x -> ConnectArguments
$cfrom :: forall x. ConnectArguments -> Rep ConnectArguments x
Generic)

instance Reproducible ConnectArguments where
  inFiles :: ConnectArguments -> [FilePath]
inFiles ConnectArguments
a = [ConnectArguments -> FilePath
inFileA ConnectArguments
a, ConnectArguments -> FilePath
inFileB ConnectArguments
a]
  outSuffixes :: ConnectArguments -> [FilePath]
outSuffixes ConnectArguments
_ = [FilePath
".out"]
  getSeed :: ConnectArguments -> Maybe SeedOpt
getSeed ConnectArguments
_ = Maybe SeedOpt
forall a. Maybe a
Nothing
  setSeed :: ConnectArguments -> SeedOpt -> ConnectArguments
setSeed ConnectArguments
a SeedOpt
_ = ConnectArguments
a
  parser :: Parser ConnectArguments
parser = Parser ConnectArguments
connectArguments
  cmdName :: FilePath
cmdName = FilePath
"connect"
  cmdDsc :: [FilePath]
cmdDsc =
    [ FilePath
"Connect two phylogenetic trees in all ways (possibly honoring constraints)."
    ]

instance FromJSON ConnectArguments

instance ToJSON ConnectArguments

-- | Parse arguments of connect command.
connectArguments :: Parser ConnectArguments
connectArguments :: Parser ConnectArguments
connectArguments =
  NewickFormat
-> Maybe FilePath -> FilePath -> FilePath -> ConnectArguments
ConnectArguments (NewickFormat
 -> Maybe FilePath -> FilePath -> FilePath -> ConnectArguments)
-> Parser NewickFormat
-> Parser
     (Maybe FilePath -> FilePath -> FilePath -> ConnectArguments)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser NewickFormat
newickFormat Parser (Maybe FilePath -> FilePath -> FilePath -> ConnectArguments)
-> Parser (Maybe FilePath)
-> Parser (FilePath -> FilePath -> ConnectArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe FilePath)
constraintsFile Parser (FilePath -> FilePath -> ConnectArguments)
-> Parser FilePath -> Parser (FilePath -> ConnectArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath
fileA Parser (FilePath -> ConnectArguments)
-> Parser FilePath -> Parser ConnectArguments
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath
fileB

constraintsFile :: Parser (Maybe FilePath)
constraintsFile :: Parser (Maybe FilePath)
constraintsFile =
  Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser FilePath -> Parser (Maybe FilePath))
-> Parser FilePath -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$
    Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$
      FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"CONSTRAINTS"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'c'
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"contraints"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"File containing one or more Newick trees to be used as constraints"

fileA :: Parser FilePath
fileA :: Parser FilePath
fileA =
  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
"TREE-FILE-A"
      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
"File containing the first Newick tree"

fileB :: Parser FilePath
fileB :: Parser FilePath
fileB =
  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
"TREE-FILE-B"
      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
"File containing the second Newick tree"