packages feed

tagsoup-megaparsec (empty) → 0.1.0.0

raw patch · 6 files changed

+228/−0 lines, 6 filesdep +basedep +hspecdep +megaparsecsetup-changed

Dependencies added: base, hspec, megaparsec, raw-strings-qq, tagsoup, tagsoup-megaparsec

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Kwang Yul Seo (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Kwang Yul Seo nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,5 @@+# tagsoup-megaparsec++[![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
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Text/Megaparsec/TagSoup.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}+-- |+-- Module      :  Text.Megaparsec.TagSoup+-- Copyright   :  © 2016 Kwang Yul Seo+-- License     :  BSD+--+-- Maintainer  :  Kwang Yul Seo <kwangyul.seo@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- Make Tags an instance of 'Stream' with 'Tag str' token type.+module Text.Megaparsec.TagSoup+  ( TagParser+  , space+  , whitespace+  , lexeme+  , satisfy+  , anyTag+  , anyTagOpen+  , anyTagClose+  , tagText+  , tagOpen+  , tagClose+  ) where++import Data.Char (isSpace)+import Data.List (intercalate)+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]++instance (Show str) => ShowToken (Tag str) where+    showToken tag = show tag++instance (ShowToken (Tag str)) => ShowToken [Tag str] where+    showToken tags = intercalate " " (map showToken tags)++updatePosTag :: Int         -- ^ Tab width+             -> SourcePos   -- ^ Initial position+             -> (Tag str)   -- ^ Tag at the position+             -> SourcePos+updatePosTag width sourcePos tag = incSourceColumn sourcePos 1++-- | Parses a text block containing only characters which satisfy 'isSpace'.+space :: (Show str, StringLike str, MonadParsec s m (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 = 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, MonadParsec s m (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++-- | 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+  where testTag x = if f x+                       then Right x+                       else Left . pure . Unexpected . showToken $ x++-- | 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 = 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 = 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 = 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 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 s = satisfy (isTagCloseName s) <?> "tag close"+
+ tagsoup-megaparsec.cabal view
@@ -0,0 +1,39 @@+name:                tagsoup-megaparsec+version:             0.1.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+license:             BSD3+license-file:        LICENSE+author:              Kwang Yul Seo+maintainer:          kwangyul.seo@gmail.com+copyright:           BSD3+category:            XML+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++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+  default-language:    Haskell2010++test-suite tagsoup-megaparsec-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , hspec+                     , megaparsec+                     , raw-strings-qq+                     , tagsoup+                     , tagsoup-megaparsec+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/kseo/tagsoup-megaparsec
+ test/Spec.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE QuasiQuotes #-}+import Test.Hspec+import Text.RawString.QQ+import Text.HTML.TagSoup+import Text.Megaparsec+import Text.Megaparsec.TagSoup++type StringTagParser = TagParser String++testDoc = [r|+<ul>+<li>Item 1</li>+<li>Item 2</li>+</ul>+|]++liParser :: StringTagParser String+liParser = do+  tagOpen "li"+  text <- tagText+  tagClose "li"+  return (fromTagText text)++ulParser :: StringTagParser [String]+ulParser = do+  tagOpen "ul"+  texts <- many liParser+  tagClose "ul"+  return texts++tagParserSpec :: Spec+tagParserSpec = do+  let input = parseTags testDoc+  describe "TagParser" $ do+    it "parses a xml doc" $+      parse (whitespace *> ulParser) "" input `shouldBe` Right ["Item 1", "Item 2"]++main :: IO ()+main = hspec tagParserSpec