parsec-tagsoup (empty) → 0.1

raw patch · 3 files changed

+197/−0 lines, 3 filesdep +basedep +parsecdep +tagsoupsetup-changed

Dependencies added: base, parsec, tagsoup

Files

• Setup.hs +2/−0
• Text/ParserCombinators/Parsec/Tag.hs +140/−0
• parsec-tagsoup.cabal +55/−0

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,140 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Text.ParserCombinators.Parsec.Tag+ ( TagParser+ , satisfy, lexeme+ , space, whitespace+ , anyTag, anyTagOpen, anyTagClose+ , tag, tagOpen, tagClose+ , tagP, anyTagP+ , tagText+ , oneOf, noneOf+ ) where++import Control.Applicative+import Control.Monad+import Data.Char+import Data.Maybe+import Text.HTML.TagSoup+import Text.StringLike+import Text.ParserCombinators.Parsec.Prim  hiding ((<|>), many)+import Text.ParserCombinators.Parsec.Combinator (many1)+import Text.ParserCombinators.Parsec.Pos++-- | The type of Tag parsers, a synonym for GenParser (Tag str)+type TagParser str st = GenParser (Tag str) st++-- | The primitive tag token parser+tagToken :: (Show str, StringLike str) => (Tag str -> Maybe a) -> TagParser str st a+tagToken = tokenPrim show updatePosTag+  where updatePosTag s _ _ = setSourceLine s ( 1 + sourceLine s )++-- | Parse a tag if it satisfies the predicate.+--   As all the tag parsers, it consumes the whitespace immediately after the parsed tag.+satisfy :: (StringLike str, Show str) => (Tag str -> Bool) -> TagParser str st (Tag str)+satisfy f = lexeme $ tagToken (\t -> if (f t) then Just t else Nothing)+++-- | Parse the given opening or closing tag+--   As all the tag parsers, these consume the whitespace immediately after the parsed tag.+tagOpen, tagClose :: (Show str, StringLike str) => str -> TagParser str st (Tag str)+tagOpen  x = satisfy (isTagOpenName  x) <?> show (TagOpen x [])+tagClose x = satisfy (isTagCloseName x) <?> show (TagClose x)++-- | Parse any opening or closing tag.+--   As all the tag parsers, these consume the whitespace immediately after the parsed tag.+anyTagOpen, anyTagClose :: (Show str, StringLike str) => TagParser str st (Tag str)+anyTagOpen  = satisfy isTagOpen  <?> "<TAG>"+anyTagClose = satisfy isTagClose <?> "</TAG>"++-- | Parses a chunk of text.+--   As all the tag parsers, it consumes the whitespace immediately after the parsed tag.+tagText :: (Show str, StringLike str) => TagParser str st str+tagText   = (lexeme $+             tagToken (\tag -> case tag of+                                TagText x -> Just x+                                _         -> Nothing))+            <?> "TEXT"++-- | Parses a text block containing only characters which satisfy 'isSpace'.+space :: (Show str, StringLike str) => TagParser str st (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) => TagParser str st ()+whitespace = skipMany space++-- | @lexeme p@ first applies parser @p@ and then 'whitespace', returning the value of @p@.+--    +--    @lexeme = (<* whitespace)@+--    +--   Every tag parser is defined using 'lexeme', this way every parse starts at a point+--   without whitespace.+-- +--   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) => TagParser str st a -> TagParser str st a+lexeme p = p <* whitespace++-- | @tag t@ parses any tag for which @(~== t)@ is true.+tag :: forall st str rep . (StringLike str, Show str, TagRep rep) => rep -> TagParser str st (Tag str)+tag t = satisfy (~== t) <?> show(toTagRep t :: Tag str)++-- | Parses any tag for which the predicate is true.+tag' :: (StringLike str, Show str, TagRep str) => (Tag str -> Bool) -> TagParser str st (Tag str)+tag' t = satisfy t <?> "TAG"++-- | The main workhorse.+--+--   @tagP t p@ parses an opening tag @u@ for which @(~== t)@ is true.+--   Then it runs the continuation parser @p@.+--   Next it skips all the tags until the closing tag for @u@.+--   Finally it returns the results of @p@.+-- +--   The @p@ parser should never consume the closing tag for @u@, or tagP will fail.++tagP :: forall rep str st a. (StringLike str, Show str, TagRep rep) => rep -> (Tag str -> TagParser str st a) -> TagParser str st a+tagP t p = lexeme (do+  x@(TagOpen name _) <- tag t+  result <- p x+  skipMany (satisfy (/= TagClose name))--  skipMany tagText+  tagClose name+  return result+  ) <?> show (toTagRep t :: Tag str)++-- | Parses any tag.+anyTag :: (Show str, StringLike str) => TagParser str st (Tag str)+anyTag = lexeme $ tagToken Just++-- | Behaves like @tagP@ sans the predicate. Expects that the next tag will be an opening tag or fails otherwise.+anyTagP :: (Show str, StringLike str) => (Tag str -> TagParser str st a) -> TagParser str st a+anyTagP p = lexeme $ do+  x@(TagOpen name _) <- anyTagOpen+  result <- p x+  skipMany (satisfy (/= TagClose name))+  tagClose name+  return result++elemTag :: StringLike str => Tag str -> [Tag str] -> Bool+elemTag tag = any (tag ~==)++-- | Versions of these Parsec combinators for tags+oneOf, noneOf :: (Show str, StringLike str) => [Tag str] -> TagParser str st (Tag str)+oneOf ts  = satisfy (`elemTag` ts)+noneOf ts = satisfy (not . (`elemTag` ts))++-- | @someTagP t k@ skips tags until it finds an opening tag that satisfies @(~== t)@. From there on it  behaves like 'tagP'.+someTagP :: (Show str, StringLike str, TagRep str) => str -> (Tag str -> TagParser str st a) -> TagParser str st a+someTagP t k = skipMany (satisfy (~/= t)) >>  tagP t k+--someTagP t k = (tagP t k <|> (skipTagP >> someTagP t k)) <* many skipTagP++childrenP :: (Show str, StringLike str) => TagParser str st [Tag str]+childrenP = do+  open@(TagOpen name _) <- anyTagOpen+  content <- many (many1 (TagText <$> tagText) <|> childrenP)+  close <- tagClose name+  return (open : concat content ++ [close])

@@ -0,0 +1,55 @@+-- tagsoup-parsec-alt.cabal auto-generated by cabal init. For+-- additional options, see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name:                parsec-tagsoup++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version:             0.1++-- A short (one-line) description of the package.+Synopsis:            Parsec parsers for Tagsoup tag streams++-- A longer description of the package.+Description:         This package provides a Tag token parser, as well as Tag specific parsing combinators.   ++-- The license under which the package is released.+License:             PublicDomain++-- The package author(s).+Author:              Jose Iborra++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer:          pepeiborra@gmail.com++-- A copyright notice.+-- Copyright:           ++Category:            XML++Build-type:          Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+-- Extra-source-files:  ++-- Constraint on the version of Cabal needed to build this package.+Cabal-version:       >=1.2+++Library+  -- Modules exported by the library.+  Exposed-modules: Text.ParserCombinators.Parsec.Tag+  +  -- Packages needed in order to build this package.+  Build-depends: base < 5, tagsoup, parsec+  +  -- Modules not exported by this package.+  -- Other-modules:       +  +  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+  -- Build-tools:         +