tagsoup-megaparsec 0.1.0.0 → 0.2.0.0

raw patch · 4 files changed

+152/−31 lines, 4 filesdep +containersdep +semigroupsdep ~megaparsecPVP ok

version bump matches the API change (PVP)

Dependencies added: containers, semigroups

Dependency ranges changed: megaparsec

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• README.md +85/−1
• src/Text/Megaparsec/TagSoup.hs +39/−26
• tagsoup-megaparsec.cabal +19/−4

@@ -0,0 +1,9 @@+## tagsoup-megaparsec 0.2.0.0++* Bump dependency on `megaparsec` to 5.0.1.++* `(Show str)` constraint is removed from combinators.++## tagsoup-megaparsec 0.1.0.0++* Initial version.

@@ -2,4 +2,88 @@  [![Build Status](https://travis-ci.org/kseo/tagsoup-megaparsec.svg?branch=master)](https://travis-ci.org/kseo/tagsoup-megaparsec) -A Tag token parser and Tag specific parsing combinators+A Tag token parser and Tag specific parsing combinators, inspired by [parsec-tagsoup][parsec-tagsoup] and [tagsoup-parsec][tagsoup-parsec]. This library helps you build a megaparsec parser using TagSoup's Tag as tokens.++[parsec-tagsoup]: https://hackage.haskell.org/package/parsec-tagsoup+[tagsoup-parsec]: https://hackage.haskell.org/package/tagsoup-parsec++## Usage++### DOM parser++We can build a DOM parser using TagSoup's Tag as a token type in Megaparsec. Let's start the example with importing all the required modules.++```haskell+import Data.Text ( Text )+import qualified Data.Text as T+import Data.HashMap.Strict ( HashMap )+import qualified Data.HashMap.Strict as HMS+import Text.HTML.TagSoup+import Text.Megaparsec+import Text.Megaparsec.ShowToken+import Text.Megaparsec.TagSoup+```++Here's the data types used to represent our DOM. `Node` is either `ElementNode` or `TextNode`. `TextNode` data constructor takes a `Text` and `ElementNode` data constructor takes an `Element` whose fields consist of `elementName`, `elementAttrs` and `elementChildren`.++```haskell+type AttrName   = Text+type AttrValue  = Text++data Element = Element+  { elementName :: !Text+  , elementAttrs :: !(HashMap AttrName AttrValue)+  , elementChildren :: [Node]+  } deriving (Eq, Show)++data Node =+    ElementNode Element+  | TextNode Text+  deriving (Eq, Show)+```++Our `Parser` is defined as a type synonym for `TagParser Text`. `TagParser` takes a type argument representing the string type and we chose `Text` here. We can pass any of `StringLike` types such as `String` and `ByteString`.++```haskell+type Parser = TagParser Text+```++There is nothing new in defining a parser except that our token is `Tag Text` instead of `Char`. We can use any Megaparsec combinators we want as usual. Our `node` parser is either `element` or `text` so we used the choice combinator `(<|>)`.++```haskell+node :: Parser Node+node = ElementNode <$> element+   <|> TextNode <$> text+```++tagsoup-megaparsec library provides some `Tag` specific combinators.++* `tagText`: parse a chunk of text.+* `anyTagOpen`/`anyTagClose`: parse any opening and closing tag.++`text` and `element` parsers are built using these combinators.++NOTE: We don't need to worry about the text blocks containing only whitespace characters because all the parsers provided by tagsoup-megaparsec are lexeme parsers.++```haskell+text :: Parser Text+text = fromTagText <$> tagText++element :: Parser Element+element = do+  t@(TagOpen tagName attrs) <- anyTagOpen+  children <- many node+  closeTag@(TagClose tagName') <- anyTagClose+  if tagName == tagName'+     then return $ Element tagName (HMS.fromList attrs) children+     else fail $ "unexpected close tag" ++ showToken closeTag+```++Now it's time to define our driver. `parseDOM` takes a `Text` and returns either `ParseError` or `[Node]`. We used `many` combinator to represent that there are zero or more occurences of `node`. We used TagSoup's `parseTags` to create tokens and passed it to Megaparsec's `parse` function.++```haskell+parseDOM :: Text -> Either ParseError [Node]+parseDOM html = parse (many node) "" tags+  where tags = parseTags html+```+

@@ -1,4 +1,7 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts   #-}+{-# LANGUAGE FlexibleInstances  #-}+{-# LANGUAGE TypeFamilies       #-}+ -- | -- Module      :  Text.Megaparsec.TagSoup -- Copyright   :  © 2016 Kwang Yul Seo@@ -24,41 +27,52 @@   ) where  import Data.Char (isSpace)-import Data.List (intercalate)+import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NE+import Data.Semigroup ((<>))+import qualified Data.Set as Set import Text.HTML.TagSoup import Text.StringLike import Text.Megaparsec.Combinator import Text.Megaparsec.Error import Text.Megaparsec.Pos import Text.Megaparsec.Prim-import Text.Megaparsec.ShowToken  -- | Different modules corresponding to various types of streams (@String@, -- @Text@, @ByteString@) define it differently, so user can use “abstract” -- @Parser@ type and easily change it by importing different “type -- modules”. This one is for TagSoup tags.-type TagParser str = Parsec [Tag str]+type TagParser str = Parsec Dec [Tag str]  instance (Show str) => ShowToken (Tag str) where-    showToken tag = show tag+    showTokens tags = unwords (NE.toList (NE.map show tags)) -instance (ShowToken (Tag str)) => ShowToken [Tag str] where-    showToken tags = intercalate " " (map showToken tags)+instance (Ord str) => Stream [Tag str] where+  type Token [Tag str] = Tag str+  uncons [] = Nothing+  uncons (t:ts) = Just (t, ts)+  {-# INLINE uncons #-}+  updatePos = const updatePosTag+  {-# INLINE updatePos #-} -updatePosTag :: Int         -- ^ Tab width-             -> SourcePos   -- ^ Initial position-             -> (Tag str)   -- ^ Tag at the position-             -> SourcePos-updatePosTag width sourcePos tag = incSourceColumn sourcePos 1+updatePosTag+  :: Pos                    -- ^ Tab width+  -> SourcePos              -- ^ Current position+  -> Tag str                -- ^ Current token+  -> (SourcePos, SourcePos) -- ^ Actual position and incremented position+updatePosTag _ apos@(SourcePos n l c) _ = (apos, npos)+  where+    u = unsafePos 1+    npos = SourcePos n l (c <> u)  -- | Parses a text block containing only characters which satisfy 'isSpace'.-space :: (Show str, StringLike str, MonadParsec s m (Tag str)) => m (Tag str)+space :: (StringLike str, MonadParsec e s m, Token s ~ Tag str) => m (Tag str) space = satisfy (\tag -> case tag of                            TagText x | all isSpace (toString x) -> True                            _ -> False)  -- | Parses any whitespace. Whitespace consists of zero or more ocurrences of 'space'.-whitespace :: (Show str, StringLike str, MonadParsec s m (Tag str)) => m ()+whitespace :: (StringLike str, MonadParsec e s m, Token s ~ Tag str) => m () whitespace = skipMany space  -- | @lexeme p@ first applies parser @p@ and then 'whitespace', returning the value of @p@.@@ -70,44 +84,43 @@ -- --   The only point where 'whitespace' should be called explicitly is at the start of --   the top level parser, in order to skip any leading whitespace.-lexeme :: (Show str, StringLike str, MonadParsec s m (Tag str)) => m (Tag str) -> m (Tag str)+lexeme :: (StringLike str, MonadParsec e s m, Token s ~ Tag str) => m (Tag str) -> m (Tag str) lexeme p = p <* whitespace  -- | Parses any tag. -- As all the tag parsers, it consumes the whitespace immediately after the parsed tag.-anyTag :: (Show str, StringLike str, MonadParsec s m (Tag str)) => m (Tag str)-anyTag = lexeme $ token updatePosTag Right+anyTag :: (StringLike str, MonadParsec e s m, Token s ~ Tag str) => m (Tag str)+anyTag = lexeme $ token Right Nothing  -- | Parse a tag if it satisfies the predicate. -- As all the tag parsers, it consumes the whitespace immediately after the parsed tag.-satisfy :: (Show str, StringLike str, MonadParsec s m (Tag str)) => (Tag str -> Bool) -> m (Tag str)-satisfy f = lexeme $ token updatePosTag testTag+satisfy :: (StringLike str, MonadParsec e s m, Token s ~ Tag str) => (Tag str -> Bool) -> m (Tag str)+satisfy f = lexeme $ token testTag Nothing   where testTag x = if f x                        then Right x-                       else Left . pure . Unexpected . showToken $ x+                       else Left (Set.singleton (Tokens (x:|[])), Set.empty, Set.empty)  -- | Parse any opening tag. -- As all the tag parsers, it consumes the whitespace immediately after the parsed tag.-anyTagOpen :: (Show str, StringLike str, MonadParsec s m (Tag str)) => m (Tag str)+anyTagOpen :: (StringLike str, MonadParsec e s m, Token s ~ Tag str) => m (Tag str) anyTagOpen = satisfy isTagOpen <?> "any tag open"  -- | Parse any closing tag. -- As all the tag parsers, it consumes the whitespace immediately after the parsed tag.-anyTagClose :: (Show str, StringLike str, MonadParsec s m (Tag str)) => m (Tag str)+anyTagClose :: (StringLike str, MonadParsec e s m, Token s ~ Tag str) => m (Tag str) anyTagClose = satisfy isTagClose <?> "any tag close"  -- | Parses a chunk of text. -- As all the tag parsers, it consumes the whitespace immediately after the parsed tag.-tagText :: (Show str, StringLike str, MonadParsec s m (Tag str)) => m (Tag str)+tagText :: (StringLike str, MonadParsec e s m, Token s ~ Tag str) => m (Tag str) tagText = satisfy isTagText <?> "text"  -- | Parse the given opening tag. -- As all the tag parsers, these consume the whitespace immediately after the parsed tag.-tagOpen :: (Show str, StringLike str, MonadParsec s m (Tag str)) => str -> m (Tag str)+tagOpen :: (StringLike str, MonadParsec e s m, Token s ~ Tag str) => str -> m (Tag str) tagOpen s = satisfy (isTagOpenName s) <?> "tag open"  -- | Parse the given closing tag. -- As all the tag parsers, these consume the whitespace immediately after the parsed tag.-tagClose :: (Show str, StringLike str, MonadParsec s m (Tag str)) => str -> m (Tag str)+tagClose :: (StringLike str, MonadParsec e s m, Token s ~ Tag str) => str -> m (Tag str) tagClose s = satisfy (isTagCloseName s) <?> "tag close"-

@@ -1,5 +1,5 @@ name:                tagsoup-megaparsec-version:             0.1.0.0+version:             0.2.0.0 synopsis:            A Tag token parser and Tag specific parsing combinators description:         Please see README.md homepage:            https://github.com/kseo/tagsoup-megaparsec#readme@@ -10,15 +10,30 @@ copyright:           BSD3 category:            XML build-type:          Simple+tested-with:         GHC == 7.10.1, GHC == 8.0.1 extra-source-files:  README.md+                   , CHANGELOG.md cabal-version:       >=1.10 +flag pedantic+  Description: Enable -Werror+  manual:      True+  Default:     False+ library   hs-source-dirs:      src   exposed-modules:     Text.Megaparsec.TagSoup-  build-depends:       base >= 4.7 && < 5-                     , megaparsec >= 4.4 && < 5-                     , tagsoup >= 0.13 && < 0.15+  build-depends:       base         >= 4.7   && < 5+                     , containers   >= 0.5   && < 0.6+                     , megaparsec   >= 5.0.1 && < 6+                     , tagsoup      >= 0.13  && < 0.15+  if !impl(ghc >= 8.0)+    -- packages providing modules that moved into base-4.9.0.0+    build-depends:     semigroups   == 0.18.*++  ghc-options:         -Wall+  if flag(pedantic)+     ghc-options:      -Werror   default-language:    Haskell2010  test-suite tagsoup-megaparsec-test