-- | DOT AST. See <http://www.graphviz.org/doc/info/lang.html>.

module Language.Dot.Syntax where

data Graph
  = Graph GraphStrictness GraphDirectedness (Maybe Id) [Statement]
  deriving (Graph -> Graph -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Graph -> Graph -> Bool
$c/= :: Graph -> Graph -> Bool
== :: Graph -> Graph -> Bool
$c== :: Graph -> Graph -> Bool
Eq, Eq Graph
Graph -> Graph -> Bool
Graph -> Graph -> Ordering
Graph -> Graph -> Graph
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 :: Graph -> Graph -> Graph
$cmin :: Graph -> Graph -> Graph
max :: Graph -> Graph -> Graph
$cmax :: Graph -> Graph -> Graph
>= :: Graph -> Graph -> Bool
$c>= :: Graph -> Graph -> Bool
> :: Graph -> Graph -> Bool
$c> :: Graph -> Graph -> Bool
<= :: Graph -> Graph -> Bool
$c<= :: Graph -> Graph -> Bool
< :: Graph -> Graph -> Bool
$c< :: Graph -> Graph -> Bool
compare :: Graph -> Graph -> Ordering
$ccompare :: Graph -> Graph -> Ordering
Ord, Int -> Graph -> ShowS
[Graph] -> ShowS
Graph -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Graph] -> ShowS
$cshowList :: [Graph] -> ShowS
show :: Graph -> String
$cshow :: Graph -> String
showsPrec :: Int -> Graph -> ShowS
$cshowsPrec :: Int -> Graph -> ShowS
Show)

data GraphStrictness
  = StrictGraph
  | UnstrictGraph
  deriving (GraphStrictness -> GraphStrictness -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GraphStrictness -> GraphStrictness -> Bool
$c/= :: GraphStrictness -> GraphStrictness -> Bool
== :: GraphStrictness -> GraphStrictness -> Bool
$c== :: GraphStrictness -> GraphStrictness -> Bool
Eq, Eq GraphStrictness
GraphStrictness -> GraphStrictness -> Bool
GraphStrictness -> GraphStrictness -> Ordering
GraphStrictness -> GraphStrictness -> GraphStrictness
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 :: GraphStrictness -> GraphStrictness -> GraphStrictness
$cmin :: GraphStrictness -> GraphStrictness -> GraphStrictness
max :: GraphStrictness -> GraphStrictness -> GraphStrictness
$cmax :: GraphStrictness -> GraphStrictness -> GraphStrictness
>= :: GraphStrictness -> GraphStrictness -> Bool
$c>= :: GraphStrictness -> GraphStrictness -> Bool
> :: GraphStrictness -> GraphStrictness -> Bool
$c> :: GraphStrictness -> GraphStrictness -> Bool
<= :: GraphStrictness -> GraphStrictness -> Bool
$c<= :: GraphStrictness -> GraphStrictness -> Bool
< :: GraphStrictness -> GraphStrictness -> Bool
$c< :: GraphStrictness -> GraphStrictness -> Bool
compare :: GraphStrictness -> GraphStrictness -> Ordering
$ccompare :: GraphStrictness -> GraphStrictness -> Ordering
Ord, Int -> GraphStrictness -> ShowS
[GraphStrictness] -> ShowS
GraphStrictness -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GraphStrictness] -> ShowS
$cshowList :: [GraphStrictness] -> ShowS
show :: GraphStrictness -> String
$cshow :: GraphStrictness -> String
showsPrec :: Int -> GraphStrictness -> ShowS
$cshowsPrec :: Int -> GraphStrictness -> ShowS
Show, Int -> GraphStrictness
GraphStrictness -> Int
GraphStrictness -> [GraphStrictness]
GraphStrictness -> GraphStrictness
GraphStrictness -> GraphStrictness -> [GraphStrictness]
GraphStrictness
-> GraphStrictness -> GraphStrictness -> [GraphStrictness]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GraphStrictness
-> GraphStrictness -> GraphStrictness -> [GraphStrictness]
$cenumFromThenTo :: GraphStrictness
-> GraphStrictness -> GraphStrictness -> [GraphStrictness]
enumFromTo :: GraphStrictness -> GraphStrictness -> [GraphStrictness]
$cenumFromTo :: GraphStrictness -> GraphStrictness -> [GraphStrictness]
enumFromThen :: GraphStrictness -> GraphStrictness -> [GraphStrictness]
$cenumFromThen :: GraphStrictness -> GraphStrictness -> [GraphStrictness]
enumFrom :: GraphStrictness -> [GraphStrictness]
$cenumFrom :: GraphStrictness -> [GraphStrictness]
fromEnum :: GraphStrictness -> Int
$cfromEnum :: GraphStrictness -> Int
toEnum :: Int -> GraphStrictness
$ctoEnum :: Int -> GraphStrictness
pred :: GraphStrictness -> GraphStrictness
$cpred :: GraphStrictness -> GraphStrictness
succ :: GraphStrictness -> GraphStrictness
$csucc :: GraphStrictness -> GraphStrictness
Enum, GraphStrictness
forall a. a -> a -> Bounded a
maxBound :: GraphStrictness
$cmaxBound :: GraphStrictness
minBound :: GraphStrictness
$cminBound :: GraphStrictness
Bounded)

