{-# LANGUAGE DeriveGeneric #-}

-- |
-- Module      :  TLynx.Compare.Options
-- Description :  Options for the compare 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.Compare.Options
  ( CompareArguments (..),
    compareArguments,
  )
where

import ELynx.Tools
import Options.Applicative
import TLynx.Parsers

-- | Arguments of compare command.
data CompareArguments = CompareArguments
  { CompareArguments -> Bool
argsNormalize :: Bool,
    CompareArguments -> Bool
argsBipartitions :: Bool,
    CompareArguments -> Bool
argsIntersect :: Bool,
    CompareArguments -> NewickFormat
argsNewickFormat :: NewickFormat,
    CompareArguments -> [FilePath]
argsInFiles :: [FilePath]
  }
  deriving (CompareArguments -> CompareArguments -> Bool
(CompareArguments -> CompareArguments -> Bool)
-> (CompareArguments -> CompareArguments -> Bool)
-> Eq CompareArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompareArguments -> CompareArguments -> Bool
$c/= :: CompareArguments -> CompareArguments -> Bool
== :: CompareArguments -> CompareArguments -> Bool
$c== :: CompareArguments -> CompareArguments -> Bool
Eq, Int -> CompareArguments -> ShowS
[CompareArguments] -> ShowS
CompareArguments -> FilePath
(Int -> CompareArguments -> ShowS)
-> (CompareArguments -> FilePath)
-> ([CompareArguments] -> ShowS)
-> Show CompareArguments
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CompareArguments] -> ShowS
$cshowList :: [CompareArguments] -> ShowS
show :: CompareArguments -> FilePath
$cshow :: CompareArguments -> FilePath
showsPrec :: Int -> CompareArguments -> ShowS
$cshowsPrec :: Int -> CompareArguments -> ShowS
Show, (forall x. CompareArguments -> Rep CompareArguments x)
-> (forall x. Rep CompareArguments x -> CompareArguments)
-> Generic CompareArguments
forall x. Rep CompareArguments x -> CompareArguments
forall x. CompareArguments -> Rep CompareArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CompareArguments x -> CompareArguments
$cfrom :: forall x. CompareArguments -> Rep CompareArguments x
Generic)

instance Reproducible CompareArguments where
  inFiles :: CompareArguments -> [FilePath]
inFiles = CompareArguments -> [FilePath]
argsInFiles

  -- XXX: The plots are not checked with the ELynx file, because they are not
  -- always created and this is hard with the actual setup.
  outSuffixes :: CompareArguments -> [FilePath]
outSuffixes CompareArguments
_ = [FilePath
".out"]

  -- outSuffixes a = ".out" : if argsBipartitions a then [".eps", ".pdf"] else []
  getSeed :: CompareArguments -> Maybe SeedOpt
getSeed CompareArguments
_ = Maybe SeedOpt
forall a. Maybe a
Nothing
  setSeed :: CompareArguments -> SeedOpt -> CompareArguments
setSeed CompareArguments
a SeedOpt
_ = CompareArguments
a
  parser :: Parser CompareArguments
parser = Parser CompareArguments
compareArguments
  cmdName :: FilePath
cmdName = FilePath
"compare"
  cmdDsc :: [FilePath]
cmdDsc =
    [ FilePath
"Compare two phylogenetic trees (compute distances and branch-wise differences)."
    ]

instance FromJSON CompareArguments

instance ToJSON CompareArguments

-- | Parse arguments of compare command.
compareArguments :: Parser CompareArguments
compareArguments :: Parser CompareArguments
compareArguments =
  Bool
-> Bool -> Bool -> NewickFormat -> [FilePath] -> CompareArguments
CompareArguments
    (Bool
 -> Bool -> Bool -> NewickFormat -> [FilePath] -> CompareArguments)
-> Parser Bool
-> Parser
     (Bool -> Bool -> NewickFormat -> [FilePath] -> CompareArguments)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
normalize
    Parser
  (Bool -> Bool -> NewickFormat -> [FilePath] -> CompareArguments)
-> Parser Bool
-> Parser (Bool -> NewickFormat -> [FilePath] -> CompareArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
bipartitions
    Parser (Bool -> NewickFormat -> [FilePath] -> CompareArguments)
-> Parser Bool
-> Parser (NewickFormat -> [FilePath] -> CompareArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
intersect
    Parser (NewickFormat -> [FilePath] -> CompareArguments)
-> Parser NewickFormat -> Parser ([FilePath] -> CompareArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NewickFormat
newickFormat
    Parser ([FilePath] -> CompareArguments)
-> Parser [FilePath] -> Parser CompareArguments
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [FilePath]
file

normalize :: Parser Bool
normalize :: Parser Bool
normalize =
  Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
    FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"normalize" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'n'
      Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help
        FilePath
"Normalize trees before comparison"

bipartitions :: Parser Bool
bipartitions :: Parser Bool
bipartitions =
  Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
    FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"bipartitions" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'b'
      Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help
        FilePath
"Print and plot common and missing bipartitions"

intersect :: Parser Bool
intersect :: Parser Bool
intersect =
  Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
    FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"intersect"
      Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
't'
      Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help
        FilePath
"Compare intersections; i.e., before comparison, drop leaves that are not present in the other tree"

file :: Parser [FilePath]
file :: Parser [FilePath]
file = Parser FilePath -> Parser [FilePath]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Parser FilePath -> Parser [FilePath])
-> Parser FilePath -> Parser [FilePath]
forall a b. (a -> b) -> a -> b
$ 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
"NAMES" 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
"Tree files"