module Data.CSS.Syntax.AtLayer(parseAtLayer, Tree(..),
    registerLayer, layerPath, uniqueName, emptyTree) where

import Data.HashMap.Lazy as M (HashMap, (!?), insert, size, empty)
import Data.Text as T hiding (reverse, replicate, length)
import Data.CSS.Syntax.Tokens

import Stylist.Parse

parseAtLayer :: StyleSheet s => [Text] -> [Token] -> Tree ->
    ([Text] -> [Int] -> s) -> (Tree, Maybe s, [Token])
parseAtLayer :: [Text]
-> [Token]
-> Tree
-> ([Text] -> [Int] -> s)
-> (Tree, Maybe s, [Token])
parseAtLayer namespace :: [Text]
namespace (Whitespace:toks :: [Token]
toks) tree :: Tree
tree cb :: [Text] -> [Int] -> s
cb = [Text]
-> [Token]
-> Tree
-> ([Text] -> [Int] -> s)
-> (Tree, Maybe s, [Token])
forall s.
StyleSheet s =>
[Text]
-> [Token]
-> Tree
-> ([Text] -> [Int] -> s)
-> (Tree, Maybe s, [Token])
parseAtLayer [Text]
namespace [Token]
toks Tree
tree [Text] -> [Int] -> s
cb
parseAtLayer namespace :: [Text]
namespace (Ident layer :: Text
layer:toks :: [Token]
toks) tree :: Tree
tree cb :: [Text] -> [Int] -> s
cb = [Token] -> [Text] -> Tree -> (Tree, Maybe s, [Token])
inner [Token]
toks [Text
layer] Tree
tree
    where
        inner :: [Token] -> [Text] -> Tree -> (Tree, Maybe s, [Token])