data GraphDirectedness
  = DirectedGraph
  | UndirectedGraph
  deriving (GraphDirectedness -> GraphDirectedness -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GraphDirectedness -> GraphDirectedness -> Bool
$c/= :: GraphDirectedness -> GraphDirectedness -> Bool
== :: GraphDirectedness -> GraphDirectedness -> Bool
$c== :: GraphDirectedness -> GraphDirectedness -> Bool
Eq, Eq GraphDirectedness
GraphDirectedness -> GraphDirectedness -> Bool
GraphDirectedness -> GraphDirectedness -> Ordering
GraphDirectedness -> GraphDirectedness -> GraphDirectedness
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 :: GraphDirectedness -> GraphDirectedness -> GraphDirectedness
$cmin :: GraphDirectedness -> GraphDirectedness -> GraphDirectedness
max :: GraphDirectedness -> GraphDirectedness -> GraphDirectedness
$cmax :: GraphDirectedness -> GraphDirectedness -> GraphDirectedness
>= :: GraphDirectedness -> GraphDirectedness -> Bool
$c>= :: GraphDirectedness -> GraphDirectedness -> Bool
> :: GraphDirectedness -> GraphDirectedness -> Bool
$c> :: GraphDirectedness -> GraphDirectedness -> Bool
<= :: GraphDirectedness -> GraphDirectedness -> Bool
$c<= :: GraphDirectedness -> GraphDirectedness -> Bool
< :: GraphDirectedness -> GraphDirectedness -> Bool
$c< :: GraphDirectedness -> GraphDirectedness -> Bool
compare :: GraphDirectedness -> GraphDirectedness -> Ordering
$ccompare :: GraphDirectedness -> GraphDirectedness -> Ordering
Ord, Int -> GraphDirectedness -> ShowS
[GraphDirectedness] -> ShowS
GraphDirectedness -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GraphDirectedness] -> ShowS
$cshowList :: [GraphDirectedness] -> ShowS
show :: GraphDirectedness -> String
$cshow :: GraphDirectedness -> String
showsPrec :: Int -> GraphDirectedness -> ShowS
$cshowsPrec :: Int -> GraphDirectedness -> ShowS
Show, Int -> GraphDirectedness
GraphDirectedness -> Int
GraphDirectedness -> [GraphDirectedness]
GraphDirectedness -> GraphDirectedness
GraphDirectedness -> GraphDirectedness -> [GraphDirectedness]
GraphDirectedness
-> GraphDirectedness -> GraphDirectedness -> [GraphDirectedness]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GraphDirectedness
-> GraphDirectedness -> GraphDirectedness -> [GraphDirectedness]
$cenumFromThenTo :: GraphDirectedness
-> GraphDirectedness -> GraphDirectedness -> [GraphDirectedness]
enumFromTo :: GraphDirectedness -> GraphDirectedness -> [GraphDirectedness]
$cenumFromTo :: GraphDirectedness -> GraphDirectedness -> [GraphDirectedness]
enumFromThen :: GraphDirectedness -> GraphDirectedness -> [GraphDirectedness]
$cenumFromThen :: GraphDirectedness -> GraphDirectedness -> [GraphDirectedness]
enumFrom :: GraphDirectedness -> [GraphDirectedness]
$cenumFrom :: GraphDirectedness -> [GraphDirectedness]
fromEnum :: GraphDirectedness -> Int
$cfromEnum :: GraphDirectedness -> Int
toEnum :: Int -> GraphDirectedness
$ctoEnum :: Int -> GraphDirectedness
pred :: GraphDirectedness -> GraphDirectedness
$cpred :: GraphDirectedness -> GraphDirectedness
succ :: GraphDirectedness -> GraphDirectedness
$csucc :: GraphDirectedness -> GraphDirectedness
Enum, GraphDirectedness
forall a. a -> a -> Bounded a
maxBound :: GraphDirectedness
$cmaxBound :: GraphDirectedness
minBound :: GraphDirectedness
$cminBound :: GraphDirectedness
Bounded)

