{-# LANGUAGE DeriveGeneric #-}

-- |
-- Module      :  ELynx.Tree.Import.Newick
-- Description :  Import Newick trees
-- Copyright   :  (c) Dominik Schrempf 2020
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Thu Jan 17 14:56:27 2019.
--
-- Some functions are inspired by
-- [Biobase.Newick.Import](https://hackage.haskell.org/package/BiobaseNewick).
--
-- [Specifications](http://evolution.genetics.washington.edu/phylip/newicktree.html)
--
-- In particular, no conversion from _ to (space) is done right now.
--
-- For a description of rooted 'Tree's, please see the 'ELynx.Tree.Rooted'
--
-- Code snippet:
--
-- @
-- import Data.Attoparsec.ByteString
-- import ELynx.Tree
--
-- getOneNewick = either error id . parseOnly (oneNewick Standard)
-- @
module ELynx.Tree.Import.Newick
  ( NewickFormat (..),
    describeNewickFormat,
    newick,
    parseNewick,
    oneNewick,
    parseOneNewick,
    someNewick,
    parseSomeNewick,
  )
where

import Control.Applicative
import Data.Aeson (FromJSON, ToJSON)
import Data.Attoparsec.ByteString.Char8
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BL
import ELynx.Tree.Length
import ELynx.Tree.Name
import ELynx.Tree.Phylogeny
import ELynx.Tree.Rooted hiding (forest, label)
import ELynx.Tree.Support
import GHC.Generics
import Prelude hiding (takeWhile)

-- | Newick tree format.
--
-- >>> unlines $ map (("- " <>) . description) (allValues :: [NewickFormat])
-- - Standard: Branch support values are stored in square brackets after branch lengths.
-- - IqTree:   Branch support values are stored as node names after the closing bracket of forests.
-- - RevBayes: Key-value pairs is provided in square brackets after node names as well as branch lengths. XXX: Key value pairs are ignored at the moment.
data NewickFormat = Standard | IqTree | RevBayes
  deriving (NewickFormat -> NewickFormat -> Bool
(NewickFormat -> NewickFormat -> Bool)
-> (NewickFormat -> NewickFormat -> Bool) -> Eq NewickFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewickFormat -> NewickFormat -> Bool
$c/= :: NewickFormat -> NewickFormat -> Bool
== :: NewickFormat -> NewickFormat -> Bool
$c== :: NewickFormat -> NewickFormat -> Bool
Eq, Int -> NewickFormat -> ShowS
[NewickFormat] -> ShowS
NewickFormat -> String
(Int -> NewickFormat -> ShowS)
-> (NewickFormat -> String)
-> ([NewickFormat] -> ShowS)
-> Show NewickFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewickFormat] -> ShowS
$cshowList :: [NewickFormat] -> ShowS
show :: NewickFormat -> String
$cshow :: NewickFormat -> String
showsPrec :: Int -> NewickFormat -> ShowS
$cshowsPrec :: Int -> NewickFormat -> ShowS
Show, ReadPrec [NewickFormat]
ReadPrec NewickFormat
Int -> ReadS NewickFormat
ReadS [NewickFormat]
(Int -> ReadS NewickFormat)
-> ReadS [NewickFormat]
-> ReadPrec NewickFormat
-> ReadPrec [NewickFormat]
-> Read NewickFormat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NewickFormat]
$creadListPrec :: ReadPrec [NewickFormat]
readPrec :: ReadPrec NewickFormat
$creadPrec :: ReadPrec NewickFormat
readList :: ReadS [NewickFormat]
$creadList :: ReadS [NewickFormat]
readsPrec :: Int -> ReadS NewickFormat
$creadsPrec :: Int -> ReadS NewickFormat
Read, NewickFormat
NewickFormat -> NewickFormat -> Bounded NewickFormat
forall a. a -> a -> Bounded a
maxBound :: NewickFormat
$cmaxBound :: NewickFormat
minBound :: NewickFormat
$cminBound :: NewickFormat
Bounded, Int -> NewickFormat
NewickFormat -> Int
NewickFormat -> [NewickFormat]
NewickFormat -> NewickFormat
NewickFormat -> NewickFormat -> [NewickFormat]
NewickFormat -> NewickFormat -> NewickFormat -> [NewickFormat]
(NewickFormat -> NewickFormat)
-> (NewickFormat -> NewickFormat)
-> (Int -> NewickFormat)
-> (NewickFormat -> Int)
-> (NewickFormat -> [NewickFormat])
-> (NewickFormat -> NewickFormat -> [NewickFormat])
-> (NewickFormat -> NewickFormat -> [NewickFormat])
-> (NewickFormat -> NewickFormat -> NewickFormat -> [NewickFormat])
-> Enum NewickFormat
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NewickFormat -> NewickFormat -> NewickFormat -> [NewickFormat]
$cenumFromThenTo :: NewickFormat -> NewickFormat -> NewickFormat -> [NewickFormat]
enumFromTo :: NewickFormat -> NewickFormat -> [NewickFormat]
$cenumFromTo :: NewickFormat -> NewickFormat -> [NewickFormat]
enumFromThen :: NewickFormat -> NewickFormat -> [NewickFormat]
$cenumFromThen :: NewickFormat -> NewickFormat -> [NewickFormat]
enumFrom :: NewickFormat -> [NewickFormat]
$cenumFrom :: NewickFormat -> [NewickFormat]
fromEnum :: NewickFormat -> Int
$cfromEnum :: NewickFormat -> Int
toEnum :: Int -> NewickFormat
$ctoEnum :: Int -> NewickFormat
pred :: NewickFormat -> NewickFormat
$cpred :: NewickFormat -> NewickFormat
succ :: NewickFormat -> NewickFormat
$csucc :: NewickFormat -> NewickFormat
Enum, (forall x. NewickFormat -> Rep NewickFormat x)
-> (forall x. Rep NewickFormat x -> NewickFormat)
-> Generic NewickFormat
forall x. Rep NewickFormat x -> NewickFormat
forall x. NewickFormat -> Rep NewickFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NewickFormat x -> NewickFormat
$cfrom :: forall x. NewickFormat -> Rep NewickFormat x
Generic)

instance FromJSON NewickFormat

instance ToJSON NewickFormat

-- | Short description of the supported Newick formats.
describeNewickFormat :: NewickFormat -> String
describeNewickFormat :: NewickFormat -> String
describeNewickFormat NewickFormat
Standard =
  String
"Standard: Branch support values are stored in square brackets after branch lengths."
describeNewickFormat NewickFormat
IqTree =
  String
"IqTree:   Branch support values are stored as node names after the closing bracket of forests."
describeNewickFormat NewickFormat
RevBayes =
  String
"RevBayes: Key-value pairs is provided in square brackets after node names as well as branch lengths. XXX: Key value pairs are ignored at the moment."

-- | Newick tree parser. Also succeeds when more trees follow.
newick :: NewickFormat -> Parser (Tree Phylo Name)
newick :: NewickFormat -> Parser (Tree Phylo Name)
newick NewickFormat
Standard = Parser (Tree Phylo Name)
newickStandard
newick NewickFormat
IqTree = Parser (Tree Phylo Name)
newickIqTree
newick NewickFormat
RevBayes = Parser (Tree Phylo Name)
newickRevBayes

-- | See 'newick'.
parseNewick :: NewickFormat -> BS.ByteString -> Tree Phylo Name
parseNewick :: NewickFormat -> ByteString -> Tree Phylo Name
parseNewick NewickFormat
f = (String -> Tree Phylo Name)
-> (Tree Phylo Name -> Tree Phylo Name)
-> Either String (Tree Phylo Name)
-> Tree Phylo Name
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Tree Phylo Name
forall a. HasCallStack => String -> a
error Tree Phylo Name -> Tree Phylo Name
forall a. a -> a
id (Either String (Tree Phylo Name) -> Tree Phylo Name)
-> (ByteString -> Either String (Tree Phylo Name))
-> ByteString
-> Tree Phylo Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Tree Phylo Name)
-> ByteString -> Either String (Tree Phylo Name)
forall a. Parser a -> ByteString -> Either String a
parseOnly (NewickFormat -> Parser (Tree Phylo Name)
newick NewickFormat
f)

