{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

{- |
Description :  Analyze trees
Copyright   :  (c) Dominik Schrempf 2019
License     :  GPL-3

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

Creation date: Fri May 24 13:47:56 2019.

-}

module Examine.Examine
  ( examine
  )
where

import           Control.Monad                  (unless)
import           Control.Monad.IO.Class
import           Control.Monad.Logger
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Reader
import qualified Data.ByteString.Lazy.Char8     as L
import           Data.List                      (nub, (\\))
import qualified Data.Text                      as T
import           Data.Tree
import           System.IO                      (Handle, hPutStrLn)

import           Examine.Options

import           ELynx.Data.Tree.MeasurableTree
import           ELynx.Data.Tree.NamedTree
import           ELynx.Data.Tree.PhyloTree
import           ELynx.Data.Tree.Tree
import           ELynx.Import.Tree.Newick
import           ELynx.Tools.InputOutput

readTrees :: Maybe FilePath -> Examine [Tree (PhyloLabel L.ByteString)]
readTrees mfp = do
  case mfp of
    Nothing -> $(logInfo) "Read tree(s) from standard input."
    Just fp -> $(logInfo) $ T.pack $ "Read tree(s) from file " <> fp <> "."
  a <- lift ask
  let nw = if argsNewickIqTree a then manyNewickIqTree else manyNewick
  liftIO $ parseFileOrIOWith nw mfp

examineTree :: (Measurable a, Named a)
            => Handle -> Tree a -> IO ()
examineTree h t = do
  L.hPutStrLn h $ summarize t
  unless (null dups) (hPutStrLn h $ "Duplicate leaves: " ++ show dups)
  where lvs = map getName $ leaves t
        dups = lvs \\ nub lvs

-- | Examine phylogenetic trees.
examine :: Maybe FilePath -> Examine ()
examine outFn = do
  a <- lift ask
  let inFn = argsInFile a
  trs <- readTrees inFn
  let outFilePath = (++ ".out") <$> outFn
  outH <- outHandle "results" outFilePath
  liftIO $ mapM_ (examineTree outH) trs