From 41adcf9dadc941ca71322a1c4043a26e912e9d53 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Sat, 11 Jan 2020 20:06:49 +1300
Subject: [PATCH] Introduce simplified html2css API

Which, now that these are implemented, lowers <style> to @media & <link rel=stylesheet> to @import.
---
 src/Data/CSS/Preprocessor/Conditions.hs       |  2 +-
 stylist.cabal                                 | 11 +++----
 xml-conduit-stylist/src/Data/HTML2CSS.hs      | 32 +++++++++++++++++--
 xml-conduit-stylist/xml-conduit-stylist.cabal |  4 +--
 4 files changed, 37 insertions(+), 12 deletions(-)

diff --git a/src/Data/CSS/Preprocessor/Conditions.hs b/src/Data/CSS/Preprocessor/Conditions.hs
index 07ee4fa..64fb186 100644
--- a/src/Data/CSS/Preprocessor/Conditions.hs
+++ b/src/Data/CSS/Preprocessor/Conditions.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Data.CSS.Preprocessor.Conditions(
-        ConditionalStyles(..), conditionalStyles,
+        ConditionalStyles(..), conditionalStyles, ConditionalRule(..),
         extractImports, resolveImports, loadImports, resolve,
         Datum(..)
     ) where
diff --git a/stylist.cabal b/stylist.cabal
index 3b986b6..a093968 100644
--- a/stylist.cabal
+++ b/stylist.cabal
@@ -10,7 +10,7 @@ name:                stylist
 -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             1.1.0.0
+version:             1.1.1.0
 
 -- A short (one-line) description of the package.
 synopsis:            Apply CSS styles to a document tree.
@@ -53,19 +53,18 @@ source-repository head
 
 library
   -- Modules exported by the library.
-  exposed-modules:     Data.CSS.Syntax.StyleSheet, Data.CSS.Syntax.Selector, Data.CSS.Style, Data.CSS.Preprocessor.Conditions
+  exposed-modules:     Data.CSS.Syntax.StyleSheet, Data.CSS.Syntax.Selector, Data.CSS.Style, Data.CSS.Preprocessor.Conditions, Data.CSS.Preprocessor.Conditions.Expr
   
   -- Modules included in this library but not exported.
   other-modules:       Data.CSS.Syntax.StylishUtil,
                        Data.CSS.Style.Importance, Data.CSS.Style.Common, Data.CSS.Style.Cascade,
-                       Data.CSS.Style.Selector.Index, Data.CSS.Style.Selector.Interpret, Data.CSS.Style.Selector.Specificity,
-                       Data.CSS.Preprocessor.Conditions.Expr
+                       Data.CSS.Style.Selector.Index, Data.CSS.Style.Selector.Interpret, Data.CSS.Style.Selector.Specificity
   
   -- LANGUAGE extensions used by modules in this package.
   -- other-extensions:    
   
   -- Other library packages from which modules are imported.
-  build-depends:       base >=4.9 && <4.10, css-syntax >=0.1 && <0.2, text,
+  build-depends:       base >=4.9 && <=4.12, css-syntax >=0.1 && <0.2, text,
                         unordered-containers >= 0.2 && <0.3, hashable,
                         network-uri >= 2.6 && <2.7
   
@@ -83,7 +82,7 @@ test-suite test-stylist
   type:     exitcode-stdio-1.0
   main-is:              Test.hs
   other-modules:        Data.CSS.Syntax.StyleSheet, Data.CSS.Syntax.Selector, Data.CSS.Style
-  build-depends:       base >=4.9 && <4.10, css-syntax >=0.1 && <0.2, text,
+  build-depends:       base >=4.9 && <=4.12, css-syntax >=0.1 && <0.2, text,
                         unordered-containers >= 0.2 && <0.3, hashable,
                         network-uri >= 2.6 && <2.7, hspec, QuickCheck,
                         scientific >= 0.3 && <1.0
diff --git a/xml-conduit-stylist/src/Data/HTML2CSS.hs b/xml-conduit-stylist/src/Data/HTML2CSS.hs
index 05fba93..c7c557f 100644
--- a/xml-conduit-stylist/src/Data/HTML2CSS.hs
+++ b/xml-conduit-stylist/src/Data/HTML2CSS.hs
@@ -1,8 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Data.HTML2CSS(
-        externalStyles, externalStylesForURL, internalStyles, internalStylesForURL,
-        cssPriorityAgent, cssPriorityUser, cssPriorityAuthor,
-        traverseStyles, traversePrepopulatedStyles, traverseStyles', elToStylish
+        externalStyles, externalStylesForURL, internalStyles, internalStylesForURL, -- legacy
+        html2css, cssPriorityAgent, cssPriorityUser, cssPriorityAuthor, -- parsing
+        traverseStyles, traversePrepopulatedStyles, traverseStyles', elToStylish -- application
     ) where
 
 import qualified Data.List as L
@@ -15,6 +15,8 @@ import qualified Text.XML as XML
 import Data.CSS.Syntax.StyleSheet
 import Data.CSS.Style
 import Data.CSS.Syntax.Tokens (tokenize)
+import Data.CSS.Preprocessor.Conditions
+import qualified Data.CSS.Preprocessor.Conditions.Expr as Query
 
 import Network.URI
 
@@ -25,6 +27,30 @@ cssPriorityUser = setPriority 2
 cssPriorityAuthor = setPriority 3
 
 ---- Parsing
+html2css :: PropertyParser p => XML.Document -> URI -> ConditionalStyles p
+html2css xml url = ConditionalStyles {
+    hostURL = url,
+    mediaDocument = "document",
+    rules = Priority 3 : html2css' (XML.documentRoot xml) (conditionalStyles url "document"),
+    propertyParser = temp
+}
+
+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,
+        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 = []
+
+---- Parsing (legacy)
 externalStyles :: StyleSheet s => s -> (M.Map XML.Name Txt.Text -> Bool) ->
         XML.Element -> (URI -> IO Txt.Text) -> IO s
 externalStyles a b c d = externalStylesForURL a b c nullURI d
diff --git a/xml-conduit-stylist/xml-conduit-stylist.cabal b/xml-conduit-stylist/xml-conduit-stylist.cabal
index ab01eb8..bfffc1a 100644
--- a/xml-conduit-stylist/xml-conduit-stylist.cabal
+++ b/xml-conduit-stylist/xml-conduit-stylist.cabal
@@ -10,7 +10,7 @@ name:                xml-conduit-stylist
 -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             1.0.0.0
+version:             1.0.1.0
 
 -- A short (one-line) description of the package.
 synopsis:            Bridge between xml-conduit/html-conduit and stylist
@@ -61,7 +61,7 @@ library
   
   -- Other library packages from which modules are imported.
   build-depends:       base >=4.9 && <4.10,
-                       stylist >=1 && <2, css-syntax, unordered-containers,
+                       stylist >=1.1.1 && <2, css-syntax, unordered-containers,
                        xml-conduit >=1.8 && < 1.9, text, containers,
                        network-uri
   
-- 
2.30.2