data Id
  = NameId    String
  | StringId  String
  | IntegerId Integer
  | FloatId   Float
  | XmlId     Xml
  deriving (Id -> Id -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Id -> Id -> Bool
$c/= :: Id -> Id -> Bool
== :: Id -> Id -> Bool
$c== :: Id -> Id -> Bool
Eq, Eq Id
Id -> Id -> Bool
Id -> Id -> Ordering
Id -> Id -> Id
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 :: Id -> Id -> Id
$cmin :: Id -> Id -> Id
max :: Id -> Id -> Id
$cmax :: Id -> Id -> Id
>= :: Id -> Id -> Bool
$c>= :: Id -> Id -> Bool
> :: Id -> Id -> Bool
$c> :: Id -> Id -> Bool
<= :: Id -> Id -> Bool
$c<= :: Id -> Id -> Bool
< :: Id -> Id -> Bool
$c< :: Id -> Id -> Bool
compare :: Id -> Id -> Ordering
$ccompare :: Id -> Id -> Ordering
Ord, Int -> Id -> ShowS
[Id] -> ShowS
Id -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Id] -> ShowS
$cshowList :: [Id] -> ShowS
show :: Id -> String
$cshow :: Id -> String
showsPrec :: Int -> Id -> ShowS
$cshowsPrec :: Int -> Id -> ShowS
Show)

data Statement
  = NodeStatement       NodeId [Attribute]
  | EdgeStatement       [Entity] [Attribute]
  | AttributeStatement  AttributeStatementType [Attribute]
  | AssignmentStatement Id Id
  | SubgraphStatement   Subgraph
  deriving (Statement -> Statement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Statement -> Statement -> Bool
$c/= :: Statement -> Statement -> Bool
== :: Statement -> Statement -> Bool
$c== :: Statement -> Statement -> Bool
Eq, Eq Statement
Statement -> Statement -> Bool
Statement -> Statement -> Ordering
Statement -> Statement -> Statement
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 :: Statement -> Statement -> Statement
$cmin :: Statement -> Statement -> Statement
max :: Statement -> Statement -> Statement
$cmax :: Statement -> Statement -> Statement
>= :: Statement -> Statement -> Bool
$c>= :: Statement -> Statement -> Bool
> :: Statement -> Statement -> Bool
$c> :: Statement -> Statement -> Bool
<= :: Statement -> Statement -> Bool
$c<= :: Statement -> Statement -> Bool
< :: Statement -> Statement -> Bool
$c< :: Statement -> Statement -> Bool
compare :: Statement -> Statement -> Ordering
$ccompare :: Statement -> Statement -> Ordering
Ord, Int -> Statement -> ShowS
[Statement] -> ShowS
Statement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Statement] -> ShowS
$cshowList :: [Statement] -> ShowS
show :: Statement -> String
$cshow :: Statement -> String
showsPrec :: Int -> Statement -> ShowS
$cshowsPrec :: Int -> Statement -> ShowS
Show)

