{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
module Data.BTree.Impure.NonEmpty (
NonEmptyTree(..)
, Node(..)
, fromTree
, toTree
, toList
, fromList
, insert
, insertMany
) where
import Control.Applicative ((<$>), (<*>))
import Data.Binary
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Map (Map)
import Data.Maybe (fromJust)
import Data.Typeable (Typeable)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import Data.BTree.Alloc.Class
import Data.BTree.Impure (Tree(..), Node(..))
import Data.BTree.Primitives
import qualified Data.BTree.Impure as B
data NonEmptyTree key val where
NonEmptyTree :: {
treeHeight :: Height height
,
treeRootId :: NodeId height key val
} -> NonEmptyTree key val
deriving (Typeable)
deriving instance (Show key, Show val) => Show (NonEmptyTree key val)
instance (Value k, Value v) => Value (NonEmptyTree k v) where
instance Binary (NonEmptyTree key val) where
put (NonEmptyTree h root) = put h >> put root
get = NonEmptyTree <$> get <*> get
fromTree :: Tree key val -> Maybe (NonEmptyTree key val)
fromTree (Tree h n) = case n of
Nothing -> Nothing
Just root -> Just $ NonEmptyTree h root
toTree :: NonEmptyTree key val -> Tree key val
toTree (NonEmptyTree h n) = Tree h (Just n)
fromList :: (AllocM m, Key k, Value v)
=> NonEmpty (k, v)
-> m (NonEmptyTree k v)
fromList (x :| xs) = fromJust . fromTree <$> B.insertMany (M.fromList (x:xs)) B.empty
insert :: (AllocM m, Key k, Value v)
=> k
-> v
-> NonEmptyTree k v
-> m (NonEmptyTree k v)
insert k v tree = fromJust . fromTree <$> B.insert k v (toTree tree)
insertMany :: (AllocM m, Key k, Value v)
=> Map k v
-> NonEmptyTree k v
-> m (NonEmptyTree k v)
insertMany kvs tree = fromJust . fromTree <$> B.insertMany kvs (toTree tree)
toList :: (AllocReaderM m, Key k, Value v)
=> NonEmptyTree k v
-> m (NonEmpty (k, v))
toList tree = NE.fromList <$> B.toList (toTree tree)