{- |
Module      :  Distance.Options
Description :  Options of tree-dist
Copyright   :  (c) Dominik Schrempf 2019
License     :  GPL-3

Maintainer  :  dominik.schrempf@gmail.com
Stability   :  unstable
Portability :  portable

Creation date: Thu Aug 29 13:02:22 2019.

-}

module Distance.Options
  ( DistanceArguments (..)
  , DistanceMeasure (..)
  , Distance
  , distanceArguments
  , distanceFooter
  ) where

import           Control.Monad.Logger
import           Control.Monad.Trans.Reader
import           Data.List
import           Data.Void
import           Options.Applicative
import           Text.Megaparsec            (Parsec, eof, try)
import           Text.Megaparsec.Char       (char, string)
import           Text.Megaparsec.Char.Lexer (float)
import           Text.Printf

import           ELynx.Tools.Options

-- | Supported distance measures.
data DistanceMeasure =
  Symmetric                  -- ^ Symmetric distance.
  | IncompatibleSplit Double -- ^ Incompatible split distance; collapse nodes
                             -- with branch support below given value.
  | BranchScore              -- ^ Branch score distance.

instance Show DistanceMeasure where
  show Symmetric             = "Symmetric"
  show (IncompatibleSplit c) = "Incompatible Split (" ++ printf "%.1f" c ++ ")"
  show BranchScore           = "Branch Score"

-- | Arguments needed to compute distance measures.
data DistanceArguments = DistanceArguments
  { argsDistance          :: DistanceMeasure
  , argsNormalize         :: Bool
  , argsSummaryStatistics :: Bool
  , argsMasterTreeFile    :: Maybe FilePath
  , argsNewickIqTree      :: Bool
  , argsInFiles           :: [FilePath]
  }

-- | Logger and reader data type.
type Distance = LoggingT (ReaderT DistanceArguments IO)

-- | COmmand line parser.
distanceArguments :: Parser DistanceArguments
distanceArguments = DistanceArguments <$>
  distanceOpt
  <*> normalizeSwitch
  <*> summaryStatisticsSwitch
  <*> masterTreeFile
  <*> newickIqTree
  <*> many inFilesArg

masterTreeFile :: Parser (Maybe FilePath)
masterTreeFile = optional $ strOption $
  long "master-tree-file" <>
  short 'm' <>
  metavar "MASTER-TREE-File" <>
  help "Compare all trees to the tree in the master tree file."

inFilesArg :: Parser FilePath
inFilesArg = strArgument $
  metavar "INPUT-FILES" <>
  help "Read tree(s) from INPUT-FILES; if more files are given, one tree is expected per file"

symmetric :: Parsec Void String DistanceMeasure
symmetric = do
  _ <- string "symmetric"
  _ <- eof
  pure Symmetric

incompatibleSplit :: Parsec Void String DistanceMeasure
incompatibleSplit = do
  _ <- string "incompatible-split"
  _ <- char '['
  f <- float
  _ <- char ']'
  _ <- eof
  if (0 < f) && (f < 1)
    then pure $ IncompatibleSplit f
    else error "Branch support has to be between 0 and 1."

branchScore :: Parsec Void String DistanceMeasure
branchScore = do
  _ <- string "branch-score"
  _ <- eof
  pure BranchScore

distanceParser :: Parsec Void String DistanceMeasure
distanceParser = try symmetric
                 <|> try incompatibleSplit
                 -- Try first the normalized one, since the normal branch score
                 -- parser also succeeds in this case.
                 <|> branchScore

distanceOpt :: Parser DistanceMeasure
distanceOpt = option (megaReadM distanceParser) $
  long "distance" <>
  short 'd' <>
  metavar "MEASURE" <>
  help "Type of distance to calculate (available distance measures are listed below)"

summaryStatisticsSwitch :: Parser Bool
summaryStatisticsSwitch = switch $
  long "summary-statistics" <>
  short 's' <>
  help "Report summary statistics only"

normalizeSwitch :: Parser Bool
normalizeSwitch = switch $
  long "normalize" <>
  short 'n' <>
  help "Normalize trees before distance calculation; only affect distances depending on branch lengths"

newickIqTree :: Parser Bool
newickIqTree = switch $
  long "newick-iqtree"
  <> short 'i'
  <> help "Use IQ-TREE Newick format (internal node labels are branch support values)"

-- | Information about provided distance types.
distanceFooter :: String
distanceFooter = intercalate "\n"
  [ "Available distance measures:"
  , "  symmetric                Symmetric distance (Robinson-Foulds distance)."
  , "  incompatible-split[VAL]  Incompatible split distance. Collapse branches"
  , "                           with support less than VAL before distance calculation;"
  , "                           in this way, only well supported difference contribute"
  , "                           to the distance measure."
  , "  branch-score             Branch score distance."
  ]