data AttributeStatementType
  = GraphAttributeStatement
  | NodeAttributeStatement
  | EdgeAttributeStatement
  deriving (AttributeStatementType -> AttributeStatementType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeStatementType -> AttributeStatementType -> Bool
$c/= :: AttributeStatementType -> AttributeStatementType -> Bool
== :: AttributeStatementType -> AttributeStatementType -> Bool
$c== :: AttributeStatementType -> AttributeStatementType -> Bool
Eq, Eq AttributeStatementType
AttributeStatementType -> AttributeStatementType -> Bool
AttributeStatementType -> AttributeStatementType -> Ordering
AttributeStatementType
-> AttributeStatementType -> AttributeStatementType
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 :: AttributeStatementType
-> AttributeStatementType -> AttributeStatementType
$cmin :: AttributeStatementType
-> AttributeStatementType -> AttributeStatementType
max :: AttributeStatementType
-> AttributeStatementType -> AttributeStatementType
$cmax :: AttributeStatementType
-> AttributeStatementType -> AttributeStatementType
>= :: AttributeStatementType -> AttributeStatementType -> Bool
$c>= :: AttributeStatementType -> AttributeStatementType -> Bool
> :: AttributeStatementType -> AttributeStatementType -> Bool
$c> :: AttributeStatementType -> AttributeStatementType -> Bool
<= :: AttributeStatementType -> AttributeStatementType -> Bool
$c<= :: AttributeStatementType -> AttributeStatementType -> Bool
< :: AttributeStatementType -> AttributeStatementType -> Bool
$c< :: AttributeStatementType -> AttributeStatementType -> Bool
compare :: AttributeStatementType -> AttributeStatementType -> Ordering
$ccompare :: AttributeStatementType -> AttributeStatementType -> Ordering
Ord, Int -> AttributeStatementType -> ShowS
[AttributeStatementType] -> ShowS
AttributeStatementType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeStatementType] -> ShowS
$cshowList :: [AttributeStatementType] -> ShowS
show :: AttributeStatementType -> String
$cshow :: AttributeStatementType -> String
showsPrec :: Int -> AttributeStatementType -> ShowS
$cshowsPrec :: Int -> AttributeStatementType -> ShowS
Show, Int -> AttributeStatementType
AttributeStatementType -> Int
AttributeStatementType -> [AttributeStatementType]
AttributeStatementType -> AttributeStatementType
AttributeStatementType
-> AttributeStatementType -> [AttributeStatementType]
AttributeStatementType
-> AttributeStatementType
-> AttributeStatementType
-> [AttributeStatementType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AttributeStatementType
-> AttributeStatementType
-> AttributeStatementType
-> [AttributeStatementType]
$cenumFromThenTo :: AttributeStatementType
-> AttributeStatementType
-> AttributeStatementType
-> [AttributeStatementType]
enumFromTo :: AttributeStatementType
-> AttributeStatementType -> [AttributeStatementType]
$cenumFromTo :: AttributeStatementType
-> AttributeStatementType -> [AttributeStatementType]
enumFromThen :: AttributeStatementType
-> AttributeStatementType -> [AttributeStatementType]
$cenumFromThen :: AttributeStatementType
-> AttributeStatementType -> [AttributeStatementType]
enumFrom :: AttributeStatementType -> [AttributeStatementType]
$cenumFrom :: AttributeStatementType -> [AttributeStatementType]
fromEnum :: AttributeStatementType -> Int
$cfromEnum :: AttributeStatementType -> Int
toEnum :: Int -> AttributeStatementType
$ctoEnum :: Int -> AttributeStatementType
pred :: AttributeStatementType -> AttributeStatementType
$cpred :: AttributeStatementType -> AttributeStatementType
succ :: AttributeStatementType -> AttributeStatementType
$csucc :: AttributeStatementType -> AttributeStatementType
Enum, AttributeStatementType
forall a. a -> a -> Bounded a
maxBound :: AttributeStatementType
$cmaxBound :: AttributeStatementType
minBound :: AttributeStatementType
$cminBound :: AttributeStatementType
Bounded)

data Attribute
  = AttributeSetTrue  Id
  | AttributeSetValue Id Id
  deriving (Attribute -> Attribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c== :: Attribute -> Attribute -> Bool
Eq, Eq Attribute
Attribute -> Attribute -> Bool
Attribute -> Attribute -> Ordering
Attribute -> Attribute -> Attribute
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 :: Attribute -> Attribute -> Attribute
$cmin :: Attribute -> Attribute -> Attribute
max :: Attribute -> Attribute -> Attribute
$cmax :: Attribute -> Attribute -> Attribute
>= :: Attribute -> Attribute -> Bool
$c>= :: Attribute -> Attribute -> Bool
> :: Attribute -> Attribute -> Bool
$c> :: Attribute -> Attribute -> Bool
<= :: Attribute -> Attribute -> Bool
$c<= :: Attribute -> Attribute -> Bool
< :: Attribute -> Attribute -> Bool
$c< :: Attribute -> Attribute -> Bool
compare :: Attribute -> Attribute -> Ordering
$ccompare :: Attribute -> Attribute -> Ordering
Ord, Int -> Attribute -> ShowS
[Attribute] -> ShowS
Attribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attribute] -> ShowS
$cshowList :: [Attribute] -> ShowS
show :: Attribute -> String
$cshow :: Attribute -> String
showsPrec :: Int -> Attribute -> ShowS
$cshowsPrec :: Int -> Attribute -> ShowS
Show)

