From a50ff3102fe51e3151ac64a9a707d1479ae97209 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Sun, 10 Nov 2019 19:13:33 +1300
Subject: [PATCH] Integrate var(), @import, @document, @media, & @supports
 support.

---
 rhapsode.cabal |  2 +-
 src/Main.hs    | 25 +++++++++++++++++--------
 2 files changed, 18 insertions(+), 9 deletions(-)

diff --git a/rhapsode.cabal b/rhapsode.cabal
index ca4d24d..9a91079 100644
--- a/rhapsode.cabal
+++ b/rhapsode.cabal
@@ -64,7 +64,7 @@ executable rhapsode
         http-client, http-client-tls, bytestring,
         html-conduit, xml-conduit, text, containers,
         network-uri,
-        stylist, css-syntax, xml-conduit-stylist, scientific
+        stylist >= 1.1, css-syntax, xml-conduit-stylist, scientific
   
   -- Directories containing source files.
   hs-source-dirs:      src
diff --git a/src/Main.hs b/src/Main.hs
index dad06be..625cc2d 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -18,12 +18,13 @@ import           Data.Text as Txt (pack, unpack, Text(..), append,
 import qualified Data.CSS.Syntax.StyleSheet as CSS
 import qualified Data.CSS.Style as Style
 import qualified Data.CSS.Syntax.Tokens as CSSTok
+import qualified Data.CSS.Preprocessor.Conditions as CSSCond
 import qualified Data.HTML2CSS as H2C
 
 import qualified Data.List as L
 import qualified Data.Map as M
 import Data.Scientific (toRealFloat)
-import Data.Maybe (fromJust)
+import Data.Maybe (fromJust, fromMaybe)
 import System.Directory as Dir
 
 import DefaultCSS
@@ -38,7 +39,8 @@ main = do
     manager <- HTTP.newManager TLS.tlsManagerSettings
     response <- HTTP.httpLbs request manager
     let html = XML.documentRoot $ HTML.parseLBS $ HTTP.responseBody response
-    style <- retreiveStyles html manager $ fromJust $ parseURI url
+    let aboutBlank = fromJust $ parseURI "about:blank"
+    style <- retreiveStyles (fromMaybe aboutBlank $ parseURI url) html manager $ fromJust $ parseURI url
     let transcript = stylize style html
     C8.putStrLn $ renderElLBS $ styleToSSML $ applyCounters transcript
 
@@ -48,12 +50,14 @@ renderElLBS el = XML.renderLBS XML.def $ XML.Document {
         XML.documentEpilogue = []
     }
 
-retreiveStyles html manager base = do
+retreiveStyles uri html manager base = do
     style <- H2C.externalStylesForURL authorStyle testMedia html base loadURL
-    loadUserStyles style
+    userStyle <- loadUserStyles style
+    importedStyle <- CSSCond.loadImports loadURL lowerVars lowerToks userStyle []
+    return $ CSSCond.resolve lowerVars lowerToks Style.queryableStyleSheet importedStyle
   where
-    emptyStyle :: Style.QueryableStyleSheet StyleTree
-    emptyStyle = Style.queryableStyleSheet
+    emptyStyle :: CSSCond.ConditionalStyles StyleTree
+    emptyStyle = CSSCond.conditionalStyles uri "document"
     agentStyle = H2C.cssPriorityAgent emptyStyle `CSS.parse` Txt.pack userAgentCSS
     authorStyle = H2C.internalStylesForURL testMedia agentStyle base html
 
@@ -62,6 +66,11 @@ retreiveStyles html manager base = do
         response <- HTTP.httpLbs request manager
         return $ Txt.pack $ C8.unpack $ HTTP.responseBody response
 
+    lowerVars "speech" = CSSCond.B True
+    lowerVars "-rhapsode" = CSSCond.B True
+    lowerVars _ = CSSCond.B False
+    lowerToks _ = CSSCond.B False
+
 loadUserStyles styles = do
     dir <- Dir.getXdgDirectory Dir.XdgConfig "rhapsode"
     exists <- Dir.doesDirectoryExist dir
@@ -82,9 +91,9 @@ testMedia attrs = media == Nothing || media == Just "speech"
 
 stylize styles html = H2C.traversePrepopulatedStyles buildChild buildNode buildText styles html
     where
-        buildChild self _ | content self == [] = Nothing
+        buildChild (Style.VarParser _ self) _ | content self == [] = Nothing
             | otherwise = Just [Style.temp {content = content self}]
-        buildNode self children = self {children = children}
+        buildNode (Style.VarParser _ self) children = self {children = children}
         buildText _ txt = Style.temp {content = [Content txt]}
 
 --------
-- 
2.30.2