From 28a709555980af1084ad2117b646acf429c15316 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Fri, 24 Apr 2020 21:08:50 +1200
Subject: [PATCH] Draft stylize function.

---
 xml-conduit-stylist/src/Data/HTML2CSS.hs | 70 ++++++------------------
 1 file changed, 16 insertions(+), 54 deletions(-)

diff --git a/xml-conduit-stylist/src/Data/HTML2CSS.hs b/xml-conduit-stylist/src/Data/HTML2CSS.hs
index 8f5ffca..e088c15 100644
--- a/xml-conduit-stylist/src/Data/HTML2CSS.hs
+++ b/xml-conduit-stylist/src/Data/HTML2CSS.hs
@@ -2,14 +2,14 @@
 -- | Bindings from `xml-conduit` to `haskell-stylist`.
 module Data.HTML2CSS(
         html2css, cssPriorityAgent, cssPriorityUser, cssPriorityAuthor, -- parsing
-        traverseStyles, traversePrepopulatedStyles, traverseStyles', elToStylish -- application
+        el2stylist, stylize' -- 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 (fromMaybe)
+import Data.Maybe (fromMaybe, listToMaybe)
 
 import qualified Text.XML as XML
 import Data.CSS.Syntax.StyleSheet
@@ -64,58 +64,6 @@ strContent (_:rest) = strContent rest
 strContent [] = ""
 
 ---- Styling
--- | Converts a parsed XML or HTML document to a specified style tree type.
-traverseStyles :: PropertyParser s => (s -> [o] -> o) -> (s -> Txt.Text -> o) ->
-        QueryableStyleSheet s -> XML.Element -> o
-traverseStyles = traverseStyles' Nothing temp Nothing (\x y -> Nothing)
--- | Converts a parsed XML or HTML document to a specified style tree type,
--- with a routine to compute alternative contents based on the raw element or computed styles.
-traversePrepopulatedStyles :: PropertyParser s => (s -> XML.Element -> Maybe [o]) ->
-        (s -> [o] -> o) -> (s -> Txt.Text -> o) -> QueryableStyleSheet s -> XML.Element -> o
-traversePrepopulatedStyles = traverseStyles' Nothing temp Nothing
--- | Full routine for converting a parsed XML or HTML document to a specified style tree type.
-traverseStyles' :: PropertyParser s => Maybe Element -> s -> Maybe Element ->
-        (s -> XML.Element -> Maybe [o]) -> (s -> [o] -> o) -> (s -> Txt.Text -> o) ->
-        QueryableStyleSheet s -> XML.Element -> o
-traverseStyles' parent parentStyle previous prepopulate builder textBuilder stylesheet el@(
-        XML.Element _ attrs children
-    ) = builder style traverseChildren
-    where
-        stylishEl = elToStylish el parent previous
-        maybeEl = Just stylishEl
-        rules = queryRules stylesheet stylishEl
-        style = cascade' (HM.lookupDefault [] "" rules) overrides parentStyle
-        overrides | Just styleAttr <- "style" `M.lookup` attrs =
-                fst $ parseProperties' $ tokenize styleAttr
-            | otherwise = []
-
-        traverseChildren = traversePsuedo' "before" ++
-                fromMaybe (traverseChildren' Nothing children) (prepopulate style el) ++
-                traversePsuedo' "after"
-        traversePsuedo' psuedo = traversePsuedo rules psuedo style builder
-        traverseChildren' prev (XML.NodeContent txt:nodes) =
-            textBuilder style txt : traverseChildren' prev nodes
-        traverseChildren' prev (XML.NodeElement el:nodes) =
-            traverseStyles' maybeEl style prev prepopulate builder textBuilder stylesheet el :
-                traverseChildren' (Just $ elToStylish el maybeEl prev) nodes
-        traverseChildren' prev (_:nodes) = traverseChildren' prev nodes
-        traverseChildren' _ [] = []
-traversePsuedo rules psuedo parentStyle builder
-    | Just rules' <- HM.lookup psuedo rules = [builder (cascade' rules' [] parentStyle) []]
-    | otherwise = []
-
--- | Converts a xml-conduit Element to a stylist Element.
-elToStylish (XML.Element (XML.Name name ns _) attrs _) parent previous =
-    ElementNode {
-        name = name,
-        namespace = fromMaybe "" ns,
-        attributes = L.sort [
-            Attribute name (fromMaybe "" ns) (Txt.unpack value)
-            | (XML.Name name ns _, value) <- M.toList attrs
-        ],
-        parent = parent,
-        previous = previous
-    }
 
 el2stylist el = nodes2stylist [XML.NodeElement el] Nothing Nothing
 nodes2stylist (XML.NodeElement (XML.Element (XML.Name name ns _) attrs childs):nodes) parent previous =
@@ -143,3 +91,17 @@ nodes2stylist (XML.NodeContent txt:nodes) parent previous = StyleTree {
     } : nodes2stylist nodes parent previous
 nodes2stylist (_:nodes) parent previous = nodes2stylist nodes parent previous
 nodes2stylist [] _ _ = []
+
+stylize' parent stylesheet (StyleTree el childs) = StyleTree {
+        style = cascade' (HM.lookupDefault [] "" rules) overrides parent,
+        children = traversePseudo "before" ++
+            map (stylize' parent stylesheet) childs ++
+            traversePseudo "after"
+    }
+  where
+    rules = queryRules stylesheet el
+    overrides = concat [ fst $ parseProperties' $ tokenize $ Txt.pack val
+        | Attribute "style" _ val <- attributes el ]
+    traversePseudo pclass
+        | Just rules' <- pclass `HM.lookup` rules = [StyleTree (cascade' rules' [] parent) []]
+        | otherwise = []
-- 
2.30.2