data NodeId
  = NodeId Id (Maybe Port)
  deriving (NodeId -> NodeId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeId -> NodeId -> Bool
$c/= :: NodeId -> NodeId -> Bool
== :: NodeId -> NodeId -> Bool
$c== :: NodeId -> NodeId -> Bool
Eq, Eq NodeId
NodeId -> NodeId -> Bool
NodeId -> NodeId -> Ordering
NodeId -> NodeId -> NodeId
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 :: NodeId -> NodeId -> NodeId
$cmin :: NodeId -> NodeId -> NodeId
max :: NodeId -> NodeId -> NodeId
$cmax :: NodeId -> NodeId -> NodeId
>= :: NodeId -> NodeId -> Bool
$c>= :: NodeId -> NodeId -> Bool
> :: NodeId -> NodeId -> Bool
$c> :: NodeId -> NodeId -> Bool
<= :: NodeId -> NodeId -> Bool
$c<= :: NodeId -> NodeId -> Bool
< :: NodeId -> NodeId -> Bool
$c< :: NodeId -> NodeId -> Bool
compare :: NodeId -> NodeId -> Ordering
$ccompare :: NodeId -> NodeId -> Ordering
Ord, Int -> NodeId -> ShowS
[NodeId] -> ShowS
NodeId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeId] -> ShowS
$cshowList :: [NodeId] -> ShowS
show :: NodeId -> String
$cshow :: NodeId -> String
showsPrec :: Int -> NodeId -> ShowS
$cshowsPrec :: Int -> NodeId -> ShowS
Show)

data Port
  = PortI Id (Maybe Compass)
  | PortC Compass
  deriving (Port -> Port -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Port -> Port -> Bool
$c/= :: Port -> Port -> Bool
== :: Port -> Port -> Bool
$c== :: Port -> Port -> Bool
Eq, Eq Port
Port -> Port -> Bool
Port -> Port -> Ordering
Port -> Port -> Port
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 :: Port -> Port -> Port
$cmin :: Port -> Port -> Port
max :: Port -> Port -> Port
$cmax :: Port -> Port -> Port
>= :: Port -> Port -> Bool
$c>= :: Port -> Port -> Bool
> :: Port -> Port -> Bool
$c> :: Port -> Port -> Bool
<= :: Port -> Port -> Bool
$c<= :: Port -> Port -> Bool
< :: Port -> Port -> Bool
$c< :: Port -> Port -> Bool
compare :: Port -> Port -> Ordering
$ccompare :: Port -> Port -> Ordering
Ord, Int -> Port -> ShowS
[Port] -> ShowS
Port -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Port] -> ShowS
$cshowList :: [Port] -> ShowS
show :: Port -> String
$cshow :: Port -> String
showsPrec :: Int -> Port -> ShowS
$cshowsPrec :: Int -> Port -> ShowS
Show)

data Compass
  = CompassN  | CompassE  | CompassS  | CompassW
  | CompassNE | CompassNW | CompassSE | CompassSW
  deriving (Compass -> Compass -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Compass -> Compass -> Bool
$c/= :: Compass -> Compass -> Bool
== :: Compass -> Compass -> Bool
$c== :: Compass -> Compass -> Bool
Eq, Eq Compass
Compass -> Compass -> Bool
Compass -> Compass -> Ordering
Compass -> Compass -> Compass
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 :: Compass -> Compass -> Compass
$cmin :: Compass -> Compass -> Compass
max :: Compass -> Compass -> Compass
$cmax :: Compass -> Compass -> Compass
>= :: Compass -> Compass -> Bool
$c>= :: Compass -> Compass -> Bool
> :: Compass -> Compass -> Bool
$c> :: Compass -> Compass -> Bool
<= :: Compass -> Compass -> Bool
$c<= :: Compass -> Compass -> Bool
< :: Compass -> Compass -> Bool
$c< :: Compass -> Compass -> Bool
compare :: Compass -> Compass -> Ordering
$ccompare :: Compass -> Compass -> Ordering
Ord, Int -> Compass -> ShowS
[Compass] -> ShowS
Compass -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Compass] -> ShowS
$cshowList :: [Compass] -> ShowS
show :: Compass -> String
$cshow :: Compass -> String
showsPrec :: Int -> Compass -> ShowS
$cshowsPrec :: Int -> Compass -> ShowS
Show)

