packages feed

html-parse-util (empty) → 0.2.0

raw patch · 5 files changed

+325/−0 lines, 5 filesdep +attoparsecdep +basedep +html-parse

Dependencies added: attoparsec, base, html-parse, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# 0.2.0++- `html-parse-utils` -> `html-parse-util`
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright Neil Mitchell  2006–2019,+          Tony Zorman    2020–2022.+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 Neil Mitchell 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,8 @@+# html-parse-utils++This is a reimplementation of utility functions from Neil Mitchell's+[TagSoup library], as well as some extra functionality, for Ben Gamari's+[html-parse library]; because yay `Text` and yay `Attoparsec`.++[TagSoup library]: https://hackage.haskell.org/package/tagsoup+[html-parse library]: https://hackage.haskell.org/package/html-parse
+ html-parse-util.cabal view
@@ -0,0 +1,46 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.6.+--+-- see: https://github.com/sol/hpack+--+-- hash: 4509b87ce78b0d31cd8627a9f17a0d7e344fa10333c6ce49efc2dedc47d264d3++name:           html-parse-util+version:        0.2.0+synopsis:       Utility functions for working with html-parse+description:    See README.md <https://gitlab.com/slotThe/html-parse-utils/-/blob/master/README.md here>+category:       Text, XML+homepage:       https://github.com/slotThe/html-parse-util#readme+bug-reports:    https://github.com/slotThe/html-parse-util/issues+author:         Neil Mitchell (TagSoup), Tony Zorman (port to html-parse)+maintainer:     soliditsallgood@mailbox.org+copyright:      2006–2019  Neil Mitchell, 2020–2022  Tony Zorman+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/slotThe/html-parse-util++library+  exposed-modules:+      Text.HTML.Parser.Util+  other-modules:+      Paths_html_parse_util+  hs-source-dirs:+      lib+  default-extensions:+      OverloadedStrings+      LambdaCase+  ghc-options: -Weverything -Wno-implicit-prelude -Wno-missing-import-lists -Wno-unused-packages -Wno-missing-safe-haskell-mode -Wno-all-missed-specialisations -Wno-unsafe -Wno-prepositive-qualified-module+  build-depends:+      attoparsec >=0.13 && <0.15+    , base >=4.7 && <5+    , html-parse >=0.2.0.2 && <0.3+    , text ==1.2.*+  default-language: Haskell2010
+ lib/Text/HTML/Parser/Util.hs view
@@ -0,0 +1,237 @@+{- |+   Module      : Text.HTML.Parser.Util+   Description : Utility functions for the html-parse library+   Copyright   : (c) Neil Mitchell  2006–2019 (TagSoup),+                     Tony Zorman    2020–2022 (port to html-parse)+   License     : BSD-3+   Maintainer  : Tony Zorman <soliditsallgood@mailbox.org>+   Stability   : experimental+   Portability : non-portable++Utility functions to make working with @html-parse@ as easy as working+with TagSoup!  Most functions are one-to-one replacements for their+respective TagSoup analogues and work the same way.+-}+module Text.HTML.Parser.Util+    ( -- * Conversion+      toToken            -- :: Text -> Token+    , toTokenDefault     -- :: Token -> Text -> Token++      -- * Tag identification+    , isTagOpen          -- :: Token -> Bool+    , isTagClose         -- :: Token -> Bool+    , isTagSelfClose     -- :: Token -> Bool+    , isContentText      -- :: Token -> Bool+    , isContentChar      -- :: Token -> Bool+    , isComment          -- :: Token -> Bool+    , isDoctype          -- :: Token -> Bool+    , isTagOpenName      -- :: Text -> Token -> Bool+    , isTagCloseName     -- :: Text -> Token -> Bool++      -- * Extraction+    , fromContentText    -- :: Token -> Text+    , maybeContentText   -- :: Token -> Maybe Text+    , fromAttrib         -- :: Attr -> Token -> Attr+    , maybeAttrib        -- :: Attr -> Token -> Maybe Attr+    , innerText          -- :: [Token] -> Text+    , toHeadContentText  -- :: [Token] -> Text+    , between            -- :: Token -> Token -> [Token] -> [Token]+    , dropHeader         -- :: [Attr] -> [Token] -> [Token]+    , allContentText     -- :: [Token] -> [Text]++      -- * Utility+    , sections           -- :: (a -> Bool) -> [a] -> [[a]]+    , section            -- :: (a -> Bool) -> [a] -> [a]+    , partitions         -- :: (a -> Bool) -> [a] -> [[a]]++      -- * Combinators+    , (~==)              -- :: Token -> Token -> Bool+    , (~/=)              -- :: Token -> Token -> Bool+    ) where++import qualified Data.Attoparsec.Text as A+import qualified Data.List.NonEmpty   as NE+import qualified Data.Text            as T++import Data.Either (fromRight)+import Data.List (groupBy, tails)+import Data.Maybe (fromMaybe, mapMaybe)+import Data.Text (Text)+import Text.HTML.Parser (Attr (Attr), Token (Comment, ContentChar, ContentText, Doctype, TagClose, TagOpen, TagSelfClose), token)+++-- | Like 'toTokenDefault', but with a supplied default value.+--+-- >>> toToken "text"+-- ContentText "text"+toToken :: Text -> Token+toToken = toTokenDefault (Doctype "Could not parse string into token.")++-- | Convert 'Text' to 'Token', with a default in case of a parse failure.+toTokenDefault :: Token -> Text -> Token+toTokenDefault d = fromRight d . A.parseOnly token++-- | This function takes a list, and returns all suffixes whose first item+-- matches the predicate.+--+-- >>> sections (== 'c') "abc cba ccb"+-- ["c cba ccb","cba ccb","ccb","cb"]+sections :: (a -> Bool) -> [a] -> [[a]]+sections p = filter (p . head) . init . tails++-- | Like 'sections', but return the head element.  Returns an empty list if no+-- head element is present.+--+-- >>> section (== 'c') "abc cba ccb"+-- "c cba ccb"+section :: (a -> Bool) -> [a] -> [a]+section f = \case+  [] -> []+  xs -> maybe [] NE.head (NE.nonEmpty (sections f xs))++-- | This function is similar to 'sections', but splits the list so no element+-- appears in any two partitions.+--+-- >>> partitions (== 'c') "abc cba ccb"+-- ["c ","cba ","c","cb"]+partitions :: (a -> Bool) -> [a] -> [[a]]+partitions p = groupBy (const notp) . dropWhile notp+ where notp = not . p++-- | Get the first 'ContentText' element from a list of 'Token's.  If no tag+-- could be found, return an empty string.+toHeadContentText :: [Token] -> Text+toHeadContentText = maybe "" NE.head . NE.nonEmpty . allContentText++-- | Get all 'Token's between @start@ and @end@.+between :: Token -> Token -> [Token] -> [Token]+between start end = takeWhile (~/= end  )+                  . drop 1                 -- drop the tag+                  . dropWhile (~/= start)++-- | Drop an HTML header (i.e. the header tags and everything in between), as+-- well as everything before it, from a list of 'Token's.+dropHeader :: [Attr] -> [Token] -> [Token]+dropHeader attr = drop 1                   -- drop </header>+                . dropWhile (~/= TagClose "header"     )+                . dropWhile (~/= TagOpen  "header" attr)++-- | Get all 'ContentText' entries from a list of 'Token's and extract their+-- content.+allContentText :: [Token] -> [Text]+allContentText = mapMaybe maybeContentText++-- | Test if a 'Token' is a 'TagOpen'.+isTagOpen :: Token -> Bool+isTagOpen = \case+  TagOpen{} -> True+  _         -> False++-- | Test if a 'Token' is a 'TagClose'.+isTagClose :: Token -> Bool+isTagClose = \case+  TagClose{} -> True+  _          -> False++-- | Test if a 'Token' is a 'ContentText'.+isContentText :: Token -> Bool+isContentText = \case+  ContentText{} -> True+  _             -> False++-- | Extract the string from within 'ContentText', otherwise return 'Nothing'.+maybeContentText :: Token -> Maybe Text+maybeContentText = \case+  ContentText t -> Just t+  _             -> Nothing++-- | Extract the string from within 'ContentText', crashes if not a+-- 'ContentText'.+fromContentText :: Token -> Text+fromContentText = \case+  ContentText t -> t+  t             -> error $ "(" ++ show t ++ ") is not a ContentText"++-- | Extract all text content from a list of Tokens (similar to Verbatim found+-- in HaXml).+innerText :: [Token] -> Text+innerText = mconcat . mapMaybe maybeContentText++-- | Test if a 'Token' is a 'TagSelfClose'.+isTagSelfClose :: Token -> Bool+isTagSelfClose = \case+  TagSelfClose{} -> True+  _              -> False++-- | Test if a 'Token' is a 'ContentChar'.+isContentChar :: Token -> Bool+isContentChar = \case+  ContentChar{} -> True+  _             -> False++-- | Test if a 'Token' is a 'Comment'.+isComment :: Token -> Bool+isComment = \case+  Comment{} -> True+  _         -> False++-- | Test if a 'Token' is a 'Doctype'.+isDoctype :: Token -> Bool+isDoctype = \case+  Doctype{} -> True+  _         -> False++-- | Returns True if the 'Token' is 'TagOpen' and matches the given name.+isTagOpenName :: Text -> Token -> Bool+isTagOpenName name (TagOpen n _) = n == name+isTagOpenName _    _             = False++-- | Returns True if the 'Token' is 'TagClose' and matches the given name.+isTagCloseName :: Text -> Token -> Bool+isTagCloseName name (TagClose n) = n == name+isTagCloseName _    _            = False++-- | Extract an attribute; crashes if not a 'TagOpen'.  Returns @Attr \"\" \"\"@+-- if no attribute present.+--+-- Warning: does not distinguish between missing attribute and present+-- attribute with values @\"\"@.+fromAttrib :: Attr -> Token -> Attr+fromAttrib att tag = fromMaybe (Attr "" "") $ maybeAttrib att tag++-- | Extract an attribute; crashes if not a 'TagOpen'.  Returns+-- 'Nothing' if no attribute present.+maybeAttrib :: Attr -> Token -> Maybe Attr+maybeAttrib att (TagOpen _ atts)+  | att `elem` atts = Just att+  | otherwise       = Nothing+maybeAttrib _ t = error ("(" ++ show t ++ ") is not a TagOpen")++infixl 9 ~==+-- | Performs an inexact match, the first item should be the thing to+-- match.+--+-- >>> ContentText "test" ~== ContentText ""+-- True+--+-- >>> TagOpen "div" [Attr "class" "division ", Attr "id" "dd"] ~== TagOpen "div" [Attr "class" "division "]+-- True+(~==) :: Token -> Token -> Bool+(~==) = f+ where+  f (ContentText y) (ContentText x) = T.null x             || x == y+  f (TagClose    y) (TagClose    x) = T.null x             || x == y+  f (Comment     x) (Comment     y) = x == mempty          || x == y+  f (TagOpen  y ys) (TagOpen  x xs) = (T.null x || x == y) && all g xs+   where+    g :: Attr -> Bool+    g nv@(Attr name val)+      | T.null name = val  `elem` map (\(Attr o _) -> o) ys+      | T.null val  = name `elem` map (\(Attr _ t) -> t) ys+      | otherwise   = nv   `elem` ys+  f _ _ = False++infixl 9 ~/=+-- | Negation of '(~==)'.+(~/=) :: Token -> Token -> Bool+(~/=) a b = not (a ~== b)