inner (Delim '.':Ident sublayer :: Text
sublayer:toks' :: [Token]
toks') layers :: [Text]
layers tree' :: Tree
tree' =  [Token] -> [Text] -> Tree -> (Tree, Maybe s, [Token])
inner [Token]
toks' (Text
sublayerText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
layers) Tree
tree'
        inner (Whitespace:toks' :: [Token]
toks') layers :: [Text]
layers tree' :: Tree
tree' = [Token] -> [Text] -> Tree -> (Tree, Maybe s, [Token])
inner [Token]
toks' [Text]
layers Tree
tree'
        inner (Comma:toks' :: [Token]
toks') layers :: [Text]
layers tree' :: Tree
tree' =
            let (ret :: Tree
ret, tail' :: [Token]
tail') = [Text] -> [Token] -> Tree -> (Tree, [Token])
parseLayerStmt [Text]
namespace [Token]
toks' (Tree -> (Tree, [Token])) -> Tree -> (Tree, [Token])
forall a b. (a -> b) -> a -> b
$[Text] -> Tree -> Tree
registerLayer ([Text] -> [Text]
namespaced [Text]
layers) Tree
tree'
            in (Tree
ret, Maybe s
forall a. Maybe a
Nothing, [Token]
tail')
        inner (LeftCurlyBracket:toks' :: [Token]
toks') layers :: [Text]
layers  tree' :: Tree
tree' =
            let (ret :: Tree
ret, styles :: s
styles, tail' :: [Token]
tail') = [Text]
-> [Token] -> Tree -> ([Text] -> [Int] -> s) -> (Tree, s, [Token])
forall s.
StyleSheet s =>
[Text]
-> [Token] -> Tree -> ([Text] -> [Int] -> s) -> (Tree, s, [Token])
parseLayerBlock ([Text] -> [Text]
namespaced [Text]
layers) [Token]
toks' Tree
tree' [Text] -> [Int] -> s
cb
            in (Tree
ret, s -> Maybe s
forall a. a -> Maybe a
Just s
styles, [Token]
tail')
        inner (Semicolon:toks' :: [Token]
toks') layers :: [Text]
layers tree' :: Tree
tree' = ([Text] -> Tree -> Tree
registerLayer ([Text] -> [Text]
namespaced [Text]
layers) Tree
tree', Maybe s
forall a. Maybe a
Nothing, [Token]
toks')
        inner [] layers :: [Text]
layers tree' :: Tree
tree' = ([Text] -> Tree -> Tree
registerLayer ([Text] -> [Text]
namespaced [Text]
layers) Tree
tree', Maybe s
forall a. Maybe a
Nothing, [])
        inner toks' :: [Token]
toks' _ _ = (Tree
tree, Maybe s
forall a. Maybe a
Nothing, [Token] -> [Token]
skipAtRule [Token]
toks')
        namespaced :: [Text] -> [Text]
namespaced layers :: [Text]
layers = [Text]
namespace [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
layers
parseAtLayer ns :: [Text]
ns (LeftCurlyBracket:toks :: [Token]
toks) tree :: Tree
tree cb :: [Text] -> [Int] -> s
cb = 
    let (ret :: Tree
ret, styles :: s
styles, tail' :: [Token]
tail') = [Text]
-> [Token] -> Tree -> ([Text] -> [Int] -> s) -> (Tree, s, [Token])
forall s.
StyleSheet s =>
[Text]
-> [Token] -> Tree -> ([Text] -> [Int] -> s) -> (Tree, s, [Token])
parseLayerBlock ([Text] -> Tree -> [Text]
uniqueName [Text]
ns Tree
tree) [Token]
toks Tree
tree [Text] -> [Int] -> s
cb
    in (Tree
ret, s -> Maybe s
forall a. a -> Maybe a
Just s
styles, [Token]
tail')
parseAtLayer _ toks :: [Token]
toks tree :: Tree
tree _ = (Tree
tree, Maybe s
forall a. Maybe a
Nothing, [Token] -> [Token]
skipAtRule [Token]
toks)

parseLayerStmt :: [Text] -> [Token] -> Tree -> (Tree, [Token])
parseLayerStmt :: [Text] -> [Token] -> Tree -> (Tree, [Token])
parseLayerStmt namespace :: [Text]
namespace (Whitespace:toks :: [Token]
toks) tree :: Tree
tree = [Text] -> [Token] -> Tree -> (Tree, [Token])
parseLayerStmt [Text]
namespace [Token]
toks Tree
tree
parseLayerStmt namespace :: [Text]
namespace (Ident layer :: Text
layer:toks :: [Token]
toks) tree :: Tree
tree = [Token] -> [Text] -> Tree -> (Tree, [Token])
inner [Token]
toks [Text
layer] Tree
tree
    where
        inner :: [Token] -> [Text] -> Tree -> (Tree, [Token])
inner (Delim '.':Ident sublayer :: Text
sublayer:toks' :: [Token]
toks') layers :: [Text]
layers tree' :: Tree
tree' = [Token] -> [Text] -> Tree -> (Tree, [Token])
inner [Token]
toks' (Text
sublayerText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
layers) Tree
tree'
        inner (Comma:toks' :: [Token]
toks') layers :: [Text]
layers tree' :: Tree
tree' =
            [Text] -> [Token] -> Tree -> (Tree, [Token])
parseLayerStmt [Text]
namespace [Token]
toks' (Tree -> (Tree, [Token])) -> Tree -> (Tree, [Token])
forall a b. (a -> b) -> a -> b
$ [Text] -> Tree -> Tree
registerLayer ([Text] -> [Text]
namespaced [Text]
layers) Tree
tree'
        inner (Whitespace:toks' :: [Token]
toks') layers :: [Text]
layers tree' :: Tree
tree' = [Token] -> [Text] -> Tree -> (Tree, [Token])
inner [Token]
toks' [Text]
layers Tree
tree'
        inner (Semicolon:toks' :: [Token]
toks') layers :: [Text]
layers tree' :: Tree
tree' = ([Text] -> Tree -> Tree
registerLayer ([Text] -> [Text]
namespaced [Text]
layers) Tree
tree', [Token]
toks')
        inner [] layers :: [Text]
layers tree' :: Tree
tree' = ([Text] -> Tree -> Tree
registerLayer ([Text] -> [Text]
namespaced [Text]
layers) Tree
tree', [])
        inner toks' :: [Token]
toks' _ _ = (Tree
tree, [Token] -> [Token]
skipAtRule [Token]
toks')
        namespaced :: [Text] -> [Text]
namespaced layers :: [Text]
layers = [Text]
namespace [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
layers
parseLayerStmt _ toks :: [Token]
toks tree :: Tree
tree = (Tree
tree, [Token] -> [Token]
skipAtRule [Token]
toks)

parseLayerBlock :: StyleSheet s => [Text] -> [Token] -> Tree ->
    ([Text] -> [Int] -> s) -> (Tree, s, [Token])
parseLayerBlock :: [Text]
-> [Token] -> Tree -> ([Text] -> [Int] -> s) -> (Tree, s, [Token])
parseLayerBlock layers :: [Text]
layers toks :: [Token]
toks tree :: Tree
tree cb :: [Text] -> [Int] -> s
cb = (Tree
tree', s -> [Token] -> s
forall t. StyleSheet t => t -> [Token] -> t
parse' s
styles [Token]
block, [Token]
toks')
    where
        (block :: [Token]
block, toks' :: [Token]
toks') = Parser [Token]
scanBlock [Token]
toks
        tree' :: Tree
tree' = [Text] -> Tree -> Tree
registerLayer [Text]
layers Tree
tree
        styles :: s
styles = [Text] -> [Int] -> s
cb [Text]
layers ([Int] -> s) -> [Int] -> s
forall a b. (a -> b) -> a -> b
$ [Text] -> Tree -> [Int]
layerPath [Text]
layers Tree
tree'

newtype Tree = Tree (HashMap Text (Int, Tree))
registerLayer :: [Text] -> Tree -> Tree
registerLayer :: [Text] -> Tree -> Tree
registerLayer (layer :: Text
layer:sublayers :: [Text]
sublayers) (Tree self :: HashMap Text (Int, Tree)
self)
    | Just (ix :: Int
ix, subtree :: Tree
subtree) <- HashMap Text (Int, Tree)
self HashMap Text (Int, Tree) -> Text -> Maybe (Int, Tree)
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!? Text
layer = HashMap Text (Int, Tree) -> Tree
Tree (HashMap Text (Int, Tree) -> Tree)
-> HashMap Text (Int, Tree) -> Tree
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Tree)
-> HashMap Text (Int, Tree)
-> HashMap Text (Int, Tree)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
insert Text
layer (Int
ix, [Text] -> Tree -> Tree
registerLayer [Text]
sublayers Tree
subtree) HashMap Text (Int, Tree)
self
    | Bool
otherwise = HashMap Text (Int, Tree) -> Tree
Tree (HashMap Text (Int, Tree) -> Tree)
-> HashMap Text (Int, Tree) -> Tree
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Tree)
-> HashMap Text (Int, Tree)
-> HashMap Text (Int, Tree)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
insert Text
layer (Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ HashMap Text (Int, Tree) -> Int
forall k v. HashMap k v -> Int
size HashMap Text (Int, Tree)
self, [Text] -> Tree -> Tree
registerLayer [Text]
sublayers (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$ HashMap Text (Int, Tree) -> Tree
Tree HashMap Text (Int, Tree)
forall k v. HashMap k v
M.empty) HashMap Text (Int, Tree)
self
registerLayer [] self :: Tree
self = Tree
self

layerPath :: [Text] -> Tree -> [Int]
layerPath :: [Text] -> Tree -> [Int]
layerPath (layer :: Text
layer:sublayers :: [Text]
sublayers) (Tree self :: HashMap Text (Int, Tree)
self)
    | Just (ix :: Int
ix, subtree :: Tree
subtree) <- HashMap Text (Int, Tree)
self HashMap Text (Int, Tree) -> Text -> Maybe (Int, Tree)
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!? Text
layer = Int
ixInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Text] -> Tree -> [Int]
layerPath [Text]
sublayers Tree
subtree
    | Bool
otherwise = [] -- Should have registered first...
layerPath [] _ = []

uniqueName :: [Text] -> Tree -> [Text]
uniqueName :: [Text] -> Tree -> [Text]
uniqueName (namespace :: Text
namespace:namespaces :: [Text]
namespaces) (Tree self :: HashMap Text (Int, Tree)
self) 
    | Just (_, subtree :: Tree
subtree) <- HashMap Text (Int, Tree)
self HashMap Text (Int, Tree) -> Text -> Maybe (Int, Tree)
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!? Text
namespace = Text
namespaceText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text] -> Tree -> [Text]
uniqueName [Text]
namespaces Tree
subtree
    | Bool
otherwise = Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
namespaces Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2) Text
T.empty -- Should have registered first
uniqueName [] (Tree self :: HashMap Text (Int, Tree)
self) = [String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ HashMap Text (Int, Tree) -> Int
forall k v. HashMap k v -> Int
size HashMap Text (Int, Tree)
self]

emptyTree :: Tree
emptyTree :: Tree
emptyTree = HashMap Text (Int, Tree) -> Tree
Tree HashMap Text (Int, Tree)
forall k v. HashMap k v
M.empty