list-t-html-parser (empty) → 0.1.0.0

raw patch · 4 files changed

+190/−0 lines, 4 filesdep +base-preludedep +eitherdep +html-tokenizersetup-changed

Dependencies added: base-prelude, either, html-tokenizer, list-t, mtl-prelude, text

Files

LICENSE +22/−0
Setup.hs +2/−0
library/ListT/HTMLParser.hs +112/−0
list-t-html-parser.cabal +54/−0

+ LICENSE view

@@ -0,0 +1,22 @@+Copyright (c) 2015, Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.

+ Setup.hs view

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

+ library/ListT/HTMLParser.hs view

@@ -0,0 +1,112 @@+module ListT.HTMLParser+(+  Parser,+  Error,+  ErrorDetails(..),+  run,+  -- * Parsers+  token,+  openingTag,+  closingTag,+  text,+  comment,+  -- * Combinators+  manyTill,+  skipTill,+)+where++import BasePrelude hiding (uncons, cons)+import MTLPrelude hiding (Error, shift)+import Control.Monad.Trans.Either hiding (left, right)+import ListT (ListT)+import Data.Text (Text)+import qualified ListT as L+import qualified HTMLTokenizer.Parser as HT+++-- |+-- A backtracking HTML parser.+newtype Parser m a =+  Parser { unwrap :: EitherT Error (StateT (ListT m HT.Token, [HT.Token]) m) a }+  deriving (Functor, Applicative, Monad, MonadError Error)++-- | +type Error =+  Maybe ErrorDetails++data ErrorDetails =+  -- | Unexpected token+  UnexpectedToken |+  -- | End of input+  EOI+  deriving (Show)+++instance Monad m => Alternative (Parser m) where+  empty =+    Parser $ EitherT $ return $ Left Nothing+  (<|>) a b =+    Parser $ EitherT $ StateT $ \(incoming, backtrack) -> do+      (aResult, (incoming', backtrack')) <- flip runStateT (incoming, []) $ runEitherT $ unwrap $ a+      case aResult of+        Left _ -> do+          flip runStateT (foldr L.cons incoming' backtrack', []) $ runEitherT $ unwrap $ b+        Right aResult -> do+          return (Right aResult, (incoming', backtrack'))++instance Monad m => MonadPlus (Parser m) where+  mzero = empty+  mplus = (<|>)++-- |+-- Run a parser on a stream of HTML tokens,+-- consuming only as many as needed.+run :: Monad m => Parser m a -> ListT m HT.Token -> m (Either Error a)+run p l =+  flip evalStateT (l, []) $ runEitherT $ unwrap $ p++token :: Monad m => Parser m HT.Token+token =+  Parser $ EitherT $ StateT $ \(incoming, backtrack) -> +  liftM (maybe (Left (Just EOI), (incoming, backtrack)) +               (\(a, incoming') -> (Right a, (incoming', a : backtrack)))) $ +  L.uncons incoming++openingTag :: Monad m => Parser m HT.OpeningTag+openingTag =+  token >>= \case+    HT.Token_OpeningTag x -> return x+    _ -> throwError (Just UnexpectedToken)++closingTag :: Monad m => Parser m HT.ClosingTag+closingTag =+  token >>= \case+    HT.Token_ClosingTag x -> return x+    _ -> throwError (Just UnexpectedToken)++text :: Monad m => Parser m Text+text =+  token >>= \case+    HT.Token_Text x -> return x+    _ -> throwError (Just UnexpectedToken)++comment :: Monad m => Parser m Text+comment =+  token >>= \case+    HT.Token_Comment x -> return x+    _ -> throwError (Just UnexpectedToken)++manyTill :: Monad m => Parser m a -> Parser m b -> Parser m ([a], b)+manyTill a b =+  fix $ \loop -> +    ([],) <$> b <|> +    (\a (al, b) -> (a : al, b)) <$> a <*> loop++-- |+-- Skip any tokens until the provided parser is satisfied.+skipTill :: Monad m => Parser m a -> Parser m a+skipTill a =+  fix $ \loop ->+    a <|> (token *> loop)+

+ list-t-html-parser.cabal view

@@ -0,0 +1,54 @@+name:+  list-t-html-parser+version:+  0.1.0.0+synopsis:+  Streaming HTML parser+category:+  Streaming, HTML, Parser+homepage:+  https://github.com/nikita-volkov/list-t-html-parser+bug-reports:+  https://github.com/nikita-volkov/list-t-html-parser/issues +author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+  (c) 2015, Nikita Volkov+license:+  MIT+license-file:+  LICENSE+build-type:+  Simple+cabal-version:+  >=1.10+++source-repository head+  type:+    git+  location:+    git://github.com/nikita-volkov/list-t-html-parser.git+++library+  hs-source-dirs:+    library+  other-modules:+  exposed-modules:+    ListT.HTMLParser+  ghc-options:+    -funbox-strict-fields+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators+  default-language:+    Haskell2010+  build-depends:+    list-t == 0.4.*,+    html-tokenizer >= 0.2.1 && < 0.3,+    text >= 1 && < 1.3,+    either == 4.*,+    mtl-prelude >= 1 && < 3,+    base-prelude >= 0.1.19 && < 0.2