xml-conduit 1.2.5.1 → 1.2.6
raw patch · 3 files changed
+68/−60 lines, 3 files
Files
- ChangeLog.md +4/−0
- Text/XML/Stream/Parse.hs +63/−59
- xml-conduit.cabal +1/−1
ChangeLog.md view
@@ -1,3 +1,7 @@+## 1.2.6++* Reuse 'MonadThrow' and 'force' for 'AttrParser' [#52](https://github.com/snoyberg/xml/pull/52)+ ## 1.2.5 * Added helper functions to render XML elements [#48](https://github.com/snoyberg/xml/pull/48)
Text/XML/Stream/Parse.hs view
@@ -1,10 +1,10 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ImpredicativeTypes #-}-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternGuards #-}+{-# 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.@@ -75,6 +75,7 @@ , contentMaybe -- * Attribute parsing , AttrParser+ , attr , requireAttr , optionalAttr , requireAttrRaw@@ -91,47 +92,47 @@ , PositionRange , EventPos ) where-import Data.Attoparsec.Text- ( char, Parser, takeWhile1, skipWhile, string- , manyTill, takeWhile, try, anyChar- )-import qualified Control.Applicative as A-import Control.Monad.Trans.Resource (MonadThrow, monadThrow, MonadResource)-import Data.Conduit.Attoparsec (conduitParser, PositionRange)-import Data.XML.Types- ( Name (..), Event (..), Content (..)- , Instruction (..), ExternalID (..)- )+import qualified Control.Applicative as A+import Control.Monad.Trans.Resource (MonadResource, MonadThrow (..),+ monadThrow)+import Data.Attoparsec.Text (Parser, anyChar, char, manyTill,+ skipWhile, string, takeWhile,+ takeWhile1, try)+import Data.Conduit.Attoparsec (PositionRange, conduitParser)+import Data.XML.Types (Content (..), Event (..),+ ExternalID (..),+ Instruction (..), Name (..)) -import Filesystem.Path.CurrentOS (FilePath, encodeString)-import Control.Applicative (Applicative(..), Alternative(empty,(<|>)), (<$>))-import Data.Text (Text, pack)-import Control.Arrow ((***))-import qualified Data.Text as T-import Data.Text.Read (Reader, decimal, hexadecimal)-import Data.Text.Encoding (decodeUtf32BEWith)-import Data.Text.Encoding.Error (ignore)-import Data.Word (Word32)-import Blaze.ByteString.Builder (fromWord32be, toByteString)-import Text.XML.Stream.Token-import Prelude hiding (takeWhile, FilePath)-import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as L-import qualified Data.Map as Map-import Data.Conduit-import qualified Data.Conduit.Text as CT-import qualified Data.Conduit.List as CL-import qualified Data.Conduit.Internal as CI-import Control.Monad (ap, liftM, void, guard)-import qualified Data.Text as TS-import Data.List (foldl')-import Data.Typeable (Typeable)-import Control.Exception (Exception)-import Data.Conduit.Binary (sourceFile)-import Data.Char (isSpace)-import Data.Default (Default (..))-import Control.Monad.Trans.Class (lift)-import Data.Maybe (fromMaybe, isNothing)+import Blaze.ByteString.Builder (fromWord32be, toByteString)+import Control.Applicative (Alternative (empty, (<|>)),+ Applicative (..), (<$>))+import Control.Arrow ((***))+import Control.Exception (Exception (..), SomeException)+import Control.Monad (ap, guard, liftM, void)+import Control.Monad.Trans.Class (lift)+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import Data.Char (isSpace)+import Data.Conduit+import Data.Conduit.Binary (sourceFile)+import qualified Data.Conduit.Internal as CI+import qualified Data.Conduit.List as CL+import qualified Data.Conduit.Text as CT+import Data.Default (Default (..))+import Data.List (foldl')+import qualified Data.Map as Map+import Data.Maybe (fromMaybe, isNothing)+import Data.Text (Text, pack)+import qualified Data.Text as T+import qualified Data.Text as TS+import Data.Text.Encoding (decodeUtf32BEWith)+import Data.Text.Encoding.Error (ignore)+import Data.Text.Read (Reader, decimal, hexadecimal)+import Data.Typeable (Typeable)+import Data.Word (Word32)+import Filesystem.Path.CurrentOS (FilePath, encodeString)+import Prelude hiding (FilePath, takeWhile)+import Text.XML.Stream.Token type Ents = [(Text, Text)] @@ -618,7 +619,7 @@ case runAttrParser p as of Left e -> Left e Right ([], x) -> Right x- Right (attr, _) -> Left $ UnparsedAttributes attr+ Right (attr, _) -> Left $ toException $ UnparsedAttributes attr -- | A simplified version of 'tag' which matches against boolean predicates. tagPredicate :: MonadThrow m@@ -675,14 +676,13 @@ i >>= maybe (choose is) (return . Just) -- | Force an optional parser into a required parser. All of the 'tag'--- functions, 'choose' and 'many' deal with 'Maybe' parsers. Use this when you+-- functions, 'attr', 'choose' and 'many' deal with 'Maybe' parsers. Use this when you -- want to finally force something to happen. force :: MonadThrow m => String -- ^ Error message- -> CI.ConduitM Event o m (Maybe a) -- ^ Optional parser to be forced- -> CI.ConduitM Event o m a-force msg i =- i >>= maybe (lift $ monadThrow $ XmlException msg Nothing) return+ -> m (Maybe a) -- ^ Optional parser to be forced+ -> m a+force msg i = i >>= maybe (throwM $ XmlException msg Nothing) return -- | A helper function which reads a file from disk using 'enumFile', detects -- character encoding using 'detectUtf', parses the XML using 'parseBytes', and@@ -718,7 +718,7 @@ -- -- 'Alternative' instance behave like 'First' monoid. It chooses first -- parser which doesn't fail.-newtype AttrParser a = AttrParser { runAttrParser :: [(Name, [Content])] -> Either XmlException ([(Name, [Content])], a) }+newtype AttrParser a = AttrParser { runAttrParser :: [(Name, [Content])] -> Either SomeException ([(Name, [Content])], a) } instance Monad AttrParser where return a = AttrParser $ \as -> Right (as, a)@@ -730,9 +730,11 @@ pure = return (<*>) = ap instance Alternative AttrParser where- empty = AttrParser $ const $ Left $ XmlException "AttrParser.empty" Nothing+ empty = AttrParser $ const $ Left $ toException $ XmlException "AttrParser.empty" Nothing AttrParser f <|> AttrParser g = AttrParser $ \x -> either (const $ g x) Right (f x)+instance MonadThrow AttrParser where+ throwM = AttrParser . const . throwM optionalAttrRaw :: ((Name, [Content]) -> Maybe b) -> AttrParser (Maybe b) optionalAttrRaw f =@@ -746,16 +748,18 @@ requireAttrRaw :: String -> ((Name, [Content]) -> Maybe b) -> AttrParser b requireAttrRaw msg f = optionalAttrRaw f >>=- maybe (AttrParser $ const $ Left $ XmlException msg Nothing)+ maybe (AttrParser $ const $ Left $ toException $ XmlException msg Nothing) return --- | Require that a certain attribute be present and return its value.+-- | Return the value for an attribute if present.+attr :: Name -> AttrParser (Maybe Text)+attr = optionalAttr++-- | Shortcut composition of 'force' and 'attr'. requireAttr :: Name -> AttrParser Text-requireAttr n = requireAttrRaw- ("Missing attribute: " ++ show n)- (\(x, y) -> if x == n then Just (contentsToText y) else Nothing)+requireAttr n = force ("Missing attribute: " ++ show n) $ attr n --- | Return the value for an attribute if present.+{-# DEPRECATED optionalAttr "Please use 'attr'." #-} optionalAttr :: Name -> AttrParser (Maybe Text) optionalAttr n = optionalAttrRaw (\(x, y) -> if x == n then Just (contentsToText y) else Nothing)
xml-conduit.cabal view
@@ -1,5 +1,5 @@ name: xml-conduit-version: 1.2.5.1+version: 1.2.6 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>, Aristid Breitkreuz <aristidb@googlemail.com>