data Subgraph
  = NewSubgraph (Maybe Id) [Statement]
  | SubgraphRef Id
  deriving (Subgraph -> Subgraph -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Subgraph -> Subgraph -> Bool
$c/= :: Subgraph -> Subgraph -> Bool
== :: Subgraph -> Subgraph -> Bool
$c== :: Subgraph -> Subgraph -> Bool
Eq, Eq Subgraph
Subgraph -> Subgraph -> Bool
Subgraph -> Subgraph -> Ordering
Subgraph -> Subgraph -> Subgraph
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 :: Subgraph -> Subgraph -> Subgraph
$cmin :: Subgraph -> Subgraph -> Subgraph
max :: Subgraph -> Subgraph -> Subgraph
$cmax :: Subgraph -> Subgraph -> Subgraph
>= :: Subgraph -> Subgraph -> Bool
$c>= :: Subgraph -> Subgraph -> Bool
> :: Subgraph -> Subgraph -> Bool
$c> :: Subgraph -> Subgraph -> Bool
<= :: Subgraph -> Subgraph -> Bool
$c<= :: Subgraph -> Subgraph -> Bool
< :: Subgraph -> Subgraph -> Bool
$c< :: Subgraph -> Subgraph -> Bool
compare :: Subgraph -> Subgraph -> Ordering
$ccompare :: Subgraph -> Subgraph -> Ordering
Ord, Int -> Subgraph -> ShowS
[Subgraph] -> ShowS
Subgraph -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Subgraph] -> ShowS
$cshowList :: [Subgraph] -> ShowS
show :: Subgraph -> String
$cshow :: Subgraph -> String
showsPrec :: Int -> Subgraph -> ShowS
$cshowsPrec :: Int -> Subgraph -> ShowS
Show)

data Entity
  = ENodeId   EdgeType NodeId
  | ESubgraph EdgeType Subgraph
  deriving (Entity -> Entity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entity -> Entity -> Bool
$c/= :: Entity -> Entity -> Bool
== :: Entity -> Entity -> Bool
$c== :: Entity -> Entity -> Bool
Eq, Eq Entity
Entity -> Entity -> Bool
Entity -> Entity -> Ordering
Entity -> Entity -> Entity
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 :: Entity -> Entity -> Entity
$cmin :: Entity -> Entity -> Entity
max :: Entity -> Entity -> Entity
$cmax :: Entity -> Entity -> Entity
>= :: Entity -> Entity -> Bool
$c>= :: Entity -> Entity -> Bool
> :: Entity -> Entity -> Bool
$c> :: Entity -> Entity -> Bool
<= :: Entity -> Entity -> Bool
$c<= :: Entity -> Entity -> Bool
< :: Entity -> Entity -> Bool
$c< :: Entity -> Entity -> Bool
compare :: Entity -> Entity -> Ordering
$ccompare :: Entity -> Entity -> Ordering
Ord, Int -> Entity -> ShowS
[Entity] -> ShowS
Entity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entity] -> ShowS
$cshowList :: [Entity] -> ShowS
show :: Entity -> String
$cshow :: Entity -> String
showsPrec :: Int -> Entity -> ShowS
$cshowsPrec :: Int -> Entity -> ShowS
Show)

