{-# LANGUAGE OverloadedStrings #-}
-- | Lowers psuedoclasses to rawer syntactic forms.
module Data.CSS.Preprocessor.PsuedoClasses(LowerPsuedoClasses(..)) where

import Data.CSS.Syntax.StyleSheet
import Data.CSS.Syntax.Selector
import Data.CSS.Syntax.Tokens

import Data.Text
import Data.HashMap.Lazy as HM

data LowerPsuedoClasses s = LowerPsuedoClasses {
    inner :: s,
    rewriteRules :: HashMap Text [Token]
}

instance StyleSheet s => StyleSheet (LowerPsuedoClasses s) where
    setPriority p self = self { inner = setPriority p $ inner self }
    addRule self rule = self { inner = addRule (inner self) $ lowerRule self rule }
    addAtRule self name toks = let (inner', toks') = addAtRule (inner self) name toks
        in (self { inner = inner' }, toks')

lowerRule :: LowerPsuedoClasses t -> StyleRule -> StyleRule
lowerRule LowerPsuedoClasses { rewriteRules = rewrites } (StyleRule sel props pseudoel) =
    StyleRule (lowerSelector rewrites sel) props pseudoel

lowerSelector :: HashMap Text [Token] -> Selector -> Selector
lowerSelector rewrites (Element sel') = Element $ lowerSelector' rewrites sel'
lowerSelector rewrites (Child p sel') = Child p $ lowerSelector' rewrites sel'
lowerSelector rewrites (Descendant p sel') = Descendant p $ lowerSelector' rewrites sel'
lowerSelector rewrites (Adjacent sib sel') = Adjacent sib $ lowerSelector' rewrites sel'
lowerSelector rewrites (Sibling sib sel') = Sibling sib $ lowerSelector' rewrites sel'

lowerSelector' :: HashMap Text [Token] -> [SimpleSelector] -> [SimpleSelector]
lowerSelector' rewrites (Psuedoclass name []:sels)
    | Just value <- name `HM.lookup` rewrites = Psuedoclass "where" value : lowerSelector' rewrites sels
lowerSelector' rewrites (Psuedoclass name [arg]:sels)
    | Just value <- name `HM.lookup` rewrites =
        Psuedoclass "where" [if a == Ident "_" then arg else a | a <- value] : lowerSelector' rewrites sels
lowerSelector' rewrites (sel:sels) = sel : lowerSelector' rewrites sels
lowerSelector' _ [] = []