module Stylist(cssPriorityAgent, cssPriorityUser, cssPriorityAuthor,
    PropertyParser(..), TrivialPropertyParser(..),
    StyleSheet(..), TrivialStyleSheet(..), Props,
    Element(..), Attribute(..),
    elementPath, compileAttrTest, matched, attrTest, hasWord, hasLang) where

import Data.Text (Text, unpack)
import Data.CSS.Syntax.Tokens (Token)
import Data.List

import Stylist.Parse (StyleSheet(..), TrivialStyleSheet(..))
import Stylist.Parse.Selector

-- | Set the priority for a CSS stylesheet being parsed.
cssPriorityAgent, cssPriorityUser, cssPriorityAuthor :: StyleSheet s => s -> s
cssPriorityAgent = setPriority 1
cssPriorityUser = setPriority 2
cssPriorityAuthor = setPriority 3

-- | Defines how to parse CSS properties into an output "style" format.
class PropertyParser a where
    -- | Default styles.
    temp :: a
    -- | Creates a style inherited from a parent style.
    inherit :: a -> a
    inherit = id

    -- | Expand a shorthand property into longhand properties.
    shorthand :: a -> Text -> [Token] -> [(Text, [Token])]
    shorthand self key value | Just _ <- longhand self self key value = [(key, value)]
        | otherwise = []
    -- longhand parent self name value
    longhand :: a -> a -> Text -> [Token] -> Maybe a

    -- | Retrieve stored variables, optional.
    getVars :: a -> Props
    getVars _ = []
    -- | Save variable values, optional.
    setVars :: Props -> a -> a
    setVars _ = id

-- | "key: value;" entries to be parsed into an output type.
type Props = [(Text, [Token])]

-- | Gathers properties as a key'd list.
-- Works well with `lookup`.
data TrivialPropertyParser = TrivialPropertyParser [(String, [Token])] deriving (Show, Eq)
instance PropertyParser TrivialPropertyParser where
    temp = TrivialPropertyParser []
    longhand _ (TrivialPropertyParser self) key value =
        Just $ TrivialPropertyParser ((unpack key, value):self)

-- | An inversely-linked tree of elements, to apply CSS selectors to.
data Element = ElementNode {
    -- | The element's parent in the tree.
    parent :: Maybe Element,
    -- | The element's previous sibling in the tree.
    previous :: Maybe Element,
    -- | The element's name.
    name :: Text,
    -- | The element's namespace.
    namespace :: Text,
    -- | The element's attributes, in sorted order.
    attributes :: [Attribute]
}
-- | A key-value attribute.
data Attribute = Attribute Text Text String deriving (Eq, Ord)

elementPath :: Element -> [Int]
elementPath = elementPath' []
elementPath' path ElementNode { parent = Just parent', previous = prev } =
    elementPath' (succ (countSib prev) : path) parent'
elementPath' path ElementNode { parent = Nothing, previous = prev } =
    (succ (countSib prev) : path)
countSib (Just (ElementNode { previous = prev })) = succ $ countSib prev
countSib Nothing = 0

compileAttrTest :: PropertyTest -> String -> Bool
compileAttrTest Exists = matched
compileAttrTest (Equals val) = (== (unpack val))
compileAttrTest (Suffix val) = isSuffixOf $ unpack val
compileAttrTest (Prefix val) = isPrefixOf $ unpack val
compileAttrTest (Substring val) = isInfixOf $ unpack val
compileAttrTest (Include val) = hasWord $ unpack val
compileAttrTest (Dash val) = hasLang $ unpack val
compileAttrTest (Callback (PropertyFunc cb)) = cb

matched :: t -> Bool
matched _ = True
hasWord :: String -> String -> Bool
hasWord expected value = expected `elem` words value
hasLang :: [Char] -> [Char] -> Bool
hasLang expected value = expected == value || isPrefixOf (expected ++ "-") value

attrTest :: Maybe Text -> Text -> PropertyTest -> Element -> Bool
attrTest namespace name test ElementNode { attributes = attrs } = any predicate attrs
    where
        predicate attr@(Attribute ns' _ _) | Just ns <- namespace = ns == ns' && predicate' attr
            | otherwise = predicate' attr
        predicate' (Attribute _ name' value') = name == name' && compileAttrTest test value'