{-# LANGUAGE OverloadedStrings #-}
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)
nexusTrees :: NewickFormat -> Parser [(BS.ByteString, Tree Phylo Name)]
nexusTrees :: NewickFormat -> Parser [(ByteString, Tree Phylo Name)]
nexusTrees = forall a. Block a -> Parser a
nexusBlock 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 = forall a. ByteString -> Parser a -> Block a
Block ByteString
"TREES" (forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall a b. (a -> b) -> a -> b
$ NewickFormat -> Parser (ByteString, Tree Phylo Name)
namedNewick NewickFormat
f)
namedNewick :: NewickFormat -> Parser (BS.ByteString, Tree Phylo Name)
namedNewick :: NewickFormat -> Parser (ByteString, Tree Phylo Name)
namedNewick NewickFormat
f = do
()
_ <- (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace
ByteString
_ <- (ByteString -> Parser ByteString ByteString
stringCI ByteString
"TREE" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
stringCI ByteString
"UTREE") 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 ByteString
takeWhile1 (\Char
x -> Char -> Bool
isAlpha_ascii Char
x Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
x) forall i a. Parser i a -> String -> Parser i a
<?> String
"namedNewickTreeName"
()
_ <- (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace
Char
_ <- Char -> Parser ByteString Char
char 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 ByteString (Tree Phylo Name)
newick NewickFormat
f forall i a. Parser i a -> String -> Parser i a
<?> String
"namedNewickTree"
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
n, Tree Phylo Name
t)