xml-enumerator 0.1.2.1 → 0.1.3

raw patch · 3 files changed

+102/−1 lines, 3 files

Files

• Text/XML/Enumerator/Document.hs +38/−0
• Text/XML/Enumerator/Parse.hs +63/−0
• xml-enumerator.cabal +1/−1

@@ -4,6 +4,8 @@       writeFile
     , readFile
     , readFile_
+      -- * Lazy bytestrings
+    , renderDocument
       -- * Streaming functions
     , toEvents
     , fromEvents
@@ -34,6 +36,12 @@ import Data.Enumerator.Binary (enumFile, iterHandle)
 import qualified Data.Text.Lazy 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)
 
 readFile :: FilePath -> IO (Either SomeException Document)
 readFile fn = run $ enumFile fn $$ joinI $ P.parseBytes $$ fromEvents
@@ -44,6 +52,36 @@ writeFile :: FilePath -> Document -> IO ()
 writeFile fn doc = SIO.withBinaryFile fn SIO.WriteMode $ \h ->
     run_ $ renderBytes doc $$ iterHandle h
+
+renderDocument :: Document -> L.ByteString
+renderDocument doc =
+    L.fromChunks $ unsafePerformIO $ lazyConsume $ renderBytes doc
+
+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)

@@ -57,6 +57,8 @@     , tagNoAttr
     , content
     , content'
+    , ignoreElem
+    , ignoreSiblings
       -- * Attribute parsing
     , AttrParser
     , requireAttr
@@ -68,6 +70,8 @@     , choose
     , many
     , force
+    , skipTill
+    , skipSiblings
       -- * Exceptions
     , XmlException (..)
     ) where
@@ -670,3 +674,62 @@         case x of
             Nothing -> return $ front []
             Just y -> go $ front . (:) y
+
+{-
+-- There is some possible realisations using higher interface
+-- ignoreSiblings' is about 30 percent slowly than ignoreSiblings
+-- if ignoreSiblings' uses ignoreElem (instead of ignoreElem') it is about 5 percent slowly than ignoreSiblings 
+
+-- | Ignore  content if exists
+ignoreContent :: Monad m => Iteratee SEvent m (Maybe ())
+ignoreContent = fmap (fmap $ const ()) content
+-- | Iteratee to skip the next element. 
+ignoreElem' :: Monad m => Iteratee SEvent m (Maybe ())
+ignoreElem' = tag (const $ Just ()) (const ignoreAttrs) (const $ ignoreSiblings' >> return ())
+
+-- | Iteratee to skip the siblings element. 
+ignoreSiblings' :: Monad m => Iteratee SEvent m [()]
+ignoreSiblings' = many (choose [ignoreElem', ignoreContent])
+-}
+
+-- | Iteratee to skip the siblings element. 
+ignoreSiblings :: Monad m => Iteratee SEvent m ()
+ignoreSiblings = E.continue (loop 0) 
+  where
+    loop :: Monad m => Int -> Stream SEvent -> Iteratee SEvent m ()
+    loop n (Chunks []) = E.continue (loop n)
+    loop n chs@(Chunks (x:_)) = case x of
+        (SBeginElement _ _) -> E.continue (loop (n+1))
+        SEndElement 
+            | n == 0    -> yield () chs 
+            | otherwise -> E.continue (loop (n-1))
+        _ -> E.continue (loop n)
+    loop _ EOF = throwError $ XmlException "Unbalanced xml-tree. (Error in skipSiblings)" Nothing
+
+-- | Iteratee to skip the next element. 
+ignoreElem :: Monad m => Iteratee SEvent m (Maybe ())
+ignoreElem = E.continue (loop 0) 
+  where
+    loop :: Monad m => Int -> Stream SEvent -> Iteratee SEvent m (Maybe ())
+    loop n (Chunks []) = E.continue (loop n)
+    loop n chs@(Chunks (x:xs)) = case x of
+        (SBeginElement _ _) -> E.continue (loop (n+1))
+        SEndElement 
+            | n == 0    -> yield Nothing chs 
+            | n == 1    -> yield (Just ()) (Chunks xs) 
+            | otherwise -> E.continue (loop (n-1))
+        _ -> E.continue (loop n)
+    loop _ EOF = throwError $ XmlException "Unbalanced xml-tree. (Error in skipSiblings)" Nothing
+    
+-- | Skip the siblings elements until iteratee not right. 
+skipTill :: Monad m => Iteratee SEvent m (Maybe a) -> Iteratee SEvent m (Maybe a)
+skipTill i = go
+  where
+    go = i >>= \x -> case x of
+        Nothing -> ignoreElem >>= (\x -> if x == Nothing then return Nothing else go)
+        r -> return r
+
+-- | Combinator to skip the siblings element. 
+skipSiblings :: Monad m => Iteratee SEvent m a -> Iteratee SEvent m a
+skipSiblings i = i >>= \r -> ignoreSiblings >> return r
+

@@ -1,5 +1,5 @@ name:            xml-enumerator
-version:         0.1.2.1
+version:         0.1.3
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman <michaels@suite-sol.com>