xml-enumerator 0.3.0 → 0.3.1

raw patch · 9 files changed

+1652/−1569 lines, 9 filessetup-changed

Files

• LICENSE +25/−25
• Setup.lhs +7/−7
• Text/XML/Enumerator/Cursor.hs +82/−0
• Text/XML/Enumerator/Document.hs +252/−252
• Text/XML/Enumerator/Parse.hs +680/−680
• Text/XML/Enumerator/Render.hs +268/−268
• Text/XML/Enumerator/Token.hs +151/−151
• runtests.hs +139/−139
• xml-enumerator.cabal +48/−47

@@ -1,25 +1,25 @@-The following license covers this documentation, and the source code, except
-where otherwise indicated.
-
-Copyright 2010, Suite Solutions. All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-* Redistributions of source code must retain the above copyright notice, this
-  list of conditions and the following disclaimer.
-
-* Redistributions in binary form must reproduce the above copyright notice,
-  this list of conditions and the following disclaimer in the documentation
-  and/or other materials provided with the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR
-IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
-EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
-INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
-NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
-OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
-OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2010, Suite Solutions. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -1,7 +1,7 @@-#!/usr/bin/env runhaskell
-
-> module Main where
-> import Distribution.Simple
-
-> main :: IO ()
-> main = defaultMain
+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple++> main :: IO ()+> main = defaultMain

@@ -0,0 +1,82 @@+module Text.XML.Enumerator.Cursor+    ( Cursor+    , toCursor+    , parent+    , precedingSibling+    , followingSibling+    , children+    , node+    {-+    , preceding+    , following+    -}+    , ancestor+--    , descendant+    ) where++import Data.XML.Types++type DiffCursor = [Cursor] -> [Cursor]++data Cursor = Cursor+    { parent :: Maybe Cursor+    , precedingSibling' :: DiffCursor+    , followingSibling' :: DiffCursor+    , children :: [Cursor]+    , node :: Node+    }++precedingSibling :: Cursor -> [Cursor]+precedingSibling = ($ []) . precedingSibling'++followingSibling :: Cursor -> [Cursor]+followingSibling = ($ []) . followingSibling'++toCursor :: Node -> Cursor+toCursor = toCursor' Nothing id id++toCursor' :: Maybe Cursor -> DiffCursor -> DiffCursor -> Node -> Cursor+toCursor' par pre fol n =+    me+  where+    me = Cursor par pre fol chi n+    chi' =+        case n of+            NodeElement (Element _ _ x) -> x+            _ -> []+    chi = go id chi' []+    go _ [] = id+    go pre' (n':ns') =+        (:) me' . fol'+      where+        me' = toCursor' (Just me) pre' fol' n'+        fol' = go ((:) me' . pre') ns'++{- FIXME+preceding :: Cursor -> [Cursor]+preceding c =+    precedingSibling' c+        $ case parent c of+            Nothing -> []+            Just p -> p : preceding p++following :: Cursor -> [Cursor]+following+-}++ancestor :: Cursor -> [Cursor]+ancestor c =+    case parent c of+        Nothing -> []+        Just p -> p : ancestor p++{-+descendant :: Cursor -> [Cursor]+descendant =+    go' . map go . children+  where+    go :: Cursor -> DiffCursor+    go c = (c :) . go' . map go (children c)+    go' :: [DiffCursor] -> DiffCursor+    go' = undefined+-}