-- | One Newick tree parser. Fails when end of input is not reached.
oneNewick :: NewickFormat -> Parser (Tree Phylo Name)
oneNewick :: NewickFormat -> Parser (Tree Phylo Name)
oneNewick NewickFormat
Standard = Parser (Tree Phylo Name)
oneNewickStandard
oneNewick NewickFormat
IqTree = Parser (Tree Phylo Name)
oneNewickIqTree
oneNewick NewickFormat
RevBayes = Parser (Tree Phylo Name)
oneNewickRevBayes

-- | See 'oneNewick'.
parseOneNewick :: NewickFormat -> BS.ByteString -> Tree Phylo Name
parseOneNewick :: NewickFormat -> ByteString -> Tree Phylo Name
parseOneNewick NewickFormat
f = (String -> Tree Phylo Name)
-> (Tree Phylo Name -> Tree Phylo Name)
-> Either String (Tree Phylo Name)
-> Tree Phylo Name
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Tree Phylo Name
forall a. HasCallStack => String -> a
error Tree Phylo Name -> Tree Phylo Name
forall a. a -> a
id (Either String (Tree Phylo Name) -> Tree Phylo Name)
-> (ByteString -> Either String (Tree Phylo Name))
-> ByteString
-> Tree Phylo Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Tree Phylo Name)
-> ByteString -> Either String (Tree Phylo Name)
forall a. Parser a -> ByteString -> Either String a
parseOnly (NewickFormat -> Parser (Tree Phylo Name)
oneNewick NewickFormat
f)

