{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Graphs.Graph(
Graph(..),
Node, Arc, NodeType, ArcType,
firstNode,
Update(..),
CannedGraph(..),
GraphConnection,
GraphConnectionData(..),
PartialShow(..),
) where
import Util.AtomString
import Util.QuickReadShow
import Util.Dynamics
import Graphs.NewNames
class Graph graph where
getNodes :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO [Node]
getArcs :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO [Arc]
getNodeTypes :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO [NodeType]
getArcTypes :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO [ArcType]
getArcsOut :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Node -> IO [Arc]
getArcsIn :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Node -> IO [Arc]
getNodeLabel :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Node -> IO nodeLabel
getNodeType :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Node -> IO NodeType
getNodeTypeLabel :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> NodeType -> IO nodeTypeLabel
getSource :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Arc -> IO Node
getTarget :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Arc -> IO Node
getArcLabel :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Arc -> IO arcLabel
getArcType :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Arc -> IO ArcType
getArcTypeLabel :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ArcType -> IO arcTypeLabel
shareGraph :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
newGraph :: GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO (graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
newNodeType :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> nodeTypeLabel -> IO NodeType
newNode :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> NodeType -> nodeLabel -> IO Node
newArcType :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> arcTypeLabel -> IO ArcType
newArc :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ArcType -> arcLabel -> Node -> Node -> IO Arc
update :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
newEmptyGraph :: IO (graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
type GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel =
(Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ())
-> IO (GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
data GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel =
GraphConnectionData {
graphState :: CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel,
deRegister :: IO (),
graphUpdate :: Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO(),
nameSourceBranch :: NameSourceBranch
}
newtype Node = Node AtomString deriving (Eq,Ord,Typeable)
instance StringClass Node where
toString (Node atomString) = toString atomString
fromString atomString = Node (fromString atomString)
instance Show Node where
showsPrec = qShow
instance Read Node where
readsPrec = qRead
firstNode :: Node
firstNode = Node firstAtomString
newtype NodeType = NodeType AtomString deriving (Eq,Ord,Typeable)
instance StringClass NodeType where
toString (NodeType atomString) = toString atomString
fromString atomString = NodeType (fromString atomString)
instance Show NodeType where
showsPrec = qShow
instance Read NodeType where
readsPrec = qRead
newtype Arc = Arc AtomString deriving (Eq,Ord,Typeable)
instance StringClass Arc where
toString (Arc atomString) = toString atomString
fromString atomString = Arc (fromString atomString)
instance Show Arc where
showsPrec = qShow
instance Read Arc where
readsPrec = qRead
newtype ArcType = ArcType AtomString deriving (Eq,Ord,Typeable)
instance StringClass ArcType where
toString (ArcType atomString) = toString atomString
fromString atomString = ArcType (fromString atomString)
instance Show ArcType where
showsPrec = qShow
instance Read ArcType where
readsPrec = qRead
data Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel =
NewNodeType NodeType nodeTypeLabel
| SetNodeTypeLabel NodeType nodeTypeLabel
| NewNode Node NodeType nodeLabel
| DeleteNode Node
| SetNodeLabel Node nodeLabel
| SetNodeType Node NodeType
| NewArcType ArcType arcTypeLabel
| SetArcTypeLabel ArcType arcTypeLabel
| NewArc Arc ArcType arcLabel Node Node
| DeleteArc Arc
| SetArcLabel Arc arcLabel
| SetArcType Arc ArcType
| MultiUpdate [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
deriving (Read,Show)
newtype PartialShow a = PartialShow a
instance Show (PartialShow a) => Show (PartialShow [a]) where
show (PartialShow as) = show (map PartialShow as)
instance Show (PartialShow (
Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)) where
show (PartialShow update) = case update of
NewNodeType nodeType nodeTypeLabel ->
"NewNodeType " ++ show nodeType
SetNodeTypeLabel nodeType nodeTypeLabel ->
"SetNodeTypeLabel " ++ show nodeType
NewNode node nodeType nodeLabel ->
"NewNode " ++ show node ++ "::" ++ show nodeType
DeleteNode node ->
"DeleteNode " ++ show node
SetNodeLabel node nodeLabel ->
"SetNodeLabel " ++ show node
SetNodeType node nodeType ->
"SetNodeType " ++ show node ++ "::" ++ show nodeType
NewArcType arcType arcTypeLabel ->
"NewArcType " ++ show arcType
SetArcTypeLabel arcType arcTypeLabel ->
"SetArcTypeLabel " ++ show arcType
NewArc arc arcType arcLabel node1 node2 ->
"NewArc " ++ show arc ++ "::" ++ show arcType ++ " " ++ show node1
++ "->" ++ show node2
DeleteArc arc ->
"DeleteArc " ++ show arc
SetArcLabel arc arcLabel ->
"SetArcLabel " ++ show arc
SetArcType arc arcType ->
"SetArcType " ++ show arc ++ "::" ++ show arcType
MultiUpdate updates -> "MultiUpdate " ++ show (PartialShow updates)
instance Show (PartialShow (
CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)) where
show (PartialShow (CannedGraph {updates = updates})) =
"CannedGraph " ++ show (PartialShow updates)
data CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel =
CannedGraph {
updates :: [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
} deriving (Read,Show)