~alcinnz/haskell-stylist

ref: e16b1d18edd47bb5c0b91e76a6944fe7d66d0d2b haskell-stylist/src/Data/CSS/Preprocessor/Conditions.hs -rw-r--r-- 1.8 KiB
e16b1d18 — Adrian Cochrane Merge branch 'master' of git.nzoss.org.nz:alcinnz/stylish-haskell 5 years ago
                                                                                
8f545827 Adrian Cochrane
4435ce00 Adrian Cochrane
8f545827 Adrian Cochrane
4435ce00 Adrian Cochrane
8f545827 Adrian Cochrane
4435ce00 Adrian Cochrane
8f545827 Adrian Cochrane
4435ce00 Adrian Cochrane
8f545827 Adrian Cochrane
4435ce00 Adrian Cochrane
8f545827 Adrian Cochrane
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')