{-# LANGUAGE OverloadedStrings #-}
-- | Evaluates !important.
-- INTERNAL MODULE.
module Data.CSS.Style.Importance (
        ImportanceSplitter(..)
    ) where

import Data.CSS.Syntax.Tokens
import Data.CSS.Style.Common

type Property = (Text, [Token])
splitProperties :: [Property] -> ([Property], [Property])
splitProperties :: [Property] -> ([Property], [Property])
splitProperties (prop :: Property
prop@(key :: Text
key, value :: [Token]
value):rest :: [Property]
rest)
        | (Ident "important":Delim '!':value' :: [Token]
value') <- [Token] -> [Token]
forall a. [a] -> [a]
reverse [Token]
value =
            ([Property]
unimportant, (Text
key, [Token] -> [Token]
forall a. [a] -> [a]
reverse [Token]
value')Property -> [Property] -> [Property]
forall a. a -> [a] -> [a]
:[Property]
important)
        | Bool
otherwise = (Property
propProperty -> [Property] -> [Property]
forall a. a -> [a] -> [a]
:[Property]
unimportant, [Property]
important)
    where (unimportant :: [Property]
unimportant, important :: [Property]
important) = [Property] -> ([Property], [Property])
splitProperties [Property]
rest
splitProperties [] = ([], [])

--- NOTE: Prorities are defined with lower numbers being more important,
---     so negate to be consistant with other priority sources.
--- This API decision started out being accidental, but I find it more intuitive.
-- | Evaluates "!important" by splitting all `StyleRule'` in two.
data ImportanceSplitter a = ImportanceSplitter a
instance RuleStore inner => RuleStore (ImportanceSplitter inner) where
    new :: ImportanceSplitter inner
new = inner -> ImportanceSplitter inner
forall a. a -> ImportanceSplitter a
ImportanceSplitter inner
forall a. RuleStore a => a
new
    addStyleRule :: ImportanceSplitter inner
-> [Int] -> StyleRule' -> ImportanceSplitter inner
addStyleRule (ImportanceSplitter self :: inner
self) priority :: [Int]
priority rule :: StyleRule'
rule =
            inner -> ImportanceSplitter inner
forall a. a -> ImportanceSplitter a
ImportanceSplitter (inner -> ImportanceSplitter inner)
-> inner -> ImportanceSplitter inner
forall a b. (a -> b) -> a -> b
$ inner -> [Int] -> StyleRule' -> inner
forall a. RuleStore a => a -> [Int] -> StyleRule' -> a
addStyleRule (
                inner -> [Int] -> StyleRule' -> inner
forall a. RuleStore a => a -> [Int] -> StyleRule' -> a
addStyleRule inner
self ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
forall a. Num a => a -> a
negate [Int]
priority) (StyleRule' -> inner) -> StyleRule' -> inner
forall a b. (a -> b) -> a -> b
$ [Property] -> StyleRule'
buildRule [Property]
unimportant
            ) [Int]
priority (StyleRule' -> inner) -> StyleRule' -> inner
forall a b. (a -> b) -> a -> b
$ [Property] -> StyleRule'
buildRule [Property]
important
        where
            (unimportant :: [Property]
unimportant, important :: [Property]
important) = [Property] -> ([Property], [Property])
splitProperties [Property]
props
            (StyleRule sel :: Selector
sel props :: [Property]
props psuedo :: Text
psuedo) = StyleRule' -> StyleRule
inner StyleRule'
rule
            buildRule :: [Property] -> StyleRule'
buildRule x :: [Property]
x = StyleRule'
rule {inner :: StyleRule
inner = Selector -> [Property] -> Text -> StyleRule
StyleRule Selector
sel [Property]
x Text
psuedo}
    lookupRules :: ImportanceSplitter inner -> Element -> [StyleRule']
lookupRules (ImportanceSplitter self :: inner
self) el :: Element
el = inner -> Element -> [StyleRule']
forall a. RuleStore a => a -> Element -> [StyleRule']
lookupRules inner
self Element
el