{-# LANGUAGE DeriveGeneric #-}

-- |
-- Module      :  ELynx.Tree.Import.Newick
-- Description :  Import Newick trees
-- Copyright   :  2021 Dominik Schrempf
-- 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'
module ELynx.Tree.Import.Newick
  ( NewickFormat (..),
    newick,
    oneNewick,
    parseOneNewick,
    readOneNewick,
    someNewick,
    parseSomeNewick,
    readSomeNewick,
  )
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)

-- IDEA: Key-value pairs in Newick files.
--
-- After some thinking I believe the best way to go is RevBayes-like key-value
-- pairs after branch lengths and node labels by default and the option to
-- import IqTree-like trees.
--
-- I can not really provide a general parser for key-value pairs, but I can
-- provide appropriate export functions for reasonably general key-value pairs
-- such as branch support values. This could look like so:
--
-- @
-- fromNewickG :: Parser (Tree (Maybe Length, BL.ByteString) (Name, BL.ByteString))
--
-- fromNewick :: Parser (Tree (Maybe Length) Name)
--
-- toNewickG :: Tree BL.ByteString BL.ByteString -> BL.ByteString
--
-- toNewick :: (HasMaybeLength e, HasMaybeSupport e, HasName a) => Tree e a -> BL.ByteString
-- @
--
-- In this case, I would also rename RevBayes to KeyVal (or provide a separate
-- function for IqTree-like trees). I would not ignore the key values but just
-- provide the whole string to be parsed by the user.

-- | Newick tree format.
--
-- - 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 are provided in square brackets after node names
--   as well as branch lengths. NOTE: Key value pairs are ignored.
data NewickFormat = Standard | IqTree | RevBayes
  deriving (NewickFormat -> NewickFormat -> Bool
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
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]
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
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]
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. 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

-- | Newick tree parser. Also succeeds when more trees follow.
newick :: NewickFormat -> Parser (Tree Phylo Name)
newick :: NewickFormat -> Parser (Tree Phylo Name)
newick NewickFormat
f = case NewickFormat
f of
  NewickFormat
Standard -> forall {a}. Parser ByteString a -> Parser ByteString a
p Parser (Tree Phylo Name)
tree
  NewickFormat
IqTree -> forall {a}. Parser ByteString a -> Parser ByteString a
p Parser (Tree Phylo Name)
treeIqTree
  NewickFormat
RevBayes -> Parser (Tree Phylo Name)
newickRevBayes
  where
    p :: Parser ByteString a -> Parser ByteString a
p Parser ByteString a
t = (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString a
t forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
';' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace forall i a. Parser i a -> String -> Parser i a
<?> String
"newick"

-- | 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
f = NewickFormat -> Parser (Tree Phylo Name)
newick NewickFormat
f forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
endOfInput forall i a. Parser i a -> String -> Parser i a
<?> String
"oneNewick"

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

-- | See 'oneNewick'; may fail with 'error'.
readOneNewick :: NewickFormat -> FilePath -> IO (Tree Phylo Name)
readOneNewick :: NewickFormat -> String -> IO (Tree Phylo Name)
readOneNewick NewickFormat
f String
fn = String -> IO ByteString
BS.readFile String
fn forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => String -> a
error forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewickFormat -> ByteString -> Either String (Tree Phylo Name)
parseOneNewick NewickFormat
f)

-- | One or more Newick trees parser.
someNewick :: NewickFormat -> Parser (Forest Phylo Name)
someNewick :: NewickFormat -> Parser (Forest Phylo Name)
someNewick NewickFormat
f = forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (NewickFormat -> Parser (Tree Phylo Name)
newick NewickFormat
f) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
endOfInput forall i a. Parser i a -> String -> Parser i a
<?> String
"someNewick"

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

-- | See 'someNewick'; may fail with 'error'.
readSomeNewick :: NewickFormat -> FilePath -> IO [Tree Phylo Name]
readSomeNewick :: NewickFormat -> String -> IO (Forest Phylo Name)
readSomeNewick NewickFormat
f String
fn = String -> IO ByteString
BS.readFile String
fn forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => String -> a
error forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewickFormat -> ByteString -> Either String (Forest Phylo Name)
parseSomeNewick NewickFormat
f)

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

branched :: Parser (Tree Phylo Name)
branched :: Parser (Tree Phylo Name)
branched = (forall i a. Parser i a -> String -> Parser i a
<?> String
"branched") 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
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall e a. e -> a -> Forest e a -> Tree e a
Node Phylo
p Name
n Forest Phylo Name
f

forestSep :: Parser ()
forestSep :: Parser ()
forestSep = Char -> Parser Char
char Char
',' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace

-- 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 Char
char Char
'(' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser (Tree Phylo Name)
tree forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Parser ()
forestSep) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
')' 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 = (forall i a. Parser i a -> String -> Parser i a
<?> String
"leaf") forall a b. (a -> b) -> a -> b
$ do
  Name
n <- Parser Name
name
  Phylo
