tagstream-conduit 0.5.5.1 → 0.5.6
raw patch · 5 files changed
Files
- Text/HTML/TagStream/ByteString.hs +3/−2
- Text/HTML/TagStream/Entities.hs +12/−1
- Text/HTML/TagStream/Text.hs +5/−4
- tagstream-conduit.cabal +13/−9
- tests/Tests.hs +22/−0
Text/HTML/TagStream/ByteString.hs view
@@ -6,7 +6,8 @@ import qualified Blaze.ByteString.Builder as B import Control.Applicative import Control.Monad (unless)-import Data.Attoparsec.Char8+import qualified Control.Monad.Fail as Fail+import Data.Attoparsec.ByteString.Char8 import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S import Data.Conduit@@ -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.1+Version: 0.5.6 Synopsis: streamlined html tag parser Description: Tag-stream is a library for parsing HTML//XML to a token stream.@@ -19,7 +19,7 @@ , Parse.hs , HighlightText.hs , ParseText.hs-Cabal-version: >=1.8+Cabal-version: >=1.10 source-repository head type: git@@ -27,6 +27,7 @@ Library GHC-Options: -Wall -O2+ Default-Language: Haskell2010 Exposed-modules: Text.HTML.TagStream , Text.HTML.TagStream.ByteString , Text.HTML.TagStream.Text@@ -38,24 +39,27 @@ , text , case-insensitive , transformers >= 0.2- , conduit >= 0.5 && < 1.2- , conduit-extra+ , conduit >= 1.2+ , conduit-extra >= 1.1.0 , resourcet- , attoparsec+ , attoparsec >= 0.10 , blaze-builder- , blaze-builder-conduit >= 0.5 && < 1.2- , attoparsec-conduit >= 0.5- , xml-conduit >= 1.1.0.0+ , 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 hs-source-dirs: tests main-is: Tests.hs type: exitcode-stdio-1.0 build-depends: base >= 4 && < 5 , bytestring , text- , conduit >= 0.0.2+ , conduit >= 1.2 , QuickCheck , HUnit , hspec >= 1.3
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\\"