list-t-html-parser 0.3.0.0 → 0.4.0.0

raw patch · 4 files changed

+96/−35 lines, 4 filesdep +conversion-case-insensitivedep ~html-tokenizerPVP ok

version bump matches the API change (PVP)

Dependencies added: conversion-case-insensitive

Dependency ranges changed: html-tokenizer

API changes (from Hackage documentation)

Files

• hspec/Main.hs +14/−2
• library/ListT/HTMLParser.hs +65/−20
• library/ListT/HTMLParser/Renderer.hs +12/−11
• list-t-html-parser.cabal +5/−2

@@ -15,6 +15,18 @@  main =   hspec $ do+    it "text with spaces gets ignored" $ do+      result <- parse (P.openingTag *> P.closingTag) "<a>   </a>"+      shouldSatisfy result isRight+    it "text gets trimmed" $ do+      result <- parse (P.openingTag *> P.text <* P.closingTag) "<a>  b </a>"+      shouldBe result (Right "b")+    it "html consumes text" $ do+      result <- parse P.html "a<br/>"+      shouldBe result (Right "a")+    it "html consumes comment" $ do+      result <- parse P.html "<!--a-->b"+      shouldBe result (Right "<!--a-->")     it "Backtracking" $ do       let          text = "<a><b></b></a>"@@ -121,10 +133,10 @@         let text = "<ul><li>I'm not your friend, <b>buddy</b>!</li><li>I'm not your buddy, <b>guy</b>!</li><li>He's not your guy, <b>friend</b>!</li><li>I'm not your friend, <b>buddy</b>!</li></ul>"         it "Single" $ do           Right result <- parse (P.openingTag *> P.html) text-          shouldBe result "<li>I&#39;m not your friend, <b>buddy</b>!</li>"+          shouldBe result "<li>I'm not your friend, <b>buddy</b>!</li>"         it "Multiple" $ do           Right result <- parse (P.openingTag *> (mconcat <$> many P.properHTML) <* P.closingTag) text-          shouldBe result "<li>I&#39;m not your friend, <b>buddy</b>!</li><li>I&#39;m not your buddy, <b>guy</b>!</li><li>He&#39;s not your guy, <b>friend</b>!</li><li>I&#39;m not your friend, <b>buddy</b>!</li>"+          shouldBe result "<li>I'm not your friend, <b>buddy</b>!</li><li>I'm not your buddy, <b>guy</b>!</li><li>He's not your guy, <b>friend</b>!</li><li>I'm not your friend, <b>buddy</b>!</li>"  parse :: ListT.HTMLParser.Parser IO a -> Text -> IO (Either Error a) parse parser =

