module LineageConvert
( lineageToTree
, decodeLineageTree
, getLineageTree
) where
import Data.Maybe
import qualified Data.Sequence as Seq
import Data.Tree
import qualified Data.HashMap.Strict as Hash
import qualified Data.Vector as V
import qualified Data.ByteString.Lazy.Char8 as C
import qualified Data.Text as T
import Math.TreeFun.Types
import Math.TreeFun.Tree
import Data.Aeson
import Data.Aeson.Types
import Types
lineageToTree :: Label -> Object -> Tree NodeLabel
lineageToTree label object = Node { rootLabel = getNodeLabel label object
, subForest = map
(lineageToTree label)
. getChildren
$ object
}
getNodeLabel :: Label -> Object -> NodeLabel
getNodeLabel label object = NodeLabel { nodeID = getNodeID object
, nodeLabels = getLabel label object
}
getNodeID :: Object -> T.Text
getNodeID object = T.intercalate "_"
. (\(Object x) -> Hash.keys x)
. either error id
. flip parseEither object $ \obj -> do
info <- obj .: "data"
seqIDs <- info .: "seq_ids"
return seqIDs
getLabel :: Label -> Object -> Labels
getLabel label object = Seq.fromList
. V.toList
. either error id
. flip parseEither object $ \obj -> do
info <- obj .: "data"
labels <- info .: label
return labels
getChildren :: Object -> [Object]
getChildren object = either error id
. flip parseEither object $ \obj -> do
children <- obj .: "children"
return children
decodeLineageTree :: C.ByteString -> Object
decodeLineageTree contents = fromMaybe
(error "Input is not a JSON object")
(decode contents :: Maybe Object)
getLineageTree :: Label -> Object -> Tree NodeLabel
getLineageTree label object = either error (lineageToTree label)
. flip parseEither object $ \obj -> do
germTree <- obj .: "tree"
tree <- germTree .: "children"
return . rootCheck tree $ germTree
where
rootCheck [tree] _ = tree
rootCheck _ tree = tree