summaryrefslogtreecommitdiff
path: root/src/Data/Graph/Dynamic/Internal/Tree.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/Graph/Dynamic/Internal/Tree.hs')
-rw-r--r--src/Data/Graph/Dynamic/Internal/Tree.hs120
1 files changed, 120 insertions, 0 deletions
diff --git a/src/Data/Graph/Dynamic/Internal/Tree.hs b/src/Data/Graph/Dynamic/Internal/Tree.hs
new file mode 100644
index 0000000..8682d16
--- /dev/null
+++ b/src/Data/Graph/Dynamic/Internal/Tree.hs
@@ -0,0 +1,120 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+module Data.Graph.Dynamic.Internal.Tree
+ ( Tree (..)
+ , concat
+
+ , TestTree (..)
+ ) where
+
+import Control.Monad (foldM)
+import Control.Monad.Primitive (PrimMonad (..))
+import Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as NonEmpty
+import Data.Proxy (Proxy)
+import Prelude hiding (concat)
+
+-- | The chosen represenation of the tree has a big impact on the performance of
+-- the algorithms. This typeclass allows us to swap them out more easily.
+class Tree (t :: * -> * -> * -> *) where
+ -- | A management structure used to create new trees
+ type TreeGen t :: * -> *
+
+ -- | Create a tree gen itself
+ newTreeGen
+ :: PrimMonad m => Proxy t -> m (TreeGen t (PrimState m))
+
+ -- | Create a tree with a single element.
+ singleton
+ :: (PrimMonad m, Monoid v)
+ => TreeGen t (PrimState m) -> a -> v -> m (t (PrimState m) a v)
+
+ -- | Join two trees together.
+ append
+ :: (PrimMonad m, Monoid v)
+ => t (PrimState m) a v -> t (PrimState m) a v
+ -> m (t (PrimState m) a v)
+
+ -- | Prepend a singleton tree
+ cons
+ :: (PrimMonad m, Monoid v)
+ => t (PrimState m) a v -> t (PrimState m) a v
+ -> m (t (PrimState m) a v)
+ cons = append
+
+ -- | Append a singleton tree
+ snoc
+ :: (PrimMonad m, Monoid v)
+ => t (PrimState m) a v -> t (PrimState m) a v
+ -> m (t (PrimState m) a v)
+ snoc = append
+
+ -- | Split a tree, turning the argument into a singleton and returning the
+ -- left and right halves of the tree.
+ split
+ :: (PrimMonad m, Monoid v)
+ => t (PrimState m) a v
+ -> m (Maybe (t (PrimState m) a v), Maybe (t (PrimState m) a v))
+
+ -- | Check if two nodes belong to the same tree
+ connected
+ :: (PrimMonad m, Monoid v)
+ => t (PrimState m) a v -> t (PrimState m) a v
+ -> m Bool
+
+ -- | Find the root of a tree
+ root
+ :: (PrimMonad m, Monoid v)
+ => t (PrimState m) a v
+ -> m (t (PrimState m) a v)
+
+ -- | Read the root of a tree. This is not allowed to modify the tree (e.g.,
+ -- no splaying allowed).
+ readRoot
+ :: (PrimMonad m, Monoid v)
+ => t (PrimState m) a v
+ -> m (t (PrimState m) a v)
+ readRoot = root
+
+ -- | Read the label from a tree
+ label
+ :: (PrimMonad m, Monoid v)
+ => t (PrimState m) a v
+ -> m a
+
+ -- | Read the aggregate of a tree
+ aggregate
+ :: (PrimMonad m, Monoid v)
+ => t (PrimState m) a v
+ -> m v
+
+ -- | Convert a tree to a list
+ toList
+ :: (PrimMonad m, Monoid v)
+ => t (PrimState m) a v
+ -> m [a]
+
+concat
+ :: forall t m a v. (Tree t, PrimMonad m, Monoid v)
+ => NonEmpty (t (PrimState m) a v)
+ -> m (t (PrimState m) a v)
+concat trees0 =
+ case trees0 of x NonEmpty.:| xs -> foldM append x xs
+
+-- | These methods can be used for testing and debugging.
+class Tree t => TestTree t where
+ print
+ :: Show a
+ => t (PrimState IO) a v -> IO ()
+
+ assertInvariants
+ :: (PrimMonad m, Monoid v, Eq v, Show v)
+ => t (PrimState m) a v -> m ()
+
+ assertSingleton
+ :: (PrimMonad m, Monoid v, Eq v, Show v)
+ => t (PrimState m) a v -> m ()
+
+ assertRoot
+ :: (PrimMonad m, Monoid v, Eq v, Show v)
+ => t (PrimState m) a v -> m ()