data EdgeType
  = NoEdge
  | DirectedEdge
  | UndirectedEdge
  deriving (EdgeType -> EdgeType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EdgeType -> EdgeType -> Bool
$c/= :: EdgeType -> EdgeType -> Bool
== :: EdgeType -> EdgeType -> Bool
$c== :: EdgeType -> EdgeType -> Bool
Eq, Eq EdgeType
EdgeType -> EdgeType -> Bool
EdgeType -> EdgeType -> Ordering
EdgeType -> EdgeType -> EdgeType
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 :: EdgeType -> EdgeType -> EdgeType
$cmin :: EdgeType -> EdgeType -> EdgeType
max :: EdgeType -> EdgeType -> EdgeType
$cmax :: EdgeType -> EdgeType -> EdgeType
>= :: EdgeType -> EdgeType -> Bool
$c>= :: EdgeType -> EdgeType -> Bool
> :: EdgeType -> EdgeType -> Bool
$c> :: EdgeType -> EdgeType -> Bool
<= :: EdgeType -> EdgeType -> Bool
$c<= :: EdgeType -> EdgeType -> Bool
< :: EdgeType -> EdgeType -> Bool
$c< :: EdgeType -> EdgeType -> Bool
compare :: EdgeType -> EdgeType -> Ordering
$ccompare :: EdgeType -> EdgeType -> Ordering
Ord, Int -> EdgeType -> ShowS
[EdgeType] -> ShowS
EdgeType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EdgeType] -> ShowS
$cshowList :: [EdgeType] -> ShowS
show :: EdgeType -> String
$cshow :: EdgeType -> String
showsPrec :: Int -> EdgeType -> ShowS
$cshowsPrec :: Int -> EdgeType -> ShowS
Show, Int -> EdgeType
EdgeType -> Int
EdgeType -> [EdgeType]
EdgeType -> EdgeType
EdgeType -> EdgeType -> [EdgeType]
EdgeType -> EdgeType -> EdgeType -> [EdgeType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EdgeType -> EdgeType -> EdgeType -> [EdgeType]
$cenumFromThenTo :: EdgeType -> EdgeType -> EdgeType -> [EdgeType]
enumFromTo :: EdgeType -> EdgeType -> [EdgeType]
$cenumFromTo :: EdgeType -> EdgeType -> [EdgeType]
enumFromThen :: EdgeType -> EdgeType -> [EdgeType]
$cenumFromThen :: EdgeType -> EdgeType -> [EdgeType]
enumFrom :: EdgeType -> [EdgeType]
$cenumFrom :: EdgeType -> [EdgeType]
fromEnum :: EdgeType -> Int
$cfromEnum :: EdgeType -> Int
toEnum :: Int -> EdgeType
$ctoEnum :: Int -> EdgeType
pred :: EdgeType -> EdgeType
$cpred :: EdgeType -> EdgeType
succ :: EdgeType -> EdgeType
$csucc :: EdgeType -> EdgeType
Enum, EdgeType
forall a. a -> a -> Bounded a
maxBound :: EdgeType
$cmaxBound :: EdgeType
minBound :: EdgeType
$cminBound :: EdgeType
Bounded)

data Xml
  = XmlEmptyTag XmlName [XmlAttribute]
  | XmlTag      XmlName [XmlAttribute] [Xml]
  | XmlText     String
  deriving (Xml -> Xml -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Xml -> Xml -> Bool
$c/= :: Xml -> Xml -> Bool
== :: Xml -> Xml -> Bool
$c== :: Xml -> Xml -> Bool
Eq, Eq Xml
Xml -> Xml -> Bool
Xml -> Xml -> Ordering
Xml -> Xml -> Xml
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 :: Xml -> Xml -> Xml
$cmin :: Xml -> Xml -> Xml
max :: Xml -> Xml -> Xml
$cmax :: Xml -> Xml -> Xml
>= :: Xml -> Xml -> Bool
$c>= :: Xml -> Xml -> Bool
> :: Xml -> Xml -> Bool
$c> :: Xml -> Xml -> Bool
<= :: Xml -> Xml -> Bool
$c<= :: Xml -> Xml -> Bool
< :: Xml -> Xml -> Bool
$c< :: Xml -> Xml -> Bool
compare :: Xml -> Xml -> Ordering
$ccompare :: Xml -> Xml -> Ordering
Ord, Int -> Xml -> ShowS
[Xml] -> ShowS
Xml -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Xml] -> ShowS
$cshowList :: [Xml] -> ShowS
show :: Xml -> String
$cshow :: Xml -> String
showsPrec :: Int -> Xml -> ShowS
$cshowsPrec :: Int -> Xml -> ShowS
Show)

data XmlName
  = XmlName String
  deriving (XmlName -> XmlName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XmlName -> XmlName -> Bool
$c/= :: XmlName -> XmlName -> Bool
== :: XmlName -> XmlName -> Bool
$c== :: XmlName -> XmlName -> Bool
Eq, Eq XmlName
XmlName -> XmlName -> Bool
XmlName -> XmlName -> Ordering
XmlName -> XmlName -> XmlName
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 :: XmlName -> XmlName -> XmlName
$cmin :: XmlName -> XmlName -> XmlName
max :: XmlName -> XmlName -> XmlName
$cmax :: XmlName -> XmlName -> XmlName
>= :: XmlName -> XmlName -> Bool
$c>= :: XmlName -> XmlName -> Bool
> :: XmlName -> XmlName -> Bool
$c> :: XmlName -> XmlName -> Bool
<= :: XmlName -> XmlName -> Bool
$c<= :: XmlName -> XmlName -> Bool
< :: XmlName -> XmlName -> Bool
$c< :: XmlName -> XmlName -> Bool
compare :: XmlName -> XmlName -> Ordering
$ccompare :: XmlName -> XmlName -> Ordering
Ord, Int -> XmlName -> ShowS
[XmlName] -> ShowS
XmlName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XmlName] -> ShowS
$cshowList :: [XmlName] -> ShowS
show :: XmlName -> String
$cshow :: XmlName -> String
showsPrec :: Int -> XmlName -> ShowS
$cshowsPrec :: Int -> XmlName -> ShowS
Show)