@@ -1,252 +1,252 @@-{-# LANGUAGE DeriveDataTypeable #-}
-module Text.XML.Enumerator.Document
-    ( -- * Non-streaming functions
-      writeFile
-    , writePrettyFile
-    , readFile
-    , readFile_
-      -- * Lazy bytestrings
-    , renderLBS
-    , prettyLBS
-    , parseLBS
-    , parseLBS_
-      -- * Streaming functions
-    , toEvents
-    , fromEvents
-    , renderBuilder
-    , renderBytes
-    , renderText
-      -- ** Pretty versions
-    , prettyBuilder
-    , prettyBytes
-    , prettyText
-      -- * Exceptions
-    , InvalidEventStream (InvalidEventStream)
-    ) where
-
-import Prelude hiding (writeFile, readFile)
-import Data.XML.Types
-import Data.Enumerator
-    ( ($$), enumList, joinE, Enumerator, Iteratee, peek, returnI
-    , throwError, joinI, run, run_, Step (Continue), Stream (Chunks)
-    )
-import Control.Exception (Exception, SomeException)
-import Data.Typeable (Typeable)
-import qualified Data.Enumerator.List as EL
-import Blaze.ByteString.Builder (Builder)
-import Control.Monad.IO.Class (MonadIO)
-import qualified Text.XML.Enumerator.Render as R
-import qualified Text.XML.Enumerator.Parse as P
-import Data.ByteString (ByteString)
-import Data.Text (Text)
-import Control.Applicative ((<$>), (<*>))
-import qualified System.IO as SIO
-import Data.Enumerator.Binary (enumFile, iterHandle)
-import qualified Data.Text as T
-import Data.Char (isSpace)
-import qualified Data.ByteString.Lazy as L
-import System.IO.Unsafe (unsafePerformIO)
-import qualified Control.Concurrent.MVar as M
-import System.IO.Unsafe (unsafeInterleaveIO)
-import Control.Monad.IO.Class (liftIO)
-import Control.Concurrent (forkIO)
-import Data.Functor.Identity (runIdentity)
-
-readFile :: FilePath -> P.DecodeEntities -> IO (Either SomeException Document)
-readFile fn de = run $ enumFile fn $$ joinI $ P.parseBytes de $$ fromEvents
-
-readFile_ :: FilePath -> P.DecodeEntities -> IO Document
-readFile_ fn de = run_ $ enumFile fn $$ joinI $ P.parseBytes de $$ fromEvents
-
-writeFile :: FilePath -> Document -> IO ()
-writeFile fn doc = SIO.withBinaryFile fn SIO.WriteMode $ \h ->
-    run_ $ renderBytes doc $$ iterHandle h
-
--- | Pretty prints via 'prettyBytes'.
-writePrettyFile :: FilePath -> Document -> IO ()
-writePrettyFile fn doc = SIO.withBinaryFile fn SIO.WriteMode $ \h ->
-    run_ $ prettyBytes doc $$ iterHandle h
-
-renderLBS :: Document -> L.ByteString
-renderLBS doc =
-    L.fromChunks $ unsafePerformIO $ lazyConsume $ renderBytes doc
-
--- | Pretty prints via 'prettyBytes'.
-prettyLBS :: Document -> L.ByteString
-prettyLBS doc =
-    L.fromChunks $ unsafePerformIO $ lazyConsume $ prettyBytes doc
-
-parseLBS :: L.ByteString -> P.DecodeEntities -> Either SomeException Document
-parseLBS lbs de = runIdentity
-                $ run $ enumSingle (L.toChunks lbs)
-                     $$ joinI $ P.parseBytes de $$ fromEvents
-
-parseLBS_ :: L.ByteString -> P.DecodeEntities -> Document
-parseLBS_ lbs de = runIdentity
-                 $ run_ $ enumSingle (L.toChunks lbs)
-                       $$ joinI $ P.parseBytes de $$ fromEvents
-
-enumSingle :: Monad m => [a] -> Enumerator a m b
-enumSingle as (Continue k) = k $ Chunks as
-enumSingle _ step = returnI step
-
-lazyConsume :: Enumerator a IO () -> IO [a]
-lazyConsume enum = do
-    toGrabber <- M.newEmptyMVar
-    toFiller <- M.newMVar True
-    _ <- forkIO $ run_ $ enum $$ filler toGrabber toFiller
-    grabber toGrabber toFiller
-  where
-    grabber toGrabber toFiller = do
-        x <- M.takeMVar toGrabber
-        case x of
-            Nothing -> return []
-            Just x' -> do
-                M.putMVar toFiller True
-                xs <- unsafeInterleaveIO $ grabber toGrabber toFiller
-                return $ x' : xs
-    filler toGrabber toFiller = do
-        cont <- liftIO $ M.takeMVar toFiller
-        if cont
-            then do
-                x <- EL.head
-                liftIO $ M.putMVar toGrabber x
-                case x of
-                    Nothing -> return ()
-                    Just _ -> filler toGrabber toFiller
-            else liftIO $ M.putMVar toGrabber Nothing
-
-data InvalidEventStream = InvalidEventStream String
-    deriving (Show, Typeable)
-instance Exception InvalidEventStream
-
-prettyBuilder :: MonadIO m => Document -> Enumerator Builder m a
-prettyBuilder doc = enumList 8 (toEvents doc) `joinE` R.prettyBuilder
-
-prettyBytes :: MonadIO m => Document -> Enumerator ByteString m a
-prettyBytes doc = enumList 8 (toEvents doc) `joinE` R.prettyBytes
-
-prettyText :: MonadIO m => Document -> Enumerator Text m a
-prettyText doc = enumList 8 (toEvents doc) `joinE` R.prettyText
-
-renderBuilder :: MonadIO m => Document -> Enumerator Builder m a
-renderBuilder doc = enumList 8 (toEvents doc) `joinE` R.renderBuilder
-
-renderBytes :: MonadIO m => Document -> Enumerator ByteString m a
-renderBytes doc = enumList 8 (toEvents doc) `joinE` R.renderBytes
-
-renderText :: MonadIO m => Document -> Enumerator Text m a
-renderText doc = enumList 8 (toEvents doc) `joinE` R.renderText
-
-fromEvents :: Monad m => Iteratee Event m Document
-fromEvents = do
-    skip EventBeginDocument
-    d <- Document <$> goP <*> require goE <*> goM
-    skip EventEndDocument
-    y <- EL.head
-    if y == Nothing
-        then return d
-        else throwError $ InvalidEventStream $ "Trailing matter after epilogue: " ++ show y
-  where
-    skip e = do
-        x <- peek
-        if x == Just e then EL.drop 1 else return ()
-    many f =
-        go id
-      where
-        go front = do
-            x <- f
-            case x of
-                Nothing -> return $ front []
-                Just y -> go (front . (:) y)
-    dropReturn x = EL.drop 1 >> return x
-    require f = do
-        x <- f
-        case x of
-            Just y -> return y
-            Nothing -> do
-                y <- EL.head
-                throwError $ InvalidEventStream $ "Document must have a single root element, got: " ++ show y
-    goP = Prologue <$> goM <*> goD <*> goM
-    goM = many goM'
-    goM' = do
-        x <- peek
-        case x of
-            Just (EventInstruction i) -> dropReturn $ Just $ MiscInstruction i
-            Just (EventComment t) -> dropReturn $ Just $ MiscComment t
-            Just (EventContent (ContentText t))
-                | T.all isSpace t -> EL.drop 1 >> goM'
-            _ -> return Nothing
-    goD = do
-        x <- peek
-        case x of
-            Just (EventBeginDoctype name meid) -> do
-                EL.drop 1
-                dropTillDoctype
-                return (Just $ Doctype name meid)
-            _ -> return Nothing
-    dropTillDoctype = do
-        x <- EL.head
-        case x of
-            -- Leaving the following line commented so that the intention of
-            -- this function stays clear. I figure in the future xml-types will
-            -- be expanded again to support some form of EventDeclaration
-            --
-            -- Just (EventDeclaration _) -> dropTillDoctype
-            Just EventEndDoctype -> return ()
-            _ -> throwError $ InvalidEventStream $ "Invalid event during doctype, got: " ++ show x
-    goE = do
-        x <- peek
-        case x of
-            Just (EventBeginElement n as) -> Just <$> goE' n as
-            _ -> return Nothing
-    goE' n as = do
-        EL.drop 1
-        ns <- many goN
-        y <- EL.head
-        if y == Just (EventEndElement n)
-            then return $ Element n as $ compressNodes ns
-            else throwError $ InvalidEventStream $ "Missing end element for " ++ show n ++ ", got: " ++ show y
-    goN = do
-        x <- peek
-        case x of
-            Just (EventBeginElement n as) -> (Just . NodeElement) <$> goE' n as
-            Just (EventInstruction i) -> dropReturn $ Just $ NodeInstruction i
-            Just (EventContent c) -> dropReturn $ Just $ NodeContent c
-            Just (EventComment t) -> dropReturn $ Just $ NodeComment t
-            Just (EventCDATA t) -> dropReturn $ Just $ NodeContent $ ContentText t
-            _ -> return Nothing
-
-toEvents :: Document -> [Event]
-toEvents (Document prol root epi) =
-      (EventBeginDocument :)
-    . goP prol . goE root . goM epi $ [EventEndDocument]
-  where
-    goP (Prologue before doctype after) =
-        goM before . maybe id goD doctype . goM after
-    goM [] = id
-    goM [x] = (goM' x :)
-    goM (x:xs) = (goM' x :) . goM xs
-    goM' (MiscInstruction i) = EventInstruction i
-    goM' (MiscComment t) = EventComment t
-    goD (Doctype name meid) =
-        (:) (EventBeginDoctype name meid)
-      . (:) EventEndDoctype
-    goE (Element name as ns) =
-          (EventBeginElement name as :)
-        . goN ns
-        . (EventEndElement name :)
-    goN [] = id
-    goN [x] = goN' x
-    goN (x:xs) = goN' x . goN xs
-    goN' (NodeElement e) = goE e
-    goN' (NodeInstruction i) = (EventInstruction i :)
-    goN' (NodeContent c) = (EventContent c :)
-    goN' (NodeComment t) = (EventComment t :)
-
-compressNodes :: [Node] -> [Node]
-compressNodes [] = []
-compressNodes [x] = [x]
-compressNodes (NodeContent (ContentText x) : NodeContent (ContentText y) : z) =
-    compressNodes $ NodeContent (ContentText $ x `T.append` y) : z
-compressNodes (x:xs) = x : compressNodes xs
+{-# LANGUAGE DeriveDataTypeable #-}+module Text.XML.Enumerator.Document+    ( -- * Non-streaming functions+      writeFile+    , writePrettyFile+    , readFile+    , readFile_+      -- * Lazy bytestrings+    , renderLBS+    , prettyLBS+    , parseLBS+    , parseLBS_+      -- * Streaming functions+    , toEvents+    , fromEvents+    , renderBuilder+    , renderBytes+    , renderText+      -- ** Pretty versions+    , prettyBuilder+    , prettyBytes+    , prettyText+      -- * Exceptions+    , InvalidEventStream (InvalidEventStream)+    ) where++import Prelude hiding (writeFile, readFile)+import Data.XML.Types+import Data.Enumerator+    ( ($$), enumList, joinE, Enumerator, Iteratee, peek, returnI+    , throwError, joinI, run, run_, Step (Continue), Stream (Chunks)+    )+import Control.Exception (Exception, SomeException)+import Data.Typeable (Typeable)+import qualified Data.Enumerator.List as EL+import Blaze.ByteString.Builder (Builder)+import Control.Monad.IO.Class (MonadIO)+import qualified Text.XML.Enumerator.Render as R+import qualified Text.XML.Enumerator.Parse as P+import Data.ByteString (ByteString)+import Data.Text (Text)+import Control.Applicative ((<$>), (<*>))+import qualified System.IO as SIO+import Data.Enumerator.Binary (enumFile, iterHandle)+import qualified Data.Text as T+import Data.Char (isSpace)+import qualified Data.ByteString.Lazy as L+import System.IO.Unsafe (unsafePerformIO)+import qualified Control.Concurrent.MVar as M+import System.IO.Unsafe (unsafeInterleaveIO)+import Control.Monad.IO.Class (liftIO)+import Control.Concurrent (forkIO)+import Data.Functor.Identity (runIdentity)++readFile :: FilePath -> P.DecodeEntities -> IO (Either SomeException Document)+readFile fn de = run $ enumFile fn $$ joinI $ P.parseBytes de $$ fromEvents++readFile_ :: FilePath -> P.DecodeEntities -> IO Document+readFile_ fn de = run_ $ enumFile fn $$ joinI $ P.parseBytes de $$ fromEvents++writeFile :: FilePath -> Document -> IO ()+writeFile fn doc = SIO.withBinaryFile fn SIO.WriteMode $ \h ->+    run_ $ renderBytes doc $$ iterHandle h++-- | Pretty prints via 'prettyBytes'.+writePrettyFile :: FilePath -> Document -> IO ()+writePrettyFile fn doc = SIO.withBinaryFile fn SIO.WriteMode $ \h ->+    run_ $ prettyBytes doc $$ iterHandle h++renderLBS :: Document -> L.ByteString+renderLBS doc =+    L.fromChunks $ unsafePerformIO $ lazyConsume $ renderBytes doc++-- | Pretty prints via 'prettyBytes'.+prettyLBS :: Document -> L.ByteString+prettyLBS doc =+    L.fromChunks $ unsafePerformIO $ lazyConsume $ prettyBytes doc++parseLBS :: L.ByteString -> P.DecodeEntities -> Either SomeException Document+parseLBS lbs de = runIdentity+                $ run $ enumSingle (L.toChunks lbs)+                     $$ joinI $ P.parseBytes de $$ fromEvents++parseLBS_ :: L.ByteString -> P.DecodeEntities -> Document+parseLBS_ lbs de = runIdentity+                 $ run_ $ enumSingle (L.toChunks lbs)+                       $$ joinI $ P.parseBytes de $$ fromEvents++enumSingle :: Monad m => [a] -> Enumerator a m b+enumSingle as (Continue k) = k $ Chunks as+enumSingle _ step = returnI step++lazyConsume :: Enumerator a IO () -> IO [a]+lazyConsume enum = do+    toGrabber <- M.newEmptyMVar+    toFiller <- M.newMVar True+    _ <- forkIO $ run_ $ enum $$ filler toGrabber toFiller+    grabber toGrabber toFiller+  where+    grabber toGrabber toFiller = do+        x <- M.takeMVar toGrabber+        case x of+            Nothing -> return []+            Just x' -> do+                M.putMVar toFiller True+                xs <- unsafeInterleaveIO $ grabber toGrabber toFiller+                return $ x' : xs+    filler toGrabber toFiller = do+        cont <- liftIO $ M.takeMVar toFiller+        if cont+            then do+                x <- EL.head+                liftIO $ M.putMVar toGrabber x+                case x of+                    Nothing -> return ()+                    Just _ -> filler toGrabber toFiller+            else liftIO $ M.putMVar toGrabber Nothing++data InvalidEventStream = InvalidEventStream String+    deriving (Show, Typeable)+instance Exception InvalidEventStream++prettyBuilder :: MonadIO m => Document -> Enumerator Builder m a+prettyBuilder doc = enumList 8 (toEvents doc) `joinE` R.prettyBuilder++prettyBytes :: MonadIO m => Document -> Enumerator ByteString m a+prettyBytes doc = enumList 8 (toEvents doc) `joinE` R.prettyBytes++prettyText :: MonadIO m => Document -> Enumerator Text m a+prettyText doc = enumList 8 (toEvents doc) `joinE` R.prettyText++renderBuilder :: MonadIO m => Document -> Enumerator Builder m a+renderBuilder doc = enumList 8 (toEvents doc) `joinE` R.renderBuilder++renderBytes :: MonadIO m => Document -> Enumerator ByteString m a+renderBytes doc = enumList 8 (toEvents doc) `joinE` R.renderBytes++renderText :: MonadIO m => Document -> Enumerator Text m a+renderText doc = enumList 8 (toEvents doc) `joinE` R.renderText++fromEvents :: Monad m => Iteratee Event m Document+fromEvents = do+    skip EventBeginDocument+    d <- Document <$> goP <*> require goE <*> goM+    skip EventEndDocument+    y <- EL.head+    if y == Nothing+        then return d+        else throwError $ InvalidEventStream $ "Trailing matter after epilogue: " ++ show y+  where+    skip e = do+        x <- peek+        if x == Just e then EL.drop 1 else return ()+    many f =+        go id+      where+        go front = do+            x <- f+            case x of+                Nothing -> return $ front []+                Just y -> go (front . (:) y)+    dropReturn x = EL.drop 1 >> return x+    require f = do+        x <- f+        case x of+            Just y -> return y+            Nothing -> do+                y <- EL.head+                throwError $ InvalidEventStream $ "Document must have a single root element, got: " ++ show y+    goP = Prologue <$> goM <*> goD <*> goM+    goM = many goM'+    goM' = do+        x <- peek+        case x of+            Just (EventInstruction i) -> dropReturn $ Just $ MiscInstruction i+            Just (EventComment t) -> dropReturn $ Just $ MiscComment t+            Just (EventContent (ContentText t))+                | T.all isSpace t -> EL.drop 1 >> goM'+            _ -> return Nothing+    goD = do+        x <- peek+        case x of+            Just (EventBeginDoctype name meid) -> do+                EL.drop 1+                dropTillDoctype+                return (Just $ Doctype name meid)+            _ -> return Nothing+    dropTillDoctype = do+        x <- EL.head+        case x of+            -- Leaving the following line commented so that the intention of+            -- this function stays clear. I figure in the future xml-types will+            -- be expanded again to support some form of EventDeclaration+            --+            -- Just (EventDeclaration _) -> dropTillDoctype+            Just EventEndDoctype -> return ()+            _ -> throwError $ InvalidEventStream $ "Invalid event during doctype, got: " ++ show x+    goE = do+        x <- peek+        case x of+            Just (EventBeginElement n as) -> Just <$> goE' n as+            _ -> return Nothing+    goE' n as = do+        EL.drop 1+        ns <- many goN+        y <- EL.head+        if y == Just (EventEndElement n)+            then return $ Element n as $ compressNodes ns+            else throwError $ InvalidEventStream $ "Missing end element for " ++ show n ++ ", got: " ++ show y+    goN = do+        x <- peek+        case x of+            Just (EventBeginElement n as) -> (Just . NodeElement) <$> goE' n as+            Just (EventInstruction i) -> dropReturn $ Just $ NodeInstruction i+            Just (EventContent c) -> dropReturn $ Just $ NodeContent c+            Just (EventComment t) -> dropReturn $ Just $ NodeComment t+            Just (EventCDATA t) -> dropReturn $ Just $ NodeContent $ ContentText t+            _ -> return Nothing++toEvents :: Document -> [Event]+toEvents (Document prol root epi) =+      (EventBeginDocument :)+    . goP prol . goE root . goM epi $ [EventEndDocument]+  where+    goP (Prologue before doctype after) =+        goM before . maybe id goD doctype . goM after+    goM [] = id+    goM [x] = (goM' x :)+    goM (x:xs) = (goM' x :) . goM xs+    goM' (MiscInstruction i) = EventInstruction i+    goM' (MiscComment t) = EventComment t+    goD (Doctype name meid) =+        (:) (EventBeginDoctype name meid)+      . (:) EventEndDoctype+    goE (Element name as ns) =+          (EventBeginElement name as :)+        . goN ns+        . (EventEndElement name :)+    goN [] = id+    goN [x] = goN' x+    goN (x:xs) = goN' x . goN xs+    goN' (NodeElement e) = goE e+    goN' (NodeInstruction i) = (EventInstruction i :)+    goN' (NodeContent c) = (EventContent c :)+    goN' (NodeComment t) = (EventComment t :)++compressNodes :: [Node] -> [Node]+compressNodes [] = []+compressNodes [x] = [x]+compressNodes (NodeContent (ContentText x) : NodeContent (ContentText y) : z) =+    compressNodes $ NodeContent (ContentText $ x `T.append` y) : z+compressNodes (x:xs) = x : compressNodes xs

@@ -1,680 +1,680 @@-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE RankNTypes #-}
--- | This module provides both a native Haskell solution for parsing XML
--- documents into a stream of events, and a set of parser combinators for
--- dealing with a stream of events.
---
--- As a simple example, if you have the following XML file:
---
--- > <?xml version="1.0" encoding="utf-8"?>
--- > <people>
--- >     <person age="25">Michael</person>
--- >     <person age="2">Eliezer</person>
--- > </people>
---
--- Then this code:
---
--- > {-# LANGUAGE OverloadedStrings #-}
--- > import Text.XML.Enumerator.Parse
--- > import Data.Text.Lazy (Text, unpack)
--- > 
--- > data Person = Person { age :: Int, name :: Text }
--- >     deriving Show
--- > 
--- > parsePerson = tagName "person" (requireAttr "age") $ \age -> do
--- >     name <- content
--- >     return $ Person (read $ unpack age) name
--- > 
--- > parsePeople = tagNoAttr "people" $ many parsePerson
--- > 
--- > main = parseFile_ "people.xml" decodeEntities $ force "people required" parsePeople
---
--- will produce:
---
--- > [Person {age = 25, name = "Michael"},Person {age = 2, name = "Eliezer"}]
---
--- Previous versions of this module contained a number of more sophisticated
--- functions written by Aristid Breitkreuz and Dmitry Olshansky. To keep this
--- package simpler, those functions are being moved to a separate package. This
--- note will be updated with the name of the package(s) when available.
-module Text.XML.Enumerator.Parse
-    ( -- * Parsing XML files
-      parseBytes
-    , parseText
-    , detectUtf
-    , parseFile
-    , parseFile_
-    , parseLBS
-    , parseLBS_
-      -- ** Entity decoding
-    , DecodeEntities
-    , decodeEntities
-      -- * Event parsing
-    , tag
-    , tagPredicate
-    , tagName
-    , tagNoAttr
-    , content
-    , contentMaybe
-      -- * Attribute parsing
-    , AttrParser
-    , requireAttr
-    , optionalAttr
-    , requireAttrRaw
-    , optionalAttrRaw
-    , ignoreAttrs
-      -- * Combinators
-    , orE
-    , choose
-    , many
-    , force
-      -- * Exceptions
-    , XmlException (..)
-    ) where
-import Data.Attoparsec.Text
-    ( char, Parser, takeWhile1, skipWhile, string
-    , manyTill, takeWhile, try, anyChar, endOfInput
-    )
-import qualified Data.Attoparsec.Text as A
-import Data.Attoparsec.Text.Enumerator (iterParser)
-import Data.XML.Types
-    ( Name (..), Event (..), Content (..)
-    , Instruction (..), ExternalID (..)
-    )
-import Control.Applicative ((<|>), (<$>))
-import Data.Text (Text)
-import qualified Data.Text as T
-import Text.XML.Enumerator.Token
-import Prelude hiding (takeWhile)
-import qualified Data.ByteString as S
-import qualified Data.ByteString.Lazy as L
-import qualified Data.Map as Map
-import Data.Enumerator
-    ( Iteratee, Enumeratee, (>>==), Stream (..), run_, Enumerator, Step (..)
-    , checkDone, yield, ($$), joinI, run, throwError, returnI
-    )
-import qualified Data.Enumerator as E
-import qualified Data.Enumerator.List as EL
-import qualified Data.Enumerator.Text as ET
-import qualified Data.Enumerator.Binary as EB
-import Control.Monad (unless, ap, liftM)
-import qualified Data.Text as TS
-import Data.List (foldl')
-import Control.Applicative (Applicative (..))
-import Data.Typeable (Typeable)
-import Control.Exception (Exception, throwIO, SomeException)
-import Data.Enumerator.Binary (enumFile)
-import Control.Monad.IO.Class (liftIO)
-import Data.Char (isSpace)
-
-tokenToEvent :: [NSLevel] -> Token -> ([NSLevel], [Event])
-tokenToEvent n (TokenBeginDocument _) = (n, [])
-tokenToEvent n (TokenInstruction i) = (n, [EventInstruction i])
-tokenToEvent n (TokenBeginElement name as isClosed _) =
-    (n', if isClosed then [begin, end] else [begin])
-  where
-    l0 = case n of
-            [] -> NSLevel Nothing Map.empty
-            x:_ -> x
-    (as', l') = foldl' go (id, l0) as
-    go (front, l) a@(TName kpref kname, val)
-        | kpref == Just "xmlns" =
-            (front, l { prefixes = Map.insert kname (contentsToText val)
-                                 $ prefixes l })
-        | kpref == Nothing && kname == "xmlns" =
-            (front, l { defaultNS = if T.null $ contentsToText val
-                                        then Nothing
-                                        else Just $ contentsToText val })
-        | otherwise = (front . (:) a, l)
-    n' = if isClosed then n else l' : n
-    fixAttName level (name', val) = (tnameToName True level name', val)
-    begin = EventBeginElement (tnameToName False l' name)
-          $ map (fixAttName l')
-          $ as' []
-    end = EventEndElement $ tnameToName False l' name
-tokenToEvent n (TokenEndElement name) =
-    (n', [EventEndElement $ tnameToName False l name])
-  where
-    (l, n') =
-        case n of
-            [] -> (NSLevel Nothing Map.empty, [])
-            x:xs -> (x, xs)
-tokenToEvent n (TokenContent c) = (n, [EventContent c])
-tokenToEvent n (TokenComment c) = (n, [EventComment c])
-tokenToEvent n (TokenDoctype t eid) = (n, [EventBeginDoctype t eid, EventEndDoctype])
-tokenToEvent n (TokenCDATA t) = (n, [EventCDATA t])
-
-tnameToName :: Bool -> NSLevel -> TName -> Name
-tnameToName _ _ (TName (Just "xml") name) =
-    Name name (Just "http://www.w3.org/XML/1998/namespace") (Just "xml")
-tnameToName isAttr (NSLevel def _) (TName Nothing name) =
-    Name name (if isAttr then Nothing else def) Nothing
-tnameToName _ (NSLevel _ m) (TName (Just pref) name) =
-    case Map.lookup pref m of
-        Just ns -> Name name (Just ns) (Just pref)
-        Nothing -> Name name Nothing (Just pref) -- FIXME is this correct?
-
--- | Automatically determine which UTF variant is being used. This function
--- first checks for BOMs, removing them as necessary, and then check for the
--- equivalent of <?xml for each of UTF-8, UTF-16LE/BE, and UTF-32LE/BE. It
--- defaults to assuming UTF-8.
-detectUtf :: Monad m => Enumeratee S.ByteString TS.Text m a
-detectUtf step = do
-    x <- EB.take 4
-    let (toDrop, codec) =
-            case L.unpack x of
-                [0x00, 0x00, 0xFE, 0xFF] -> (4, ET.utf32_be)
-                [0xFF, 0xFE, 0x00, 0x00] -> (4, ET.utf32_le)
-                0xFE : 0xFF: _           -> (2, ET.utf16_be)
-                0xFF : 0xFE: _           -> (2, ET.utf16_le)
-                0xEF : 0xBB: 0xBF : _    -> (3, ET.utf8)
-                [0x00, 0x00, 0x00, 0x3C] -> (0, ET.utf32_be)
-                [0x3C, 0x00, 0x00, 0x00] -> (0, ET.utf32_le)
-                [0x00, 0x3C, 0x00, 0x3F] -> (0, ET.utf16_be)
-                [0x3C, 0x00, 0x3F, 0x00] -> (0, ET.utf16_le)
-                _                        -> (0, ET.utf8) -- Assuming UTF-8
-    unless (toDrop == 4) $ yield () $ Chunks $ L.toChunks $ L.drop toDrop x
-    ET.decode codec step
-
--- | Parses a byte stream into 'Event's. This function is implemented fully in
--- Haskell using attoparsec-text for parsing. The produced error messages do
--- not give line/column information, so you may prefer to stick with the parser
--- provided by libxml-enumerator. However, this has the advantage of not
--- relying on any C libraries.
---
--- This relies on 'detectUtf' to determine character encoding, and 'parseText'
--- to do the actual parsing.
-parseBytes :: Monad m => DecodeEntities -> Enumeratee S.ByteString Event m a
-parseBytes de step = joinI $ detectUtf $$ parseText de step
-
--- | Parses a character stream into 'Event's. This function is implemented
--- fully in Haskell using attoparsec-text for parsing. The produced error
--- messages do not give line/column information, so you may prefer to stick
--- with the parser provided by libxml-enumerator. However, this has the
--- advantage of not relying on any C libraries.
-parseText :: Monad m => DecodeEntities -> Enumeratee TS.Text Event m a
-parseText de =
-    checkDone $ \k -> k (Chunks [EventBeginDocument]) >>== loop []
-  where
-    loop levels = checkDone $ go levels
-    go levels k = do
-        mtoken <- iterToken de
-        case mtoken of
-            Nothing -> k (Chunks [EventEndDocument]) >>== return
-            Just token ->
-                let (levels', events) = tokenToEvent levels token
-                 in k (Chunks events) >>== loop levels'
-
-iterToken :: Monad m => DecodeEntities -> Iteratee TS.Text m (Maybe Token)
-iterToken de = iterParser ((endOfInput >> return Nothing) <|> fmap Just (parseToken de))
-
-parseToken :: DecodeEntities -> Parser Token
-parseToken de = do
-    (char '<' >> parseLt) <|> fmap TokenContent (parseContent de False False)
-  where
-    parseLt =
-        (char '?' >> parseInstr) <|>
-        (char '!' >> (parseComment <|> parseCdata <|> parseDoctype)) <|>
-        (char '/' >> parseEnd) <|>
-        parseBegin
-    parseInstr = do
-        name <- parseIdent
-        if name == "xml"
-            then do
-                as <- A.many $ parseAttribute de
-                skipSpace
-                char' '?'
-                char' '>'
-                newline <|> return ()
-                return $ TokenBeginDocument as
-            else do
-                skipSpace
-                x <- T.pack <$> manyTill anyChar (try $ string "?>")
-                return $ TokenInstruction $ Instruction name x
-    parseComment = do
-        char' '-'
-        char' '-'
-        c <- T.pack <$> manyTill anyChar (string "-->") -- FIXME use takeWhile instead
-        return $ TokenComment c
-    parseCdata = do
-        _ <- string "[CDATA["
-        t <- T.pack <$> manyTill anyChar (string "]]>") -- FIXME use takeWhile instead
-        return $ TokenCDATA t
-    parseDoctype = do
-        _ <- string "DOCTYPE"
-        skipSpace
-        i <- parseIdent
-        skipSpace
-        eid <- fmap Just parsePublicID <|>
-               fmap Just parseSystemID <|>
-               return Nothing
-        skipSpace
-        (do
-            char' '['
-            skipWhile (/= ']')
-            char' ']'
-            skipSpace) <|> return ()
-        char' '>'
-        newline <|> return ()
-        return $ TokenDoctype i eid
-    parsePublicID = do
-        _ <- string "PUBLIC"
-        x <- quotedText
-        y <- quotedText
-        return $ PublicID x y
-    parseSystemID = do
-        _ <- string "SYSTEM"
-        x <- quotedText
-        return $ SystemID x
-    quotedText = do
-        skipSpace
-        between '"' <|> between '\''
-    between c = do
-        char' c
-        x <- takeWhile (/=c)
-        char' c
-        return x
-    parseEnd = do
-        skipSpace
-        n <- parseName
-        skipSpace
-        char' '>'
-        return $ TokenEndElement n
-    parseBegin = do
-        skipSpace
-        n <- parseName
-        as <- A.many $ parseAttribute de
-        skipSpace
-        isClose <- (char '/' >> skipSpace >> return True) <|> return False
-        char' '>'
-        return $ TokenBeginElement n as isClose 0
-
-parseAttribute :: DecodeEntities -> Parser TAttribute
-parseAttribute de = do
-    skipSpace
-    key <- parseName
-    skipSpace
-    char' '='
-    skipSpace
-    val <- squoted <|> dquoted
-    return (key, val)
-  where
-    squoted = do
-        char' '\''
-        manyTill (parseContent de False True) (char '\'')
-    dquoted = do
-        char' '"'
-        manyTill (parseContent de True False) (char '"')
-
-parseName :: Parser TName
-parseName = do
-    i1 <- parseIdent
-    mi2 <- (char ':' >> fmap Just parseIdent) <|> return Nothing
-    return $
-        case mi2 of
-            Nothing -> TName Nothing i1
-            Just i2 -> TName (Just i1) i2
-
-parseIdent :: Parser Text
-parseIdent =
-    takeWhile1 valid
-  where
-    valid '&' = False
-    valid '<' = False
-    valid '>' = False
-    valid ':' = False
-    valid '?' = False
-    valid '=' = False
-    valid '"' = False
-    valid '\'' = False
-    valid '/' = False
-    valid c  = not $ isSpace c
-
-parseContent :: DecodeEntities
-             -> Bool -- break on double quote
-             -> Bool -- break on single quote
-             -> Parser Content
-parseContent de breakDouble breakSingle =
-    parseEntity <|> parseText'
-  where
-    parseEntity = do
-        char' '&'
-        t <- takeWhile1 (/= ';')
-        char' ';'
-        return $ de t
-    parseText' = do
-        bs <- takeWhile1 valid
-        return $ ContentText bs
-    valid '"' = not breakDouble
-    valid '\'' = not breakSingle
-    valid '&' = False -- amp
-    valid '<' = False -- lt
-    valid _  = True
-
-skipSpace :: Parser ()
-skipSpace = skipWhile isSpace
-
-newline :: Parser ()
-newline = ((char '\r' >> char '\n') <|> char '\n') >> return ()
-
-char' :: Char -> Parser ()
-char' c = char c >> return ()
-
-data ContentType =
-    Ignore | IsContent Text | IsError String | NotContent
-
--- | Grabs the next piece of content if available. This function skips over any
--- comments and instructions and concatenates all content until the next start
--- or end tag.
-contentMaybe :: Monad m => Iteratee Event m (Maybe Text)
-contentMaybe = do
-    x <- E.peek
-    case pc' x of
-        Ignore -> EL.drop 1 >> contentMaybe
-        IsContent t -> EL.drop 1 >> fmap Just (takeContents (t:))
-        IsError e -> throwError $ XmlException e x
-        NotContent -> return Nothing
-  where
-    pc' Nothing = NotContent
-    pc' (Just x) = pc x
-    pc (EventContent (ContentText t)) = IsContent t
-    pc (EventContent (ContentEntity e)) = IsError $ "Unknown entity: " ++ show e
-    pc (EventCDATA t) = IsContent t
-    pc EventBeginElement{} = NotContent
-    pc EventEndElement{} = NotContent
-    pc EventBeginDocument{} = Ignore
-    pc EventEndDocument = Ignore
-    pc EventBeginDoctype{} = Ignore
-    pc EventEndDoctype = Ignore
-    pc EventInstruction{} = Ignore
-    pc EventComment{} = Ignore
-    takeContents front = do
-        x <- E.peek
-        case pc' x of
-            Ignore -> EL.drop 1 >> takeContents front
-            IsContent t -> EL.drop 1 >> takeContents (front . (:) t)
-            IsError e -> throwError $ XmlException e x
-            NotContent -> return $ T.concat $ front []
-
--- | Grabs the next piece of content. If none if available, returns 'T.empty'.
--- This is simply a wrapper around 'contentMaybe'.
-content :: Monad m => Iteratee Event m Text
-content = do
-    x <- contentMaybe
-    case x of
-        Nothing -> return T.empty
-        Just y -> return y
-
--- | The most generic way to parse a tag. It takes a predicate for checking if
--- this is the correct tag name, an 'AttrParser' for handling attributes, and
--- then a parser for dealing with content.
---
--- This function automatically absorbs its balancing closing tag, and will
--- throw an exception if not all of the attributes or child elements are
--- consumed. If you want to allow extra attributes, see 'ignoreAttrs'.
---
--- This function automatically ignores comments, instructions and whitespace.
-tag :: Monad m
-    => (Name -> Maybe a)
-    -> (a -> AttrParser b)
-    -> (b -> Iteratee Event m c)
-    -> Iteratee Event m (Maybe c)
-tag checkName attrParser f = do
-    x <- dropWS
-    case x of
-        Just (EventBeginElement name as) ->
-            case checkName name of
-                Just y ->
-                    case runAttrParser' (attrParser y) as of
-                        Left e -> throwError e
-                        Right z -> do
-                            EL.drop 1
-                            z' <- f z
-                            a <- dropWS
-                            case a of
-                                Just (EventEndElement name')
-                                    | name == name' -> EL.drop 1 >> return (Just z')
-                                _ -> throwError $ XmlException ("Expected end tag for: " ++ show name) a
-                Nothing -> return Nothing
-        _ -> return Nothing
-  where
-    dropWS = do
-        x <- E.peek
-        let isWS =
-                case x of
-                    Just EventBeginDocument -> True
-                    Just EventEndDocument -> True
-                    Just EventBeginDoctype{} -> True
-                    Just EventEndDoctype -> True
-                    Just EventInstruction{} -> True
-                    Just EventBeginElement{} -> False
-                    Just EventEndElement{} -> False
-                    Just (EventContent (ContentText t))
-                        | T.all isSpace t -> True
-                        | otherwise -> False
-                    Just (EventContent ContentEntity{}) -> False
-                    Just EventComment{} -> True
-                    Just EventCDATA{} -> False
-                    Nothing -> False
-        if isWS then EL.drop 1 >> dropWS else return x
-    runAttrParser' p as =
-        case runAttrParser p as of
-            Left e -> Left e
-            Right ([], x) -> Right x
-            Right (attr, _) -> Left $ UnparsedAttributes attr
-
--- | A simplified version of 'tag' which matches against boolean predicates.
-tagPredicate :: Monad m => (Name -> Bool) -> AttrParser a -> (a -> Iteratee Event m b) -> Iteratee Event m (Maybe b)
-tagPredicate p attrParser = tag (\x -> if p x then Just () else Nothing) (const attrParser)
-
--- | A simplified version of 'tag' which matches for specific tag names instead
--- of taking a predicate function. This is often sufficient, and when combined
--- with OverloadedStrings and the IsString instance of 'Name', can prove to be
--- very concise.
-tagName :: Monad m
-     => Name
-     -> AttrParser a
-     -> (a -> Iteratee Event m b)
-     -> Iteratee Event m (Maybe b)
-tagName name = tagPredicate (== name)
-
--- | A further simplified tag parser, which requires that no attributes exist.
-tagNoAttr :: Monad m => Name -> Iteratee Event m a -> Iteratee Event m (Maybe a)
-tagNoAttr name f = tagName name (return ()) $ const f
-
--- | Get the value of the first parser which returns 'Just'. If no parsers
--- succeed (i.e., return 'Just'), this function returns 'Nothing'.
---
--- > orE a b = choose [a, b]
-orE :: Monad m => Iteratee Event m (Maybe a) -> Iteratee Event m (Maybe a) -> Iteratee Event m (Maybe a)
-orE a b = do
-  x <- a
-  case x of
-    Nothing -> b
-    _ -> return x
-
--- | Get the value of the first parser which returns 'Just'. If no parsers
--- succeed (i.e., return 'Just'), this function returns 'Nothing'.
-choose :: Monad m
-       => [Iteratee Event m (Maybe a)]
-       -> Iteratee Event m (Maybe a)
-choose [] = return Nothing
-choose (i:is) = do
-    x <- i
-    case x of
-        Nothing -> choose is
-        Just a -> return $ Just a
-
--- | Force an optional parser into a required parser. All of the 'tag'
--- functions, 'choose' and 'many' deal with 'Maybe' parsers. Use this when you
--- want to finally force something to happen.
-force :: Monad m
-      => String -- ^ Error message
-      -> Iteratee Event m (Maybe a)
-      -> Iteratee Event m a
-force msg i = do
-    x <- i
-    case x of
-        Nothing -> throwError $ XmlException msg Nothing
-        Just a -> return a
-
--- | The same as 'parseFile', but throws any exceptions.
-parseFile_ :: FilePath -> DecodeEntities -> Iteratee Event IO a -> IO a
-parseFile_ fn de p =
-    parseFile fn de p >>= go
-  where
-    go (Left e) = liftIO $ throwIO e
-    go (Right a) = return a
-
--- | A helper function which reads a file from disk using 'enumFile', detects
--- character encoding using 'detectUtf', parses the XML using 'parseBytes', and
--- then hands off control to your supplied parser.
-parseFile :: FilePath
-          -> DecodeEntities
-          -> Iteratee Event IO a
-          -> IO (Either SomeException a)
-parseFile fn de p =
-    run $ enumFile fn     $$ joinI
-        $ parseBytes de   $$ p
-
--- | Parse an event stream from a lazy 'L.ByteString'.
-parseLBS :: L.ByteString -> DecodeEntities -> Iteratee Event IO a -> IO (Either SomeException a)
-parseLBS lbs de p =
-    run $ enumSingle (L.toChunks lbs)   $$ joinI
-        $ parseBytes de                 $$ p
-
--- | Same as 'parseLBS', but throws exceptions.
-parseLBS_ :: L.ByteString -> DecodeEntities -> Iteratee Event IO a -> IO a
-parseLBS_ lbs de p =
-    run_ $ enumSingle (L.toChunks lbs)   $$ joinI
-         $ parseBytes de                 $$ p
-
-enumSingle :: Monad m => [a] -> Enumerator a m b
-enumSingle as (Continue k) = k $ Chunks as
-enumSingle _ step = returnI step
-
-data XmlException = XmlException
-    { xmlErrorMessage :: String
-    , xmlBadInput :: Maybe Event
-    }
-                  | InvalidEndElement Name
-                  | InvalidEntity Text
-                  | UnparsedAttributes [(Name, [Content])]
-    deriving (Show, Typeable)
-instance Exception XmlException
-
--- | A monad for parsing attributes. By default, it requires you to deal with
--- all attributes present on an element, and will throw an exception if there
--- are unhandled attributes. Use the 'requireAttr', 'optionalAttr' et al
--- functions for handling an attribute, and 'ignoreAttrs' if you would like to
--- skip the rest of the attributes on an element.
-newtype AttrParser a = AttrParser { runAttrParser :: [(Name, [Content])] -> Either XmlException ([(Name, [Content])], a) }
-
-instance Monad AttrParser where
-    return a = AttrParser $ \as -> Right (as, a)
-    (AttrParser f) >>= g = AttrParser $ \as ->
-        case f as of
-            Left e -> Left e
-            Right (as', f') -> runAttrParser (g f') as'
-instance Functor AttrParser where
-    fmap = liftM
-instance Applicative AttrParser where
-    pure = return
-    (<*>) = ap
-
-optionalAttrRaw :: ((Name, [Content]) -> Maybe b) -> AttrParser (Maybe b)
-optionalAttrRaw f =
-    AttrParser $ go id
-  where
-    go front [] = Right (front [], Nothing)
-    go front (a:as) =
-        case f a of
-            Nothing -> go (front . (:) a) as
-            Just b -> Right (front as, Just b)
-
-requireAttrRaw :: String -> ((Name, [Content]) -> Maybe b) -> AttrParser b
-requireAttrRaw msg f = do
-    x <- optionalAttrRaw f
-    case x of
-        Just b -> return b
-        Nothing -> AttrParser $ const $ Left $ XmlException msg Nothing
-
--- | Require that a certain attribute be present and return its value.
-requireAttr :: Name -> AttrParser Text
-requireAttr n = requireAttrRaw
-    ("Missing attribute: " ++ show n)
-    (\(x, y) -> if x == n then Just (contentsToText y) else Nothing)
-
--- | Return the value for an attribute if present.
-optionalAttr :: Name -> AttrParser (Maybe Text)
-optionalAttr n = optionalAttrRaw
-    (\(x, y) -> if x == n then Just (contentsToText y) else Nothing)
-
-contentsToText :: [Content] -> Text
-contentsToText =
-    T.concat . map toText
-  where
-    toText (ContentText t) = t
-    toText (ContentEntity e) = T.concat ["&", e, ";"]
-
--- | Skip the remaining attributes on an element. Since this will clear the
--- list of attributes, you must call this /after/ any calls to 'requireAttr',
--- 'optionalAttr', etc.
-ignoreAttrs :: AttrParser ()
-ignoreAttrs = AttrParser $ \_ -> Right ([], ())
-
--- | Keep parsing elements as long as the parser returns 'Just'.
-many :: Monad m => Iteratee Event m (Maybe a) -> Iteratee Event m [a]
-many i =
-    go id
-  where
-    go front = do
-        x <- i
-        case x of
-            Nothing -> return $ front []
-            Just y -> go $ front . (:) y
-
-type DecodeEntities = Text -> Content
-
--- | Default implementation of 'DecodeEntities': handles numeric entities and
--- the five standard character entities (lt, gt, amp, quot, apos).
-decodeEntities :: DecodeEntities
-decodeEntities "lt" = ContentText "<"
-decodeEntities "gt" = ContentText ">"
-decodeEntities "amp" = ContentText "&"
-decodeEntities "quot" = ContentText "\""
-decodeEntities "apos" = ContentText "'"
-decodeEntities t =
-    case T.uncons t of
-        Just ('#', t') ->
-            case T.uncons t' of
-                Just ('x', t'') -> decodeHex (ContentEntity t) t''
-                _ -> decodeDec (ContentEntity t) t'
-        _ -> ContentEntity t
-
-decodeHex :: Content -> Text -> Content
-decodeHex backup val
-    | T.null val = backup
-decodeHex backup val =
-    go (T.unpack val) 0
-  where
-    go [] i = ContentText $ T.singleton $ toEnum i
-    go (c:cs) i = maybe backup (go cs . ((i * 16) +)) $ getHex c
-    getHex c
-        | '0' <= c && c <= '9' = Just $ fromEnum c - fromEnum '0'
-        | 'A' <= c && c <= 'F' = Just $ fromEnum c - fromEnum 'A' + 10
-        | 'a' <= c && c <= 'f' = Just $ fromEnum c - fromEnum 'a' + 10
-        | otherwise = Nothing
-
-decodeDec :: Content -> Text -> Content
-decodeDec backup val
-    | T.null val = backup
-decodeDec backup val =
-    go (T.unpack val) 0
-  where
-    go [] i = ContentText $ T.singleton $ toEnum i
-    go (c:cs) i = maybe backup (go cs . ((i * 10) +)) $ getHex c
-    getHex c
-        | '0' <= c && c <= '9' = Just $ fromEnum c - fromEnum '0'
-        | otherwise = Nothing
+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RankNTypes #-}+-- | This module provides both a native Haskell solution for parsing XML+-- documents into a stream of events, and a set of parser combinators for+-- dealing with a stream of events.+--+-- As a simple example, if you have the following XML file:+--+-- > <?xml version="1.0" encoding="utf-8"?>+-- > <people>+-- >     <person age="25">Michael</person>+-- >     <person age="2">Eliezer</person>+-- > </people>+--+-- Then this code:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > import Text.XML.Enumerator.Parse+-- > import Data.Text.Lazy (Text, unpack)+-- > +-- > data Person = Person { age :: Int, name :: Text }+-- >     deriving Show+-- > +-- > parsePerson = tagName "person" (requireAttr "age") $ \age -> do+-- >     name <- content+-- >     return $ Person (read $ unpack age) name+-- > +-- > parsePeople = tagNoAttr "people" $ many parsePerson+-- > +-- > main = parseFile_ "people.xml" decodeEntities $ force "people required" parsePeople+--+-- will produce:+--+-- > [Person {age = 25, name = "Michael"},Person {age = 2, name = "Eliezer"}]+--+-- Previous versions of this module contained a number of more sophisticated+-- functions written by Aristid Breitkreuz and Dmitry Olshansky. To keep this+-- package simpler, those functions are being moved to a separate package. This+-- note will be updated with the name of the package(s) when available.+module Text.XML.Enumerator.Parse+    ( -- * Parsing XML files+      parseBytes+    , parseText+    , detectUtf+    , parseFile+    , parseFile_+    , parseLBS+    , parseLBS_+      -- ** Entity decoding+    , DecodeEntities+    , decodeEntities+      -- * Event parsing+    , tag+    , tagPredicate+    , tagName+    , tagNoAttr+    , content+    , contentMaybe+      -- * Attribute parsing+    , AttrParser+    , requireAttr+    , optionalAttr+    , requireAttrRaw+    , optionalAttrRaw+    , ignoreAttrs+      -- * Combinators+    , orE+    , choose+    , many+    , force+      -- * Exceptions+    , XmlException (..)+    ) where+import Data.Attoparsec.Text+    ( char, Parser, takeWhile1, skipWhile, string+    , manyTill, takeWhile, try, anyChar, endOfInput+    )+import qualified Data.Attoparsec.Text as A+import Data.Attoparsec.Text.Enumerator (iterParser)+import Data.XML.Types+    ( Name (..), Event (..), Content (..)+    , Instruction (..), ExternalID (..)+    )+import Control.Applicative ((<|>), (<$>))+import Data.Text (Text)+import qualified Data.Text as T+import Text.XML.Enumerator.Token+import Prelude hiding (takeWhile)+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Data.Map as Map+import Data.Enumerator+    ( Iteratee, Enumeratee, (>>==), Stream (..), run_, Enumerator, Step (..)+    , checkDone, yield, ($$), joinI, run, throwError, returnI+    )+import qualified Data.Enumerator as E+import qualified Data.Enumerator.List as EL+import qualified Data.Enumerator.Text as ET+import qualified Data.Enumerator.Binary as EB+import Control.Monad (unless, ap, liftM)+import qualified Data.Text as TS+import Data.List (foldl')+import Control.Applicative (Applicative (..))+import Data.Typeable (Typeable)+import Control.Exception (Exception, throwIO, SomeException)+import Data.Enumerator.Binary (enumFile)+import Control.Monad.IO.Class (liftIO)+import Data.Char (isSpace)++tokenToEvent :: [NSLevel] -> Token -> ([NSLevel], [Event])+tokenToEvent n (TokenBeginDocument _) = (n, [])+tokenToEvent n (TokenInstruction i) = (n, [EventInstruction i])+tokenToEvent n (TokenBeginElement name as isClosed _) =+    (n', if isClosed then [begin, end] else [begin])+  where+    l0 = case n of+            [] -> NSLevel Nothing Map.empty+            x:_ -> x+    (as', l') = foldl' go (id, l0) as+    go (front, l) a@(TName kpref kname, val)+        | kpref == Just "xmlns" =+            (front, l { prefixes = Map.insert kname (contentsToText val)+                                 $ prefixes l })+        | kpref == Nothing && kname == "xmlns" =+            (front, l { defaultNS = if T.null $ contentsToText val+                                        then Nothing+                                        else Just $ contentsToText val })+        | otherwise = (front . (:) a, l)+    n' = if isClosed then n else l' : n+    fixAttName level (name', val) = (tnameToName True level name', val)+    begin = EventBeginElement (tnameToName False l' name)+          $ map (fixAttName l')+          $ as' []+    end = EventEndElement $ tnameToName False l' name+tokenToEvent n (TokenEndElement name) =+    (n', [EventEndElement $ tnameToName False l name])+  where+    (l, n') =+        case n of+            [] -> (NSLevel Nothing Map.empty, [])+            x:xs -> (x, xs)+tokenToEvent n (TokenContent c) = (n, [EventContent c])+tokenToEvent n (TokenComment c) = (n, [EventComment c])+tokenToEvent n (TokenDoctype t eid) = (n, [EventBeginDoctype t eid, EventEndDoctype])+tokenToEvent n (TokenCDATA t) = (n, [EventCDATA t])++tnameToName :: Bool -> NSLevel -> TName -> Name+tnameToName _ _ (TName (Just "xml") name) =+    Name name (Just "http://www.w3.org/XML/1998/namespace") (Just "xml")+tnameToName isAttr (NSLevel def _) (TName Nothing name) =+    Name name (if isAttr then Nothing else def) Nothing+tnameToName _ (NSLevel _ m) (TName (Just pref) name) =+    case Map.lookup pref m of+        Just ns -> Name name (Just ns) (Just pref)+        Nothing -> Name name Nothing (Just pref) -- FIXME is this correct?++-- | Automatically determine which UTF variant is being used. This function+-- first checks for BOMs, removing them as necessary, and then check for the+-- equivalent of <?xml for each of UTF-8, UTF-16LE/BE, and UTF-32LE/BE. It+-- defaults to assuming UTF-8.+detectUtf :: Monad m => Enumeratee S.ByteString TS.Text m a+detectUtf step = do+    x <- EB.take 4+    let (toDrop, codec) =+            case L.unpack x of+                [0x00, 0x00, 0xFE, 0xFF] -> (4, ET.utf32_be)+                [0xFF, 0xFE, 0x00, 0x00] -> (4, ET.utf32_le)+                0xFE : 0xFF: _           -> (2, ET.utf16_be)+                0xFF : 0xFE: _           -> (2, ET.utf16_le)+                0xEF : 0xBB: 0xBF : _    -> (3, ET.utf8)+                [0x00, 0x00, 0x00, 0x3C] -> (0, ET.utf32_be)+                [0x3C, 0x00, 0x00, 0x00] -> (0, ET.utf32_le)+                [0x00, 0x3C, 0x00, 0x3F] -> (0, ET.utf16_be)+                [0x3C, 0x00, 0x3F, 0x00] -> (0, ET.utf16_le)+                _                        -> (0, ET.utf8) -- Assuming UTF-8+    unless (toDrop == 4) $ yield () $ Chunks $ L.toChunks $ L.drop toDrop x+    ET.decode codec step++-- | Parses a byte stream into 'Event's. This function is implemented fully in+-- Haskell using attoparsec-text for parsing. The produced error messages do+-- not give line/column information, so you may prefer to stick with the parser+-- provided by libxml-enumerator. However, this has the advantage of not+-- relying on any C libraries.+--+-- This relies on 'detectUtf' to determine character encoding, and 'parseText'+-- to do the actual parsing.+parseBytes :: Monad m => DecodeEntities -> Enumeratee S.ByteString Event m a+parseBytes de step = joinI $ detectUtf $$ parseText de step++-- | Parses a character stream into 'Event's. This function is implemented+-- fully in Haskell using attoparsec-text for parsing. The produced error+-- messages do not give line/column information, so you may prefer to stick+-- with the parser provided by libxml-enumerator. However, this has the+-- advantage of not relying on any C libraries.+parseText :: Monad m => DecodeEntities -> Enumeratee TS.Text Event m a+parseText de =+    checkDone $ \k -> k (Chunks [EventBeginDocument]) >>== loop []+  where+    loop levels = checkDone $ go levels+    go levels k = do+        mtoken <- iterToken de+        case mtoken of+            Nothing -> k (Chunks [EventEndDocument]) >>== return+            Just token ->+                let (levels', events) = tokenToEvent levels token+                 in k (Chunks events) >>== loop levels'++iterToken :: Monad m => DecodeEntities -> Iteratee TS.Text m (Maybe Token)+iterToken de = iterParser ((endOfInput >> return Nothing) <|> fmap Just (parseToken de))++parseToken :: DecodeEntities -> Parser Token+parseToken de = do+    (char '<' >> parseLt) <|> fmap TokenContent (parseContent de False False)+  where+    parseLt =+        (char '?' >> parseInstr) <|>+        (char '!' >> (parseComment <|> parseCdata <|> parseDoctype)) <|>+        (char '/' >> parseEnd) <|>+        parseBegin+    parseInstr = do+        name <- parseIdent+        if name == "xml"+            then do+                as <- A.many $ parseAttribute de+                skipSpace+                char' '?'+                char' '>'+                newline <|> return ()+                return $ TokenBeginDocument as+            else do+                skipSpace+                x <- T.pack <$> manyTill anyChar (try $ string "?>")+                return $ TokenInstruction $ Instruction name x+    parseComment = do+        char' '-'+        char' '-'+        c <- T.pack <$> manyTill anyChar (string "-->") -- FIXME use takeWhile instead+        return $ TokenComment c+    parseCdata = do+        _ <- string "[CDATA["+        t <- T.pack <$> manyTill anyChar (string "]]>") -- FIXME use takeWhile instead+        return $ TokenCDATA t+    parseDoctype = do+        _ <- string "DOCTYPE"+        skipSpace+        i <- parseIdent+        skipSpace+        eid <- fmap Just parsePublicID <|>+               fmap Just parseSystemID <|>+               return Nothing+        skipSpace+        (do+            char' '['+            skipWhile (/= ']')+            char' ']'+            skipSpace) <|> return ()+        char' '>'+        newline <|> return ()+        return $ TokenDoctype i eid+    parsePublicID = do+        _ <- string "PUBLIC"+        x <- quotedText+        y <- quotedText+        return $ PublicID x y+    parseSystemID = do+        _ <- string "SYSTEM"+        x <- quotedText+        return $ SystemID x+    quotedText = do+        skipSpace+        between '"' <|> between '\''+    between c = do+        char' c+        x <- takeWhile (/=c)+        char' c+        return x+    parseEnd = do+        skipSpace+        n <- parseName+        skipSpace+        char' '>'+        return $ TokenEndElement n+    parseBegin = do+        skipSpace+        n <- parseName+        as <- A.many $ parseAttribute de+        skipSpace+        isClose <- (char '/' >> skipSpace >> return True) <|> return False+        char' '>'+        return $ TokenBeginElement n as isClose 0++parseAttribute :: DecodeEntities -> Parser TAttribute+parseAttribute de = do+    skipSpace+    key <- parseName+    skipSpace+    char' '='+    skipSpace+    val <- squoted <|> dquoted+    return (key, val)+  where+    squoted = do+        char' '\''+        manyTill (parseContent de False True) (char '\'')+    dquoted = do+        char' '"'+        manyTill (parseContent de True False) (char '"')++parseName :: Parser TName+parseName = do+    i1 <- parseIdent+    mi2 <- (char ':' >> fmap Just parseIdent) <|> return Nothing+    return $+        case mi2 of+            Nothing -> TName Nothing i1+            Just i2 -> TName (Just i1) i2++parseIdent :: Parser Text+parseIdent =+    takeWhile1 valid+  where+    valid '&' = False+    valid '<' = False+    valid '>' = False+    valid ':' = False+    valid '?' = False+    valid '=' = False+    valid '"' = False+    valid '\'' = False+    valid '/' = False+    valid c  = not $ isSpace c++parseContent :: DecodeEntities+             -> Bool -- break on double quote+             -> Bool -- break on single quote+             -> Parser Content+parseContent de breakDouble breakSingle =+    parseEntity <|> parseText'+  where+    parseEntity = do+        char' '&'+        t <- takeWhile1 (/= ';')+        char' ';'+        return $ de t+    parseText' = do+        bs <- takeWhile1 valid+        return $ ContentText bs+    valid '"' = not breakDouble+    valid '\'' = not breakSingle+    valid '&' = False -- amp+    valid '<' = False -- lt+    valid _  = True++skipSpace :: Parser ()+skipSpace = skipWhile isSpace++newline :: Parser ()+newline = ((char '\r' >> char '\n') <|> char '\n') >> return ()++char' :: Char -> Parser ()+char' c = char c >> return ()++data ContentType =+    Ignore | IsContent Text | IsError String | NotContent++-- | Grabs the next piece of content if available. This function skips over any+-- comments and instructions and concatenates all content until the next start+-- or end tag.+contentMaybe :: Monad m => Iteratee Event m (Maybe Text)+contentMaybe = do+    x <- E.peek+    case pc' x of+        Ignore -> EL.drop 1 >> contentMaybe+        IsContent t -> EL.drop 1 >> fmap Just (takeContents (t:))+        IsError e -> throwError $ XmlException e x+        NotContent -> return Nothing+  where+    pc' Nothing = NotContent+    pc' (Just x) = pc x+    pc (EventContent (ContentText t)) = IsContent t+    pc (EventContent (ContentEntity e)) = IsError $ "Unknown entity: " ++ show e+    pc (EventCDATA t) = IsContent t+    pc EventBeginElement{} = NotContent+    pc EventEndElement{} = NotContent+    pc EventBeginDocument{} = Ignore+    pc EventEndDocument = Ignore+    pc EventBeginDoctype{} = Ignore+    pc EventEndDoctype = Ignore+    pc EventInstruction{} = Ignore+    pc EventComment{} = Ignore+    takeContents front = do+        x <- E.peek+        case pc' x of+            Ignore -> EL.drop 1 >> takeContents front+            IsContent t -> EL.drop 1 >> takeContents (front . (:) t)+            IsError e -> throwError $ XmlException e x+            NotContent -> return $ T.concat $ front []++-- | Grabs the next piece of content. If none if available, returns 'T.empty'.+-- This is simply a wrapper around 'contentMaybe'.+content :: Monad m => Iteratee Event m Text+content = do+    x <- contentMaybe+    case x of+        Nothing -> return T.empty+        Just y -> return y++-- | The most generic way to parse a tag. It takes a predicate for checking if+-- this is the correct tag name, an 'AttrParser' for handling attributes, and+-- then a parser for dealing with content.+--+-- This function automatically absorbs its balancing closing tag, and will+-- throw an exception if not all of the attributes or child elements are+-- consumed. If you want to allow extra attributes, see 'ignoreAttrs'.+--+-- This function automatically ignores comments, instructions and whitespace.+tag :: Monad m+    => (Name -> Maybe a)+    -> (a -> AttrParser b)+    -> (b -> Iteratee Event m c)+    -> Iteratee Event m (Maybe c)+tag checkName attrParser f = do+    x <- dropWS+    case x of+        Just (EventBeginElement name as) ->+            case checkName name of+                Just y ->+                    case runAttrParser' (attrParser y) as of+                        Left e -> throwError e+                        Right z -> do+                            EL.drop 1+                            z' <- f z+                            a <- dropWS+                            case a of+                                Just (EventEndElement name')+                                    | name == name' -> EL.drop 1 >> return (Just z')+                                _ -> throwError $ XmlException ("Expected end tag for: " ++ show name) a+                Nothing -> return Nothing+        _ -> return Nothing+  where+    dropWS = do+        x <- E.peek+        let isWS =+                case x of+                    Just EventBeginDocument -> True+                    Just EventEndDocument -> True+                    Just EventBeginDoctype{} -> True+                    Just EventEndDoctype -> True+                    Just EventInstruction{} -> True+                    Just EventBeginElement{} -> False+                    Just EventEndElement{} -> False+                    Just (EventContent (ContentText t))+                        | T.all isSpace t -> True+                        | otherwise -> False+                    Just (EventContent ContentEntity{}) -> False+                    Just EventComment{} -> True+                    Just EventCDATA{} -> False+                    Nothing -> False+        if isWS then EL.drop 1 >> dropWS else return x+    runAttrParser' p as =+        case runAttrParser p as of+            Left e -> Left e+            Right ([], x) -> Right x+            Right (attr, _) -> Left $ UnparsedAttributes attr++-- | A simplified version of 'tag' which matches against boolean predicates.+tagPredicate :: Monad m => (Name -> Bool) -> AttrParser a -> (a -> Iteratee Event m b) -> Iteratee Event m (Maybe b)+tagPredicate p attrParser = tag (\x -> if p x then Just () else Nothing) (const attrParser)++-- | A simplified version of 'tag' which matches for specific tag names instead+-- of taking a predicate function. This is often sufficient, and when combined+-- with OverloadedStrings and the IsString instance of 'Name', can prove to be+-- very concise.+tagName :: Monad m+     => Name+     -> AttrParser a+     -> (a -> Iteratee Event m b)+     -> Iteratee Event m (Maybe b)+tagName name = tagPredicate (== name)++-- | A further simplified tag parser, which requires that no attributes exist.+tagNoAttr :: Monad m => Name -> Iteratee Event m a -> Iteratee Event m (Maybe a)+tagNoAttr name f = tagName name (return ()) $ const f++-- | Get the value of the first parser which returns 'Just'. If no parsers+-- succeed (i.e., return 'Just'), this function returns 'Nothing'.+--+-- > orE a b = choose [a, b]+orE :: Monad m => Iteratee Event m (Maybe a) -> Iteratee Event m (Maybe a) -> Iteratee Event m (Maybe a)+orE a b = do+  x <- a+  case x of+    Nothing -> b+    _ -> return x++-- | Get the value of the first parser which returns 'Just'. If no parsers+-- succeed (i.e., return 'Just'), this function returns 'Nothing'.+choose :: Monad m+       => [Iteratee Event m (Maybe a)]+       -> Iteratee Event m (Maybe a)+choose [] = return Nothing+choose (i:is) = do+    x <- i+    case x of+        Nothing -> choose is+        Just a -> return $ Just a++-- | Force an optional parser into a required parser. All of the 'tag'+-- functions, 'choose' and 'many' deal with 'Maybe' parsers. Use this when you+-- want to finally force something to happen.+force :: Monad m+      => String -- ^ Error message+      -> Iteratee Event m (Maybe a)+      -> Iteratee Event m a+force msg i = do+    x <- i+    case x of+        Nothing -> throwError $ XmlException msg Nothing+        Just a -> return a++-- | The same as 'parseFile', but throws any exceptions.+parseFile_ :: FilePath -> DecodeEntities -> Iteratee Event IO a -> IO a+parseFile_ fn de p =+    parseFile fn de p >>= go+  where+    go (Left e) = liftIO $ throwIO e+    go (Right a) = return a++-- | A helper function which reads a file from disk using 'enumFile', detects+-- character encoding using 'detectUtf', parses the XML using 'parseBytes', and+-- then hands off control to your supplied parser.+parseFile :: FilePath+          -> DecodeEntities+          -> Iteratee Event IO a+          -> IO (Either SomeException a)+parseFile fn de p =+    run $ enumFile fn     $$ joinI+        $ parseBytes de   $$ p++-- | Parse an event stream from a lazy 'L.ByteString'.+parseLBS :: L.ByteString -> DecodeEntities -> Iteratee Event IO a -> IO (Either SomeException a)+parseLBS lbs de p =+    run $ enumSingle (L.toChunks lbs)   $$ joinI+        $ parseBytes de                 $$ p++-- | Same as 'parseLBS', but throws exceptions.+parseLBS_ :: L.ByteString -> DecodeEntities -> Iteratee Event IO a -> IO a+parseLBS_ lbs de p =+    run_ $ enumSingle (L.toChunks lbs)   $$ joinI+         $ parseBytes de                 $$ p++enumSingle :: Monad m => [a] -> Enumerator a m b+enumSingle as (Continue k) = k $ Chunks as+enumSingle _ step = returnI step++data XmlException = XmlException+    { xmlErrorMessage :: String+    , xmlBadInput :: Maybe Event+    }+                  | InvalidEndElement Name+                  | InvalidEntity Text+                  | UnparsedAttributes [(Name, [Content])]+    deriving (Show, Typeable)+instance Exception XmlException++-- | A monad for parsing attributes. By default, it requires you to deal with+-- all attributes present on an element, and will throw an exception if there+-- are unhandled attributes. Use the 'requireAttr', 'optionalAttr' et al+-- functions for handling an attribute, and 'ignoreAttrs' if you would like to+-- skip the rest of the attributes on an element.+newtype AttrParser a = AttrParser { runAttrParser :: [(Name, [Content])] -> Either XmlException ([(Name, [Content])], a) }++instance Monad AttrParser where+    return a = AttrParser $ \as -> Right (as, a)+    (AttrParser f) >>= g = AttrParser $ \as ->+        case f as of+            Left e -> Left e+            Right (as', f') -> runAttrParser (g f') as'+instance Functor AttrParser where+    fmap = liftM+instance Applicative AttrParser where+    pure = return+    (<*>) = ap++optionalAttrRaw :: ((Name, [Content]) -> Maybe b) -> AttrParser (Maybe b)+optionalAttrRaw f =+    AttrParser $ go id+  where+    go front [] = Right (front [], Nothing)+    go front (a:as) =+        case f a of+            Nothing -> go (front . (:) a) as+            Just b -> Right (front as, Just b)++requireAttrRaw :: String -> ((Name, [Content]) -> Maybe b) -> AttrParser b+requireAttrRaw msg f = do+    x <- optionalAttrRaw f+    case x of+        Just b -> return b+        Nothing -> AttrParser $ const $ Left $ XmlException msg Nothing++-- | Require that a certain attribute be present and return its value.+requireAttr :: Name -> AttrParser Text+requireAttr n = requireAttrRaw+    ("Missing attribute: " ++ show n)+    (\(x, y) -> if x == n then Just (contentsToText y) else Nothing)++-- | Return the value for an attribute if present.+optionalAttr :: Name -> AttrParser (Maybe Text)+optionalAttr n = optionalAttrRaw+    (\(x, y) -> if x == n then Just (contentsToText y) else Nothing)++contentsToText :: [Content] -> Text+contentsToText =+    T.concat . map toText+  where+    toText (ContentText t) = t+    toText (ContentEntity e) = T.concat ["&", e, ";"]++-- | Skip the remaining attributes on an element. Since this will clear the+-- list of attributes, you must call this /after/ any calls to 'requireAttr',+-- 'optionalAttr', etc.+ignoreAttrs :: AttrParser ()+ignoreAttrs = AttrParser $ \_ -> Right ([], ())++-- | Keep parsing elements as long as the parser returns 'Just'.+many :: Monad m => Iteratee Event m (Maybe a) -> Iteratee Event m [a]+many i =+    go id+  where+    go front = do+        x <- i+        case x of+            Nothing -> return $ front []+            Just y -> go $ front . (:) y++type DecodeEntities = Text -> Content++-- | Default implementation of 'DecodeEntities': handles numeric entities and+-- the five standard character entities (lt, gt, amp, quot, apos).+decodeEntities :: DecodeEntities+decodeEntities "lt" = ContentText "<"+decodeEntities "gt" = ContentText ">"+decodeEntities "amp" = ContentText "&"+decodeEntities "quot" = ContentText "\""+decodeEntities "apos" = ContentText "'"+decodeEntities t =+    case T.uncons t of+        Just ('#', t') ->+            case T.uncons t' of+                Just ('x', t'') -> decodeHex (ContentEntity t) t''+                _ -> decodeDec (ContentEntity t) t'+        _ -> ContentEntity t++decodeHex :: Content -> Text -> Content+decodeHex backup val+    | T.null val = backup+decodeHex backup val =+    go (T.unpack val) 0+  where+    go [] i = ContentText $ T.singleton $ toEnum i+    go (c:cs) i = maybe backup (go cs . ((i * 16) +)) $ getHex c+    getHex c+        | '0' <= c && c <= '9' = Just $ fromEnum c - fromEnum '0'+        | 'A' <= c && c <= 'F' = Just $ fromEnum c - fromEnum 'A' + 10+        | 'a' <= c && c <= 'f' = Just $ fromEnum c - fromEnum 'a' + 10+        | otherwise = Nothing++decodeDec :: Content -> Text -> Content+decodeDec backup val+    | T.null val = backup+decodeDec backup val =+    go (T.unpack val) 0+  where+    go [] i = ContentText $ T.singleton $ toEnum i+    go (c:cs) i = maybe backup (go cs . ((i * 10) +)) $ getHex c+    getHex c+        | '0' <= c && c <= '9' = Just $ fromEnum c - fromEnum '0'+        | otherwise = Nothing

@@ -1,268 +1,268 @@-{-# LANGUAGE OverloadedStrings #-}
--- | 'Enumeratee's to render XML 'Event's. Unlike libxml-enumerator and
--- expat-enumerator, this module does not provide IO and ST variants, since the
--- underlying rendering operations are pure functions.
-module Text.XML.Enumerator.Render
-    ( renderBuilder
-    , renderBytes
-    , renderText
-    , prettyBuilder
-    , prettyBytes
-    , prettyText
-    ) where
-
-import Data.XML.Types (Event (..), Content (..), Name (..))
-import Text.XML.Enumerator.Token
-import qualified Data.Enumerator as E
-import qualified Data.Enumerator.List as EL
-import qualified Data.Enumerator.Text as ET
-import Data.Enumerator ((>>==), ($$), Iteratee, Step (..))
-import qualified Data.Text as T
-import Data.Text (Text)
-import Blaze.ByteString.Builder
-import Blaze.ByteString.Builder.Enumerator (builderToByteString)
-import qualified Data.Map as Map
-import Data.Map (Map)
-import Data.Maybe (fromMaybe)
-import Data.ByteString (ByteString)
-import Control.Monad.IO.Class (MonadIO)
-import Data.Char (isSpace)
-
--- | Pretty prints a stream of 'Event's into a stream of 'Builder's. This
--- changes the meaning of some documents, by inserting/modifying whitespace.
-prettyBuilder :: Monad m => E.Enumeratee Event Builder m b
-prettyBuilder step0 =
-    E.joinI $ prettify 0 [] $$ loop [] step0
-  where
-    loop stack = E.checkDone $ step stack
-    step stack k = do
-        x <- EL.head
-        case x of
-            Nothing -> E.yield (E.Continue k) E.EOF
-            Just (EventBeginElement name as) -> do
-                x' <- E.peek
-                if x' == Just (EventEndElement name)
-                    then do
-                        EL.drop 1
-                        go $ mkBeginToken True True stack name as
-                    else go $ mkBeginToken True False stack name as
-            Just e -> go $ eventToToken stack e
-      where
-        go (ts, stack') = k (E.Chunks $ map tokenToBuilder $ ts []) >>== loop stack'
-
--- | Same as 'prettyBuilder', but produces a stream of 'ByteString's.
-prettyBytes :: MonadIO m => E.Enumeratee Event ByteString m b
-prettyBytes s = E.joinI $ prettyBuilder $$ builderToByteString s
-
--- | Same as 'prettyBuilder', but produces a stream of 'Text's.
-prettyText :: MonadIO m => E.Enumeratee Event Text m b
-prettyText s = E.joinI $ prettyBytes $$ ET.decode ET.utf8 s
-
--- | Render a stream of 'Event's into a stream of 'ByteString's. This function
--- wraps around 'renderBuilder' and 'builderToByteString', so it produces
--- optimally sized 'ByteString's with minimal buffer copying.
---
--- The output is UTF8 encoded.
-renderBytes :: MonadIO m => E.Enumeratee Event ByteString m b
-renderBytes s = E.joinI $ renderBuilder $$ builderToByteString s
-
--- | Render a stream of 'Event's into a stream of 'ByteString's. This function
--- wraps around 'renderBuilder', 'builderToByteString' and 'renderBytes', so it
--- produces optimally sized 'ByteString's with minimal buffer copying.
-renderText :: MonadIO m => E.Enumeratee Event Text m b
-renderText s = E.joinI $ renderBytes $$ ET.decode ET.utf8 s
-
--- | Render a stream of 'Event's into a stream of 'Builder's. Builders are from
--- the blaze-builder package, and allow the create of optimally sized
--- 'ByteString's with minimal buffer copying.
-renderBuilder :: Monad m => E.Enumeratee Event Builder m b
-renderBuilder =
-    loop []
-  where
-    loop stack = E.checkDone $ step stack
-    step stack k = do
-        x <- EL.head
-        case x of
-            Nothing -> E.yield (E.Continue k) E.EOF
-            Just (EventBeginElement name as) -> do
-                x' <- E.peek
-                if x' == Just (EventEndElement name)
-                    then do
-                        EL.drop 1
-                        go $ mkBeginToken False True stack name as
-                    else go $ mkBeginToken False False stack name as
-            Just e -> go $ eventToToken stack e
-      where
-        go (ts, stack') = k (E.Chunks $ map tokenToBuilder $ ts []) >>== loop stack'
-
-eventToToken :: Stack -> Event -> ([Token] -> [Token], [NSLevel])
-eventToToken s EventBeginDocument =
-    ((:) (TokenBeginDocument
-            [ ("version", [ContentText "1.0"])
-            , ("encoding", [ContentText "UTF-8"])
-            ])
-     , s)
-eventToToken s EventEndDocument = (id, s)
-eventToToken s (EventInstruction i) = ((:) (TokenInstruction i), s)
-eventToToken s (EventBeginDoctype n meid) = ((:) (TokenDoctype n meid), s)
-eventToToken s EventEndDoctype = (id, s)
-eventToToken s (EventCDATA t) = ((:) (TokenCDATA t), s)
-eventToToken s (EventEndElement name) =
-    ((:) (TokenEndElement $ nameToTName sl name), s')
-  where
-    (sl:s') = s
-eventToToken s (EventContent c) = ((:) (TokenContent c), s)
-eventToToken s (EventComment t) = ((:) (TokenComment t), s)
-eventToToken _ EventBeginElement{} = error "eventToToken on EventBeginElement" -- mkBeginToken False s name attrs
-
-type Stack = [NSLevel]
-
-nameToTName :: NSLevel -> Name -> TName
-nameToTName _ (Name name _ (Just pref))
-    | pref == "xml" = TName (Just "xml") name
-nameToTName _ (Name name Nothing _) = TName Nothing name -- invariant that this is true
-nameToTName (NSLevel def sl) (Name name (Just ns) _)
-    | def == Just ns = TName Nothing name
-    | otherwise =
-        case Map.lookup ns sl of
-            Nothing -> error "nameToTName"
-            Just pref -> TName (Just pref) name
-
-mkBeginToken :: Bool -- ^ pretty print attributes?
-             -> Bool -> Stack -> Name -> [(Name, [Content])]
-             -> ([Token] -> [Token], Stack)
-mkBeginToken isPretty isClosed s name attrs =
-    ((:) (TokenBeginElement tname tattrs2 isClosed indent),
-     if isClosed then s else sl2 : s)
-  where
-    indent = if isPretty then 2 + 4 * length s else 0
-    prevsl = case s of
-                [] -> NSLevel Nothing Map.empty
-                sl':_ -> sl'
-    (sl1, tname, tattrs1) = newElemStack prevsl name
-    (sl2, tattrs2) = foldr newAttrStack (sl1, tattrs1) attrs
-
-newElemStack :: NSLevel -> Name -> (NSLevel, TName, [TAttribute])
-newElemStack nsl@(NSLevel def _) (Name local ns _)
-    | def == ns = (nsl, TName Nothing local, [])
-newElemStack (NSLevel _ nsmap) (Name local Nothing _) =
-    (NSLevel Nothing nsmap, TName Nothing local, [(TName Nothing "xmlns", [])])
-newElemStack (NSLevel _ nsmap) (Name local (Just ns) Nothing) =
-    (NSLevel (Just ns) nsmap, TName Nothing local, [(TName Nothing "xmlns", [ContentText ns])])
-newElemStack (NSLevel def nsmap) (Name local (Just ns) (Just pref)) =
-    case Map.lookup ns nsmap of
-        Just pref'
-            | pref == pref' ->
-                ( NSLevel def nsmap
-                , TName (Just pref) local
-                , []
-                )
-        _ -> ( NSLevel def nsmap'
-             , TName (Just pref) local
-             , [(TName (Just "xmlns") pref, [ContentText ns])]
-             )
-  where
-    nsmap' = Map.insert ns pref nsmap
-
-newAttrStack :: (Name, [Content]) -> (NSLevel, [TAttribute]) -> (NSLevel, [TAttribute])
-newAttrStack (name, value) (NSLevel def nsmap, attrs) =
-    (NSLevel def nsmap', addNS $ (tname, value) : attrs)
-  where
-    (nsmap', tname, addNS) =
-        case name of
-            Name local Nothing _ -> (nsmap, TName Nothing local, id)
-            Name local (Just ns) mpref ->
-                let ppref = fromMaybe "ns" mpref
-                    (pref, addNS') = getPrefix ppref nsmap ns
-                 in (Map.insert ns pref nsmap, TName (Just pref) local, addNS')
-
-getPrefix :: Text -> Map Text Text -> Text -> (Text, [TAttribute] -> [TAttribute])
-getPrefix _ _ "http://www.w3.org/XML/1998/namespace" = ("xml", id)
-getPrefix ppref nsmap ns =
-    case Map.lookup ns nsmap of
-        Just pref -> (pref, id)
-        Nothing ->
-            let pref = findUnused ppref $ Map.elems nsmap
-             in (pref, (:) (TName (Just "xmlns") pref, [ContentText ns]))
-  where
-    findUnused x xs
-        | x `elem` xs = findUnused (x `T.snoc` '_') xs
-        | otherwise = x
-
-prettify :: Monad m => Int -> [Name] -> E.Enumeratee Event Event m a
-prettify level names (Continue k) = do
-    mx <- eventHead
-    case mx of
-        Nothing -> return $ Continue k
-        Just x -> do
-            y <- E.peek
-            (chunks, level', names') <-
-                case (x, y) of
-                    (Left contents, _) -> do
-                        let es = map EventContent $ cleanWhite contents
-                        let es' = if null es
-                                    then []
-                                    else before level : es ++ [after]
-                        return (es', level, names)
-                    (Right (EventBeginElement name attrs), Just (EventEndElement _)) -> do
-                        EL.drop 1
-                        return ([before level, EventBeginElement name attrs, EventEndElement name, after], level, names)
-                    (Right (EventBeginElement name attrs), _) -> do
-                        return ([before level, EventBeginElement name attrs, after], level + 1, name : names)
-                    (Right (EventEndElement _), _) -> do
-                        let newLevel = level - 1
-                        return ([before newLevel, EventEndElement $ head names, after], newLevel, tail names)
-                    (Right EventBeginDocument, _) -> do
-                        _ <- takeContents id
-                        return ([EventBeginDocument], level, names)
-                    (Right EventEndDocument, _) -> do
-                        _ <- takeContents id
-                        return ([EventEndDocument, after], level, names)
-                    (Right (EventComment t), _) -> do
-                        _ <- takeContents id
-                        return ([before level, EventComment $ T.map normalSpace t, after], level, names)
-                    (Right e, _) -> do
-                        _ <- takeContents id
-                        return ([before level, e, after], level, names)
-            k (E.Chunks chunks) >>== prettify level' names'
-  where
-    before l = EventContent $ ContentText $ T.replicate l "    "
-    after = EventContent $ ContentText "\n"
-prettify _ _ step = return step
-
-eventHead :: Monad m => Iteratee Event m (Maybe (Either [Content] Event))
-eventHead = do
-    x <- EL.head
-    case x of
-        Just (EventContent e) -> do
-            es <- takeContents id
-            return $ Just $ Left $ e : es
-        Nothing -> return Nothing
-        Just e -> return $ Just $ Right e
-
-takeContents :: Monad m => ([Content] -> [Content]) -> Iteratee Event m [Content]
-takeContents front = do
-    x <- E.peek
-    case x of
-        Just (EventContent e) -> do
-            EL.drop 1
-            takeContents $ front . (:) e
-        _ -> return $ front []
-
-normalSpace :: Char -> Char
-normalSpace c
-    | isSpace c = ' '
-    | otherwise = c
-
-cleanWhite :: [Content] -> [Content]
-cleanWhite x =
-    go True [] $ go True [] x
-  where
-    go _ end (ContentEntity e:rest) = go False (ContentEntity e : end) rest
-    go isFront end (ContentText t:rest) =
-        if T.null t'
-            then go isFront end rest
-            else go False (ContentText t' : end) rest
-      where
-        t' = (if isFront then T.dropWhile isSpace else id) $ T.map normalSpace t
-    go _ end [] = end
+{-# LANGUAGE OverloadedStrings #-}+-- | 'Enumeratee's to render XML 'Event's. Unlike libxml-enumerator and+-- expat-enumerator, this module does not provide IO and ST variants, since the+-- underlying rendering operations are pure functions.+module Text.XML.Enumerator.Render+    ( renderBuilder+    , renderBytes+    , renderText+    , prettyBuilder+    , prettyBytes+    , prettyText+    ) where++import Data.XML.Types (Event (..), Content (..), Name (..))+import Text.XML.Enumerator.Token+import qualified Data.Enumerator as E+import qualified Data.Enumerator.List as EL+import qualified Data.Enumerator.Text as ET+import Data.Enumerator ((>>==), ($$), Iteratee, Step (..))+import qualified Data.Text as T+import Data.Text (Text)+import Blaze.ByteString.Builder+import Blaze.ByteString.Builder.Enumerator (builderToByteString)+import qualified Data.Map as Map+import Data.Map (Map)+import Data.Maybe (fromMaybe)+import Data.ByteString (ByteString)+import Control.Monad.IO.Class (MonadIO)+import Data.Char (isSpace)++-- | Pretty prints a stream of 'Event's into a stream of 'Builder's. This+-- changes the meaning of some documents, by inserting/modifying whitespace.+prettyBuilder :: Monad m => E.Enumeratee Event Builder m b+prettyBuilder step0 =+    E.joinI $ prettify 0 [] $$ loop [] step0+  where+    loop stack = E.checkDone $ step stack+    step stack k = do+        x <- EL.head+        case x of+            Nothing -> E.yield (E.Continue k) E.EOF+            Just (EventBeginElement name as) -> do+                x' <- E.peek+                if x' == Just (EventEndElement name)+                    then do+                        EL.drop 1+                        go $ mkBeginToken True True stack name as+                    else go $ mkBeginToken True False stack name as+            Just e -> go $ eventToToken stack e+      where+        go (ts, stack') = k (E.Chunks $ map tokenToBuilder $ ts []) >>== loop stack'++-- | Same as 'prettyBuilder', but produces a stream of 'ByteString's.+prettyBytes :: MonadIO m => E.Enumeratee Event ByteString m b+prettyBytes s = E.joinI $ prettyBuilder $$ builderToByteString s++-- | Same as 'prettyBuilder', but produces a stream of 'Text's.+prettyText :: MonadIO m => E.Enumeratee Event Text m b+prettyText s = E.joinI $ prettyBytes $$ ET.decode ET.utf8 s++-- | Render a stream of 'Event's into a stream of 'ByteString's. This function+-- wraps around 'renderBuilder' and 'builderToByteString', so it produces+-- optimally sized 'ByteString's with minimal buffer copying.+--+-- The output is UTF8 encoded.+renderBytes :: MonadIO m => E.Enumeratee Event ByteString m b+renderBytes s = E.joinI $ renderBuilder $$ builderToByteString s++-- | Render a stream of 'Event's into a stream of 'ByteString's. This function+-- wraps around 'renderBuilder', 'builderToByteString' and 'renderBytes', so it+-- produces optimally sized 'ByteString's with minimal buffer copying.+renderText :: MonadIO m => E.Enumeratee Event Text m b+renderText s = E.joinI $ renderBytes $$ ET.decode ET.utf8 s++-- | Render a stream of 'Event's into a stream of 'Builder's. Builders are from+-- the blaze-builder package, and allow the create of optimally sized+-- 'ByteString's with minimal buffer copying.+renderBuilder :: Monad m => E.Enumeratee Event Builder m b+renderBuilder =+    loop []+  where+    loop stack = E.checkDone $ step stack+    step stack k = do+        x <- EL.head+        case x of+            Nothing -> E.yield (E.Continue k) E.EOF+            Just (EventBeginElement name as) -> do+                x' <- E.peek+                if x' == Just (EventEndElement name)+                    then do+                        EL.drop 1+                        go $ mkBeginToken False True stack name as+                    else go $ mkBeginToken False False stack name as+            Just e -> go $ eventToToken stack e+      where+        go (ts, stack') = k (E.Chunks $ map tokenToBuilder $ ts []) >>== loop stack'++eventToToken :: Stack -> Event -> ([Token] -> [Token], [NSLevel])+eventToToken s EventBeginDocument =+    ((:) (TokenBeginDocument+            [ ("version", [ContentText "1.0"])+            , ("encoding", [ContentText "UTF-8"])+            ])+     , s)+eventToToken s EventEndDocument = (id, s)+eventToToken s (EventInstruction i) = ((:) (TokenInstruction i), s)+eventToToken s (EventBeginDoctype n meid) = ((:) (TokenDoctype n meid), s)+eventToToken s EventEndDoctype = (id, s)+eventToToken s (EventCDATA t) = ((:) (TokenCDATA t), s)+eventToToken s (EventEndElement name) =+    ((:) (TokenEndElement $ nameToTName sl name), s')+  where+    (sl:s') = s+eventToToken s (EventContent c) = ((:) (TokenContent c), s)+eventToToken s (EventComment t) = ((:) (TokenComment t), s)+eventToToken _ EventBeginElement{} = error "eventToToken on EventBeginElement" -- mkBeginToken False s name attrs++type Stack = [NSLevel]++nameToTName :: NSLevel -> Name -> TName+nameToTName _ (Name name _ (Just pref))+    | pref == "xml" = TName (Just "xml") name+nameToTName _ (Name name Nothing _) = TName Nothing name -- invariant that this is true+nameToTName (NSLevel def sl) (Name name (Just ns) _)+    | def == Just ns = TName Nothing name+    | otherwise =+        case Map.lookup ns sl of+            Nothing -> error "nameToTName"+            Just pref -> TName (Just pref) name++mkBeginToken :: Bool -- ^ pretty print attributes?+             -> Bool -> Stack -> Name -> [(Name, [Content])]+             -> ([Token] -> [Token], Stack)+mkBeginToken isPretty isClosed s name attrs =+    ((:) (TokenBeginElement tname tattrs2 isClosed indent),+     if isClosed then s else sl2 : s)+  where+    indent = if isPretty then 2 + 4 * length s else 0+    prevsl = case s of+                [] -> NSLevel Nothing Map.empty+                sl':_ -> sl'+    (sl1, tname, tattrs1) = newElemStack prevsl name+    (sl2, tattrs2) = foldr newAttrStack (sl1, tattrs1) attrs++newElemStack :: NSLevel -> Name -> (NSLevel, TName, [TAttribute])+newElemStack nsl@(NSLevel def _) (Name local ns _)+    | def == ns = (nsl, TName Nothing local, [])+newElemStack (NSLevel _ nsmap) (Name local Nothing _) =+    (NSLevel Nothing nsmap, TName Nothing local, [(TName Nothing "xmlns", [])])+newElemStack (NSLevel _ nsmap) (Name local (Just ns) Nothing) =+    (NSLevel (Just ns) nsmap, TName Nothing local, [(TName Nothing "xmlns", [ContentText ns])])+newElemStack (NSLevel def nsmap) (Name local (Just ns) (Just pref)) =+    case Map.lookup ns nsmap of+        Just pref'+            | pref == pref' ->+                ( NSLevel def nsmap+                , TName (Just pref) local+                , []+                )+        _ -> ( NSLevel def nsmap'+             , TName (Just pref) local+             , [(TName (Just "xmlns") pref, [ContentText ns])]+             )+  where+    nsmap' = Map.insert ns pref nsmap++newAttrStack :: (Name, [Content]) -> (NSLevel, [TAttribute]) -> (NSLevel, [TAttribute])+newAttrStack (name, value) (NSLevel def nsmap, attrs) =+    (NSLevel def nsmap', addNS $ (tname, value) : attrs)+  where+    (nsmap', tname, addNS) =+        case name of+            Name local Nothing _ -> (nsmap, TName Nothing local, id)+            Name local (Just ns) mpref ->+                let ppref = fromMaybe "ns" mpref+                    (pref, addNS') = getPrefix ppref nsmap ns+                 in (Map.insert ns pref nsmap, TName (Just pref) local, addNS')++getPrefix :: Text -> Map Text Text -> Text -> (Text, [TAttribute] -> [TAttribute])+getPrefix _ _ "http://www.w3.org/XML/1998/namespace" = ("xml", id)+getPrefix ppref nsmap ns =+    case Map.lookup ns nsmap of+        Just pref -> (pref, id)+        Nothing ->+            let pref = findUnused ppref $ Map.elems nsmap+             in (pref, (:) (TName (Just "xmlns") pref, [ContentText ns]))+  where+    findUnused x xs+        | x `elem` xs = findUnused (x `T.snoc` '_') xs+        | otherwise = x++prettify :: Monad m => Int -> [Name] -> E.Enumeratee Event Event m a+prettify level names (Continue k) = do+    mx <- eventHead+    case mx of+        Nothing -> return $ Continue k+        Just x -> do+            y <- E.peek+            (chunks, level', names') <-+                case (x, y) of+                    (Left contents, _) -> do+                        let es = map EventContent $ cleanWhite contents+                        let es' = if null es+                                    then []+                                    else before level : es ++ [after]+                        return (es', level, names)+                    (Right (EventBeginElement name attrs), Just (EventEndElement _)) -> do+                        EL.drop 1+                        return ([before level, EventBeginElement name attrs, EventEndElement name, after], level, names)+                    (Right (EventBeginElement name attrs), _) -> do+                        return ([before level, EventBeginElement name attrs, after], level + 1, name : names)+                    (Right (EventEndElement _), _) -> do+                        let newLevel = level - 1+                        return ([before newLevel, EventEndElement $ head names, after], newLevel, tail names)+                    (Right EventBeginDocument, _) -> do+                        _ <- takeContents id+                        return ([EventBeginDocument], level, names)+                    (Right EventEndDocument, _) -> do+                        _ <- takeContents id+                        return ([EventEndDocument, after], level, names)+                    (Right (EventComment t), _) -> do+                        _ <- takeContents id+                        return ([before level, EventComment $ T.map normalSpace t, after], level, names)+                    (Right e, _) -> do+                        _ <- takeContents id+                        return ([before level, e, after], level, names)+            k (E.Chunks chunks) >>== prettify level' names'+  where+    before l = EventContent $ ContentText $ T.replicate l "    "+    after = EventContent $ ContentText "\n"+prettify _ _ step = return step++eventHead :: Monad m => Iteratee Event m (Maybe (Either [Content] Event))+eventHead = do+    x <- EL.head+    case x of+        Just (EventContent e) -> do+            es <- takeContents id+            return $ Just $ Left $ e : es+        Nothing -> return Nothing+        Just e -> return $ Just $ Right e++takeContents :: Monad m => ([Content] -> [Content]) -> Iteratee Event m [Content]+takeContents front = do+    x <- E.peek+    case x of+        Just (EventContent e) -> do+            EL.drop 1+            takeContents $ front . (:) e+        _ -> return $ front []++normalSpace :: Char -> Char+normalSpace c+    | isSpace c = ' '+    | otherwise = c++cleanWhite :: [Content] -> [Content]+cleanWhite x =+    go True [] $ go True [] x+  where+    go _ end (ContentEntity e:rest) = go False (ContentEntity e : end) rest+    go isFront end (ContentText t:rest) =+        if T.null t'+            then go isFront end rest+            else go False (ContentText t' : end) rest+      where+        t' = (if isFront then T.dropWhile isSpace else id) $ T.map normalSpace t+    go _ end [] = end

@@ -1,151 +1,151 @@-{-# LANGUAGE OverloadedStrings #-}
-module Text.XML.Enumerator.Token
-    ( tokenToBuilder
-    , TName (..)
-    , Token (..)
-    , TAttribute
-    , NSLevel (..)
-    ) where
-
-import Data.XML.Types (Instruction (..), Content (..), ExternalID (..))
-import qualified Data.Text as T
-import Data.Text (Text)
-import Data.String (IsString (fromString))
-import Blaze.ByteString.Builder
-    (Builder, fromByteString, writeByteString, copyByteString)
-import Blaze.ByteString.Builder.Internal.Write (fromWriteList)
-import Blaze.ByteString.Builder.Char.Utf8 (writeChar, fromText)
-import Data.Monoid (mconcat, mempty, mappend)
-import Data.ByteString.Char8 ()
-import Data.Map (Map)
-import qualified Blaze.ByteString.Builder.Char8 as BC8
-
-oneSpace :: Builder
-oneSpace = copyByteString " "
-
-data Token = TokenBeginDocument [TAttribute]
-           | TokenInstruction Instruction
-           | TokenBeginElement TName [TAttribute] Bool Int -- ^ indent
-           | TokenEndElement TName
-           | TokenContent Content
-           | TokenComment Text
-           | TokenDoctype Text (Maybe ExternalID)
-           | TokenCDATA Text
-    deriving Show
-tokenToBuilder :: Token -> Builder
-tokenToBuilder (TokenBeginDocument attrs) =
-    fromByteString "<?xml"
-    `mappend` foldAttrs oneSpace attrs (fromByteString "?>\n")
-tokenToBuilder (TokenInstruction (Instruction target data_)) = mconcat
-    [ fromByteString "<?"
-    , fromText target
-    , fromByteString " "
-    , fromText data_
-    , fromByteString "?>"
-    ]
-tokenToBuilder (TokenBeginElement name attrs isEmpty indent) =
-      copyByteString "<"
-    `mappend` tnameToText name
-    `mappend` foldAttrs
-        (if indent == 0 || lessThan3 attrs
-            then oneSpace
-            else BC8.fromString ('\n' : replicate indent ' '))
-        attrs
-        (if isEmpty then fromByteString "/>" else fromByteString ">")
-  where
-    lessThan3 [] = True
-    lessThan3 [_] = True
-    lessThan3 [_, _] = True
-    lessThan3 _ = False
-tokenToBuilder (TokenEndElement name) = mconcat
-    [ fromByteString "</"
-    , tnameToText name
-    , fromByteString ">"
-    ]
-tokenToBuilder (TokenContent c) = contentToText c
-tokenToBuilder (TokenCDATA t) =
-    copyByteString "<![CDATA["
-    `mappend` fromText t
-    `mappend` copyByteString "]]>"
-tokenToBuilder (TokenComment t) = mconcat [fromByteString "<!--", fromText t, fromByteString "-->"]
-tokenToBuilder (TokenDoctype name eid) = mconcat
-    [ fromByteString "<!DOCTYPE "
-    , fromText name
-    , go eid
-    , fromByteString ">\n"
-    ]
-  where
-    go Nothing = mempty
-    go (Just (SystemID uri)) = mconcat
-        [ fromByteString " SYSTEM \""
-        , fromText uri
-        , fromByteString "\""
-        ]
-    go (Just (PublicID pid uri)) = mconcat
-        [ fromByteString " PUBLIC \""
-        , fromText pid
-        , fromByteString "\" \""
-        , fromText uri
-        , fromByteString "\""
-        ]
-
-data TName = TName (Maybe Text) Text
-    deriving Show
-
-tnameToText :: TName -> Builder
-tnameToText (TName Nothing name) = fromText name
-tnameToText (TName (Just prefix) name) = mconcat [fromText prefix, fromByteString ":", fromText name]
-
-contentToText :: Content -> Builder
-contentToText (ContentText t) =
-    fromWriteList go $ T.unpack t
-  where
-    go '<' = writeByteString "&lt;"
-    go '>' = writeByteString "&gt;"
-    go '&' = writeByteString "&amp;"
-    -- Not escaping quotes, since this is only called outside of attributes
-    go c   = writeChar c
-contentToText (ContentEntity e) = mconcat
-    [ fromByteString "&"
-    , fromText e
-    , fromByteString ";"
-    ]
-
-type TAttribute = (TName, [Content])
-
-foldAttrs :: Builder -- ^ before
-          -> [TAttribute]
-          -> Builder
-          -> Builder
-foldAttrs before attrs rest' =
-    foldr go rest' attrs
-  where
-    go (key, val) rest =
-      before
-      `mappend` tnameToText key
-      `mappend` copyByteString "=\""
-      `mappend` foldr go' (fromByteString "\"" `mappend` rest) val
-    go' (ContentText t) rest =
-        fromWriteList h (T.unpack t) `mappend` rest
-      where
-        h '<' = writeByteString "&lt;"
-        h '>' = writeByteString "&gt;"
-        h '&' = writeByteString "&amp;"
-        h '"' = writeByteString "&quot;"
-        -- Not escaping single quotes, since our attributes are always double
-        -- quoted
-        h c   = writeChar c
-    go' (ContentEntity t) rest =
-        fromByteString "&"
-        `mappend` fromText t
-        `mappend` fromByteString ";"
-        `mappend` rest
-
-instance IsString TName where
-    fromString = TName Nothing . T.pack
-
-data NSLevel = NSLevel
-    { defaultNS :: Maybe Text
-    , prefixes :: Map Text Text
-    }
-    deriving Show
+{-# LANGUAGE OverloadedStrings #-}+module Text.XML.Enumerator.Token+    ( tokenToBuilder+    , TName (..)+    , Token (..)+    , TAttribute+    , NSLevel (..)+    ) where++import Data.XML.Types (Instruction (..), Content (..), ExternalID (..))+import qualified Data.Text as T+import Data.Text (Text)+import Data.String (IsString (fromString))+import Blaze.ByteString.Builder+    (Builder, fromByteString, writeByteString, copyByteString)+import Blaze.ByteString.Builder.Internal.Write (fromWriteList)+import Blaze.ByteString.Builder.Char.Utf8 (writeChar, fromText)+import Data.Monoid (mconcat, mempty, mappend)+import Data.ByteString.Char8 ()+import Data.Map (Map)+import qualified Blaze.ByteString.Builder.Char8 as BC8++oneSpace :: Builder+oneSpace = copyByteString " "++data Token = TokenBeginDocument [TAttribute]+           | TokenInstruction Instruction+           | TokenBeginElement TName [TAttribute] Bool Int -- ^ indent+           | TokenEndElement TName+           | TokenContent Content+           | TokenComment Text+           | TokenDoctype Text (Maybe ExternalID)+           | TokenCDATA Text+    deriving Show+tokenToBuilder :: Token -> Builder+tokenToBuilder (TokenBeginDocument attrs) =+    fromByteString "<?xml"+    `mappend` foldAttrs oneSpace attrs (fromByteString "?>\n")+tokenToBuilder (TokenInstruction (Instruction target data_)) = mconcat+    [ fromByteString "<?"+    , fromText target+    , fromByteString " "+    , fromText data_+    , fromByteString "?>"+    ]+tokenToBuilder (TokenBeginElement name attrs isEmpty indent) =+      copyByteString "<"+    `mappend` tnameToText name+    `mappend` foldAttrs+        (if indent == 0 || lessThan3 attrs+            then oneSpace+            else BC8.fromString ('\n' : replicate indent ' '))+        attrs+        (if isEmpty then fromByteString "/>" else fromByteString ">")+  where+    lessThan3 [] = True+    lessThan3 [_] = True+    lessThan3 [_, _] = True+    lessThan3 _ = False+tokenToBuilder (TokenEndElement name) = mconcat+    [ fromByteString "</"+    , tnameToText name+    , fromByteString ">"+    ]+tokenToBuilder (TokenContent c) = contentToText c+tokenToBuilder (TokenCDATA t) =+    copyByteString "<![CDATA["+    `mappend` fromText t+    `mappend` copyByteString "]]>"+tokenToBuilder (TokenComment t) = mconcat [fromByteString "<!--", fromText t, fromByteString "-->"]+tokenToBuilder (TokenDoctype name eid) = mconcat+    [ fromByteString "<!DOCTYPE "+    , fromText name+    , go eid+    , fromByteString ">\n"+    ]+  where+    go Nothing = mempty+    go (Just (SystemID uri)) = mconcat+        [ fromByteString " SYSTEM \""+        , fromText uri+        , fromByteString "\""+        ]+    go (Just (PublicID pid uri)) = mconcat+        [ fromByteString " PUBLIC \""+        , fromText pid+        , fromByteString "\" \""+        , fromText uri+        , fromByteString "\""+        ]++data TName = TName (Maybe Text) Text+    deriving Show++tnameToText :: TName -> Builder+tnameToText (TName Nothing name) = fromText name+tnameToText (TName (Just prefix) name) = mconcat [fromText prefix, fromByteString ":", fromText name]++contentToText :: Content -> Builder+contentToText (ContentText t) =+    fromWriteList go $ T.unpack t+  where+    go '<' = writeByteString "&lt;"+    go '>' = writeByteString "&gt;"+    go '&' = writeByteString "&amp;"+    -- Not escaping quotes, since this is only called outside of attributes+    go c   = writeChar c+contentToText (ContentEntity e) = mconcat+    [ fromByteString "&"+    , fromText e+    , fromByteString ";"+    ]++type TAttribute = (TName, [Content])++foldAttrs :: Builder -- ^ before+          -> [TAttribute]+          -> Builder+          -> Builder+foldAttrs before attrs rest' =+    foldr go rest' attrs+  where+    go (key, val) rest =+      before+      `mappend` tnameToText key+      `mappend` copyByteString "=\""+      `mappend` foldr go' (fromByteString "\"" `mappend` rest) val+    go' (ContentText t) rest =+        fromWriteList h (T.unpack t) `mappend` rest+      where+        h '<' = writeByteString "&lt;"+        h '>' = writeByteString "&gt;"+        h '&' = writeByteString "&amp;"+        h '"' = writeByteString "&quot;"+        -- Not escaping single quotes, since our attributes are always double+        -- quoted+        h c   = writeChar c+    go' (ContentEntity t) rest =+        fromByteString "&"+        `mappend` fromText t+        `mappend` fromByteString ";"+        `mappend` rest++instance IsString TName where+    fromString = TName Nothing . T.pack++data NSLevel = NSLevel+    { defaultNS :: Maybe Text+    , prefixes :: Map Text Text+    }+    deriving Show

@@ -1,139 +1,139 @@-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-import           Control.Monad                (guard)
-import           Control.Monad.IO.Class       (liftIO)
-import           Data.Char                    (chr,ord)
-import           Data.String                  (fromString)
-import           Data.Text                    (toLower)
-import           Data.XML.Types
-import           Test.HUnit                   hiding (Test)
-import           Test.Hspec
-import           Test.Hspec.HUnit
-import           Text.XML.Enumerator.Parse    (decodeEntities)
-import qualified Control.Exception            as C
-import qualified Data.ByteString.Lazy.Char8   as L
-import qualified Data.Map                     as Map
-import qualified Text.XML.Enumerator.Document as D
-import qualified Text.XML.Enumerator.Parse    as P
-
-import Text.XML.Enumerator.Parse (decodeEntities)
-import qualified Text.XML.Enumerator.Parse as P
-import qualified Text.XML.Enumerator.Render as R
-import qualified Data.Map as Map
-import qualified Data.ByteString.Lazy.Char8 as L
-import Control.Monad.IO.Class (liftIO)
-import qualified Data.Enumerator as E
-import Data.Enumerator(($$))
-import qualified Data.Enumerator.List as EL
-import Data.Monoid
-import Data.Text(Text)
-import Control.Monad.IO.Class(MonadIO)
-import Control.Monad
-import Control.Applicative((<$>), (<*>))
-
-main :: IO ()
-main = hspec $ describe "XML parsing and rendering"
-    [ it "is idempotent to parse and render a document" documentParseRender
-    , it "has valid parser combinators" combinators
-    , it "has working choose function" testChoose
-    , it "has working many function" testMany
-    , it "has working orE" testOrE
-    ]
-
-documentParseRender =
-    mapM_ go docs
-  where
-    go x = x @=? D.parseLBS_ (D.renderLBS x) decodeEntities
-    docs =
-        [ Document (Prologue [] Nothing [])
-                   (Element "foo" [] [])
-                   []
-        , D.parseLBS_
-            "<?xml version=\"1.0\"?>\n<!DOCTYPE foo>\n<foo/>"
-            decodeEntities
-        , D.parseLBS_
-            "<?xml version=\"1.0\"?>\n<!DOCTYPE foo>\n<foo><nested>&ignore;</nested></foo>"
-            decodeEntities
-        , D.parseLBS_
-            "<foo><![CDATA[this is some<CDATA content>]]></foo>"
-            decodeEntities
-        , D.parseLBS_
-            "<foo bar='baz&amp;bin'/>"
-            decodeEntities
-        , D.parseLBS_
-            "<foo><?instr this is a processing instruction?></foo>"
-            decodeEntities
-        , D.parseLBS_
-            "<foo><!-- this is a comment --></foo>"
-            decodeEntities
-        ]
-
-combinators = P.parseLBS_ input decodeEntities $ do
-    P.force "need hello" $ P.tagName "hello" (P.requireAttr "world") $ \world -> do
-        liftIO $ world @?= "true"
-        P.force "need child1" $ P.tagNoAttr "{mynamespace}child1" $ return ()
-        P.force "need child2" $ P.tagNoAttr "child2" $ return ()
-        P.force "need child3" $ P.tagNoAttr "child3" $ do
-            x <- P.contentMaybe
-            liftIO $ x @?= Just "combine <all> &content"
-  where
-    input = L.concat
-        [ "<?xml version='1.0'?>\n"
-        , "<!DOCTYPE foo []>\n"
-        , "<hello world='true'>"
-        , "<?this should be ignored?>"
-        , "<child1 xmlns='mynamespace'/>"
-        , "<!-- this should be ignored -->"
-        , "<child2>   </child2>"
-        , "<child3>combine &lt;all&gt; <![CDATA[&content]]></child3>\n"
-        , "</hello>"
-        ]
-
-testChoose = P.parseLBS_ input decodeEntities $ do
-    P.force "need hello" $ P.tagNoAttr "hello" $ do
-        x <- P.choose
-            [ P.tagNoAttr "failure" $ return 1
-            , P.tagNoAttr "success" $ return 2
-            ]
-        liftIO $ x @?= Just 2
-  where
-    input = L.concat
-        [ "<?xml version='1.0'?>\n"
-        , "<!DOCTYPE foo []>\n"
-        , "<hello>"
-        , "<success/>"
-        , "</hello>"
-        ]
-
-testMany = P.parseLBS_ input decodeEntities $ do
-    P.force "need hello" $ P.tagNoAttr "hello" $ do
-        x <- P.many $ P.tagNoAttr "success" $ return ()
-        liftIO $ length x @?= 5
-  where
-    input = L.concat
-        [ "<?xml version='1.0'?>\n"
-        , "<!DOCTYPE foo []>\n"
-        , "<hello>"
-        , "<success/>"
-        , "<success/>"
-        , "<success/>"
-        , "<success/>"
-        , "<success/>"
-        , "</hello>"
-        ]
-
-testOrE = P.parseLBS_ input decodeEntities $ do
-    P.force "need hello" $ P.tagNoAttr "hello" $ do
-        x <- P.tagNoAttr "failure" (return 1) `P.orE`
-             P.tagNoAttr "success" (return 2)
-        liftIO $ x @?= Just 2
-  where
-    input = L.concat
-        [ "<?xml version='1.0'?>\n"
-        , "<!DOCTYPE foo []>\n"
-        , "<hello>"
-        , "<success/>"
-        , "</hello>"
-        ]
+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}++import           Control.Monad                (guard)+import           Control.Monad.IO.Class       (liftIO)+import           Data.Char                    (chr,ord)+import           Data.String                  (fromString)+import           Data.Text                    (toLower)+import           Data.XML.Types+import           Test.HUnit                   hiding (Test)+import           Test.Hspec+import           Test.Hspec.HUnit+import           Text.XML.Enumerator.Parse    (decodeEntities)+import qualified Control.Exception            as C+import qualified Data.ByteString.Lazy.Char8   as L+import qualified Data.Map                     as Map+import qualified Text.XML.Enumerator.Document as D+import qualified Text.XML.Enumerator.Parse    as P++import Text.XML.Enumerator.Parse (decodeEntities)+import qualified Text.XML.Enumerator.Parse as P+import qualified Text.XML.Enumerator.Render as R+import qualified Data.Map as Map+import qualified Data.ByteString.Lazy.Char8 as L+import Control.Monad.IO.Class (liftIO)+import qualified Data.Enumerator as E+import Data.Enumerator(($$))+import qualified Data.Enumerator.List as EL+import Data.Monoid+import Data.Text(Text)+import Control.Monad.IO.Class(MonadIO)+import Control.Monad+import Control.Applicative((<$>), (<*>))++main :: IO ()+main = hspec $ describe "XML parsing and rendering"+    [ it "is idempotent to parse and render a document" documentParseRender+    , it "has valid parser combinators" combinators+    , it "has working choose function" testChoose+    , it "has working many function" testMany+    , it "has working orE" testOrE+    ]++documentParseRender =+    mapM_ go docs+  where+    go x = x @=? D.parseLBS_ (D.renderLBS x) decodeEntities+    docs =+        [ Document (Prologue [] Nothing [])+                   (Element "foo" [] [])+                   []+        , D.parseLBS_+            "<?xml version=\"1.0\"?>\n<!DOCTYPE foo>\n<foo/>"+            decodeEntities+        , D.parseLBS_+            "<?xml version=\"1.0\"?>\n<!DOCTYPE foo>\n<foo><nested>&ignore;</nested></foo>"+            decodeEntities+        , D.parseLBS_+            "<foo><![CDATA[this is some<CDATA content>]]></foo>"+            decodeEntities+        , D.parseLBS_+            "<foo bar='baz&amp;bin'/>"+            decodeEntities+        , D.parseLBS_+            "<foo><?instr this is a processing instruction?></foo>"+            decodeEntities+        , D.parseLBS_+            "<foo><!-- this is a comment --></foo>"+            decodeEntities+        ]++combinators = P.parseLBS_ input decodeEntities $ do+    P.force "need hello" $ P.tagName "hello" (P.requireAttr "world") $ \world -> do+        liftIO $ world @?= "true"+        P.force "need child1" $ P.tagNoAttr "{mynamespace}child1" $ return ()+        P.force "need child2" $ P.tagNoAttr "child2" $ return ()+        P.force "need child3" $ P.tagNoAttr "child3" $ do+            x <- P.contentMaybe+            liftIO $ x @?= Just "combine <all> &content"+  where+    input = L.concat+        [ "<?xml version='1.0'?>\n"+        , "<!DOCTYPE foo []>\n"+        , "<hello world='true'>"+        , "<?this should be ignored?>"+        , "<child1 xmlns='mynamespace'/>"+        , "<!-- this should be ignored -->"+        , "<child2>   </child2>"+        , "<child3>combine &lt;all&gt; <![CDATA[&content]]></child3>\n"+        , "</hello>"+        ]++testChoose = P.parseLBS_ input decodeEntities $ do+    P.force "need hello" $ P.tagNoAttr "hello" $ do+        x <- P.choose+            [ P.tagNoAttr "failure" $ return 1+            , P.tagNoAttr "success" $ return 2+            ]+        liftIO $ x @?= Just 2+  where+    input = L.concat+        [ "<?xml version='1.0'?>\n"+        , "<!DOCTYPE foo []>\n"+        , "<hello>"+        , "<success/>"+        , "</hello>"+        ]++testMany = P.parseLBS_ input decodeEntities $ do+    P.force "need hello" $ P.tagNoAttr "hello" $ do+        x <- P.many $ P.tagNoAttr "success" $ return ()+        liftIO $ length x @?= 5+  where+    input = L.concat+        [ "<?xml version='1.0'?>\n"+        , "<!DOCTYPE foo []>\n"+        , "<hello>"+        , "<success/>"+        , "<success/>"+        , "<success/>"+        , "<success/>"+        , "<success/>"+        , "</hello>"+        ]++testOrE = P.parseLBS_ input decodeEntities $ do+    P.force "need hello" $ P.tagNoAttr "hello" $ do+        x <- P.tagNoAttr "failure" (return 1) `P.orE`+             P.tagNoAttr "success" (return 2)+        liftIO $ x @?= Just 2+  where+    input = L.concat+        [ "<?xml version='1.0'?>\n"+        , "<!DOCTYPE foo []>\n"+        , "<hello>"+        , "<success/>"+        , "</hello>"+        ]

@@ -1,47 +1,48 @@-name:            xml-enumerator
-version:         0.3.0
-license:         BSD3
-license-file:    LICENSE
-author:          Michael Snoyman <michaels@suite-sol.com>
-maintainer:      Michael Snoyman <michaels@suite-sol.com>
-synopsis:        Pure-Haskell utilities for dealing with XML with the enumerator package.
-description:
-    Provides the ability to parse and render XML in a streaming manner using the enumerator package.
-category:        XML, Enumerator
-stability:       Stable
-cabal-version:   >= 1.6
-build-type:      Simple
-homepage:        http://github.com/snoyberg/xml-enumerator
-
-flag test
-    default: False
-
-library
-    build-depends:   base                      >= 4        && < 5
-                   , enumerator                >= 0.4.5    && < 0.5
-                   , bytestring                >= 0.9      && < 0.10
-                   , text                      >= 0.7      && < 0.12
-                   , containers                >= 0.2      && < 0.5
-                   , xml-types                 >= 0.3      && < 0.4
-                   , attoparsec-text-enumerator >= 0.2     && < 0.3
-                   , attoparsec-text           >= 0.8.2    && < 0.9
-                   , blaze-builder             >= 0.2      && < 0.4
-                   , blaze-builder-enumerator  >= 0.2      && < 0.3
-                   , transformers              >= 0.2      && < 0.3
-    exposed-modules: Text.XML.Enumerator.Parse
-                     Text.XML.Enumerator.Render
-                     Text.XML.Enumerator.Document
-    other-modules:   Text.XML.Enumerator.Token
-    ghc-options:     -Wall
-
-executable runtests
-    main-is:         runtests.hs
-    if flag(test)
-        Buildable: True
-        Build-depends: base, HUnit, hspec >= 0.3 && < 0.4
-    else
-        Buildable: False
-
-source-repository head
-  type:     git
-  location: git://github.com/snoyberg/xml-enumerator.git
+name:            xml-enumerator+version:         0.3.1+license:         BSD3+license-file:    LICENSE+author:          Michael Snoyman <michaels@suite-sol.com>+maintainer:      Michael Snoyman <michaels@suite-sol.com>+synopsis:        Pure-Haskell utilities for dealing with XML with the enumerator package.+description:+    Provides the ability to parse and render XML in a streaming manner using the enumerator package.+category:        XML, Enumerator+stability:       Stable+cabal-version:   >= 1.6+build-type:      Simple+homepage:        http://github.com/snoyberg/xml-enumerator++flag test+    default: False++library+    build-depends:   base                      >= 4        && < 5+                   , enumerator                >= 0.4.5    && < 0.5+                   , bytestring                >= 0.9      && < 0.10+                   , text                      >= 0.7      && < 0.12+                   , containers                >= 0.2      && < 0.5+                   , xml-types                 >= 0.3      && < 0.4+                   , attoparsec-text-enumerator >= 0.2     && < 0.3+                   , attoparsec-text           >= 0.8.2    && < 0.9+                   , blaze-builder             >= 0.2      && < 0.4+                   , blaze-builder-enumerator  >= 0.2      && < 0.3+                   , transformers              >= 0.2      && < 0.3+    exposed-modules: Text.XML.Enumerator.Parse+                     Text.XML.Enumerator.Render+                     Text.XML.Enumerator.Document+                     Text.XML.Enumerator.Cursor+    other-modules:   Text.XML.Enumerator.Token+    ghc-options:     -Wall++executable runtests+    main-is:         runtests.hs+    if flag(test)+        Buildable: True+        Build-depends: base, HUnit, hspec >= 0.3 && < 0.4+    else+        Buildable: False++source-repository head+  type:     git+  location: git://github.com/snoyberg/xml-enumerator.git