{-# OPTIONS_GHC -Wno-orphans #-}
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
instance HasMaybeSupport Length where
getMaybeSupport :: Length -> Maybe Support
getMaybeSupport = forall a b. a -> b -> a
const forall a. Maybe a
Nothing
instance HasMaybeLength Support where
getMaybeLength :: Support -> Maybe Length
getMaybeLength = forall a b. a -> b -> a
const forall a. Maybe a
Nothing
buildBrLen :: Length -> BB.Builder
buildBrLen :: Length -> Builder
buildBrLen Length
bl = Char -> Builder
BB.char8 Char
':' 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
'[' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
BB.doubleDec (Support -> Double
fromSupport Support
bs) forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char8 Char
']'
toNewickBuilder :: (HasMaybeLength e, HasMaybeSupport e, HasName a) => Tree e a -> BB.Builder
toNewickBuilder :: forall e a.
(HasMaybeLength e, HasMaybeSupport e, HasName a) =>
Tree e a -> Builder
toNewickBuilder Tree e a
t = forall {a} {e}.
(HasName a, HasMaybeLength e, HasMaybeSupport e) =>
Tree e a -> Builder
go Tree e a
t forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char8 Char
';'
where
go :: Tree e a -> Builder
go (Node e
b a
l []) = forall {a} {e}.
(HasName a, HasMaybeLength e, HasMaybeSupport e) =>
e -> a -> Builder
lbl e
b a
l
go (Node e
b a
l [Tree e a]
ts) =
Char -> Builder
BB.char8 Char
'('
forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse (Char -> Builder
BB.char8 Char
',') forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Tree e a -> Builder
go [Tree e a]
ts)
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char8 Char
')'
forall a. Semigroup a => a -> a -> a
<> forall {a} {e}.
(HasName a, HasMaybeLength e, HasMaybeSupport e) =>
e -> a -> Builder
lbl e
b a
l
mBrSupBuilder :: e -> Builder
mBrSupBuilder e
x = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Support -> Builder
buildBrSup (forall e. HasMaybeSupport e => e -> Maybe Support
getMaybeSupport e
x)
mBrLenBuilder :: e -> Builder
mBrLenBuilder e
x = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Length -> Builder
buildBrLen (forall e. HasMaybeLength e => e -> Maybe Length
getMaybeLength e
x)
lbl :: e -> a -> Builder
lbl e
x a
y =
ByteString -> Builder
BB.lazyByteString (Name -> ByteString
fromName forall a b. (a -> b) -> a -> b
$ forall a. HasName a => a -> Name
getName a
y)
forall a. Semigroup a => a -> a -> a
<> forall {e}. HasMaybeLength e => e -> Builder
mBrLenBuilder e
x
forall a. Semigroup a => a -> a -> a
<> forall {e}. HasMaybeSupport e => e -> Builder
mBrSupBuilder e
x
{-# SPECIALIZE toNewickBuilder :: Tree Length Name -> BB.Builder #-}
{-# SPECIALIZE toNewickBuilder :: Tree Length Int -> BB.Builder #-}
{-# SPECIALIZE toNewickBuilder :: Tree Phylo Name -> BB.Builder #-}
{-# SPECIALIZE toNewickBuilder :: Tree Phylo Int -> BB.Builder #-}
toNewick :: (HasMaybeLength e, HasMaybeSupport e, HasName a) => Tree e a -> BL.ByteString
toNewick :: forall e a.
(HasMaybeLength e, HasMaybeSupport e, HasName a) =>
Tree e a -> ByteString
toNewick = Builder -> ByteString
BB.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a.
(HasMaybeLength e, HasMaybeSupport e, HasName a) =>
Tree e a -> Builder
toNewickBuilder
{-# SPECIALIZE toNewick :: Tree Length Name -> BL.ByteString #-}
{-# SPECIALIZE toNewick :: Tree Length Int -> BL.ByteString #-}
{-# SPECIALIZE toNewick :: Tree Phylo Name -> BL.ByteString #-}
{-# SPECIALIZE toNewick :: Tree Phylo Int -> BL.ByteString #-}