data XmlAttribute
  = XmlAttribute XmlName XmlAttributeValue
  deriving (XmlAttribute -> XmlAttribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XmlAttribute -> XmlAttribute -> Bool
$c/= :: XmlAttribute -> XmlAttribute -> Bool
== :: XmlAttribute -> XmlAttribute -> Bool
$c== :: XmlAttribute -> XmlAttribute -> Bool
Eq, Eq XmlAttribute
XmlAttribute -> XmlAttribute -> Bool
XmlAttribute -> XmlAttribute -> Ordering
XmlAttribute -> XmlAttribute -> XmlAttribute
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 :: XmlAttribute -> XmlAttribute -> XmlAttribute
$cmin :: XmlAttribute -> XmlAttribute -> XmlAttribute
max :: XmlAttribute -> XmlAttribute -> XmlAttribute
$cmax :: XmlAttribute -> XmlAttribute -> XmlAttribute
>= :: XmlAttribute -> XmlAttribute -> Bool
$c>= :: XmlAttribute -> XmlAttribute -> Bool
> :: XmlAttribute -> XmlAttribute -> Bool
$c> :: XmlAttribute -> XmlAttribute -> Bool
<= :: XmlAttribute -> XmlAttribute -> Bool
$c<= :: XmlAttribute -> XmlAttribute -> Bool
< :: XmlAttribute -> XmlAttribute -> Bool
$c< :: XmlAttribute -> XmlAttribute -> Bool
compare :: XmlAttribute -> XmlAttribute -> Ordering
$ccompare :: XmlAttribute -> XmlAttribute -> Ordering
Ord, Int -> XmlAttribute -> ShowS
[XmlAttribute] -> ShowS
XmlAttribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XmlAttribute] -> ShowS
$cshowList :: [XmlAttribute] -> ShowS
show :: XmlAttribute -> String
$cshow :: XmlAttribute -> String
showsPrec :: Int -> XmlAttribute -> ShowS
$cshowsPrec :: Int -> XmlAttribute -> ShowS
Show)

data XmlAttributeValue
  = XmlAttributeValue String
  deriving (XmlAttributeValue -> XmlAttributeValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XmlAttributeValue -> XmlAttributeValue -> Bool
$c/= :: XmlAttributeValue -> XmlAttributeValue -> Bool
== :: XmlAttributeValue -> XmlAttributeValue -> Bool
$c== :: XmlAttributeValue -> XmlAttributeValue -> Bool
Eq, Eq XmlAttributeValue
XmlAttributeValue -> XmlAttributeValue -> Bool
XmlAttributeValue -> XmlAttributeValue -> Ordering
XmlAttributeValue -> XmlAttributeValue -> XmlAttributeValue
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 :: XmlAttributeValue -> XmlAttributeValue -> XmlAttributeValue
$cmin :: XmlAttributeValue -> XmlAttributeValue -> XmlAttributeValue
max :: XmlAttributeValue -> XmlAttributeValue -> XmlAttributeValue
$cmax :: XmlAttributeValue -> XmlAttributeValue -> XmlAttributeValue
>= :: XmlAttributeValue -> XmlAttributeValue -> Bool
$c>= :: XmlAttributeValue -> XmlAttributeValue -> Bool
> :: XmlAttributeValue -> XmlAttributeValue -> Bool
$c> :: XmlAttributeValue -> XmlAttributeValue -> Bool
<= :: XmlAttributeValue -> XmlAttributeValue -> Bool
$c<= :: XmlAttributeValue -> XmlAttributeValue -> Bool
< :: XmlAttributeValue -> XmlAttributeValue -> Bool
$c< :: XmlAttributeValue -> XmlAttributeValue -> Bool
compare :: XmlAttributeValue -> XmlAttributeValue -> Ordering
$ccompare :: XmlAttributeValue -> XmlAttributeValue -> Ordering
Ord, Int -> XmlAttributeValue -> ShowS
[XmlAttributeValue] -> ShowS
XmlAttributeValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XmlAttributeValue] -> ShowS
$cshowList :: [XmlAttributeValue] -> ShowS
show :: XmlAttributeValue -> String
$cshow :: XmlAttributeValue -> String
showsPrec :: Int -> XmlAttributeValue -> ShowS
$cshowsPrec :: Int -> XmlAttributeValue -> ShowS
Show)