From 98329e0a3dd4f78b5d815ac3896272ec70904901 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Thu, 11 Dec 2025 10:28:11 +0100
Subject: Add remaining haskell book exercises

---
 Haskell-book/24/language-dot/src/Language/Dot.hs   |  10 +
 .../24/language-dot/src/Language/Dot/Parser.hs     | 486 +++++++++++++++++++++
 .../24/language-dot/src/Language/Dot/Pretty.hs     | 135 ++++++
 .../24/language-dot/src/Language/Dot/Syntax.hs     |  92 ++++
 4 files changed, 723 insertions(+)
 create mode 100644 Haskell-book/24/language-dot/src/Language/Dot.hs
 create mode 100644 Haskell-book/24/language-dot/src/Language/Dot/Parser.hs
 create mode 100644 Haskell-book/24/language-dot/src/Language/Dot/Pretty.hs
 create mode 100644 Haskell-book/24/language-dot/src/Language/Dot/Syntax.hs

(limited to 'Haskell-book/24/language-dot/src/Language')

diff --git a/Haskell-book/24/language-dot/src/Language/Dot.hs b/Haskell-book/24/language-dot/src/Language/Dot.hs
new file mode 100644
index 0000000..b1a87a3
--- /dev/null
+++ b/Haskell-book/24/language-dot/src/Language/Dot.hs
@@ -0,0 +1,10 @@
+module Language.Dot
+  ( module Language.Dot.Parser
+  , module Language.Dot.Pretty
+  , module Language.Dot.Syntax
+  )
+  where
+
+import Language.Dot.Parser
+import Language.Dot.Pretty
+import Language.Dot.Syntax
diff --git a/Haskell-book/24/language-dot/src/Language/Dot/Parser.hs b/Haskell-book/24/language-dot/src/Language/Dot/Parser.hs
new file mode 100644
index 0000000..a13d457
--- /dev/null
+++ b/Haskell-book/24/language-dot/src/Language/Dot/Parser.hs
@@ -0,0 +1,486 @@
+{-# LANGUAGE CPP #-}
+
+module Language.Dot.Parser
+  ( parseDot
+#ifdef TEST
+  , parsePort
+  , parseCompass
+  , parseAttribute
+  , parseId
+#endif
+  )
+  where
+
+import Control.Applicative ((<$>), (<*>), (<*), (*>))
+import Control.Monad       (when)
+import Data.Char           (digitToInt, toLower)
+import Data.List           (foldl')
+import Data.Maybe          (fromJust, fromMaybe, isJust)
+import Numeric             (readFloat)
+
+import Text.Parsec
+import Text.Parsec.Language
+import Text.Parsec.String
+import Text.Parsec.Token
+
+import Language.Dot.Syntax
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseDot
+  :: String  -- ^ origin of the data, e.g., the name of a file
+  -> String  -- ^ DOT source code
+  -> Either ParseError Graph
+parseDot origin =
+    parse (whiteSpace' >> parseGraph) origin . preprocess
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+preprocess :: String -> String
+preprocess =
+    unlines . map commentPoundLines . lines
+  where
+    commentPoundLines []         = []
+    commentPoundLines line@(c:_) = if c == '#' then "// " ++ line else line
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseGraph :: Parser Graph
+parseGraph =
+    ( Graph <$>
+          parseGraphStrictness
+      <*> parseGraphDirectedness
+      <*> optionMaybe parseId
+      <*> parseStatementList
+    )
+    <?> "graph"
+
+parseGraphStrictness :: Parser GraphStrictness
+parseGraphStrictness =
+    ((reserved' "strict" >> return StrictGraph) <|> return UnstrictGraph)
+    <?> "graph strictness"
+
+parseGraphDirectedness :: Parser GraphDirectedness
+parseGraphDirectedness =
+    (   (reserved' "graph"   >> return UndirectedGraph)
+    <|> (reserved' "digraph" >> return DirectedGraph)
+    )
+    <?> "graph directedness"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseStatementList :: Parser [Statement]
+parseStatementList =
+    braces' (parseStatement `endBy` optional semi')
+    <?> "statement list"
+
+parseStatement :: Parser Statement
+parseStatement =
+    (   try parseEdgeStatement
+    <|> try parseAttributeStatement
+    <|> try parseAssignmentStatement
+    <|> try parseSubgraphStatement
+    <|>     parseNodeStatement
+    )
+    <?> "statement"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseNodeStatement :: Parser Statement
+parseNodeStatement =
+    ( NodeStatement <$>
+      parseNodeId <*> parseAttributeList
+    )
+    <?> "node statement"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseEdgeStatement :: Parser Statement
+parseEdgeStatement =
+    ( EdgeStatement <$>
+      parseEntityList <*> parseAttributeList
+    )
+    <?> "edge statement"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseAttributeStatement :: Parser Statement
+parseAttributeStatement =
+    ( AttributeStatement <$>
+      parseAttributeStatementType <*> parseAttributeList
+    )
+    <?> "attribute statement"
+
+parseAttributeStatementType :: Parser AttributeStatementType
+parseAttributeStatementType =
+    (   (reserved' "graph" >> return GraphAttributeStatement)
+    <|> (reserved' "node"  >> return NodeAttributeStatement)
+    <|> (reserved' "edge"  >> return EdgeAttributeStatement)
+    )
+    <?> "attribute statement type"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseAssignmentStatement :: Parser Statement
+parseAssignmentStatement =
+    ( AssignmentStatement <$>
+      parseId <*> (reservedOp' "=" *> parseId)
+    )
+    <?> "assignment statement"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseSubgraphStatement :: Parser Statement
+parseSubgraphStatement =
+    ( SubgraphStatement <$>
+       parseSubgraph
+    )
+    <?> "subgraph statement"
+
+parseSubgraph :: Parser Subgraph
+parseSubgraph =
+    (   try parseNewSubgraph
+    <|>     parseSubgraphRef
+    )
+    <?> "subgraph"
+
+parseNewSubgraph :: Parser Subgraph
+parseNewSubgraph =
+    ( NewSubgraph <$>
+      (optional (reserved' "subgraph") *> optionMaybe parseId) <*> parseStatementList
+    )
+    <?> "new subgraph"
+
+parseSubgraphRef :: Parser Subgraph
+parseSubgraphRef =
+    ( SubgraphRef <$>
+      (reserved' "subgraph" *> parseId)
+    )
+    <?> "subgraph ref"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseEntityList :: Parser [Entity]
+parseEntityList =
+    ( (:) <$>
+      parseEntity True <*> many1 (parseEntity False)
+    )
+    <?> "entity list"
+
+parseEntity :: Bool -> Parser Entity
+parseEntity first =
+    (   try (parseENodeId first)
+    <|>     parseESubgraph first
+    )
+    <?> "entity"
+
+parseENodeId :: Bool -> Parser Entity
+parseENodeId first =
+    ( ENodeId <$>
+      (if first then return NoEdge else parseEdgeType) <*> parseNodeId
+    )
+    <?> "entity node id"
+
+parseESubgraph :: Bool -> Parser Entity
+parseESubgraph first =
+    ( ESubgraph <$>
+      (if first then return NoEdge else parseEdgeType) <*> parseSubgraph
+    )
+    <?> "entity subgraph"
+
+parseEdgeType :: Parser EdgeType
+parseEdgeType =
+    (   try (reservedOp' "->" >> return DirectedEdge)
+    <|>     (reservedOp' "--" >> return UndirectedEdge)
+    )
+    <?> "edge operator"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseNodeId :: Parser NodeId
+parseNodeId =
+    ( NodeId <$>
+      parseId <*> optionMaybe parsePort
+    )
+    <?> "node id"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parsePort :: Parser Port
+parsePort =
+    (   try parsePortC
+    <|>     parsePortI
+    )
+    <?> "port"
+
+parsePortC :: Parser Port
+parsePortC =
+    ( PortC <$>
+      (colon' *> parseCompass)
+    )
+    <?> "port (compass variant)"
+
+parsePortI :: Parser Port
+parsePortI =
+    ( PortI <$>
+      (colon' *> parseId) <*> optionMaybe (colon' *> parseCompass)
+    )
+    <?> "port (id variant)"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseCompass :: Parser Compass
+parseCompass =
+    (fmap convert identifier' >>= maybe err return)
+    <?> "compass"
+  where
+    err = parserFail "invalid compass value"
+    convert =
+        flip lookup table . stringToLower
+      where
+        table =
+          [ ("n",  CompassN),  ("e",  CompassE),  ("s",  CompassS),  ("w",  CompassW)
+          , ("ne", CompassNE), ("nw", CompassNW), ("se", CompassSE), ("sw", CompassSW)
+          ]
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseAttributeList :: Parser [Attribute]
+parseAttributeList =
+    (brackets' (parseAttribute `sepBy` optional comma') <|> return [])
+    <?> "attribute list"
+
+parseAttribute :: Parser Attribute
+parseAttribute =
+    ( do
+      id0 <- parseId
+      id1 <- optionMaybe (reservedOp' "=" >> parseId)
+      return $ maybe (AttributeSetTrue id0) (AttributeSetValue id0) id1
+    )
+    <?> "attribute"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseId :: Parser Id
+parseId =
+    (   try parseNameId
+    <|> try parseStringId
+    <|> try parseFloatId
+    <|> try parseIntegerId
+    <|>     parseXmlId
+    )
+    <?> "id"
+
+parseNameId :: Parser Id
+parseNameId =
+    ( NameId <$>
+      identifier'
+    )
+    <?> "name"
+
+parseStringId :: Parser Id
+parseStringId =
+    ( StringId <$>
+      lexeme' (char '"' *> manyTill stringChar (char '"'))
+    )
+    <?> "string literal"
+  where
+    stringChar =
+        (try (string "\\\"" >> return '"') <|> noneOf "\"")
+        <?> "string character"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+-- | DOT allows floating point numbers having no whole part like @.123@, but
+--   Parsec 'float' does not accept them.
+parseFloatId :: Parser Id
+parseFloatId =
+    lexeme'
+      ( do s <- parseSign
+           l <- fmap (fromMaybe 0) (optionMaybe parseNatural)
+           _ <- char '.'
+           r <- many1 digit
+           maybe err return (make s (show l ++ "." ++ r))
+      )
+    <?> "float"
+  where
+    err = parserFail "invalid float value"
+    make s f =
+        case readFloat f of
+          [(v,"")] -> (Just . FloatId . s) v
+          _        -> Nothing
+
+parseSign :: (Num a) => Parser (a -> a)
+parseSign =
+    (   (char '-' >> return negate)
+    <|> (char '+' >> return id)
+    <|> return id
+    )
+    <?> "sign"
+
+-- | Non-'lexeme' variant of 'natural' for parsing the natural part of a float.
+parseNatural :: Parser Integer
+parseNatural =
+    (   (char '0' >> return 0)
+    <|> (convert <$> many1 digit)
+    )
+    <?> "natural"
+  where
+    convert = foldl' (\acc d -> 10 * acc + fromIntegral (digitToInt d)) 0
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseIntegerId :: Parser Id
+parseIntegerId =
+    ( IntegerId <$>
+      integer'
+    )
+    <?> "integer"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseXmlId :: Parser Id
+parseXmlId =
+    ( XmlId <$>
+      angles' parseXml
+    )
+    <?> "XML id"
+
+parseXml :: Parser Xml
+parseXml =
+    (   try parseXmlEmptyTag
+    <|> try parseXmlTag
+    <|>     parseXmlText
+    )
+    <?> "XML"
+
+parseXmlEmptyTag :: Parser Xml
+parseXmlEmptyTag =
+    ( XmlEmptyTag <$>
+      (char '<' *> parseXmlName) <*> (parseXmlAttributes <* (char '/' >> char '>'))
+    )
+    <?> "XML empty tag"
+
+parseXmlTag :: Parser Xml
+parseXmlTag =
+    ( do (name, attributes) <- parseXmlTagOpen
+         elements           <- manyTill parseXml (lookAhead (try (parseXmlTagClose (Just name))))
+         parseXmlTagClose (Just name)
+         return $ XmlTag name attributes elements
+    )
+    <?> "XML tag"
+
+parseXmlTagOpen :: Parser (XmlName, [XmlAttribute])
+parseXmlTagOpen =
+    ( (,) <$>
+      (char '<' *> parseXmlName) <*> (parseXmlAttributes <* char '>')
+    )
+    <?> "XML opening tag"
+
+parseXmlTagClose :: Maybe XmlName -> Parser ()
+parseXmlTagClose mn0 =
+    ( do _  <- char '<'
+         _  <- char '/'
+         n1 <- parseXmlName
+         _  <- char '>'
+         when (isJust mn0 && fromJust mn0 /= n1) parserZero
+    )
+    <?> "XML closing tag " ++ "(" ++ which ++ ")"
+  where
+    which =
+        case mn0 of
+          Just (XmlName n) -> "for " ++ show n
+          Nothing          -> "any"
+
+parseXmlText :: Parser Xml
+parseXmlText =
+    ( XmlText <$>
+      anyChar `manyTill` lookAhead (   try (parseXmlEmptyTag >> return ())
+                                   <|> try (parseXmlTag      >> return ())
+                                   <|>      parseXmlTagClose Nothing
+                                   )
+    )
+    <?> "XML text"
+
+parseXmlAttributes :: Parser [XmlAttribute]
+parseXmlAttributes =
+    many parseXmlAttribute
+    <?> "XML attribute list"
+
+parseXmlAttribute :: Parser XmlAttribute
+parseXmlAttribute =
+    ( XmlAttribute <$>
+      (parseXmlName <* reservedOp' "=") <*> parseXmlAttributeValue
+    )
+    <?> "XML attribute"
+
+parseXmlAttributeValue :: Parser XmlAttributeValue
+parseXmlAttributeValue =
+    ( XmlAttributeValue <$>
+      stringLiteral'
+    )
+    <?> "XML attribute value"
+
+parseXmlName :: Parser XmlName
+parseXmlName =
+    ( XmlName <$>
+      ((:) <$> c0 <*> (many c1 <* whiteSpace'))
+    )
+    <?> "XML name"
+  where
+    c0 = letter   <|> cs
+    c1 = alphaNum <|> cs
+    cs = oneOf "-.:_"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+angles'        :: Parser a -> Parser a
+braces'        :: Parser a -> Parser a
+brackets'      :: Parser a -> Parser a
+colon'         :: Parser String
+comma'         :: Parser String
+identifier'    :: Parser String
+integer'       :: Parser Integer
+lexeme'        :: Parser a -> Parser a
+reserved'      :: String -> Parser ()
+reservedOp'    :: String -> Parser ()
+semi'          :: Parser String
+stringLiteral' :: Parser String
+whiteSpace'    :: Parser ()
+
+angles'        = angles        lexer
+braces'        = braces        lexer
+brackets'      = brackets      lexer
+colon'         = colon         lexer
+comma'         = comma         lexer
+identifier'    = identifier    lexer
+integer'       = integer       lexer
+lexeme'        = lexeme        lexer
+reserved'      = reserved      lexer
+reservedOp'    = reservedOp    lexer
+semi'          = semi          lexer
+stringLiteral' = stringLiteral lexer
+whiteSpace'    = whiteSpace    lexer
+
+lexer :: TokenParser ()
+lexer =
+    makeTokenParser dotDef
+  where
+    dotDef = emptyDef
+      { commentStart    = "/*"
+      , commentEnd      = "*/"
+      , commentLine     = "//"
+      , nestedComments  = True
+      , identStart      = letter   <|> char '_'
+      , identLetter     = alphaNum <|> char '_'
+      , opStart         = oneOf "-="
+      , opLetter        = oneOf ""
+      , reservedOpNames = ["->", "--", "="]
+      , reservedNames   = ["digraph", "edge", "graph", "node", "strict", "subgraph"]
+      , caseSensitive   = False
+      }
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+stringToLower :: String -> String
+stringToLower = map toLower
diff --git a/Haskell-book/24/language-dot/src/Language/Dot/Pretty.hs b/Haskell-book/24/language-dot/src/Language/Dot/Pretty.hs
new file mode 100644
index 0000000..84a4c0c
--- /dev/null
+++ b/Haskell-book/24/language-dot/src/Language/Dot/Pretty.hs
@@ -0,0 +1,135 @@
+module Language.Dot.Pretty
+  ( prettyPrintDot
+  , renderDot
+  , PP(..)
+  )
+  where
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+import Numeric
+import Text.PrettyPrint
+
+import Language.Dot.Syntax
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+prettyPrintDot :: Graph -> Doc
+prettyPrintDot = pp
+
+renderDot :: Graph -> String
+renderDot = render . pp
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+class PP a where
+  pp :: a -> Doc
+
+instance (PP a) => PP (Maybe a) where
+  pp (Just v) = pp v
+  pp Nothing  = empty
+
+instance PP Graph where
+  pp (Graph s d mi ss) = pp s <+> pp d <+> pp mi <+> lbrace $+$ indent (vcat' ss) $+$ rbrace
+
+instance PP GraphStrictness where
+  pp StrictGraph   = text "strict"
+  pp UnstrictGraph = empty
+
+instance PP GraphDirectedness where
+  pp DirectedGraph   = text "digraph"
+  pp UndirectedGraph = text "graph"
+
+instance PP Id where
+  pp (NameId v)    = text v
+  pp (StringId v)  = doubleQuotes (text v)
+  pp (IntegerId v) = integer v
+  pp (FloatId v)   = ffloat v
+  pp (XmlId v)     = langle <> pp v <> rangle
+
+instance PP Statement where
+  pp (NodeStatement ni as)       = pp ni <+> if not (null as) then brackets (hsep' as) else empty
+  pp (EdgeStatement es as)       = hsep' es <+> if not (null as) then brackets (hsep' as) else empty
+  pp (AttributeStatement t as)   = pp t <+> brackets (hsep' as)
+  pp (AssignmentStatement i0 i1) = pp i0 <> equals <> pp i1
+  pp (SubgraphStatement s)       = pp s
+
+instance PP AttributeStatementType where
+  pp GraphAttributeStatement = text "graph"
+  pp NodeAttributeStatement  = text "node"
+  pp EdgeAttributeStatement  = text "edge"
+
+instance PP Attribute where
+  pp (AttributeSetTrue i)      = pp i
+  pp (AttributeSetValue i0 i1) = pp i0 <> equals <> pp i1
+
+instance PP NodeId where
+  pp (NodeId i mp) = pp i <> pp mp
+
+instance PP Port where
+  pp (PortI i mc) = colon <> pp i <> maybe empty ((colon <>) . pp) mc
+  pp (PortC c)    = colon <> pp c
+
+instance PP Compass where
+  pp CompassN  = text "n"
+  pp CompassE  = text "e"
+  pp CompassS  = text "s"
+  pp CompassW  = text "w"
+  pp CompassNE = text "ne"
+  pp CompassNW = text "nw"
+  pp CompassSE = text "se"
+  pp CompassSW = text "sw"
+
+instance PP Subgraph where
+  pp (NewSubgraph mi ss) = text "subgraph" <+> pp mi <+> lbrace $+$ indent (vcat' ss) $+$ rbrace
+  pp (SubgraphRef i)     = text "subgraph" <+> pp i
+
+instance PP Entity where
+  pp (ENodeId et ni)   = pp et <+> pp ni
+  pp (ESubgraph et sg) = pp et <+> pp sg
+
+instance PP EdgeType where
+  pp NoEdge         = empty
+  pp DirectedEdge   = text "->"
+  pp UndirectedEdge = text "--"
+
+instance PP Xml where
+  pp (XmlEmptyTag n as) = langle <> pp n <+> hsep' as <> slash <> rangle
+  pp (XmlTag n as xs)   = langle <> pp n <+> hsep' as <> rangle <> hcat' xs <> langle <> slash <> pp n <> rangle
+  pp (XmlText t)        = text t
+
+instance PP XmlName where
+  pp (XmlName n) = text n
+
+instance PP XmlAttribute where
+  pp (XmlAttribute n v) = pp n <> equals <> pp v
+
+instance PP XmlAttributeValue where
+  pp (XmlAttributeValue v) = doubleQuotes (text v)
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+indent :: Doc -> Doc
+indent = nest 2
+
+hcat' :: (PP a) => [a] -> Doc
+hcat' = hcat . map pp
+
+hsep' :: (PP a) => [a] -> Doc
+hsep' = hsep . map pp
+
+vcat' :: (PP a) => [a] -> Doc
+vcat' = vcat . map pp
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+langle :: Doc
+rangle :: Doc
+slash  :: Doc
+
+langle = char '<'
+rangle = char '>'
+slash  = char '/'
+
+ffloat :: Float -> Doc
+ffloat v = text (showFFloat Nothing v "")
diff --git a/Haskell-book/24/language-dot/src/Language/Dot/Syntax.hs b/Haskell-book/24/language-dot/src/Language/Dot/Syntax.hs
new file mode 100644
index 0000000..cca7d99
--- /dev/null
+++ b/Haskell-book/24/language-dot/src/Language/Dot/Syntax.hs
@@ -0,0 +1,92 @@
+-- | 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 (Eq, Show)
+
+data GraphStrictness
+  = StrictGraph
+  | UnstrictGraph
+  deriving (Eq, Show)
+
+data GraphDirectedness
+  = DirectedGraph
+  | UndirectedGraph
+  deriving (Eq, Show)
+
+data Id
+  = NameId    String
+  | StringId  String
+  | IntegerId Integer
+  | FloatId   Float
+  | XmlId     Xml
+  deriving (Eq, Show)
+
+data Statement
+  = NodeStatement       NodeId [Attribute]
+  | EdgeStatement       [Entity] [Attribute]
+  | AttributeStatement  AttributeStatementType [Attribute]
+  | AssignmentStatement Id Id
+  | SubgraphStatement   Subgraph
+  deriving (Eq, Show)
+
+data AttributeStatementType
+  = GraphAttributeStatement
+  | NodeAttributeStatement
+  | EdgeAttributeStatement
+  deriving (Eq, Show)
+
+data Attribute
+  = AttributeSetTrue  Id
+  | AttributeSetValue Id Id
+  deriving (Eq, Show)
+
+data NodeId
+  = NodeId Id (Maybe Port)
+  deriving (Eq, Show)
+
+data Port
+  = PortI Id (Maybe Compass)
+  | PortC Compass
+  deriving (Eq, Show)
+
+data Compass
+  = CompassN  | CompassE  | CompassS  | CompassW
+  | CompassNE | CompassNW | CompassSE | CompassSW
+  deriving (Eq, Show)
+
+data Subgraph
+  = NewSubgraph (Maybe Id) [Statement]
+  | SubgraphRef Id
+  deriving (Eq, Show)
+
+data Entity
+  = ENodeId   EdgeType NodeId
+  | ESubgraph EdgeType Subgraph
+  deriving (Eq, Show)
+
+data EdgeType
+  = NoEdge
+  | DirectedEdge
+  | UndirectedEdge
+  deriving (Eq, Show)
+
+data Xml
+  = XmlEmptyTag XmlName [XmlAttribute]
+  | XmlTag      XmlName [XmlAttribute] [Xml]
+  | XmlText     String
+  deriving (Eq, Show)
+
+data XmlName
+  = XmlName String
+  deriving (Eq, Show)
+
+data XmlAttribute
+  = XmlAttribute XmlName XmlAttributeValue
+  deriving (Eq, Show)
+
+data XmlAttributeValue
+  = XmlAttributeValue String
+  deriving (Eq, Show)
-- 
cgit v1.2.3