onama (empty) → 0.1.0.0
raw patch · 4 files changed
+293/−0 lines, 4 filesdep +basedep +parsecdep +tagsoupsetup-changed
Dependencies added: base, parsec, tagsoup
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- Text/HTML/Onama.hs +189/−0
- onama.cabal +72/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, William Yao++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 William Yao 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Text/HTML/Onama.hs view
@@ -0,0 +1,189 @@+{-|+ Module: Text.HTML.Onama+ Description: Parsec extended with functions to handle HTML parsing.+ Copyright: (c) William Yao, 2017+ License: BSD-3+ Maintainer: williamyaoh@gmail.com+ Stability: experimental++ Some extra primitives to parse HTMl with Parsec.++ You'll still need to import "Text.Parsec" along with this library. These+ primitives will work with all the combinators from Parsec. Note that you'll+ need to override Parsec's @satisfies@, since that one only works on+ character streams (for some reason).++ > testParser = dp+ > tagOpen "b"+ > bolded <- text+ > tagClose "b"++ > testParser2 = do+ > tagClose "div"+ > tagOpen "p"+ > inner <- text+ > tagClose "p"+ -}+module Text.HTML.Onama+ ( Tag(..)+ , Position++ , parseTags++ , tag+ , satisfy+ , tagOpen, tagOpenAny+ , tagOpen_, tagOpenAny_+ , tagClose , tagCloseAny+ , tagClose_, tagCloseAny_++ , tagText , tagTextAny+ , text+ )+where++import qualified Text.HTML.TagSoup as TS+import Text.StringLike++import qualified Text.Parsec as P+import Text.Parsec+ ( (<|>), (<?>), label, labels+ , try, unexpected+ , choice+ , count, skipMany1, many1+ , sepBy, sepBy1, endBy, endBy1, sepEndBy, sepEndBy1+ , chainl, chainl1, chainr, chainr1+ , eof+ , notFollowedBy+ , manyTill+ , lookAhead+ , anyToken+ , between+ , option, optionMaybe, optional+ , unknownError, sysUnExpectError, mergeErrorReply+ )++type Position = (TS.Row, TS.Column)++data Tag str+ = TagOpen str [TS.Attribute str] Position+ | TagClose str Position+ | TagText str Position+ deriving (Eq, Show)++parseOptions :: StringLike str => TS.ParseOptions str+parseOptions = TS.parseOptions { TS.optTagPosition = True }++type CurrentPos str = (Position, [Tag str])++startPos :: CurrentPos str+startPos = ((1, 1), [])++-- | Return a list of tags parsed from some sort of string.+-- This list should then get fed into an Onama parser.+parseTags :: StringLike str => str -> [Tag str]+parseTags str =+ reverse $ snd $ foldl attachPos startPos $+ TS.canonicalizeTags $ TS.parseTagsOptions parseOptions str+ where attachPos (pos, tags) tag =+ case tag of+ TS.TagOpen name attrs -> (pos, TagOpen name attrs pos : tags)+ TS.TagClose name -> (pos, TagClose name pos : tags)+ TS.TagText text -> (pos, TagText text pos : tags)+ TS.TagComment _ -> (pos, tags)+ TS.TagWarning _ -> (pos, tags)+ TS.TagPosition row col -> ((row, col), tags)++updatePos :: P.SourcePos -> Tag str -> [Tag str] -> P.SourcePos+updatePos pos tok _ =+ let (row, col) = case tok of+ TagOpen _ _ pos -> pos+ TagClose _ pos -> pos+ TagText _ pos -> pos+ in flip P.setSourceLine row $ flip P.setSourceColumn col $ pos++-- | Primitive. Return the next input tag.+-- All other primitive parsers should be implemented in terms of this.+tag :: (Monad m, Show str) => P.ParsecT [Tag str] u m (Tag str)+tag = P.tokenPrim show updatePos Just++-- | Create a parser which parses a single HTML tag if it passes+-- the given predicate. Return the parsed tag.+satisfy :: (Monad m, Show str) => (Tag str -> Bool) -> P.ParsecT [Tag str] u m (Tag str)+satisfy f = P.tokenPrim show updatePos $ \tag ->+ if f tag then Just tag else Nothing++-- | Tag name should be lowercase.+-- Return the parsed tag.+tagOpen_ :: (Monad m, Show str, Eq str) => str -> P.ParsecT [Tag str] u m (Tag str)+tagOpen_ str = satisfy $ \tag ->+ case tag of+ TagOpen name _ _ -> str == name+ _ -> False++-- | Tag name should be lowercase.+-- Skips over any text nodes in the HTML before attempting to parse+-- an open tag. Usually this is what you want. If not, use 'tagOpen_'.+tagOpen :: (Monad m, Show str, Eq str) => str -> P.ParsecT [Tag str] u m (Tag str)+tagOpen str = optional text >> tagOpen_ str++tagOpenAny_ :: (Monad m, Show str) => P.ParsecT [Tag str] u m (Tag str)+tagOpenAny_ = satisfy $ \tag ->+ case tag of+ TagOpen _ _ _ -> True+ _ -> False++-- | Skips over any text nodes in the HTML before attempting to parse+-- an open tag. Usually this is what you want. If not, use 'tagOpenAny_'.+tagOpenAny :: (Monad m, Show str) => P.ParsecT [Tag str] u m (Tag str)+tagOpenAny = optional text >> tagOpenAny_++-- | Tag name should be lowercase.+-- Return the parsed tag.+tagClose_ :: (Monad m, Show str, Eq str) => str -> P.ParsecT [Tag str] u m (Tag str)+tagClose_ str = satisfy $ \tag ->+ case tag of+ TagClose name _ -> str == name+ _ -> False++-- | Tag name should be lowercase.+-- Skips over any text nodes in the HTML before attempting to parse+-- a close tag. Usually this is what you want. If not, use 'tagClose_'.+tagClose :: (Monad m, Show str, Eq str) => str -> P.ParsecT [Tag str] u m (Tag str)+tagClose str = optional text >> tagClose_ str++tagCloseAny_ :: (Monad m, Show str) => P.ParsecT [Tag str] u m (Tag str)+tagCloseAny_ = satisfy $ \tag ->+ case tag of+ TagClose _ _ -> True+ _ -> False++-- | Skips over any text nodes in the HTML before attempting to parse+-- a close tag. Usually this is what you want. If not, use 'tagCloseAny_'.+tagCloseAny :: (Monad m, Show str) => P.ParsecT [Tag str] u m (Tag str)+tagCloseAny = optional text >> tagCloseAny_++-- | Return the parsed tag.+tagText :: (Monad m, Show str, Eq str) => str -> P.ParsecT [Tag str] u m (Tag str)+tagText str = satisfy $ \tag ->+ case tag of+ TagText text _ -> str == text+ _ -> False++tagTextAny :: (Monad m, Show str) => P.ParsecT [Tag str] u m (Tag str)+tagTextAny = satisfy $ \tag ->+ case tag of+ TagText text _ -> True+ _ -> False++-- | Parse and return the text of a text tag.+text :: (Monad m, Show str) => P.ParsecT [Tag str] u m str+text = do+ tag <- tagTextAny+ case tag of+ TagText t _ -> return t+ _other -> fail "Could not find a text tag."++-- | @skip p@ produces a parser which will ignore the output of @p@.+skip :: P.Stream s m t => P.ParsecT s u m a -> P.ParsecT s u m ()+skip p = p >> return ()
+ onama.cabal view
@@ -0,0 +1,72 @@+-- Initial onama.cabal generated by cabal init. For further documentation,+-- see http://haskell.org/cabal/users-guide/++-- The name of the package.+name: onama++-- The package version. See the Haskell package versioning policy (PVP)+-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary: +-+------- breaking API changes+-- | | +----- non-breaking API additions+-- | | | +--- code changes with no API change+version: 0.1.0.0++synopsis: HTML-parsing primitives for Parsec.++-- A longer description of the package.+description: Provides Parsec primitives for parsing various HTML entities.+ Requires Parsec in order to use and combine them.++-- The license under which the package is released.+license: BSD3++-- The file containing the license text.+license-file: LICENSE++-- The package author(s).+author: William Yao++-- An email address to which users can send suggestions, bug reports, and+-- patches.+maintainer: williamyaoh@gmail.com++-- A copyright notice.+-- copyright:++category: Text++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.10++-- Information about the package's version control system.+source-repository head+ type: git+ location: https://www.github.com/williamyaoh/onama/++library+ -- Modules exported by the library.+ exposed-modules: Text.HTML.Onama++ -- Modules included in this library but not exported.+ -- other-modules:++ -- LANGUAGE extensions used by modules in this package.+ -- other-extensions:++ -- Other library packages from which modules are imported.+ build-depends: base >=4.8 && <4.9+ , tagsoup+ , parsec++ -- Directories containing source files.+ -- hs-source-dirs:++ -- Base language which the package is written in.+ default-language: Haskell2010