tagstream-conduit 0.5.5.4 → 0.5.6
raw patch · 5 files changed
+49/−10 lines, 5 filesdep +faildep ~xml-conduit
Dependencies added: fail
Dependency ranges changed: xml-conduit
Files
- Text/HTML/TagStream/ByteString.hs +2/−1
- Text/HTML/TagStream/Entities.hs +12/−1
- Text/HTML/TagStream/Text.hs +5/−4
- tagstream-conduit.cabal +8/−4
- tests/Tests.hs +22/−0
Text/HTML/TagStream/ByteString.hs view
@@ -6,6 +6,7 @@ import qualified Blaze.ByteString.Builder as B import Control.Applicative import Control.Monad (unless)+import qualified Control.Monad.Fail as Fail import Data.Attoparsec.ByteString.Char8 import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S@@ -229,7 +230,7 @@ -- }}} -- {{{ Stream-tokenStream :: Monad m+tokenStream :: Fail.MonadFail m #if MIN_VERSION_conduit(1, 0, 0) => Conduit ByteString m Token #else
Text/HTML/TagStream/Entities.hs view
@@ -19,7 +19,7 @@ import qualified Data.Conduit.List as CL import Data.Maybe (fromMaybe, isJust)-import Control.Arrow (first)+import Control.Arrow (first,second) -- | A conduit to decode entities from a stream of tokens into a new stream of tokens. decodeEntities :: (Monad m@@ -34,11 +34,22 @@ where start = await >>= maybe (return ()) (\token -> start' token >> start) start' (Text t) = (yield t >> yieldWhileText) =$= decodeEntities' dec =$= CL.mapMaybe go+ start' (TagOpen name attrs bool) = yield (TagOpen name (map (second (decodeString dec)) attrs) bool) start' token = yield token go t | t == "" = Nothing | otherwise = Just (Text t)++-- | Decode entities in a complete string.+decodeString+ :: (Eq a, IsString a, Monoid builder, Monoid a)+ => Dec builder a -> a -> a+decodeString dec input =+ case makeEntityDecoder dec input of+ (value', remainder)+ | value' /= mempty -> value' <> decodeString dec remainder+ | otherwise -> input decodeEntities' :: (Monad m ,Monoid string
Text/HTML/TagStream/Text.hs view
@@ -5,6 +5,7 @@ import Control.Applicative import Control.Monad (unless, when, liftM)+import qualified Control.Monad.Fail as Fail import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Resource (MonadThrow) import Data.Char@@ -159,7 +160,7 @@ , decUncons = T.uncons } where decodeEntity entity = CL.sourceList ["&",entity,";"]- $= XML.parseText def { XML.psDecodeEntities = XML.decodeHtmlEntities }+ $= XML.parseTextPos def { XML.psDecodeEntities = XML.decodeHtmlEntities } $= CL.map snd $$ XML.content @@ -246,7 +247,7 @@ -- }}} -- {{{ Stream-tokenStream :: Monad m+tokenStream :: Fail.MonadFail m #if MIN_VERSION_conduit(1, 0, 0) => Conduit Text m Token #else@@ -273,7 +274,7 @@ -- | like `tokenStream', but it process `ByteString' input, decode it according to xml version tag. -- -- Only support utf-8 and iso8859 for now.-tokenStreamBS :: MonadThrow m+tokenStreamBS :: (MonadThrow m, Fail.MonadFail m) #if MIN_VERSION_conduit(1, 0, 0) => Conduit ByteString m Token #else@@ -291,7 +292,7 @@ let codec = fromMaybe C.utf8 (mencoding >>= getCodec . CI.mk) - when yieldToken $ lift (mapM (decodeBS codec) tk) >>= yield+ when yieldToken $ (lift (mapM (decodeBS codec) tk) >>= yield) =$= decodeEntitiesText #if MIN_VERSION_conduit(1, 0, 0) C.decode codec =$= tokenStream
tagstream-conduit.cabal view
@@ -1,5 +1,5 @@ Name: tagstream-conduit-Version: 0.5.5.4+Version: 0.5.6 Synopsis: streamlined html tag parser Description: Tag-stream is a library for parsing HTML//XML to a token stream.@@ -26,8 +26,8 @@ location: git://github.com/yihuang/tagstream-conduit Library- Default-Language: Haskell2010 GHC-Options: -Wall -O2+ Default-Language: Haskell2010 Exposed-modules: Text.HTML.TagStream , Text.HTML.TagStream.ByteString , Text.HTML.TagStream.Text@@ -44,11 +44,15 @@ , resourcet , attoparsec >= 0.10 , blaze-builder- , xml-conduit >= 1.1.0.0 && < 1.9+ , xml-conduit >= 1.2.4 , data-default >= 0.5.0+ -- this is needed to access Control.Monad.Fail on GHCs before 8.0+ if !impl(ghc >= 8.0)+ Build-depends:+ fail == 4.9.* test-suite test- Default-Language: Haskell2010+ Default-Language: Haskell2010 hs-source-dirs: tests main-is: Tests.hs type: exitcode-stdio-1.0
tests/Tests.hs view
@@ -225,9 +225,31 @@ , text "foo &" "foo &" , text "foo &" "foo &" , text "foo &" "foo &"++ -- Attribute entity decoding+ , attr "" ""+ , attr "&" "&"+ , attr "& hello" "& hello"+ , attr "&" "&"+ , attr "&" "&"+ , attr """ "\""+ , attr "&unknown;" "&unknown;"+ , attr "a &unknown b" "a &unknown b"+ , attr "\"&unknown\"" "\"&unknown\""+ , attr "foo &bar; mu" "foo &bar; mu"+ , attr "&foo; &bar "mu< zot &hello;" "&foo; &bar \"mu< zot &hello;"+ , attr "<p>" "<p>"+ , attr "<" "<"+ , attr "aaa" "aaa"+ , attr "foo &" "foo &"+ , attr "foo &" "foo &"+ , attr "foo &" "foo &" ] where text b a = ("<p>" <> b <> "</p>" ,concat [[TagOpen "p" [] False],[Text a | not (T.null a)],[TagClose "p"]])+ attr b a = ("<a title='" <> b <> "'></a><a title='" <> b <> "'></a>"+ ,concat [[TagOpen "a" [("title",a)] False],[TagClose "a"]+ ,[TagOpen "a" [("title",a)] False],[TagClose "a"]]) testChar :: Gen Char testChar = growingElements "<>/=\"' \t\r\nabcde\\"