module ELynx.Tree.Export.Newick
( toNewick,
toNewickBuilder,
)
where
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.List (intersperse)
import ELynx.Tree.Length
import ELynx.Tree.Name
import ELynx.Tree.Phylogeny
import ELynx.Tree.Rooted
import ELynx.Tree.Support
buildBrLen :: Length -> BB.Builder
buildBrLen :: Length -> Builder
buildBrLen Length
bl = Char -> Builder
BB.char8 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Double -> Builder
BB.doubleDec (Length -> Double
fromLength Length
bl)
buildBrSup :: Support -> BB.Builder
buildBrSup :: Support -> Builder
buildBrSup Support
bs = Char -> Builder
BB.char8 Char
'[' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Double -> Builder
BB.doubleDec (Support -> Double
fromSupport Support
bs) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char8 Char
']'
toNewickBuilder :: HasName a => Tree Phylo a -> BB.Builder
toNewickBuilder :: Tree Phylo a -> Builder
toNewickBuilder Tree Phylo a
t = Tree Phylo a -> Builder
forall a. HasName a => Tree Phylo a -> Builder
go Tree Phylo a
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char8 Char
';'
where
go :: Tree Phylo a -> Builder
go (Node Phylo
b a
l []) = Phylo -> a -> Builder
forall a. HasName a => Phylo -> a -> Builder
lbl Phylo
b a
l
go (Node Phylo
b a
l [Tree Phylo a]
ts) =
Char -> Builder
BB.char8 Char
'('
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
BB.char8 Char
',') ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ (Tree Phylo a -> Builder) -> [Tree Phylo a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Tree Phylo a -> Builder
go [Tree Phylo a]
ts)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char8 Char
')'
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Phylo -> a -> Builder
forall a. HasName a => Phylo -> a -> Builder
lbl Phylo
b a
l
mBrSupBuilder :: Phylo -> Builder
mBrSupBuilder Phylo
x = Builder -> (Support -> Builder) -> Maybe Support -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty Support -> Builder
buildBrSup (Phylo -> Maybe Support
brSup Phylo
x)
mBrLenBuilder :: Phylo -> Builder
mBrLenBuilder Phylo
x = Builder -> (Length -> Builder) -> Maybe Length -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty Length -> Builder
buildBrLen (Phylo -> Maybe Length
brLen Phylo
x)
lbl :: Phylo -> a -> Builder
lbl Phylo
x a
y =
ByteString -> Builder
BB.lazyByteString (Name -> ByteString
fromName (Name -> ByteString) -> Name -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> Name
forall a. HasName a => a -> Name
getName a
y)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Phylo -> Builder
mBrLenBuilder Phylo
x
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Phylo -> Builder
mBrSupBuilder Phylo
x
toNewick :: HasName a => Tree Phylo a -> BL.ByteString
toNewick :: Tree Phylo a -> ByteString
toNewick = Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString)
-> (Tree Phylo a -> Builder) -> Tree Phylo a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree Phylo a -> Builder
forall a. HasName a => Tree Phylo a -> Builder
toNewickBuilder