Add remaining haskell book exercises

4 files changed, 723 insertions, 0 deletions

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)