~alcinnz/haskell-stylist

haskell-stylist/src/Data/CSS/Style/Selector/LowerWhere.hs -rw-r--r-- 1.5 KiB
8880b129 — Adrian Cochrane Minor fix to repair the testsuite! 11 months ago
                                                                                
086da474 Adrian Cochrane
12a80582 Adrian Cochrane
086da474 Adrian Cochrane
12a80582 Adrian Cochrane
086da474 Adrian Cochrane
12a80582 Adrian Cochrane
086da474 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
{-# LANGUAGE OverloadedStrings #-}
module Data.CSS.Style.Selector.LowerWhere(
        WhereLowerer(..)
    ) where

import Data.CSS.Syntax.Selector
import Data.CSS.Style.Common

lowerSelector :: Selector -> [Selector]
lowerSelector (Element [Psuedoclass c args])
    | c `elem` ["is", "where"], (args', []) <- parseSelectors args = args'
lowerSelector (Element sel) = [Element $ lowerSelector' sel]
lowerSelector (Child sel x) = [Child sel' $ lowerSelector' x | sel' <- lowerSelector sel]
lowerSelector (Descendant sel x) = [Descendant sel' $ lowerSelector' x | sel' <- lowerSelector sel]
lowerSelector (Adjacent sel x) = [Adjacent sel' $ lowerSelector' x | sel' <- lowerSelector sel]
lowerSelector (Sibling sel x) = [Sibling sel' $ lowerSelector' x | sel' <- lowerSelector sel]

lowerSelector' :: [SimpleSelector] -> [SimpleSelector]
lowerSelector' (Psuedoclass c args:sel)
    | c `elem` ["is", "where"], ([Element arg'], []) <- parseSelectors args =
        arg' ++ lowerSelector' sel
lowerSelector' (test:tests) = test : lowerSelector' tests
lowerSelector' [] = []

data WhereLowerer s = WhereLowerer s

instance RuleStore s => RuleStore (WhereLowerer s) where
    new = WhereLowerer new
    addStyleRule (WhereLowerer self) priority rule =
        WhereLowerer $ foldl addStyleRule' self $ lowerSelector sel
      where
        addStyleRule' self' sel' = addStyleRule self' priority $ rule {
            inner = StyleRule sel' props psuedo
        }
        StyleRule sel props psuedo = inner rule
    lookupRules (WhereLowerer self) el = lookupRules self el