packages feed

html-tokenizer (empty) → 0.2.1.1

raw patch · 5 files changed

+361/−0 lines, 5 filesdep +attoparsecdep +basedep +base-preludebuild-type:Customsetup-changed

Dependencies added: attoparsec, base, base-prelude, case-insensitive, conversion, conversion-case-insensitive, conversion-text, directory, doctest, filepath, html-entities, text

Files

+ 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,42 @@+-- The code is mostly ripped from+-- https://github.com/ekmett/lens/blob/697582fb9a980f273dbf8496253c5bbefedd0a8b/Setup.lhs+import Data.List ( nub )+import Data.Version ( showVersion )+import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )+import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles )+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))+import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )+import Distribution.Text ( display )+import Distribution.Verbosity ( Verbosity, normal )+import System.FilePath ( (</>) )++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+  { buildHook = \pkg lbi hooks flags -> do+     generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi+     buildHook simpleUserHooks pkg lbi hooks flags+  }++generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+generateBuildModule verbosity pkg lbi = do+  let dir = autogenModulesDir lbi+  createDirectoryIfMissingVerbose verbosity True dir+  withLibLBI pkg lbi $ \_ libcfg -> do+    withTestLBI pkg lbi $ \suite suitecfg -> do+      rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines+        [ "module Build_" ++ testName suite ++ " where"+        , "import Prelude"+        , "deps :: [String]"+        , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))+        ]+  where+    formatdeps = map (formatone . snd)+    formatone p = case packageName p of+      PackageName n -> n ++ "-" ++ showVersion (packageVersion p)++testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]+testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys+
+ doctest/Main.hs view
@@ -0,0 +1,66 @@+-- The code is mostly ripped from+-- https://github.com/ekmett/lens/blob/d1d97469f0e93c1d3535308954a060e8a04e37aa/tests/doctests.hsc+import BasePrelude+import System.Directory+import System.FilePath+import Test.DocTest+import Build_doctest (deps)++main :: IO ()+main = do+  sources <- getSources+  doctest $ dfltParams ++ map ("-package="++) deps ++ sources+  where+    dfltParams = +      [+        "-isrc",+        "-idist/build/autogen",+        "-optP-include",+        "-optPdist/build/autogen/cabal_macros.h",+        "-XArrows",+        "-XBangPatterns",+        "-XConstraintKinds",+        "-XDataKinds",+        "-XDefaultSignatures",+        "-XDeriveDataTypeable",+        "-XDeriveFunctor",+        "-XDeriveGeneric",+        "-XEmptyDataDecls",+        "-XFlexibleContexts",+        "-XFlexibleInstances",+        "-XFunctionalDependencies",+        "-XGADTs",+        "-XGeneralizedNewtypeDeriving",+        "-XImpredicativeTypes",+        "-XLambdaCase",+        "-XLiberalTypeSynonyms",+        "-XMultiParamTypeClasses",+        "-XMultiWayIf",+        "-XNoImplicitPrelude",+        "-XNoMonomorphismRestriction",+        "-XOverloadedStrings",+        "-XPatternGuards",+        "-XParallelListComp",+        "-XQuasiQuotes",+        "-XRankNTypes",+        "-XRecordWildCards",+        "-XScopedTypeVariables",+        "-XStandaloneDeriving",+        "-XTemplateHaskell",+        "-XTupleSections",+        "-XTypeFamilies",+        "-XTypeOperators",+        "-hide-all-packages"+      ]++getSources :: IO [FilePath]+getSources = filter (isSuffixOf ".hs") <$> go "library"+  where+    go dir = do+      (dirs, files) <- getFilesAndDirectories dir+      (files ++) . concat <$> mapM go dirs++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir+  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c
+ html-tokenizer.cabal view
@@ -0,0 +1,88 @@+name:+  html-tokenizer+version:+  0.2.1.1+synopsis:+  An "attoparsec"-based HTML tokenizer+description:+  This library can be used as a basis for complex HTML parsers,+  or for streaming.+  E.g., by composing it with +  <http://hackage.haskell.org/package/list-t-attoparsec the "list-t-attoparsec" library>+  you can produce a token stream with HTML-entities decoded,+  thus becoming able to implement a highly efficient stream-parser,+  which works in a single pass, constant memory and is capable of early termination.+  <http://hackage.haskell.org/package/list-t-html-parser "list-t-html-parser"> is such a parser.+category:+  Parsing, HTML, XML+homepage:+  https://github.com/nikita-volkov/html-tokenizer+bug-reports:+  https://github.com/nikita-volkov/html-tokenizer/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:+  Custom+cabal-version:+  >=1.10+++source-repository head+  type:+    git+  location:+    git://github.com/nikita-volkov/html-tokenizer.git+++library+  hs-source-dirs:+    library+  other-modules:+  exposed-modules:+    HTMLTokenizer.Parser+  build-depends:+    html-entities == 1.0.*,+    conversion >= 1.0.1 && < 2,+    conversion-text == 1.0.*,+    conversion-case-insensitive == 1.*,+    case-insensitive == 1.2.*,+    text >= 1 && < 1.3,+    attoparsec >= 0.10 && < 0.13,+    base-prelude >= 0.1.19 && < 0.2+  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+++test-suite doctest+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    doctest+  main-is:+    Main.hs+  ghc-options:+    -threaded+    "-with-rtsopts=-N"+    -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:+    doctest == 0.9.*,+    directory == 1.2.*,+    filepath >= 1.3 && < 1.5,+    base-prelude,+    base
+ library/HTMLTokenizer/Parser.hs view
@@ -0,0 +1,143 @@+module HTMLTokenizer.Parser+(+  -- * Model+  Token(..),+  OpeningTag,+  ClosingTag,+  Attribute,+  -- * Parsers+  token,+)+where++import BasePrelude+import Conversion+import Conversion.Text+import Conversion.CaseInsensitive+import Data.Text (Text)+import Data.Text.Lazy.Builder (Builder)+import Data.CaseInsensitive (CI)+import HTMLEntities.Parser+import Data.Attoparsec.Text+import qualified Data.Text+++-- |+-- An HTML token.+data Token =+  -- |+  -- An opening tag.+  Token_OpeningTag OpeningTag |+  -- |+  -- A closing tag name.+  Token_ClosingTag (CI Text) |+  -- |+  -- A text between tags with HTML-entities decoded.+  Token_Text Text |+  -- |+  -- Contents of a comment.+  Token_Comment Text +  deriving (Show, Ord, Eq, Generic, Data, Typeable)++-- |+-- An opening tag name, attributes and whether it is closed.+type OpeningTag =+  (CI Text, [Attribute], Bool)++-- |+-- A closing tag name.+type ClosingTag =+  CI Text++-- |+-- A tag attribute identifier and a value with HTML-entities decoded.+type Attribute =+  (CI Text, Maybe Text)++-- |+-- A token parser.+token :: Parser Token+token =+  skipSpace *> (+    Token_Comment <$> comment <|>+    Token_ClosingTag <$> closingTag <|>+    Token_OpeningTag <$> openingTag <|>+    Token_Text <$> text+  )++openingTag :: Parser OpeningTag+openingTag =+  do+    char '<'+    skipSpace+    name <- identifier+    attributes <- many $ space *> skipSpace *> attribute+    skipSpace+    closed <- convert <$> optional (char '/')+    char '>'+    return (convert name, attributes, closed)++attribute :: Parser Attribute+attribute =+  do+    identifierValue <- identifier+    value <-+      optional $ do+        skipSpace+        char '='+        skipSpace+        msum (map quotedValue quotChars) <|> entityQuotedValue <|> unquotedValue+    return (convert identifierValue, value)+  where+    quotedValue q =+      do+        char q+        value <- +          fmap ((convert :: Builder -> Text) . mconcat) $ many $ +          fmap convert htmlEntity <|> fmap convert (satisfy (/= q))+        char q+        return value+    unquotedValue =+      takeWhile1 isAlphaNum+    entityQuotedValue =+      do+        q <- htmlEntity >>= \c -> bool mzero (return c) (elem c (map convert quotChars))+        fmap ((convert :: Builder -> Text) . mconcat) $ +          manyTill' (fmap convert anyChar) (htmlEntity >>= guard . (==) q)+    quotChars =+      ['"', '\'', '`']+++identifier :: Parser Text+identifier = +  takeWhile1 (flip any [isAlphaNum, flip elem ['_', '-', '!', '?']] . flip ($))++comment :: Parser Text+comment =+  (convert :: Builder -> Text) <$> (string "<!--" *> content)+  where+    content =+      (liftA2 mappend+        (fmap convert (takeWhile1 (/= '-')))+        (mplus+          (fmap (const mempty) (string "-->"))+          (liftA2 mappend+            (fmap convert (char '-'))+            (content))))++closingTag :: Parser ClosingTag+closingTag =+  string "</" *> skipSpace *> fmap convert identifier <* skipSpace <* char '>'++text :: Parser Text+text =+  fmap ((convert :: Builder -> Text) . mconcat) $ many1 $+  convert <$> htmlEntity <|> convert <$> nonTagChar+  where+    nonTagChar =+      shouldFail comment *> shouldFail closingTag *> shouldFail openingTag *> anyChar++shouldFail :: Parser a -> Parser ()+shouldFail p =+  ((p $> False) <|> pure True) >>= bool empty (pure ())+