@@ -7,6 +7,8 @@   -- * Parsers   eoi,   token,+  rawToken,+  space,   openingTag,   closingTag,   text,@@ -26,10 +28,14 @@ import Control.Monad.Trans.Either hiding (left, right) import ListT (ListT) import Data.Text (Text)+import Conversion+import Conversion.Text+import qualified Data.Text as Text import qualified Data.Text.Lazy.Builder as Text (Builder) import qualified Data.Text.Lazy.Builder as Text.Builder import qualified ListT as L import qualified HTMLTokenizer.Parser as HT+import qualified HTMLEntities.Decoder import qualified ListT.HTMLParser.Renderer as Renderer  @@ -88,22 +94,55 @@   flip evalStateT (l, []) $ runEitherT $ unwrap $ p  -- |--- End of input.-eoi :: Monad m => Parser m ()-eoi =-  token $> () <|> pure ()---- |--- Any HTML token.-token :: Monad m => Parser m HT.Token-token =+-- An HTML token as it is: without HTML-decoding and ignoring of spaces.+rawToken :: Monad m => Parser m HT.Token+rawToken =   Parser $ EitherT $ StateT $ \(incoming, backtrack) ->    liftM (maybe (Left (Just ErrorDetails_EOI), (incoming, backtrack))                 (\(a, incoming') -> (Right a, (incoming', a : backtrack)))) $    L.uncons incoming  -- |--- An opening tag.+-- A token with HTML entities decoded and with spaces filtered out.+token :: Monad m => Parser m HT.Token+token =+  rawToken >>= \case+    HT.Token_Text x -> Text.strip x & \x -> if Text.null x +      then token +      else fmap (HT.Token_Text . convert) $ decodeEntities x+    HT.Token_Comment x -> fmap (HT.Token_Comment . convert) $ decodeEntities x+    HT.Token_OpeningTag (name, attrs, closed) -> +      fmap HT.Token_OpeningTag $+        (,,) <$> +          pure name <*> +          (traverse . traversePair . traverse) ((fmap . fmap) convert decodeEntities) attrs <*> +          pure closed+    x -> return x+  where+    decodeEntities =+      either (throwError . Just . ErrorDetails_Message . convert) return .+      HTMLEntities.Decoder.htmlEncodedText+    traversePair :: Functor f => (a -> f b) -> (c, a) -> f (c, b)+    traversePair f (x, y) = (,) x <$> f y+++-- |+-- A text token, which is completely composed of characters,+-- which satisfy the 'isSpace' predicate.+space :: Monad m => Parser m Text+space =+  rawToken >>= \case+    HT.Token_Text x | Text.all isSpace x -> return x+    _ -> throwError (Just ErrorDetails_UnexpectedToken)++-- |+-- End of input.+eoi :: Monad m => Parser m ()+eoi =+  rawToken $> () <|> pure ()++-- |+-- An opening tag with HTML entities in values decoded. openingTag :: Monad m => Parser m HT.OpeningTag openingTag =   token >>= \case@@ -112,14 +151,14 @@  -- | -- A closing tag.-closingTag :: Monad m => Parser m HT.ClosingTag+closingTag :: Monad m => Parser m HT.Identifier closingTag =   token >>= \case     HT.Token_ClosingTag x -> return x     _ -> throwError (Just ErrorDetails_UnexpectedToken)  -- |--- A text between tags with HTML-entities decoded.+-- A text between tags with HTML entities decoded. text :: Monad m => Parser m Text text =   token >>= \case@@ -154,7 +193,7 @@ skipTill :: Monad m => Parser m a -> Parser m a skipTill a =   fix $ \loop ->-    a <|> (token *> loop)+    a <|> (rawToken *> loop)  -- | -- Greedily consume all the input until the end,@@ -186,7 +225,7 @@ --  -- it'll produce the following text builder value: -- --- > <li>I&#39;m not your friend, <b>buddy</b>!</li>+-- > <li>I'm not your friend, <b>buddy</b>!</li> --  -- If you want to consume all children of a node, -- it's recommended to use 'properHTML' in combination with 'many' or 'many1'.@@ -225,10 +264,10 @@ --  -- will produce a merged text builder, which consists of the following nodes: -- --- >   <li>I&#39;m not your friend, <b>buddy</b>!</li>--- >   <li>I&#39;m not your buddy, <b>guy</b>!</li>--- >   <li>He&#39;s not your guy, <b>friend</b>!</li>--- >   <li>I&#39;m not your friend, <b>buddy</b>!</li>+-- >   <li>I'm not your friend, <b>buddy</b>!</li>+-- >   <li>I'm not your buddy, <b>guy</b>!</li>+-- >   <li>He's not your guy, <b>friend</b>!</li>+-- >   <li>I'm not your friend, <b>buddy</b>!</li> --  -- Notice that unlike with 'html', it's safe to assume  -- that it will not consume the following closing @\<\/ul\>@ tag,@@ -245,7 +284,7 @@ cleanTokenSequence :: Monad m => Parser m [HT.Token] cleanTokenSequence =   fmap (fmap (either id id)) $-  flip execStateT [] $ fix $ \loop -> lift token >>= \case+  flip execStateT [] $ fix $ \loop -> lift rawToken >>= \case     HT.Token_ClosingTag ct -> do       ours <- state $ \list -> fromMaybe ([], list) $ do         (l, r) <- Just $ flip break list $ \case@@ -259,9 +298,15 @@         else do           modify $ mappend $ (:) (Left (HT.Token_ClosingTag ct)) $ fmap (either Left Left) $ ours           loop'-    t -> do+    t@(HT.Token_OpeningTag _) -> do       modify $ (:) $ Right t       loop+    t -> do+      context <- get+      modify $ (:) $ Right t+      if null context+        then return ()+        else loop   where     closeOpeningTag =       \case

@@ -1,36 +1,37 @@ module ListT.HTMLParser.Renderer where  import BasePrelude hiding (fromString)+import Conversion+import Conversion.Text import Data.Text (Text) import Data.Text.Lazy.Builder-import HTMLTokenizer.Parser (Token(..), OpeningTag, ClosingTag, Attribute)+import HTMLTokenizer.Parser (Token(..), OpeningTag, Identifier, Attribute) import qualified Data.CaseInsensitive as CI-import qualified HTMLEntities.Builder   openingTag :: OpeningTag -> Builder openingTag (name, attrs, closed) =   singleton '<' <>-  ciText name <>+  identifier name <>   mconcat (map (mappend (singleton ' ') . attribute) attrs) <>   bool (singleton '>') (fromString "/>") closed  attribute :: Attribute -> Builder attribute (name, value) =-  maybe id (flip mappend . mappend (fromString "=\"") . flip mappend (singleton '"') . HTMLEntities.Builder.text) value $-  ciText name+  maybe id (flip mappend . mappend (fromString "=\"") . flip mappend (singleton '"') . convert) value $+  identifier name -ciText :: CI.CI Text -> Builder-ciText =-  HTMLEntities.Builder.text . CI.foldedCase  +identifier :: Identifier -> Builder+identifier =+  convert . CI.foldedCase   -closingTag :: ClosingTag -> Builder+closingTag :: Identifier -> Builder closingTag name =-  fromString "</" <> ciText name <> singleton '>'+  fromString "</" <> identifier name <> singleton '>'  text :: Text -> Builder text =-  HTMLEntities.Builder.text+  convert  comment :: Text -> Builder comment content =

@@ -1,7 +1,7 @@ name:   list-t-html-parser version:-  0.3.0.0+  0.4.0.0 synopsis:   Streaming HTML parser category:@@ -50,8 +50,11 @@     Haskell2010   build-depends:     list-t == 0.4.*,-    html-tokenizer >= 0.2.1 && < 0.3,+    html-tokenizer >= 0.3 && < 0.4,     html-entities >= 1.0.1 && < 1.2,+    conversion == 1.*,+    conversion-text == 1.*,+    conversion-case-insensitive == 1.*,     case-insensitive == 1.2.*,     text >= 1 && < 1.3,     either == 4.*,