{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveDataTypeable #-}

-- | Graph defines the Graph class, which defines the basic things a
-- graph must do.  Peculiarities:
-- (1) Graphs are directed with labelled nodes and
--     arcs.  These nodes and arcs have types.
-- (2) The nodes and arcs are identified by values of type Node and Arc.
--     These values are essentially strings.  The strings are provided by
--     the user; there is no mechanism for generating new unique strings.
--     (This is because this is easy in the applications I have in mind.)
-- (3) A necessary feature of these graphs is that it is supposed to
--     be easy generate copies, both on the same system and on others.
module Graphs.Graph(
   Graph(..), -- the Graph class
   -- Instances are parameterised on
   -- nodeLabel, nodeTypeLabel, arcLabel, arcTypeLabel.

   -- Nodes, Arc, NodeTypes, Arc
   Node, Arc, NodeType, ArcType,
   -- These are all instances of AtomString.StringClass (and so Read & Show).
   -- This means that they are essentially strings; the different types
   -- are just there to add a little abstraction.
   -- They are also all instances of Eq and Ord.  However there
   -- is no guarantee that the ordering will be the same as for the
   -- corresponding strings.
   firstNode,
   -- :: Node
   -- first Node in the node ordering.

   -- They are also instances of Typeable.

   -- Updates
   Update(..),
   -- datatype encoding update to shared graph
   -- Like instances of Graph, parameterised on
   -- nodeLabel, nodeTypeLabel, arcLabel, arcTypeLabel.
   -- Derives Read and Show.

   CannedGraph(..),
   -- contains complete immutable contents of a Graph at some time
   -- Like instances of Graph, parameterised on
   -- nodeLabel, nodeTypeLabel, arcLabel, arcTypeLabel.
   -- Derives Read and Show.

   GraphConnection,
   GraphConnectionData(..),
   -- A GraphConnection contains the information generated by one
   -- instance of Graph, which can be used to construct another,
   -- including a CannedGraph.
   -- Like instances of Graph, parameterised on
   -- nodeLabel, nodeTypeLabel, arcLabel, arcTypeLabel.

   PartialShow(..),
      -- newtype alias for showing updates.
      -- NB.  This type might get moved into ExtendedPrelude if it proves
      -- useful elsewhere.

   ) where

import Util.AtomString
import Util.QuickReadShow
import Util.Dynamics
import Graphs.NewNames

class Graph graph where
   -- access functions
   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)

   -- Functions for changing the state.
   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

   -- Other updates, such as deletions should be done with the update
   -- function.  It is also possible to add nodes, arcs, arctypes and
   -- nodetypes using update; however in this case the caller is responsible
   -- for providing a globally new label.
   update :: graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
      -> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()

   newEmptyGraph :: IO (graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
   -- Actually newEmptyGraph can be synthesised from the above functions
   -- by synthesising a null GraphConnection and passing it to newGraph.

------------------------------------------------------------------------
-- GraphConnection
------------------------------------------------------------------------

type GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel =
   (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ())
   -> IO (GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
   -- The first argument is passed back to the parent graph and
   -- indicates where to put changes to the parent graph since the
   -- canned graph was made.

data GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel =
      GraphConnectionData {
   GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graphState :: CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel,
      -- current state of graph
   GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO ()
deRegister :: IO (),
      -- disables graphUpdates
   GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
graphUpdate :: Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
      -> IO(),
      -- Similar to update (in class definition) except that
      -- it doesn't get echoed on graphUpdates.
   GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> NameSourceBranch
nameSourceBranch :: NameSourceBranch
      -- A source of new names.  Each graph should contain a NameSource
      -- to generate new node strings.
   }

------------------------------------------------------------------------
-- Nodes, Arcs, NodeTypes, ArcTypes.
------------------------------------------------------------------------

newtype Node = Node AtomString deriving (Node -> Node -> Bool
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Eq,Eq Node
Eq Node
-> (Node -> Node -> Ordering)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Node)
-> (Node -> Node -> Node)
-> Ord Node
Node -> Node -> Bool
Node -> Node -> Ordering
Node -> Node -> Node
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Node -> Node -> Node
$cmin :: Node -> Node -> Node
max :: Node -> Node -> Node
$cmax :: Node -> Node -> Node
>= :: Node -> Node -> Bool
$c>= :: Node -> Node -> Bool
> :: Node -> Node -> Bool
$c> :: Node -> Node -> Bool
<= :: Node -> Node -> Bool
$c<= :: Node -> Node -> Bool
< :: Node -> Node -> Bool
$c< :: Node -> Node -> Bool
compare :: Node -> Node -> Ordering
$ccompare :: Node -> Node -> Ordering
$cp1Ord :: Eq Node
Ord,Typeable)

instance StringClass Node where
   toString :: Node -> String
toString (Node AtomString
atomString) = AtomString -> String
forall stringClass.
StringClass stringClass =>
stringClass -> String
toString AtomString
atomString
   fromString :: String -> Node
fromString String
atomString = AtomString -> Node
Node (String -> AtomString
forall stringClass.
StringClass stringClass =>
String -> stringClass
fromString String
atomString)

instance Show Node where
   showsPrec :: Int -> Node -> ShowS
showsPrec = Int -> Node -> ShowS
forall toShow. QuickShow toShow => Int -> toShow -> ShowS
qShow

instance Read Node where
   readsPrec :: Int -> ReadS Node
readsPrec = Int -> ReadS Node
forall toRead.
QuickRead toRead =>
Int -> String -> [(toRead, String)]
qRead

firstNode :: Node
firstNode :: Node
firstNode = AtomString -> Node
Node AtomString
firstAtomString

newtype NodeType = NodeType AtomString deriving (NodeType -> NodeType -> Bool
(NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> Bool) -> Eq NodeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeType -> NodeType -> Bool
$c/= :: NodeType -> NodeType -> Bool
== :: NodeType -> NodeType -> Bool
$c== :: NodeType -> NodeType -> Bool
Eq,Eq NodeType
Eq NodeType
-> (NodeType -> NodeType -> Ordering)
-> (NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> NodeType)
-> (NodeType -> NodeType -> NodeType)
-> Ord NodeType
NodeType -> NodeType -> Bool
NodeType -> NodeType -> Ordering
NodeType -> NodeType -> NodeType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NodeType -> NodeType -> NodeType
$cmin :: NodeType -> NodeType -> NodeType
max :: NodeType -> NodeType -> NodeType
$cmax :: NodeType -> NodeType -> NodeType
>= :: NodeType -> NodeType -> Bool
$c>= :: NodeType -> NodeType -> Bool
> :: NodeType -> NodeType -> Bool
$c> :: NodeType -> NodeType -> Bool
<= :: NodeType -> NodeType -> Bool
$c<= :: NodeType -> NodeType -> Bool
< :: NodeType -> NodeType -> Bool
$c< :: NodeType -> NodeType -> Bool
compare :: NodeType -> NodeType -> Ordering
$ccompare :: NodeType -> NodeType -> Ordering
$cp1Ord :: Eq NodeType
Ord,Typeable)

instance StringClass NodeType where
   toString :: NodeType -> String
toString (NodeType AtomString
atomString) = AtomString -> String
forall stringClass.
StringClass stringClass =>
stringClass -> String
toString AtomString
atomString
   fromString :: String -> NodeType
fromString String
atomString = AtomString -> NodeType
NodeType (String -> AtomString
forall stringClass.
StringClass stringClass =>
String -> stringClass
fromString String
atomString)

instance Show NodeType where
   showsPrec :: Int -> NodeType -> ShowS
showsPrec = Int -> NodeType -> ShowS
forall toShow. QuickShow toShow => Int -> toShow -> ShowS
qShow

instance Read NodeType where
   readsPrec :: Int -> ReadS NodeType
readsPrec = Int -> ReadS NodeType
forall toRead.
QuickRead toRead =>
Int -> String -> [(toRead, String)]
qRead

newtype Arc = Arc AtomString deriving (Arc -> Arc -> Bool
(Arc -> Arc -> Bool) -> (Arc -> Arc -> Bool) -> Eq Arc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Arc -> Arc -> Bool
$c/= :: Arc -> Arc -> Bool
== :: Arc -> Arc -> Bool
$c== :: Arc -> Arc -> Bool
Eq,Eq Arc
Eq Arc
-> (Arc -> Arc -> Ordering)
-> (Arc -> Arc -> Bool)
-> (Arc -> Arc -> Bool)
-> (Arc -> Arc -> Bool)
-> (Arc -> Arc -> Bool)
-> (Arc -> Arc -> Arc)
-> (Arc -> Arc -> Arc)
-> Ord Arc
Arc -> Arc -> Bool
Arc -> Arc -> Ordering
Arc -> Arc -> Arc
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Arc -> Arc -> Arc
$cmin :: Arc -> Arc -> Arc
max :: Arc -> Arc -> Arc
$cmax :: Arc -> Arc -> Arc
>= :: Arc -> Arc -> Bool
$c>= :: Arc -> Arc -> Bool
> :: Arc -> Arc -> Bool
$c> :: Arc -> Arc -> Bool
<= :: Arc -> Arc -> Bool
$c<= :: Arc -> Arc -> Bool
< :: Arc -> Arc -> Bool
$c< :: Arc -> Arc -> Bool
compare :: Arc -> Arc -> Ordering
$ccompare :: Arc -> Arc -> Ordering
$cp1Ord :: Eq Arc
Ord,Typeable)

instance StringClass Arc where
   toString :: Arc -> String
toString (Arc AtomString
atomString) = AtomString -> String
forall stringClass.
StringClass stringClass =>
stringClass -> String
toString AtomString
atomString
   fromString :: String -> Arc
fromString String
atomString = AtomString -> Arc
Arc (String -> AtomString
forall stringClass.
StringClass stringClass =>
String -> stringClass
fromString String
atomString)

instance Show Arc where
   showsPrec :: Int -> Arc -> ShowS
showsPrec = Int -> Arc -> ShowS
forall toShow. QuickShow toShow => Int -> toShow -> ShowS
qShow

instance Read Arc where
   readsPrec :: Int -> ReadS Arc
readsPrec = Int -> ReadS Arc
forall toRead.
QuickRead toRead =>
Int -> String -> [(toRead, String)]
qRead

newtype ArcType = ArcType AtomString deriving (ArcType -> ArcType -> Bool
(ArcType -> ArcType -> Bool)
-> (ArcType -> ArcType -> Bool) -> Eq ArcType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArcType -> ArcType -> Bool
$c/= :: ArcType -> ArcType -> Bool
== :: ArcType -> ArcType -> Bool
$c== :: ArcType -> ArcType -> Bool
Eq,Eq ArcType
Eq ArcType
-> (ArcType -> ArcType -> Ordering)
-> (ArcType -> ArcType -> Bool)
-> (ArcType -> ArcType -> Bool)
-> (ArcType -> ArcType -> Bool)
-> (ArcType -> ArcType -> Bool)
-> (ArcType -> ArcType -> ArcType)
-> (ArcType -> ArcType -> ArcType)
-> Ord ArcType
ArcType -> ArcType -> Bool
ArcType -> ArcType -> Ordering
ArcType -> ArcType -> ArcType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ArcType -> ArcType -> ArcType
$cmin :: ArcType -> ArcType -> ArcType
max :: ArcType -> ArcType -> ArcType
$cmax :: ArcType -> ArcType -> ArcType
>= :: ArcType -> ArcType -> Bool
$c>= :: ArcType -> ArcType -> Bool
> :: ArcType -> ArcType -> Bool
$c> :: ArcType -> ArcType -> Bool
<= :: ArcType -> ArcType -> Bool
$c<= :: ArcType -> ArcType -> Bool
< :: ArcType -> ArcType -> Bool
$c< :: ArcType -> ArcType -> Bool
compare :: ArcType -> ArcType -> Ordering
$ccompare :: ArcType -> ArcType -> Ordering
$cp1Ord :: Eq ArcType
Ord,Typeable)

instance StringClass ArcType where
   toString :: ArcType -> String
toString (ArcType AtomString
atomString) = AtomString -> String
forall stringClass.
StringClass stringClass =>
stringClass -> String
toString AtomString
atomString
   fromString :: String -> ArcType
fromString String
atomString = AtomString -> ArcType
ArcType (String -> AtomString
forall stringClass.
StringClass stringClass =>
String -> stringClass
fromString String
atomString)

instance Show ArcType where
   showsPrec :: Int -> ArcType -> ShowS
showsPrec = Int -> ArcType -> ShowS
forall toShow. QuickShow toShow => Int -> toShow -> ShowS
qShow

instance Read ArcType where
   readsPrec :: Int -> ReadS ArcType
readsPrec = Int -> ReadS ArcType
forall toRead.
QuickRead toRead =>
Int -> String -> [(toRead, String)]
qRead

------------------------------------------------------------------------
-- Update
------------------------------------------------------------------------

data Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel =
   -- NB.  For various reasons, we decree that DeleteNode and DeleteArc should
   -- return normally, doing nothing, should the node already be deleted.
      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]
      -- can be used to present unnecessary redrawing when making big
      -- updates.
   deriving (ReadPrec [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
ReadPrec (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
Int -> ReadS (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
ReadS [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
(Int
 -> ReadS (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel))
-> ReadS [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> ReadPrec (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
-> ReadPrec [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> Read (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Read nodeTypeLabel, Read nodeLabel, Read arcTypeLabel,
 Read arcLabel) =>
ReadPrec [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Read nodeTypeLabel, Read nodeLabel, Read arcTypeLabel,
 Read arcLabel) =>
ReadPrec (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Read nodeTypeLabel, Read nodeLabel, Read arcTypeLabel,
 Read arcLabel) =>
Int -> ReadS (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Read nodeTypeLabel, Read nodeLabel, Read arcTypeLabel,
 Read arcLabel) =>
ReadS [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
readListPrec :: ReadPrec [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
$creadListPrec :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Read nodeTypeLabel, Read nodeLabel, Read arcTypeLabel,
 Read arcLabel) =>
ReadPrec [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
readPrec :: ReadPrec (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
$creadPrec :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Read nodeTypeLabel, Read nodeLabel, Read arcTypeLabel,
 Read arcLabel) =>
ReadPrec (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
readList :: ReadS [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
$creadList :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Read nodeTypeLabel, Read nodeLabel, Read arcTypeLabel,
 Read arcLabel) =>
ReadS [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
readsPrec :: Int -> ReadS (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
$creadsPrec :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Read nodeTypeLabel, Read nodeLabel, Read arcTypeLabel,
 Read arcLabel) =>
Int -> ReadS (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
Read,Int
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> ShowS
[Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel] -> ShowS
Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> String
(Int
 -> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> ShowS)
-> (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> String)
-> ([Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
    -> ShowS)
-> Show (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Show nodeTypeLabel, Show nodeLabel, Show arcTypeLabel,
 Show arcLabel) =>
Int
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> ShowS
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Show nodeTypeLabel, Show nodeLabel, Show arcTypeLabel,
 Show arcLabel) =>
[Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel] -> ShowS
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Show nodeTypeLabel, Show nodeLabel, Show arcTypeLabel,
 Show arcLabel) =>
Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> String
showList :: [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel] -> ShowS
$cshowList :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Show nodeTypeLabel, Show nodeLabel, Show arcTypeLabel,
 Show arcLabel) =>
[Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel] -> ShowS
show :: Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> String
$cshow :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Show nodeTypeLabel, Show nodeLabel, Show arcTypeLabel,
 Show arcLabel) =>
Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> String
showsPrec :: Int
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> ShowS
$cshowsPrec :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Show nodeTypeLabel, Show nodeLabel, Show arcTypeLabel,
 Show arcLabel) =>
Int
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> ShowS
Show)

-- ---------------------------------------------------------------------
-- Show instance which does not require argument types to be showable
-- ---------------------------------------------------------------------

newtype PartialShow a = PartialShow a

instance Show (PartialShow a) => Show (PartialShow [a]) where
   show :: PartialShow [a] -> String
show (PartialShow [a]
as) = [PartialShow a] -> String
forall a. Show a => a -> String
show ((a -> PartialShow a) -> [a] -> [PartialShow a]
forall a b. (a -> b) -> [a] -> [b]
map a -> PartialShow a
forall a. a -> PartialShow a
PartialShow [a]
as)

instance Show (PartialShow (
      Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)) where
   show :: PartialShow (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
-> String
show (PartialShow Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update) = case Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update of
      NewNodeType NodeType
nodeType nodeTypeLabel
nodeTypeLabel ->
         String
"NewNodeType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ NodeType -> String
forall a. Show a => a -> String
show NodeType
nodeType
      SetNodeTypeLabel NodeType
nodeType nodeTypeLabel
nodeTypeLabel ->
         String
"SetNodeTypeLabel " String -> ShowS
forall a. [a] -> [a] -> [a]
++ NodeType -> String
forall a. Show a => a -> String
show NodeType
nodeType
      NewNode Node
node NodeType
nodeType nodeLabel
nodeLabel ->
         String
"NewNode " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Node -> String
forall a. Show a => a -> String
show Node
node String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::" String -> ShowS
forall a. [a] -> [a] -> [a]
++ NodeType -> String
forall a. Show a => a -> String
show NodeType
nodeType
      DeleteNode Node
node ->
         String
"DeleteNode " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Node -> String
forall a. Show a => a -> String
show Node
node
      SetNodeLabel Node
node nodeLabel
nodeLabel ->
         String
"SetNodeLabel " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Node -> String
forall a. Show a => a -> String
show Node
node
      SetNodeType Node
node NodeType
nodeType ->
         String
"SetNodeType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Node -> String
forall a. Show a => a -> String
show Node
node String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::" String -> ShowS
forall a. [a] -> [a] -> [a]
++ NodeType -> String
forall a. Show a => a -> String
show NodeType
nodeType
      NewArcType ArcType
arcType arcTypeLabel
arcTypeLabel ->
         String
"NewArcType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArcType -> String
forall a. Show a => a -> String
show ArcType
arcType
      SetArcTypeLabel ArcType
arcType arcTypeLabel
arcTypeLabel ->
         String
"SetArcTypeLabel " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArcType -> String
forall a. Show a => a -> String
show ArcType
arcType
      NewArc Arc
arc ArcType
arcType arcLabel
arcLabel Node
node1 Node
node2 ->
         String
"NewArc " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Arc -> String
forall a. Show a => a -> String
show Arc
arc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArcType -> String
forall a. Show a => a -> String
show ArcType
arcType String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Node -> String
forall a. Show a => a -> String
show Node
node1
             String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"->" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Node -> String
forall a. Show a => a -> String
show Node
node2
      DeleteArc Arc
arc ->
         String
"DeleteArc " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Arc -> String
forall a. Show a => a -> String
show Arc
arc
      SetArcLabel Arc
arc arcLabel
arcLabel ->
         String
"SetArcLabel " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Arc -> String
forall a. Show a => a -> String
show Arc
arc
      SetArcType Arc
arc ArcType
arcType ->
         String
"SetArcType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Arc -> String
forall a. Show a => a -> String
show Arc
arc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArcType -> String
forall a. Show a => a -> String
show ArcType
arcType
      MultiUpdate [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
updates -> String
"MultiUpdate " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PartialShow [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> String
forall a. Show a => a -> String
show ([Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> PartialShow
     [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. a -> PartialShow a
PartialShow [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
updates)

instance Show (PartialShow (
      CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)) where
   show :: PartialShow
  (CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
-> String
show (PartialShow (CannedGraph {updates :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
updates = [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
updates})) =
      String
"CannedGraph " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PartialShow [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> String
forall a. Show a => a -> String
show ([Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> PartialShow
     [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. a -> PartialShow a
PartialShow [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
updates)


------------------------------------------------------------------------
-- CannedGraph
------------------------------------------------------------------------

data CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel =
   CannedGraph {
      CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
updates :: [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
      -- This list may only contain NewNodeType, NewNode, NewArcType and
      -- NewArc definitions.  The updates are processed in list order, so
      -- for example the endpoints of an Arc should be created before the Arc.
      } deriving (ReadPrec
  [CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
ReadPrec
  (CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
Int
-> ReadS
     (CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
ReadS [CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
(Int
 -> ReadS
      (CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel))
-> ReadS
     [CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> ReadPrec
     (CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
-> ReadPrec
     [CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> Read (CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Read nodeTypeLabel, Read nodeLabel, Read arcTypeLabel,
 Read arcLabel) =>
ReadPrec
  [CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Read nodeTypeLabel, Read nodeLabel, Read arcTypeLabel,
 Read arcLabel) =>
ReadPrec
  (CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Read nodeTypeLabel, Read nodeLabel, Read arcTypeLabel,
 Read arcLabel) =>
Int
-> ReadS
     (CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Read nodeTypeLabel, Read nodeLabel, Read arcTypeLabel,
 Read arcLabel) =>
ReadS [CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
readListPrec :: ReadPrec
  [CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
$creadListPrec :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Read nodeTypeLabel, Read nodeLabel, Read arcTypeLabel,
 Read arcLabel) =>
ReadPrec
  [CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
readPrec :: ReadPrec
  (CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
$creadPrec :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Read nodeTypeLabel, Read nodeLabel, Read arcTypeLabel,
 Read arcLabel) =>
ReadPrec
  (CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
readList :: ReadS [CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
$creadList :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Read nodeTypeLabel, Read nodeLabel, Read arcTypeLabel,
 Read arcLabel) =>
ReadS [CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
readsPrec :: Int
-> ReadS
     (CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
$creadsPrec :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Read nodeTypeLabel, Read nodeLabel, Read arcTypeLabel,
 Read arcLabel) =>
Int
-> ReadS
     (CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
Read,Int
-> CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ShowS
[CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> ShowS
CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> String
(Int
 -> CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
 -> ShowS)
-> (CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
    -> String)
-> ([CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
    -> ShowS)
-> Show (CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Show nodeTypeLabel, Show nodeLabel, Show arcTypeLabel,
 Show arcLabel) =>
Int
-> CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ShowS
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Show nodeTypeLabel, Show nodeLabel, Show arcTypeLabel,
 Show arcLabel) =>
[CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> ShowS
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Show nodeTypeLabel, Show nodeLabel, Show arcTypeLabel,
 Show arcLabel) =>
CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> String
showList :: [CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> ShowS
$cshowList :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Show nodeTypeLabel, Show nodeLabel, Show arcTypeLabel,
 Show arcLabel) =>
[CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> ShowS
show :: CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> String
$cshow :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Show nodeTypeLabel, Show nodeLabel, Show arcTypeLabel,
 Show arcLabel) =>
CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> String
showsPrec :: Int
-> CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ShowS
$cshowsPrec :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
(Show nodeTypeLabel, Show nodeLabel, Show arcTypeLabel,
 Show arcLabel) =>
Int
-> CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ShowS
Show)