~alcinnz/haskell-stylist

ref: 4435ce007d34a8f0488a6a7634c91f0e84fe236a haskell-stylist/src/Data/CSS/Preprocessor/Conditions.hs -rw-r--r-- 1.8 KiB
4435ce00 — Adrian Cochrane Switch @document from conjunctive conditions to disjunctive conditions. 4 years ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
{-# 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 (LeftCurlyBracket:toks) =
    let (block, toks') = scanBlock toks in (parse' self block, toks')
parseAtBlock self (_:toks) = parseAtBlock self toks
parseAtBlock self [] = (self, [])

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 =
        parseAtBlock self toks
    addAtRule self "document" (Function "url-prefix":String match:RightParen:toks) =
        | unpack match `isPrefixOf` hostUrlS self = parseAtBlock self toks
    addAtRule self "document" (Function "domain":String match:RightParen:toks)
        | unpack match == domain || ('.':unpack match) `isSuffixOf` domain =
            parseAtBlock self 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 = parseAtBlock self toks
    -- TODO Support regexp() conditions, requires new dependency
    addAtRule self "document" tokens = (self, skipAtRule tokens)

    addAtRule self rule tokens =
        let (self', tokens') = addAtRule (inner self) rule tokens in (self {inner = self'}, tokens')