zenacy-html 2.1.0 → 2.1.1
raw patch · 9 files changed
+73/−42 lines, 9 filesdep ~bytestringdep ~text
Dependency ranges changed: bytestring, text
Files
- CHANGES.md +8/−0
- src/Zenacy/HTML/Internal/DOM.hs +7/−14
- src/Zenacy/HTML/Internal/HTML.hs +18/−0
- src/Zenacy/HTML/Internal/Lexer.hs +6/−5
- src/Zenacy/HTML/Internal/Oper.hs +2/−2
- src/Zenacy/HTML/Internal/Render.hs +1/−1
- src/Zenacy/HTML/Internal/Zip.hs +12/−12
- test/Samples.hs +15/−4
- zenacy-html.cabal +4/−4
CHANGES.md view
@@ -1,5 +1,13 @@ # Change Log +## next (2.2.?)++* Expose document mode in HTML document++## 2.1.1++* Support updated bytestring and text versions for resolver >= 23.1+ ## 2.1.0 * Fix removal of earliest active format element
src/Zenacy/HTML/Internal/DOM.hs view
@@ -245,8 +245,7 @@ -- | Defines a default document. domDefaultDocument :: DOMNode-domDefaultDocument =- DOMDocument+domDefaultDocument = DOMDocument { domDocumentID = domNull , domDocumentName = bsEmpty , domDocumentChildren = Seq.empty@@ -256,8 +255,7 @@ -- | Defines a default document type. domDefaultDoctype :: DOMNode-domDefaultDoctype =- DOMDoctype+domDefaultDoctype = DOMDoctype { domDoctypeID = domNull , domDoctypeName = bsEmpty , domDoctypePublicID = Nothing@@ -267,8 +265,7 @@ -- | Defines a default document fragment. domDefaultFragment :: DOMNode-domDefaultFragment =- DOMFragment+domDefaultFragment = DOMFragment { domFragmentID = domNull , domFragmentName = bsEmpty , domFragmentChildren = Seq.empty@@ -277,8 +274,7 @@ -- | Defines a default element. domDefaultElement :: DOMNode-domDefaultElement =- DOMElement+domDefaultElement = DOMElement { domElementID = domNull , domElementName = bsEmpty , domElementNamespace = HTMLNamespaceHTML@@ -289,8 +285,7 @@ -- | Defines a default template. domDefaultTemplate :: DOMNode-domDefaultTemplate =- DOMTemplate+domDefaultTemplate = DOMTemplate { domTemplateID = domNull , domTemplateNamespace = HTMLNamespaceHTML , domTemplateAttributes = Seq.empty@@ -300,8 +295,7 @@ -- | Defines a default text. domDefaultText :: DOMNode-domDefaultText =- DOMText+domDefaultText = DOMText { domTextID = domNull , domTextData = bsEmpty , domTextParent = domNull@@ -309,8 +303,7 @@ -- | Defines a default comment. domDefaultComment :: DOMNode-domDefaultComment =- DOMComment+domDefaultComment = DOMComment { domCommentID = domNull , domCommentData = bsEmpty , domCommentParent = domNull
src/Zenacy/HTML/Internal/HTML.hs view
@@ -14,6 +14,7 @@ , HTMLAttr(..) , HTMLNamespace(..) , HTMLAttrNamespace(..)+ , HTMLQuirks(..) , htmlParse , htmlParseEasy , htmlFragment@@ -83,6 +84,7 @@ data HTMLNode = HTMLDocument { htmlDocumentName :: !Text -- ^ The document name.+ , htmlDocumentMode :: !HTMLQuirks -- ^ The document mode. , htmlDocumentChildren :: ![HTMLNode] -- ^ The document children. } | HTMLDoctype@@ -148,6 +150,13 @@ , htmlAttrNamespace = HTMLAttrNamespaceNone } +-- | Indentifies the quirks mode.+data HTMLQuirks+ = HTMLQuirksNone -- ^ Indicates a document in "no-quirks" mode.+ | HTMLQuirksMode -- ^ Indicates a document in "quirks" mode.+ | HTMLQuirksLimited -- ^ Indicates a document in "limited-quirks" mode.+ deriving (Eq, Ord, Show)+ -- | Parses an HTML document. htmlParse :: HTMLOptions -> Text -> Either HTMLError HTMLResult htmlParse HTMLOptions {..} x =@@ -181,6 +190,7 @@ htmlDefaultDocument :: HTMLNode htmlDefaultDocument = HTMLDocument { htmlDocumentName = T.empty+ , htmlDocumentMode = HTMLQuirksNone , htmlDocumentChildren = [] } @@ -249,6 +259,7 @@ nodeToHTML d = go where go DOMDocument {..} = HTMLDocument { htmlDocumentName = t domDocumentName+ , htmlDocumentMode = toHTMLQuirks domDocumentQuirksMode , htmlDocumentChildren = f domDocumentChildren } go DOMDoctype {..} = HTMLDoctype@@ -282,3 +293,10 @@ h = map attr . toList t = T.decodeUtf8 attr (DOMAttr n v s) = HTMLAttr (t n) (t v) s++-- | Converts DOM quirks to HTML quirks.+toHTMLQuirks :: DOMQuirks -> HTMLQuirks+toHTMLQuirks = \case+ DOMQuirksNone -> HTMLQuirksNone+ DOMQuirksMode -> HTMLQuirksMode+ DOMQuirksLimited -> HTMLQuirksLimited
src/Zenacy/HTML/Internal/Lexer.hs view
@@ -58,7 +58,8 @@ , lookup ) import Data.Maybe- ( isJust+ ( fromMaybe+ , isJust ) import Data.Word ( Word8@@ -77,9 +78,6 @@ , grow ) -import Debug.Trace (trace)-- -- | Lexer options type. data LexerOptions = LexerOptions { lexerOptionInput :: BS@@ -88,6 +86,8 @@ -- ^ Indicates whether errors are logged. , lexerOptionIgnoreEntities :: Bool -- ^ Indicates that entities should not be tokenized.+ , lexerOptionInitialState :: Maybe LexerState+ -- ^ Determines the initial state for the lexer when handling fragments. } deriving (Show) -- | Defines the skip mode.@@ -131,6 +131,7 @@ { lexerOptionInput = bsEmpty , lexerOptionLogErrors = False , lexerOptionIgnoreEntities = False+ , lexerOptionInitialState = Nothing } -- | Defines the lexer state.@@ -392,7 +393,7 @@ lexerMake :: LexerOptions -> ST s (Lexer s) lexerMake LexerOptions{..} = do offset <- newSTRef 0- state <- newSTRef StateData+ state <- newSTRef $ fromMaybe StateData lexerOptionInitialState ret <- newSTRef StateData token <- tokenBuffer buffer <- bufferNew
src/Zenacy/HTML/Internal/Oper.hs view
@@ -171,14 +171,14 @@ -- | Gets the content of a node. htmlNodeContent :: HTMLNode -> [HTMLNode]-htmlNodeContent (HTMLDocument _ c) = c+htmlNodeContent (HTMLDocument _ _ c) = c htmlNodeContent (HTMLFragment _ c) = c htmlNodeContent (HTMLElement _ _ _ c) = c htmlNodeContent _ = [] -- | Sets the content of a node. htmlNodeContentSet :: [HTMLNode] -> HTMLNode -> HTMLNode-htmlNodeContentSet x (HTMLDocument n c) = HTMLDocument n x+htmlNodeContentSet x (HTMLDocument n m c) = HTMLDocument n m x htmlNodeContentSet x (HTMLFragment n c) = HTMLFragment n x htmlNodeContentSet x (HTMLElement n s a c) = HTMLElement n s a x htmlNodeContentSet x y = y
src/Zenacy/HTML/Internal/Render.hs view
@@ -71,7 +71,7 @@ where go level parent node = case node of- HTMLDocument _ c ->+ HTMLDocument _ _ c -> join $ map (go level parent) c HTMLDoctype n p s -> indent <> renderDoctype n p s
src/Zenacy/HTML/Internal/Zip.hs view
@@ -157,8 +157,8 @@ HTMLZipper x ((HTMLCrumb n ls rs):cs) -> let c = reverse ls <> [x] <> rs in case n of- HTMLDocument n [] ->- Just $ HTMLZipper (HTMLDocument n c) cs+ HTMLDocument n m [] ->+ Just $ HTMLZipper (HTMLDocument n m c) cs HTMLDoctype n p s -> Nothing HTMLFragment n [] ->@@ -175,8 +175,8 @@ -- | Moves the zipper to the first child node. htmlZipFirst :: HTMLZipper -> Maybe HTMLZipper htmlZipFirst (HTMLZipper y z) = case y of- HTMLDocument n c ->- f c $ HTMLDocument n []+ HTMLDocument n m c ->+ f c $ HTMLDocument n m [] HTMLFragment n c -> f c $ HTMLFragment n [] HTMLElement n s a c ->@@ -189,8 +189,8 @@ -- | Moves the zipper to the last child node. htmlZipLast :: HTMLZipper -> Maybe HTMLZipper htmlZipLast (HTMLZipper y z) = case y of- HTMLDocument n c ->- f c $ HTMLDocument n []+ HTMLDocument n m c ->+ f c $ HTMLDocument n m [] HTMLFragment n c -> f c $ HTMLFragment n [] HTMLElement n s a c ->@@ -207,8 +207,8 @@ -- | Moves the zipper to a named child element. htmlZipFind :: (HTMLNode -> Bool) -> HTMLZipper -> Maybe HTMLZipper htmlZipFind p (HTMLZipper y z) = case y of- HTMLDocument n c ->- f c $ HTMLDocument n []+ HTMLDocument n m c ->+ f c $ HTMLDocument n m [] HTMLFragment n c -> f c $ HTMLFragment n [] HTMLElement n s a c ->@@ -281,8 +281,8 @@ HTMLZipper x ((HTMLCrumb n l r):cs) -> let c = reverse l <> r in case n of- HTMLDocument n [] ->- Just $ HTMLZipper (HTMLDocument n c) cs+ HTMLDocument n m [] ->+ Just $ HTMLZipper (HTMLDocument n m c) cs HTMLFragment n [] -> Just $ HTMLZipper (HTMLFragment n c) cs HTMLElement n s a [] ->@@ -296,8 +296,8 @@ HTMLZipper x ((HTMLCrumb n l r):cs) -> let c = reverse l <> htmlNodeContent x <> r in case n of- HTMLDocument n [] ->- Just $ HTMLZipper (HTMLDocument n c) cs+ HTMLDocument n m [] ->+ Just $ HTMLZipper (HTMLDocument n m c) cs HTMLFragment n [] -> Just $ HTMLZipper (HTMLFragment n c) cs HTMLElement n s a [] ->
test/Samples.hs view
@@ -37,6 +37,7 @@ testSamples :: Test testSamples = testGroup "Samples" [ testHello+ , testQuirks , testRewrite , testExtract , testQuery@@ -51,7 +52,7 @@ flip (assertEqual "Sample 2") (htmlParseEasy "<div>HelloWorld</div>")- (HTMLDocument ""+ (HTMLDocument "" HTMLQuirksMode [ HTMLElement "html" HTMLNamespaceHTML [] [ HTMLElement "head" HTMLNamespaceHTML [] [] , HTMLElement "body" HTMLNamespaceHTML []@@ -62,6 +63,7 @@ (htmlParseEasy "<div>HelloWorld</div>") HTMLDocument { htmlDocumentName = ""+ , htmlDocumentMode = HTMLQuirksMode , htmlDocumentChildren = [ HTMLElement { htmlElementName = "html"@@ -88,6 +90,15 @@ { htmlTextData = "HelloWorld" } ] } ] } ] } ] } +testQuirks :: Test+testQuirks = testCase "sample quirks" $ do+ flip (assertEqual "Sample 1")+ (htmlDocumentMode $ htmlParseEasy "<!DOCTYPE html><div>HelloWorld</div>")+ HTMLQuirksNone+ flip (assertEqual "Sample 1")+ (htmlDocumentMode $ htmlParseEasy "<html><div>HelloWorld</div>")+ HTMLQuirksMode+ testRewrite :: Test testRewrite = testCase "sample rewrite" $ do flip (assertEqual "Sample 1")@@ -113,7 +124,7 @@ extract = go . htmlParseEasy where go = \case- HTMLDocument n c ->+ HTMLDocument n m c -> concatMap go c e@(HTMLElement "a" s a c) -> case htmlElemAttrFind (htmlAttrHasName "href") e of@@ -142,7 +153,7 @@ . htmlSpaceRemove . fromJust . htmlDocBody- . htmlParseEasy + . htmlParseEasy query :: HTMLNode -> Maybe Text query = htmlQueryExec $ do@@ -176,7 +187,7 @@ . htmlSpaceRemove . fromJust . htmlDocBody- . htmlParseEasy + . htmlParseEasy query2 :: HTMLNode -> HTMLNode query2 = htmlQueryTry $ do
zenacy-html.cabal view
@@ -1,5 +1,5 @@ cabal-version: >= 1.10-version: 2.1.0+version: 2.1.1 name: zenacy-html synopsis:@@ -23,7 +23,7 @@ maintainer: Michael Williams <mlcfp@icloud.com> copyright:- Copyright (C) 2015-2022 Michael P Williams+ Copyright (C) 2015-2025 Michael P Williams category: Web build-type:@@ -60,7 +60,7 @@ , Zenacy.HTML.Internal.Zip build-depends: base == 4.*,- bytestring >= 0.10.6.0 && < 0.12,+ bytestring >= 0.10.6.0 && < 0.13, containers >= 0.5.7.1 && < 0.7, data-default >= 0.7.1.1 && < 0.8, dlist >= 0.8 && < 1.1,@@ -69,7 +69,7 @@ pretty-show >= 1.6 && < 1.11, safe >= 0.3.14 && < 0.4, safe-exceptions >= 0.1.5.0 && < 0.2,- text >= 1.2.2.0 && < 2.1,+ text >= 1.2.2.0 && < 2.2, transformers >= 0.5.2 && < 0.7, vector >= 0.11 && < 0.14, word8 >= 0.1.2 && < 0.2