-- | One or more Newick trees parser.
someNewick :: NewickFormat -> Parser (Forest Phylo Name)
someNewick :: NewickFormat -> Parser (Forest Phylo Name)
someNewick NewickFormat
Standard = Parser (Forest Phylo Name)
someNewickStandard
someNewick NewickFormat
IqTree = Parser (Forest Phylo Name)
someNewickIqTree
someNewick NewickFormat
RevBayes = Parser (Forest Phylo Name)
someNewickRevBayes

-- | See 'someNewick'.
parseSomeNewick :: NewickFormat -> BS.ByteString -> [Tree Phylo Name]
parseSomeNewick :: NewickFormat -> ByteString -> Forest Phylo Name
parseSomeNewick NewickFormat
f = (String -> Forest Phylo Name)
-> (Forest Phylo Name -> Forest Phylo Name)
-> Either String (Forest Phylo Name)
-> Forest Phylo Name
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Forest Phylo Name
forall a. HasCallStack => String -> a
error Forest Phylo Name -> Forest Phylo Name
forall a. a -> a
id (Either String (Forest Phylo Name) -> Forest Phylo Name)
-> (ByteString -> Either String (Forest Phylo Name))
-> ByteString
-> Forest Phylo Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Forest Phylo Name)
-> ByteString -> Either String (Forest Phylo Name)
forall a. Parser a -> ByteString -> Either String a
parseOnly (NewickFormat -> Parser (Forest Phylo Name)
someNewick NewickFormat
f)

