xml-conduit-stylist 2.3.0.0 → 3.0.0.0
raw patch · 2 files changed
+35/−66 lines, 2 filesdep +stylist-traitsdep −stylistdep −unordered-containers
Dependencies added: stylist-traits
Dependencies removed: stylist, unordered-containers
Files
- src/Data/HTML2CSS.hs +32/−63
- xml-conduit-stylist.cabal +3/−3
src/Data/HTML2CSS.hs view
@@ -1,58 +1,45 @@ {-# LANGUAGE OverloadedStrings #-} -- | Bindings from `xml-conduit` to `haskell-stylist`. module Data.HTML2CSS(- html2css, cssPriorityAgent, cssPriorityUser, cssPriorityAuthor, -- parsing- preorder, el2styletree, els2stylist, el2stylist, stylize, stylize', stylizeEl, -- application- inlinePseudos, stylizeNoPseudos, stylizeElNoPseudos+ html2css, -- parsing+ el2styletree, els2stylist, el2stylist -- application ) where import qualified Data.List as L import qualified Data.Map as M-import qualified Data.HashMap.Strict as HM import qualified Data.Text as Txt import Data.Maybe import qualified Text.XML as XML-import Data.CSS.Syntax.StyleSheet-import Data.CSS.Style-import Data.CSS.StyleTree+import Stylist.Parse+import Stylist+import Stylist.Tree import Data.CSS.Syntax.Tokens-import Data.CSS.Preprocessor.Conditions-import qualified Data.CSS.Preprocessor.Conditions.Expr as Query import Network.URI ----- Constants--- | Set the priority for a CSS stylesheet being parsed.-cssPriorityAgent, cssPriorityUser, cssPriorityAuthor :: StyleSheet s => s -> s-cssPriorityAgent = setPriority 1-cssPriorityUser = setPriority 2-cssPriorityAuthor = setPriority 3- ---- Parsing -- | Converts a parsed XML or HTML file to a `ConditionalStyles` `StyleSheet`.-html2css :: PropertyParser p => XML.Document -> URI -> ConditionalStyles p-html2css xml url = testIsStyled $ ConditionalStyles {- hostURL = url,- mediaDocument = "document",- isUnstyled = False,- rules = Priority 3 : html2css' (XML.documentRoot xml) (conditionalStyles url "document"),- propertyParser = temp-}+html2css :: StyleSheet s => XML.Document -> URI -> s -> s+html2css xml url self = html2css' (XML.documentRoot xml) url self -html2css' :: PropertyParser p => XML.Element -> ConditionalStyles p -> [ConditionalRule p]-html2css' (XML.Element (XML.Name "style" _ _) attrs children) base =- [Internal (parseMediaQuery attrs) (parseForURL base (hostURL base) $ strContent children)]-html2css' (XML.Element (XML.Name "link" _ _) attrs _) base- | Just link <- "href" `M.lookup` attrs,+html2css' :: StyleSheet s => XML.Element -> URI -> s -> s+html2css' (XML.Element (XML.Name "style" _ _) attrs children) url self+ | M.lookup "type" attrs `notElem` [Nothing, Just "text/css"] = self -- Unsupported stylesheet.+ | Just media <- "media" `M.lookup` attrs =+ fst $ addAtRule self "media" (tokenize media +++ LeftCurlyBracket : tokContent url children ++ [RightCurlyBracket])+ | otherwise = parseForURL self url $ strContent children+html2css' (XML.Element (XML.Name "link" _ _) attrs _) baseURL self+ | M.lookup "type" attrs `elem` [Nothing, Just "text/css"], Just "stylesheet" <- "rel" `M.lookup` attrs,- Just uri <- parseURIReference $ Txt.unpack link =- [External (parseMediaQuery attrs) (relativeTo uri $ hostURL base)]-html2css' (XML.Element _ _ children) base = concat [html2css' el base | XML.NodeElement el <- children]--parseMediaQuery :: M.Map XML.Name Txt.Text -> Query.Expr-parseMediaQuery attrs- | Just text <- "media" `M.lookup` attrs = Query.parse' (tokenize text) []- | otherwise = []+ Just link <- "href" `M.lookup` attrs,+ Just url <- parseURIReference $ Txt.unpack link =+ fst $ addAtRule self "import" (+ Url (Txt.pack $ uriToString' $ relativeTo url baseURL) :+ fromMaybe [] (tokenize <$> M.lookup "media" attrs) +++ [Semicolon])+html2css' (XML.Element _ _ children) url self =+ L.foldl' (\s el -> html2css' el url s) self [el | XML.NodeElement el <- children] strContent :: [XML.Node] -> Txt.Text@@ -64,6 +51,14 @@ strContent (_:rest) = strContent rest strContent [] = "" +tokContent :: URI -> [XML.Node] -> [Token]+tokContent baseURL = map absolutizeUrl . tokenize . strContent+ where+ absolutizeUrl (Url link) | Just url <- parseURIReference $ Txt.unpack link =+ Url $ Txt.pack $ uriToString' $ relativeTo url baseURL++uriToString' uri = uriToString id uri ""+ ---- Styling el2styletree el = StyleTree (Left el) $ mapMaybe node2styletree $ XML.elementNodes el@@ -90,29 +85,3 @@ } where style = concat [[prop, ": ", serialize v, "; "] | (prop, v) <- attrs] el2stylist = els2stylist . el2styletree--stylize :: PropertyParser s => QueryableStyleSheet s -> StyleTree Element -> StyleTree [(Txt.Text, s)]-stylize = preorder . stylize'-stylize' :: PropertyParser s => QueryableStyleSheet s -> Maybe [(Txt.Text, s)] -> Maybe [(Txt.Text, s)] ->- Element -> [(Txt.Text, s)]-stylize' stylesheet parent _ el = ("", base) : [- (k, cascade' v [] base) | (k, v) <- HM.toList $ queryRules stylesheet el- ] where- base = cascade stylesheet el overrides $ fromMaybe temp $ lookup "" =<< parent- overrides = concat [fst $ parseProperties' $ tokenize $ Txt.pack val- | Attribute "style" _ val <- attributes el]-stylizeEl stylesheet = stylize stylesheet . el2stylist--inlinePseudos :: PropertyParser s => StyleTree [(Txt.Text, VarParser s)] -> StyleTree s-inlinePseudos (StyleTree self childs) = StyleTree {- style = fromMaybe temp $ innerParser <$> lookup "" self,- children = pseudo "before" ++ map inlinePseudos childs ++ pseudo "after"- } where- pseudo n- | Just style <- innerParser <$> lookup n self,- Just style' <- longhand style style "::" [Ident n] = [StyleTree style' []]- | Just style <- innerParser <$> lookup n self = [StyleTree style []]- | otherwise = []--stylizeNoPseudos css = inlinePseudos . stylize css-stylizeElNoPseudos css = inlinePseudos . stylizeEl css
xml-conduit-stylist.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 2.3.0.0+version: 3.0.0.0 -- A short (one-line) description of the package. synopsis: Bridge between xml-conduit/html-conduit and stylist@@ -60,8 +60,8 @@ -- other-extensions: -- Other library packages from which modules are imported.- build-depends: base >=4.9 && <4.10,- stylist >=2.4 && <3, css-syntax, unordered-containers,+ build-depends: base >=4.9 && <5,+ stylist-traits >=0.1 && <2, css-syntax, xml-conduit >=1.8 && < 1.9, text, containers, network-uri