hexpat-iteratee-0.2: test/test3.hs

{-# LANGUAGE ScopedTypeVariables #-}
import Text.XML.Expat.Chunked
import Text.XML.Expat.Format
import Text.XML.Expat.Tree hiding (parse)

import Control.Exception
import Control.Monad
import Control.Monad.Trans
import qualified Data.ByteString as B
import Data.Iteratee
import Data.Iteratee.Base.StreamChunk (ReadableChunk (..))
import Data.List.Class
import Data.Text (Text)
import qualified Data.Text as T
import System.IO
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Storable


main :: IO ()
main = do
    eErr <- myFileDriver (parse defaultParserOptions dump) "sudoku.xml"
    case eErr of
        Left err -> putStrLn $ "failed: "++show err
        Right () -> putStrLn ""

dump :: CNode IO Text Text -> HandlerT IO ()
dump doc = do
    let txt = formatG doc
    forIter txt $ liftIO . B.hPutStr stdout
    return ()

forIter :: (List l) => l a -> (a -> ItemM l b) -> ItemM l [b]
forIter iter body = fi iter []
    where
        fi iter acc = do
            elt <- runList iter
            case elt of
                Cons value iter' -> do
                    b <- body value
                    fi iter' (b:acc)
                Nil -> return (reverse acc)

-- ------------------------------------------------------------------------
-- Binary Random IO enumerators

myBufSize = 16

-- |The enumerator of a file Handle.  This version enumerates
-- over the entire contents of a file, in order, unless stopped by
-- the iteratee.  In particular, seeking is not supported.
myEnumHandle :: forall s el m a.(ReadableChunk s el, MonadIO m) =>
  Handle ->
  EnumeratorGM s el m a
myEnumHandle h i =
  liftIO (mallocForeignPtrBytes (fromIntegral buffer_size)) >>= loop i
  where
    buffer_size = myBufSize - mod myBufSize (sizeOf (undefined :: el))
    loop iter fp = do
      s <- liftIO . withForeignPtr fp $ \p -> do
        n <- try $ hGetBuf h p buffer_size :: IO (Either SomeException Int)
        case n of
          Left _  -> return $ Left "IO error"
          Right 0 -> return $ Right Nothing
          Right n' -> liftM (Right . Just) $ readFromPtr p (fromIntegral n')
      liftIO $ putStr "|"  -- ###
      checkres fp iter s
    checkres fp iter = either (flip enumErr iter)
                              (maybe (return iter)
                                     (check fp <=< runIter iter . Chunk))
    check _p (Done x _) = return . return $ x
    check p  (Cont i' Nothing) = loop i' p
    check _p (Cont _ (Just e)) = return $ throwErr e

-- |Process a file using the given IterateeGM.  This function wraps
-- enumHandle as a convenience.
myFileDriver :: (MonadIO m, ReadableChunk s el) =>
  IterateeG s el m a ->
  FilePath ->
  m a
myFileDriver iter filepath = do
  h <- liftIO $ openBinaryFile filepath ReadMode
  result <- myEnumHandle h iter >>= run
  liftIO $ hClose h
  return result