{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  ELynx.Tree.Import.Nexus
-- Description :  Import trees from Nexus files
-- Copyright   :  (c) Dominik Schrempf 2021
-- License     :  GPL-3
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Tue Apr 28 17:44:13 2020.
module ELynx.Tree.Import.Nexus
  ( nexusTrees,
  )
where

import Control.Applicative
import Data.Attoparsec.ByteString.Char8
import qualified Data.ByteString.Char8 as BS
import ELynx.Import.Nexus
import ELynx.Tree.Import.Newick
import ELynx.Tree.Name
import ELynx.Tree.Phylogeny
import ELynx.Tree.Rooted
import Prelude hiding (takeWhile)

-- | Parse a Nexus files with a TREES block.
nexusTrees :: NewickFormat -> Parser [(BS.ByteString, Tree Phylo Name)]
nexusTrees :: NewickFormat -> Parser [(ByteString, Tree Phylo Name)]
nexusTrees = Block [(ByteString, Tree Phylo Name)]
-> Parser [(ByteString, Tree Phylo Name)]
forall a. Block a -> Parser a
nexusBlock (Block [(ByteString, Tree Phylo Name)]
 -> Parser [(ByteString, Tree Phylo Name)])
-> (NewickFormat -> Block [(ByteString, Tree Phylo Name)])
-> NewickFormat
-> Parser [(ByteString, Tree Phylo Name)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewickFormat -> Block [(ByteString, Tree Phylo Name)]
trees

trees :: NewickFormat -> Block [(BS.ByteString, Tree Phylo Name)]
trees :: NewickFormat -> Block [(ByteString, Tree Phylo Name)]
trees NewickFormat
f = ByteString
-> Parser [(ByteString, Tree Phylo Name)]
-> Block [(ByteString, Tree Phylo Name)]
forall a. ByteString -> Parser a -> Block a
Block ByteString
"TREES" (Parser ByteString (ByteString, Tree Phylo Name)
-> Parser [(ByteString, Tree Phylo Name)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Parser ByteString (ByteString, Tree Phylo Name)
 -> Parser [(ByteString, Tree Phylo Name)])
-> Parser ByteString (ByteString, Tree Phylo Name)
-> Parser [(ByteString, Tree Phylo Name)]
forall a b. (a -> b) -> a -> b
$ NewickFormat -> Parser ByteString (ByteString, Tree Phylo Name)
namedNewick NewickFormat
f)

namedNewick :: NewickFormat -> Parser (BS.ByteString, Tree Phylo Name)
namedNewick :: NewickFormat -> Parser ByteString (ByteString, Tree Phylo Name)
namedNewick NewickFormat
f = do
  ()
_ <- (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace
  ByteString
_ <- ByteString -> Parser ByteString
stringCI ByteString
"TREE" Parser ByteString -> String -> Parser ByteString
forall i a. Parser i a -> String -> Parser i a
<?> String
"namedNewickTreeStart"
  ()
_ <- (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace
  ByteString
n <- (Char -> Bool) -> Parser ByteString
takeWhile1 (\Char
x -> Char -> Bool
isAlpha_ascii Char
x Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
x) Parser ByteString -> String -> Parser ByteString
forall i a. Parser i a -> String -> Parser i a
<?> String
"namedNewickTreeName"
  ()
_ <- (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace
  Char
_ <- Char -> Parser Char
char Char
'=' Parser Char -> String -> Parser Char
forall i a. Parser i a -> String -> Parser i a
<?> String
"namedNewickEqual"
  ()
_ <- (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace
  Tree Phylo Name
t <- NewickFormat -> Parser (Tree Phylo Name)
newick NewickFormat
f Parser (Tree Phylo Name) -> String -> Parser (Tree Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"namedNewickTree"
  (ByteString, Tree Phylo Name)
-> Parser ByteString (ByteString, Tree Phylo Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
n, Tree Phylo Name
t)