p <- Parser Phylo
phylo
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 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).
nameNotQuoted :: Parser Name
nameNotQuoted :: Parser Name
nameNotQuoted = ByteString -> Name
Name forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString
takeWhile Char -> Bool
nameChar forall i a. Parser i a -> String -> Parser i a
<?> String
"nameNoQuotes"

noClosingQuote :: Char -> Bool
noClosingQuote :: Char -> Bool
noClosingQuote Char
c = Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\''

nameQuoted :: Parser Name
nameQuoted :: Parser Name
nameQuoted = (forall i a. Parser i a -> String -> Parser i a
<?> String
"nameQuotes") forall a b. (a -> b) -> a -> b
$ do
  Char
_ <- Char -> Parser Char
char Char
'\''
  Name
n <- ByteString -> Name
Name forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString
takeWhile Char -> Bool
noClosingQuote forall i a. Parser i a -> String -> Parser i a
<?> String
"nameQuoted"
  Char
_ <- Char -> Parser Char
char Char
'\''
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
n

-- 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 = (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Name
nameQuoted forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Name
nameNotQuoted) 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Length
branchLengthStandard forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Support
branchSupportStandard forall i a. Parser i a -> String -> Parser i a
<?> String
"phylo"

-- Branch length.
branchLengthSimple :: Parser Length
branchLengthSimple :: Parser Length
branchLengthSimple = (forall i a. Parser i a -> String -> Parser i a
<?> String
"branchLengthSimple") forall a b. (a -> b) -> a -> b
$ do
  Double
l <- Parser ByteString Double
double forall i a. Parser i a -> String -> Parser i a
<?> String
"branchLengthSimple; double"
  case Double -> Either String Length
toLength Double
l of
    Left String
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
    Right Length
pl -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Length
pl

-- Branch length.
branchLengthStandard :: Parser Length
branchLengthStandard :: Parser Length
branchLengthStandard = do
  ()
_ <- (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace
  Char
_ <- Char -> Parser Char
char Char
':' forall i a. Parser i a -> String -> Parser i a
<?> String
"branchLengthDelimiter"
  ()
_ <- (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace
  Parser Length
branchLengthSimple

branchSupportSimple :: Parser Support
branchSupportSimple :: Parser Support
branchSupportSimple = (forall i a. Parser i a -> String -> Parser i a
<?> String
"branchSupportSimple") forall a b. (a -> b) -> a -> b
$
  do
    Double
s <- Parser ByteString Double
double forall i a. Parser i a -> String -> Parser i a
<?> String
"branchSupportSimple; double"
    case Double -> Either String Support
toSupport Double
s of
      Left String
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
      Right Support
ps -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Support
ps

branchSupportStandard :: Parser Support
branchSupportStandard :: Parser Support
branchSupportStandard = (forall i a. Parser i a -> String -> Parser i a
<?> String
"branchSupportStandard") forall a b. (a -> b) -> a -> b
$ do
  Char
_ <- Char -> Parser Char
char Char
'[' forall i a. Parser i a -> String -> Parser i a
<?> String
"branchSupportBegin"
  Support
s <- Parser Support
branchSupportSimple
  Char
_ <- Char -> Parser Char
char Char
']' forall i a. Parser i a -> String -> Parser i a
<?> String
"branchSupportEnd"
  forall (m :: * -> *) a. Monad m => a -> m a
return Support
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.

-- 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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Tree Phylo Name)
leaf 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 = (forall i a. Parser i a -> String -> Parser i a
<?> String
"branchedIqTree") forall a b. (a -> b) -> a -> b
$ do
  Forest Phylo Name
f <- Parser (Forest Phylo Name)
forestIqTree
  Maybe Support
ms <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Support
branchSupportSimple
  Name
n <- Parser Name
name
  Maybe Length
mb <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Length
branchLengthStandard
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall e a. e -> a -> Forest e a -> Tree e a
Node (Maybe Length -> Maybe Support -> Phylo
Phylo Maybe Length
mb Maybe Support
ms) 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 = (forall i a. Parser i a -> String -> Parser i a
<?> String
"forestIqTree") forall a b. (a -> b) -> a -> b
$ do
  Char
_ <- Char -> Parser Char
char Char
'('
  Forest Phylo Name
f <- Parser (Tree Phylo Name)
treeIqTree forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Parser ()
forestSep
  Char
_ <- Char -> Parser Char
char Char
')'
  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.
--
-- NOTE: Key value pairs are ignored. In my opinion, it is just not a good
-- option to import key values pairs in this form. Key value pairs can still be
-- exported by first converting them to a ByteString, and then performing a
-- normal export.
newickRevBayes :: Parser (Tree Phylo Name)
newickRevBayes :: Parser (Tree Phylo Name)
newickRevBayes =
  (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ()
brackets
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Tree Phylo Name)
treeRevBayes
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
';'
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace
    forall i a. Parser i a -> String -> Parser i a
<?> String
"newickRevBayes"

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

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

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

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

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

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

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