From 7013553deec42e19124e5ffa88c2d8c78ba92beb Mon Sep 17 00:00:00 2001 From: Philipp Balzarek Date: Tue, 3 Apr 2012 17:41:58 +0200 Subject: [PATCH] some cleanup --- .gitmodules | 10 +-- hexpat-internals | 1 - src/Data/Conduit/Hexpat.hs | 141 ------------------------------------ src/xml-conduit-testcase.hs | 22 ------ xml | 1 - xmpp-lib.cabal | 1 - 6 files changed, 2 insertions(+), 174 deletions(-) delete mode 160000 hexpat-internals delete mode 100644 src/Data/Conduit/Hexpat.hs delete mode 100644 src/xml-conduit-testcase.hs delete mode 160000 xml diff --git a/.gitmodules b/.gitmodules index f6255f8..a3c8b33 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,9 +1,3 @@ -[submodule "xml"] - path = xml - url = https://github.com/snoyberg/xml.git [submodule "xml-types-pickle"] - path = xml-types-pickle - url = git@github.com:Philonous/xml-types-pickle.git -[submodule "hexpat-internals"] - path = hexpat-internals - url = git@github.com:Philonous/hexpat-internals.git + path = xml-types-pickle + url = git@github.com:Philonous/xml-types-pickle.git diff --git a/hexpat-internals b/hexpat-internals deleted file mode 160000 index 55c95b0..0000000 --- a/hexpat-internals +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 55c95b082eaa37836822d23bf3313cc8b1ad71af diff --git a/src/Data/Conduit/Hexpat.hs b/src/Data/Conduit/Hexpat.hs deleted file mode 100644 index f236a7c..0000000 --- a/src/Data/Conduit/Hexpat.hs +++ /dev/null @@ -1,141 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable, NoMonomorphismRestriction #-} - -module Data.Conduit.Hexpat - ( ParseOptions(..) - , defaultParseOptions - , parseBS - ) - - where - -import Control.Applicative((<$>)) -import Control.Exception -import Control.Monad -import Control.Monad.Trans.Class - -import qualified Data.ByteString as BS -import Data.Conduit as C -import qualified Data.Text as Text -import qualified Data.Text.Encoding as TE -import Data.Text(Text) -import Data.Typeable -import Data.XML.Types as XML - -import Text.XML.Expat.Internal.IO hiding (parse) - -import Data.IORef --- adapted from parseG - --- | Parse a generalized list of ByteStrings containing XML to SAX events. --- In the event of an error, FailDocument is the last element of the output list. - -data HexpatParser = HexpatParser - { hParser :: Parser - , hQueueRef :: IORef [XML.Event] - } - -splitName :: Text -> Name -splitName name = case Text.split (=='}') name of - [n] -> case Text.split (==':') n of - [n'] -> Name n' Nothing Nothing - [p,n'] -> Name n' Nothing (Just p) - _ -> throw . HexpatParseException - $ "Error parsing name: " ++ show name - [ns,n] -> Name n (Just ns) Nothing - _ -> throw . HexpatParseException - $ "Error parsing name: " ++ show name - -createParser :: ParseOptions -> Maybe Char -> IO (HexpatParser) -createParser opts delim = do - let enc = overrideEncoding opts --- let mEntityDecoder = entityDecoder opts - parser <- newParser enc delim - queueRef <- newIORef [] - - -- setXMLDeclarationHandler parser $ \_ cVer cEnc cSd -> do - -- ver <- textFromCString cVer - -- mEnc <- if cEnc == nullPtr - -- then return Nothing - -- else Just <$> textFromCString cEnc - -- let sd = if cSd < 0 - -- then Nothing - -- else Just $ if cSd /= 0 then True else False - -- modifyIORef queueRef (XMLDeclaration ver mEnc sd:) - -- TODO: What to do here? - -- return True - - setStartElementHandler parser $ \_ cName cAttrs -> do - name <- splitName <$> textFromCString cName - attrs <- forM cAttrs $ \(cAttrName,cAttrValue) -> do - attrName <- splitName <$> textFromCString cAttrName - attrValue <- ContentText <$> textFromCString cAttrValue - return (attrName, [attrValue]) - modifyIORef queueRef (EventBeginElement name attrs:) - return True - - setEndElementHandler parser $ \_ cName -> do - name <- splitName <$> textFromCString cName - modifyIORef queueRef (EventEndElement name:) - return True - - setCharacterDataHandler parser $ \_ cText -> do - txt <- TE.decodeUtf8 <$> BS.packCStringLen cText - modifyIORef queueRef ((EventContent $ ContentText txt):) - return True - - setProcessingInstructionHandler parser $ \_ cTarget cText -> do - target <- textFromCString cTarget - txt <- textFromCString cText - modifyIORef queueRef (EventInstruction (Instruction target txt) :) - return True - - setCommentHandler parser $ \_ cText -> do - txt <- textFromCString cText - modifyIORef queueRef (EventComment txt :) - return True - - return (HexpatParser parser queueRef) - -data HexpatParseException = HexpatParseException String deriving (Typeable, Show) -instance Exception HexpatParseException - -parseBS - :: (MonadResource (t IO), MonadTrans t) => - ParseOptions -> Conduit BS.ByteString (t IO) Event -parseBS opts = conduitIO - (createParser opts (Just '}')) - (\_ -> return ()) - (\(HexpatParser parser queueRef) input -> lift $ do - e <- withParser parser $ \pp -> parseChunk pp input False - case e of - Nothing -> return () - Just (XMLParseError err _) -> - throwIO $ HexpatParseException err - queue <- readIORef queueRef - writeIORef queueRef [] - return . IOProducing $ reverse queue - ) - (\(HexpatParser parser queueRef) -> lift $ do - e <- withParser parser $ \pp -> parseChunk pp BS.empty True - case e of - Nothing -> return () - Just (XMLParseError err _) -> - throwIO $ HexpatParseException err - queue <- readIORef queueRef - writeIORef queueRef [] - return $ reverse queue - ) - -whileJust :: Monad m => m (Maybe a) -> m [a] -whileJust f = do - f' <- f - case f' of - Just x -> liftM (x :) $ whileJust f - Nothing -> return [] - - - -data StreamUnfinishedException = StreamUnfinishedException deriving (Typeable, Show) -instance Exception StreamUnfinishedException - - diff --git a/src/xml-conduit-testcase.hs b/src/xml-conduit-testcase.hs deleted file mode 100644 index 427d032..0000000 --- a/src/xml-conduit-testcase.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Test where - -import qualified Data.ByteString as BS -import Data.Conduit -import Data.Default -import qualified Data.Conduit.List as CL -import qualified Text.XML.Stream.Parse as XP - -xml = - [ "" - , "" - , "" - , "" - , error "Booh!" - ] :: [BS.ByteString] - -main :: IO () -main = (runResourceT $ CL.sourceList xml $= XP.parseBytes def $$ CL.take 2 ) - >>= print \ No newline at end of file diff --git a/xml b/xml deleted file mode 160000 index e5b4238..0000000 --- a/xml +++ /dev/null @@ -1 +0,0 @@ -Subproject commit e5b4238b214f288cea822222876baf7d3f02699a diff --git a/xmpp-lib.cabal b/xmpp-lib.cabal index 9771727..6f0f043 100644 --- a/xmpp-lib.cabal +++ b/xmpp-lib.cabal @@ -29,7 +29,6 @@ library , resourcet -any , containers -any , random -any - , hexpat-internals -any , tls -any , tls-extra -any , pureMD5 -any