Types/Data/Graph.hs

   1 {-# LANGUAGE
   2   EmptyDataDecls,
   3   TypeFamilies,
   4   UndecidableInstances
   5   #-}
   6 module Types.Data.Graph
   7     ( -- * Type Constructors
   8       Context
   9     , Decomp
  10     , LNode
  11     , LEdge
  12     , LPath
  13     , Graph
  14
  15       -- * Operations
  16       -- ** Graph inspection
  17     , IsEmpty
  18     , Match
  19
  20       -- ** Graph construction
  21     , Empty
  22     , Merge
  23     , InsNode
  24     , InsEdge
  25     )
  26     where
  27
  28 import qualified Types.Data.List     as L
  29 import qualified Types.Data.List.Ops as L
  30 import qualified Types.Data.Map      as M
  31
  32 import Types.Data.Bool
  33 import Types.Data.Maybe
  34
  35
  36 -- preNodes, sucNodes: map from node ID to edge label
  37 data Context preNodes nodeID nodeLabel sucNodes
  38
  39 -- nodeMap: map from node ID to context
  40 data Graph nodeMap
  41
  42 -- mContext: Maybe Context
  43 data Decomp mContext graph
  44
  45 -- nodeID: natural number
  46 data LNode nodeID nodeLabel
  47
  48 --
  49 data LEdge nodeID1 nodeID2 edgeLabel
  50
  51 -- lNodes: list of LNode
  52 data LPath lNodes
  53
  54 -- Empty
  55 type Empty = Graph M.Empty
  56
  57 -- IsEmpty
  58 type family   IsEmpty g
  59 type instance IsEmpty (Graph m) = M.Null m
  60
  61 -- Merge
  62 type family   Merge context g
  63 type instance Merge (Context ps n l ss) (Graph g)
  64     = Graph (AddPred (AddSucc (M.Insert n (Context ps n l ss) g) n ps) n ss)
  65
  66 -- InsNode
  67 type family   InsNode lNode g
  68 type instance InsNode (LNode n l) g
  69     = Merge (Context M.Empty n l M.Empty) g
  70
  71 -- InsEdge
  72 type family   InsEdge lEdge g
  73 type instance InsEdge (LEdge n1 n2 l) g
  74     = InsEdge' n1 n2 l (Match n1 g)
  75
  76 type family   InsEdge' n1 n2 l decomp
  77 type instance InsEdge' n1 n2 l (Decomp (Just (Context ps n' l' ss)) g')
  78     = Merge (Context ps n1 l' (M.Insert n2 l ss)) g'
  79
  80 -- AddSucc
  81 type AddSucc g n ps = M.FoldlWithKey (AddSucc' n) g ps
  82
  83 data AddSucc' n
  84 type instance L.App3 (AddSucc' n) g p l
  85     = M.Adjust (AddSucc'' n l) p g
  86
  87 data AddSucc'' n l
  88 type instance L.App (AddSucc'' n l) (Context ps n' l' ss)
  89     = Context ps n' l' (M.Insert n l ss)
  90
  91 -- AddPred
  92 type AddPred g n ss = M.FoldlWithKey (AddPred' n) g ss
  93
  94 data AddPred' n
  95 type instance L.App3 (AddPred' n) g s l
  96     = M.Adjust (AddPred'' n l) s g
  97
  98 data AddPred'' n l
  99 type instance L.App (AddPred'' n l) (Context ps n' l' ss)
 100     = Context (M.Insert n l ss) n' l' ss
 101
 102 -- Match
 103 type family   Match node g
 104 type instance Match node (Graph g) = Match' (M.Lookup node g) node g
 105
 106 type family   Match' mContext node g
 107 type instance Match' Nothing  node g = Decomp Nothing (Graph g)
 108 type instance Match' (Just (Context p node' label s)) node g
 109     = Decomp (Just (Context (M.Delete node p)
 110                             node
 111                             label
 112                             s))
 113              (Graph (ClearSucc (ClearPred (M.Delete node g)
 114                                           node
 115                                           (M.Keys (M.Delete node s)))
 116                                node
 117                                (M.Keys (M.Delete node p))))
 118
 119 -- ClearSucc
 120 type family   ClearSucc g n ns
 121 type instance ClearSucc g n L.Null        = g
 122 type instance ClearSucc g n (L.Cons s ss)
 123     = ClearSucc (M.Adjust (ClearSucc' n) s g) n ss
 124
 125 data ClearSucc' n
 126 type instance L.App (ClearSucc' n) (Context ps n' l ss)
 127     = Context ps n' l (M.Delete n ss)
 128
 129 -- ClearPred
 130 type family   ClearPred g n ns
 131 type instance ClearPred g n L.Null        = g
 132 type instance ClearPred g n (L.Cons p ps)
 133     = ClearPred (M.Adjust (ClearPred' n) p g) n ps
 134
 135 data ClearPred' n
 136 type instance L.App (ClearPred' n) (Context ps n' l ss)
 137     = Context (M.Delete n ps) n' l ss