summaryrefslogtreecommitdiff
path: root/src/Data/Graph/Dynamic/Internal/Tree.hs
blob: 8682d16067c0c62b0417a4613320571581db0e11 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
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 ()