From 8f545827645a4969dbf88056251b04cd9fc1d687 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Mon, 9 Sep 2019 15:36:18 +1200
Subject: [PATCH] Implement @document rules (save regexp() conditions).

I've still got to select a regexp library to power it.
---
 src/Data/CSS/Preprocessor/Conditions.hs | 44 +++++++++++++++++++++++++
 src/Data/CSS/Syntax/StyleSheet.hs       |  2 +-
 stylist.cabal                           |  5 ++-
 3 files changed, 49 insertions(+), 2 deletions(-)
 create mode 100644 src/Data/CSS/Preprocessor/Conditions.hs

diff --git a/src/Data/CSS/Preprocessor/Conditions.hs b/src/Data/CSS/Preprocessor/Conditions.hs
new file mode 100644
index 0000000..e6a3048
--- /dev/null
+++ b/src/Data/CSS/Preprocessor/Conditions.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Data.CSS.Preprocessor.Conditions(
+        ConditionalStyles(..)
+    ) where
+
+import Data.CSS.Syntax.StyleSheet
+import Data.CSS.Syntax.Tokens(Token(..))
+
+import Data.Text (unpack)
+import Network.URI (URI(..), URIAuth(..))
+
+data ConditionalStyles s = ConditionalStyles {
+    hostURL :: URI,
+    mediaDocument :: String,
+    inner :: s
+}
+
+hostUrlS = show . hostURL
+
+parseAtBlock self toks = let (block, toks') = scanBlock toks in (parse' self block, toks')
+
+instance StyleSheet ConditionalStyles where
+    setPriority x self = self {inner = setPriority x $ inner self}
+    addRule self rule = self {inner = addRule (inner self) rule}
+
+    addAtRule self "document" (Comma:toks) = addAtRule self "document" toks
+    addAtRule self "document" (Url match:toks) | unpack match == hostUrlS self =
+        addAtRule self "document" toks
+    addAtRule self "document" (Function "url-prefix":String match:RightParen:toks) =
+        | unpack match `isPrefixOf` hostUrlS self = addAtRule self "document" toks
+    addAtRule self "document" (Function "domain":String match:RightParen:toks)
+        | unpack match == domain || ('.':unpack match) `isSuffixOf` domain =
+            addAtRule self "document" toks
+        where
+            domain | Just auth <- uriAuthority $ hostURL self = uriRegName auth
+                | otherwise = ""
+    addAtRule self "document" (Function "media-document":String match:RightParen:toks) =
+        | unpack match == mediaDocument self = addAtRule self "document" toks
+    -- TODO Support regexp() conditions, requires new dependency
+    addAtRule self "document" (LeftCurlyBracket:toks) = parseAtBlock self toks
+    addAtRule self "document" tokens = (self, skipAtRule tokens)
+
+    addAtRule self rule tokens =
+        let (self', tokens') = addAtRule (inner self) rule tokens in (self {inner = self'}, tokens')
diff --git a/src/Data/CSS/Syntax/StyleSheet.hs b/src/Data/CSS/Syntax/StyleSheet.hs
index 67909f7..c9caace 100644
--- a/src/Data/CSS/Syntax/StyleSheet.hs
+++ b/src/Data/CSS/Syntax/StyleSheet.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Data.CSS.Syntax.StyleSheet (
         parse, parse', parseForURL, TrivialStyleSheet(..),
-        StyleSheet(..), skipAtRule,
+        StyleSheet(..), skipAtRule, scanBlock,
         StyleRule(..),
         -- For parsing at-rules, HTML "style" attribute, etc.
         parseProperties, parseProperties',
diff --git a/stylist.cabal b/stylist.cabal
index 9eba9a6..4d0089e 100644
--- a/stylist.cabal
+++ b/stylist.cabal
@@ -47,10 +47,13 @@ extra-source-files:  ChangeLog.md, README.md
 -- Constraint on the version of Cabal needed to build this package.
 cabal-version:       >=1.10
 
+source-repository head
+    type: git
+    location: https://git.nzoss.org.nz/alcinnz/stylish-haskell.git
 
 library
   -- Modules exported by the library.
-  exposed-modules:     Data.CSS.Syntax.StyleSheet, Data.CSS.Syntax.Selector, Data.CSS.Style
+  exposed-modules:     Data.CSS.Syntax.StyleSheet, Data.CSS.Syntax.Selector, Data.CSS.Style, Data.CSS.Preprocessor.Conditions
   
   -- Modules included in this library but not exported.
   other-modules:       Data.CSS.Syntax.StylishUtil,
-- 
2.30.2