-- Parse a single Newick tree. Also succeeds when more trees follow.
newickStandard :: Parser (Tree Phylo Name)
newickStandard :: Parser (Tree Phylo Name)
newickStandard = (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace Parser () -> Parser (Tree Phylo Name) -> Parser (Tree Phylo Name)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Tree Phylo Name)
tree Parser (Tree Phylo Name)
-> Parser ByteString Char -> Parser (Tree Phylo Name)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
char Char
';' Parser (Tree Phylo Name) -> Parser () -> Parser (Tree Phylo Name)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace Parser (Tree Phylo Name) -> String -> Parser (Tree Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"newickStandard"

-- Parse a single Newick tree. Fails when end of file is not reached.
oneNewickStandard :: Parser (Tree Phylo Name)
oneNewickStandard :: Parser (Tree Phylo Name)
oneNewickStandard = Parser (Tree Phylo Name)
newickStandard Parser (Tree Phylo Name) -> Parser () -> Parser (Tree Phylo Name)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall t. Chunk t => Parser t ()
endOfInput Parser (Tree Phylo Name) -> String -> Parser (Tree Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"oneNewickStandard"

-- Parse one ore more Newick trees until end of file.
someNewickStandard :: Parser (Forest Phylo Name)
someNewickStandard :: Parser (Forest Phylo Name)
someNewickStandard = Parser (Tree Phylo Name) -> Parser (Forest Phylo Name)
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser (Tree Phylo Name)
newickStandard Parser (Forest Phylo Name)
-> Parser () -> Parser (Forest Phylo Name)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall t. Chunk t => Parser t ()
endOfInput Parser (Forest Phylo Name) -> String -> Parser (Forest Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"someNewickStandard"

tree :: Parser (Tree Phylo Name)
tree :: Parser (Tree Phylo Name)
tree = Parser (Tree Phylo Name)
branched Parser (Tree Phylo Name)
-> Parser (Tree Phylo Name) -> Parser (Tree Phylo Name)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Tree Phylo Name)
leaf Parser (Tree Phylo Name) -> String -> Parser (Tree Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"tree"

branched :: Parser (Tree Phylo Name)
branched :: Parser (Tree Phylo Name)
branched = (Parser (Tree Phylo Name) -> String -> Parser (Tree Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"branched") (Parser (Tree Phylo Name) -> Parser (Tree Phylo Name))
-> Parser (Tree Phylo Name) -> Parser (Tree Phylo Name)
forall a b. (a -> b) -> a -> b
$ do
  Forest Phylo Name
f <- Parser (Forest Phylo Name)
forest
  Name
n <- Parser Name
name
  Phylo
p <- Parser Phylo
phylo
  Tree Phylo Name -> Parser (Tree Phylo Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tree Phylo Name -> Parser (Tree Phylo Name))
-> Tree Phylo Name -> Parser (Tree Phylo Name)
forall a b. (a -> b) -> a -> b
$ Phylo -> Name -> Forest Phylo Name -> Tree Phylo Name
forall e a. e -> a -> Forest e a -> Tree e a
Node Phylo
p Name
n Forest Phylo Name
f

-- A 'forest' is a set of trees separated by @,@ and enclosed by parentheses.
forest :: Parser (Forest Phylo Name)
forest :: Parser (Forest Phylo Name)
forest = Char -> Parser ByteString Char
char Char
'(' Parser ByteString Char
-> Parser (Forest Phylo Name) -> Parser (Forest Phylo Name)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser (Tree Phylo Name)
tree Parser (Tree Phylo Name)
-> Parser ByteString Char -> Parser (Forest Phylo Name)
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Char -> Parser ByteString Char
char Char
',') Parser (Forest Phylo Name)
-> Parser ByteString Char -> Parser (Forest Phylo Name)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
char Char
')' Parser (Forest Phylo Name) -> String -> Parser (Forest Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"forest"

-- A 'leaf' has a 'name' and a 'phylo' branch.
leaf :: Parser (Tree Phylo Name)
leaf :: Parser (Tree Phylo Name)
leaf = (Parser (Tree Phylo Name) -> String -> Parser (Tree Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"leaf") (Parser (Tree Phylo Name) -> Parser (Tree Phylo Name))
-> Parser (Tree Phylo Name) -> Parser (Tree Phylo Name)
forall a b. (a -> b) -> a -> b
$ do
  Name
n <- Parser Name
name
  Phylo
p <- Parser Phylo
phylo
  Tree Phylo Name -> Parser (Tree Phylo Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tree Phylo Name -> Parser (Tree Phylo Name))
-> Tree Phylo Name -> Parser (Tree Phylo Name)
forall a b. (a -> b) -> a -> b
$ Phylo -> Name -> Forest Phylo Name -> Tree Phylo Name
forall e a. e -> a -> Forest e a -> Tree e a
Node Phylo
p Name
n []

nameChar :: Char -> Bool
nameChar :: Char -> Bool
nameChar Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
" :;()[],"

-- A name can be any string of printable characters except blanks, colons,
-- semicolons, parentheses, and square brackets (and commas).
name :: Parser Name
name :: Parser Name
name = ByteString -> Name
Name (ByteString -> Name)
-> (ByteString -> ByteString) -> ByteString -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict (ByteString -> Name) -> Parser ByteString ByteString -> Parser Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
takeWhile Char -> Bool
nameChar Parser Name -> String -> Parser Name
forall i a. Parser i a -> String -> Parser i a
<?> String
"name"

phylo :: Parser Phylo
phylo :: Parser Phylo
phylo = Maybe Length -> Maybe Support -> Phylo
Phylo (Maybe Length -> Maybe Support -> Phylo)
-> Parser ByteString (Maybe Length)
-> Parser ByteString (Maybe Support -> Phylo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Length -> Parser ByteString (Maybe Length)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString Length
branchLength Parser ByteString (Maybe Support -> Phylo)
-> Parser ByteString (Maybe Support) -> Parser Phylo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Support -> Parser ByteString (Maybe Support)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString Support
branchSupport Parser Phylo -> String -> Parser Phylo
forall i a. Parser i a -> String -> Parser i a
<?> String
"phylo"

-- Branch length.
branchLength :: Parser Length
branchLength :: Parser ByteString Length
branchLength = do
  Char
_ <- Char -> Parser ByteString Char
char Char
':' Parser ByteString Char -> String -> Parser ByteString Char
forall i a. Parser i a -> String -> Parser i a
<?> String
"branchLengthDelimiter"
  Double
l <- Parser Double
double Parser Double -> String -> Parser Double
forall i a. Parser i a -> String -> Parser i a
<?> String
"branchLength"
  Length -> Parser ByteString Length
forall (m :: * -> *) a. Monad m => a -> m a
return (Length -> Parser ByteString Length)
-> Length -> Parser ByteString Length
forall a b. (a -> b) -> a -> b
$ String -> Double -> Length
toLength String
"branchLength" Double
l

branchSupport :: Parser Support
branchSupport :: Parser ByteString Support
branchSupport =
  do
    Char
_ <- Char -> Parser ByteString Char
char Char
'[' Parser ByteString Char -> String -> Parser ByteString Char
forall i a. Parser i a -> String -> Parser i a
<?> String
"branchSupportBegin"
    Double
s <- Parser Double
double Parser Double -> String -> Parser Double
forall i a. Parser i a -> String -> Parser i a
<?> String
"branchSupport"
    Char
_ <- Char -> Parser ByteString Char
char Char
']' Parser ByteString Char -> String -> Parser ByteString Char
forall i a. Parser i a -> String -> Parser i a
<?> String
"branchSupportEnd"
    Support -> Parser ByteString Support
forall (m :: * -> *) a. Monad m => a -> m a
return (Support -> Parser ByteString Support)
-> Support -> Parser ByteString Support
forall a b. (a -> b) -> a -> b
$ String -> Double -> Support
toSupport String
"branchSupport" Double
s

--------------------------------------------------------------------------------
-- IQ-TREE.

-- IQ-TREE stores the branch support as node names after the closing bracket of
-- a forest. Parse a single Newick tree. Also succeeds when more trees follow.
newickIqTree :: Parser (Tree Phylo Name)
newickIqTree :: Parser (Tree Phylo Name)
newickIqTree = (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace Parser () -> Parser (Tree Phylo Name) -> Parser (Tree Phylo Name)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Tree Phylo Name)
treeIqTree Parser (Tree Phylo Name)
-> Parser ByteString Char -> Parser (Tree Phylo Name)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
char Char
';' Parser (Tree Phylo Name) -> Parser () -> Parser (Tree Phylo Name)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace Parser (Tree Phylo Name) -> String -> Parser (Tree Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"newickIqTree"

-- See 'newickIqTree'. Parse a single Newick tree. Fails when end of file is not
-- reached.
oneNewickIqTree :: Parser (Tree Phylo Name)
oneNewickIqTree :: Parser (Tree Phylo Name)
oneNewickIqTree = Parser (Tree Phylo Name)
newickIqTree Parser (Tree Phylo Name) -> Parser () -> Parser (Tree Phylo Name)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall t. Chunk t => Parser t ()
endOfInput Parser (Tree Phylo Name) -> String -> Parser (Tree Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"oneNewickIqTree"

-- See 'newickIqTree'. Parse one ore more Newick trees until end of file.
someNewickIqTree :: Parser (Forest Phylo Name)
someNewickIqTree :: Parser (Forest Phylo Name)
someNewickIqTree = Parser (Tree Phylo Name) -> Parser (Forest Phylo Name)
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser (Tree Phylo Name)
newickIqTree Parser (Forest Phylo Name)
-> Parser () -> Parser (Forest Phylo Name)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall t. Chunk t => Parser t ()
endOfInput Parser (Forest Phylo Name) -> String -> Parser (Forest Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"someNewickIqTree"

-- IQ-TREE stores the branch support as node names after the closing bracket of a forest.
treeIqTree :: Parser (Tree Phylo Name)
treeIqTree :: Parser (Tree Phylo Name)
treeIqTree = Parser (Tree Phylo Name)
branchedIqTree Parser (Tree Phylo Name)
-> Parser (Tree Phylo Name) -> Parser (Tree Phylo Name)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Tree Phylo Name)
leaf Parser (Tree Phylo Name) -> String -> Parser (Tree Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"treeIqTree"

-- IQ-TREE stores the branch support as node names after the closing bracket of a forest.
branchedIqTree :: Parser (Tree Phylo Name)
branchedIqTree :: Parser (Tree Phylo Name)
branchedIqTree = (Parser (Tree Phylo Name) -> String -> Parser (Tree Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"branchedIqTree") (Parser (Tree Phylo Name) -> Parser (Tree Phylo Name))
-> Parser (Tree Phylo Name) -> Parser (Tree Phylo Name)
forall a b. (a -> b) -> a -> b
$ do
  Forest Phylo Name
f <- Parser (Forest Phylo Name)
forestIqTree
  Maybe Double
ms <- Parser Double -> Parser ByteString (Maybe Double)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Double
double
  let s :: Maybe Support
s = String -> Double -> Support
toSupport String
"branchedIqTree" (Double -> Support) -> Maybe Double -> Maybe Support
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Double
ms
  Name
n <- Parser Name
name
  Maybe Length
b <- Parser ByteString Length -> Parser ByteString (Maybe Length)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString Length
branchLength
  Tree Phylo Name -> Parser (Tree Phylo Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tree Phylo Name -> Parser (Tree Phylo Name))
-> Tree Phylo Name -> Parser (Tree Phylo Name)
forall a b. (a -> b) -> a -> b
$ Phylo -> Name -> Forest Phylo Name -> Tree Phylo Name
forall e a. e -> a -> Forest e a -> Tree e a
Node (Maybe Length -> Maybe Support -> Phylo
Phylo Maybe Length
b Maybe Support
s) Name
n Forest Phylo Name
f

-- IQ-TREE stores the branch support as node names after the closing bracket of a forest.
forestIqTree :: Parser (Forest Phylo Name)
forestIqTree :: Parser (Forest Phylo Name)
forestIqTree = (Parser (Forest Phylo Name) -> String -> Parser (Forest Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"forestIqTree") (Parser (Forest Phylo Name) -> Parser (Forest Phylo Name))
-> Parser (Forest Phylo Name) -> Parser (Forest Phylo Name)
forall a b. (a -> b) -> a -> b
$ do
  Char
_ <- Char -> Parser ByteString Char
char Char
'('
  Forest Phylo Name
f <- Parser (Tree Phylo Name)
treeIqTree Parser (Tree Phylo Name)
-> Parser ByteString Char -> Parser (Forest Phylo Name)
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Char -> Parser ByteString Char
char Char
','
  Char
_ <- Char -> Parser ByteString Char
char Char
')'
  Forest Phylo Name -> Parser (Forest Phylo Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Forest Phylo Name
f

--------------------------------------------------------------------------------
-- RevBayes.

-- RevBayes uses square brackets and key-value pairs to define information
-- about nodes and branches. Parse a single Newick tree. Also succeeds when more
-- trees follow.
--
-- TODO: Key value pairs are ignored at the moment.
newickRevBayes :: Parser (Tree Phylo Name)
newickRevBayes :: Parser (Tree Phylo Name)
newickRevBayes =
  (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace
    Parser ()
-> Parser ByteString (Maybe ()) -> Parser ByteString (Maybe ())
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ()
brackets
    Parser ByteString (Maybe ())
-> Parser (Tree Phylo Name) -> Parser (Tree Phylo Name)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Tree Phylo Name)
treeRevBayes
    Parser (Tree Phylo Name)
-> Parser ByteString Char -> Parser (Tree Phylo Name)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
char Char
';'
    Parser (Tree Phylo Name) -> Parser () -> Parser (Tree Phylo Name)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace Parser (Tree Phylo Name) -> String -> Parser (Tree Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"newickRevBayes"

-- See 'newickRevBayes'. Parse a single Newick tree. Fails when end of file is
-- not reached.
oneNewickRevBayes :: Parser (Tree Phylo Name)
oneNewickRevBayes :: Parser (Tree Phylo Name)
oneNewickRevBayes = Parser (Tree Phylo Name)
newickRevBayes Parser (Tree Phylo Name) -> Parser () -> Parser (Tree Phylo Name)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall t. Chunk t => Parser t ()
endOfInput Parser (Tree Phylo Name) -> String -> Parser (Tree Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"oneNewickRevBayes"

-- See 'newickRevBayes'. Parse one ore more Newick trees until end of file.
someNewickRevBayes :: Parser (Forest Phylo Name)
someNewickRevBayes :: Parser (Forest Phylo Name)
someNewickRevBayes = Parser (Tree Phylo Name) -> Parser (Forest Phylo Name)
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser (Tree Phylo Name)
newickRevBayes Parser (Forest Phylo Name)
-> Parser () -> Parser (Forest Phylo Name)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall t. Chunk t => Parser t ()
endOfInput Parser (Forest Phylo Name) -> String -> Parser (Forest Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"someNewickRevBayes"

treeRevBayes :: Parser (Tree Phylo Name)
treeRevBayes :: Parser (Tree Phylo Name)
treeRevBayes = Parser (Tree Phylo Name)
branchedRevBayes Parser (Tree Phylo Name)
-> Parser (Tree Phylo Name) -> Parser (Tree Phylo Name)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Tree Phylo Name)
leafRevBayes Parser (Tree Phylo Name) -> String -> Parser (Tree Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"treeRevBayes"

branchedRevBayes :: Parser (Tree Phylo Name)
branchedRevBayes :: Parser (Tree Phylo Name)
branchedRevBayes = (Parser (Tree Phylo Name) -> String -> Parser (Tree Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"branchedRevgBayes") (Parser (Tree Phylo Name) -> Parser (Tree Phylo Name))
-> Parser (Tree Phylo Name) -> Parser (Tree Phylo Name)
forall a b. (a -> b) -> a -> b
$ do
  Forest Phylo Name
f <- Parser (Forest Phylo Name)
forestRevBayes
  Name
n <- Parser Name
nameRevBayes
  Maybe Length
b <- Parser ByteString Length -> Parser ByteString (Maybe Length)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString Length
branchLengthRevBayes
  Tree Phylo Name -> Parser (Tree Phylo Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tree Phylo Name -> Parser (Tree Phylo Name))
-> Tree Phylo Name -> Parser (Tree Phylo Name)
forall a b. (a -> b) -> a -> b
$ Phylo -> Name -> Forest Phylo Name -> Tree Phylo Name
forall e a. e -> a -> Forest e a -> Tree e a
Node (Maybe Length -> Maybe Support -> Phylo
Phylo Maybe Length
b Maybe Support
forall a. Maybe a
Nothing) Name
n Forest Phylo Name
f

forestRevBayes :: Parser (Forest Phylo Name)
forestRevBayes :: Parser (Forest Phylo Name)
forestRevBayes = (Parser (Forest Phylo Name) -> String -> Parser (Forest Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"forestRevBayes") (Parser (Forest Phylo Name) -> Parser (Forest Phylo Name))
-> Parser (Forest Phylo Name) -> Parser (Forest Phylo Name)
forall a b. (a -> b) -> a -> b
$ do
  Char
_ <- Char -> Parser ByteString Char
char Char
'('
  Forest Phylo Name
f <- Parser (Tree Phylo Name)
treeRevBayes Parser (Tree Phylo Name)
-> Parser ByteString Char -> Parser (Forest Phylo Name)
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Char -> Parser ByteString Char
char Char
','
  Char
_ <- Char -> Parser ByteString Char
char Char
')'
  Forest Phylo Name -> Parser (Forest Phylo Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Forest Phylo Name
f

nameRevBayes :: Parser Name
nameRevBayes :: Parser Name
nameRevBayes = Parser Name
name Parser Name -> Parser ByteString (Maybe ()) -> Parser Name
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ()
brackets Parser Name -> String -> Parser Name
forall i a. Parser i a -> String -> Parser i a
<?> String
"nameRevBayes"

branchLengthRevBayes :: Parser Length
branchLengthRevBayes :: Parser ByteString Length
branchLengthRevBayes = Parser ByteString Length
branchLength Parser ByteString Length
-> Parser ByteString (Maybe ()) -> Parser ByteString Length
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ()
brackets Parser ByteString Length -> String -> Parser ByteString Length
forall i a. Parser i a -> String -> Parser i a
<?> String
"branchLengthRevBayes"

leafRevBayes :: Parser (Tree Phylo Name)
leafRevBayes :: Parser (Tree Phylo Name)
leafRevBayes = (Parser (Tree Phylo Name) -> String -> Parser (Tree Phylo Name)
forall i a. Parser i a -> String -> Parser i a
<?> String
"leafRevBayes") (Parser (Tree Phylo Name) -> Parser (Tree Phylo Name))
-> Parser (Tree Phylo Name) -> Parser (Tree Phylo Name)
forall a b. (a -> b) -> a -> b
$ do
  Name
n <- Parser Name
nameRevBayes
  Maybe Length
b <- Parser ByteString Length -> Parser ByteString (Maybe Length)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString Length
branchLengthRevBayes
  Tree Phylo Name -> Parser (Tree Phylo Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tree Phylo Name -> Parser (Tree Phylo Name))
-> Tree Phylo Name -> Parser (Tree Phylo Name)
forall a b. (a -> b) -> a -> b
$ Phylo -> Name -> Forest Phylo Name -> Tree Phylo Name
forall e a. e -> a -> Forest e a -> Tree e a
Node (Maybe Length -> Maybe Support -> Phylo
Phylo Maybe Length
b Maybe Support
forall a. Maybe a
Nothing) Name
n []

-- Drop anything between brackets.
brackets :: Parser ()
brackets :: Parser ()
brackets = (Parser () -> String -> Parser ()
forall i a. Parser i a -> String -> Parser i a
<?> String
"brackets") (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
  Char
_ <- Char -> Parser ByteString Char
char Char
'['
  ByteString
_ <- (Char -> Bool) -> Parser ByteString ByteString
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']')
  Char
_ <- Char -> Parser ByteString Char
char Char
']'
  () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()