From 7d1e8859d6d19e1874631c9b1fc37911cf1b1597 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Wed, 1 Apr 2020 09:48:38 +1300
Subject: [PATCH] Let user & useragent styles query for a lack of author
 styles.

---
 src/Data/CSS/Preprocessor/Conditions.hs  | 22 ++++++++++++++++++++--
 stylist.cabal                            |  2 +-
 xml-conduit-stylist/src/Data/HTML2CSS.hs |  3 +--
 3 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/src/Data/CSS/Preprocessor/Conditions.hs b/src/Data/CSS/Preprocessor/Conditions.hs
index 64fb186..db84c90 100644
--- a/src/Data/CSS/Preprocessor/Conditions.hs
+++ b/src/Data/CSS/Preprocessor/Conditions.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Data.CSS.Preprocessor.Conditions(
         ConditionalStyles(..), conditionalStyles, ConditionalRule(..),
-        extractImports, resolveImports, loadImports, resolve,
+        extractImports, resolveImports, loadImports, resolve, testIsStyled,
         Datum(..)
     ) where
 
@@ -16,19 +16,29 @@ import Data.CSS.Style (PropertyParser(..))
 import Data.Text.Internal (Text(..))
 import Data.Text (unpack)
 import Network.URI (URI(..), URIAuth(..), parseURI)
+import Control.Concurrent.Async (forConcurrently)
 
 import Data.List
 
+-- | Collects and evaluates conditional at-rules.
 data ConditionalStyles p = ConditionalStyles {
+    -- | The URL to the webpage being styled, for `@document` rules.
     hostURL :: URI,
+    -- | The type of document, `@document domain(...)` rules.
     mediaDocument :: String,
+    -- | Whether the page provided any of it's own styling (valid or not)
+    isUnstyled :: Bool,
+    -- | Queued style rules, to be evaluated later.
     rules :: [ConditionalRule p],
+    -- | PropertyParser to test against for `@supports` rules.
     propertyParser :: p
 }
 
+-- | Constructs an empty `ConditionalStyles`.
 conditionalStyles :: PropertyParser p => URI -> String -> ConditionalStyles p
-conditionalStyles uri mediaDocument' = ConditionalStyles uri mediaDocument' [] temp
+conditionalStyles uri mediaDocument' = ConditionalStyles uri mediaDocument' False [] temp
 
+-- | Style rules that can be queued in a `ConditionalStyles`.
 data ConditionalRule p = Priority Int | StyleRule' StyleRule | AtRule Text [Token] |
     External Query.Expr URI | Internal Query.Expr (ConditionalStyles p)
 
@@ -66,6 +76,10 @@ instance PropertyParser p => StyleSheet (ConditionalStyles p) where
     addAtRule self "document" (Function "media-document":String match:RightParen:toks)
         | unpack match == mediaDocument self = parseAtBlock self toks
         | otherwise = addAtRule self "document" toks
+    -- Rhapsode-specific: matches if the document didn't provide any of it's own stylings.
+    addAtRule self "document" (Ident "unstyled":toks)
+        | isUnstyled self = parseAtBlock self toks
+        | otherwise = addAtRule self "document" toks
     -- TODO Support regexp() conditions, requires new dependency
     addAtRule self "document" tokens = (self, skipAtRule tokens)
 
@@ -87,6 +101,10 @@ instance PropertyParser p => StyleSheet (ConditionalStyles p) where
 
     addAtRule self rule tokens = let (block, rest) = scanAtRule tokens in
         (addRule' self $ AtRule rule block, rest)
+
+testIsStyled :: ConditionalStyles p -> ConditionalStyles p
+testIsStyled styles = styles { isUnstyled = null $ rules styles }
+
 --------
 ---- @import/@media
 --------
diff --git a/stylist.cabal b/stylist.cabal
index a093968..59fc390 100644
--- a/stylist.cabal
+++ b/stylist.cabal
@@ -66,7 +66,7 @@ library
   -- Other library packages from which modules are imported.
   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
+                        network-uri >= 2.6 && <2.7, async >= 2.1 && <2.3
   
   -- Directories containing source files.
   hs-source-dirs:      src
diff --git a/xml-conduit-stylist/src/Data/HTML2CSS.hs b/xml-conduit-stylist/src/Data/HTML2CSS.hs
index c7c557f..7ac1177 100644
--- a/xml-conduit-stylist/src/Data/HTML2CSS.hs
+++ b/xml-conduit-stylist/src/Data/HTML2CSS.hs
@@ -17,7 +17,6 @@ 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
 
 ---- Constants
@@ -28,7 +27,7 @@ cssPriorityAuthor = setPriority 3
 
 ---- Parsing
 html2css :: PropertyParser p => XML.Document -> URI -> ConditionalStyles p
-html2css xml url = ConditionalStyles {
+html2css xml url = testIsStyled $ ConditionalStyles {
     hostURL = url,
     mediaDocument = "document",
     rules = Priority 3 : html2css' (XML.documentRoot xml) (conditionalStyles url "document"),
-- 
2.30.2