{-# LANGUAGE OverloadedStrings #-}
-- | Lowers certain CSS properties to plain text.
module Data.CSS.Preprocessor.Text(TextStyle, resolve) where

import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
import Data.CSS.Style (PropertyParser(..))
import Data.CSS.StyleTree
import qualified Data.Text as Txt
import Data.Text (Text)

import Data.Maybe (fromMaybe)
import qualified Data.HashMap.Lazy as M
import Data.Function ((&))

import Data.Char (isSpace)

type Counters = [(Text, Integer)]
-- | `PropertyParser` decorator that parses & lowers certain CSS properties to plain text.
data TextStyle p = TextStyle {
    TextStyle p -> p
inner :: p,
    TextStyle p -> [(Text, [Token])]
counterProps :: [(Text, [Token])],

    TextStyle p -> Counters
counterReset :: Counters,
    TextStyle p -> Counters
counterIncrement :: Counters,
    TextStyle p -> Counters
counterSet :: Counters,

    TextStyle p -> Bool
whiteSpaceCollapse :: Bool,
    TextStyle p -> Bool
newlineCollapse :: Bool
}

instance PropertyParser p => PropertyParser (TextStyle p) where
    temp :: TextStyle p
temp = TextStyle :: forall p.
p
-> [(Text, [Token])]
-> Counters
-> Counters
-> Counters
-> Bool
-> Bool
-> TextStyle p
TextStyle {
            inner :: p
inner = p
forall a. PropertyParser a => a
temp,
            counterProps :: [(Text, [Token])]
counterProps = [],
            counterReset :: Counters
counterReset = [],
            counterIncrement :: Counters
counterIncrement = [],
            counterSet :: Counters
counterSet = [],
            whiteSpaceCollapse :: Bool
whiteSpaceCollapse = Bool
True,
            newlineCollapse :: Bool
newlineCollapse = Bool
True
        }
    inherit :: TextStyle p -> TextStyle p
inherit TextStyle p
parent = TextStyle :: forall p.
p
-> [(Text, [Token])]
-> Counters
-> Counters
-> Counters
-> Bool
-> Bool
-> TextStyle p
TextStyle {
            inner :: p
inner = p -> p
forall a. PropertyParser a => a -> a
inherit (p -> p) -> p -> p
forall a b. (a -> b) -> a -> b
$ TextStyle p -> p
forall p. TextStyle p -> p
inner TextStyle p
parent,
            counterProps :: [(Text, [Token])]
counterProps = [],
            counterReset :: Counters
counterReset = [],
            counterIncrement :: Counters
counterIncrement = [],
            counterSet :: Counters
counterSet = [],
            whiteSpaceCollapse :: Bool
whiteSpaceCollapse = TextStyle p -> Bool
forall p. TextStyle p -> Bool
whiteSpaceCollapse TextStyle p
parent,
            newlineCollapse :: Bool
newlineCollapse = TextStyle p -> Bool
forall p. TextStyle p -> Bool
newlineCollapse TextStyle p
parent
        }

    shorthand :: TextStyle p -> Text -> [Token] -> [(Text, [Token])]
shorthand TextStyle p
_ Text
key [Token]
value
        | Text
key Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"counter-reset", Text
"counter-increment", Text
"counter-set"],
            Just Counters
_ <- Integer -> [Token] -> Maybe Counters
parseCounters Integer
0 [Token]
value = [(Text
key, [Token]
value)]
    shorthand TextStyle p
self Text
"white-space" [Ident Text
val]
        | Text
val Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"normal", Text
"pre", Text
"pre-wrap", Text
"pre-line"] = [(Text
"white-space", [Text -> Token
Ident Text
val])]
        | Bool
otherwise = p -> Text -> [Token] -> [(Text, [Token])]
forall a.
PropertyParser a =>
a -> Text -> [Token] -> [(Text, [Token])]
shorthand (TextStyle p -> p
forall p. TextStyle p -> p
inner TextStyle p
self) Text
"white-space" [Text -> Token
Ident Text
val]
    shorthand TextStyle { inner :: forall p. TextStyle p -> p
inner = p
s } Text
k [Token]
v
        | Just p
_ <- p -> p -> Text -> [Token] -> Maybe p
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand p
s p
s Text
k ([Token] -> Maybe p) -> [Token] -> Maybe p
forall a b. (a -> b) -> a -> b
$ [Token] -> [Token]
removeCounters [Token]
v = [(Text
k, [Token]
v)]
        | Bool
otherwise = p -> Text -> [Token] -> [(Text, [Token])]
forall a.
PropertyParser a =>
a -> Text -> [Token] -> [(Text, [Token])]
shorthand p
s Text
k [Token]
v

    longhand :: TextStyle p
-> TextStyle p -> Text -> [Token] -> Maybe (TextStyle p)
longhand TextStyle p
_ TextStyle p
self Text
"counter-reset" [Token]
value = (\Counters
v -> TextStyle p
self {counterReset :: Counters
counterReset = Counters
v}) (Counters -> TextStyle p) -> Maybe Counters -> Maybe (TextStyle p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> [Token] -> Maybe Counters
parseCounters Integer
0 [Token]
value
    longhand TextStyle p
_ TextStyle p
self Text
"counter-increment" [Token]
value = (\Counters
v -> TextStyle p
self {counterIncrement :: Counters
counterIncrement = Counters
v}) (Counters -> TextStyle p) -> Maybe Counters -> Maybe (TextStyle p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> [Token] -> Maybe Counters
parseCounters Integer
1 [Token]
value
    longhand TextStyle p
_ TextStyle p
self Text
"counter-set" [Token]
value = (\Counters
v -> TextStyle p
self {counterSet :: Counters
counterSet = Counters
v}) (Counters -> TextStyle p) -> Maybe Counters -> Maybe (TextStyle p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> [Token] -> Maybe Counters
parseCounters Integer
0 [Token]
value

    longhand TextStyle p
p TextStyle p
self Text
"white-space" [Ident Text
"initial"] = TextStyle p
-> TextStyle p -> Bool -> Bool -> Text -> Maybe (TextStyle p)
forall p.
PropertyParser p =>
TextStyle p
-> TextStyle p -> Bool -> Bool -> Text -> Maybe (TextStyle p)
setWhiteSpace TextStyle p
p TextStyle p
self Bool
True Bool
True Text
"normal"
    longhand TextStyle p
p TextStyle p
self Text
"white-space" [Ident Text
"normal"] = TextStyle p
-> TextStyle p -> Bool -> Bool -> Text -> Maybe (TextStyle p)
forall p.
PropertyParser p =>
TextStyle p
-> TextStyle p -> Bool -> Bool -> Text -> Maybe (TextStyle p)
setWhiteSpace TextStyle p
p TextStyle p
self Bool
True Bool
True Text
"normal"
    longhand TextStyle p
p TextStyle p
self Text
"white-space" [Ident Text
"pre"] = TextStyle p
-> TextStyle p -> Bool -> Bool -> Text -> Maybe (TextStyle p)
forall p.
PropertyParser p =>
TextStyle p
-> TextStyle p -> Bool -> Bool -> Text -> Maybe (TextStyle p)
setWhiteSpace TextStyle p
p TextStyle p
self Bool
False Bool
False Text
"nowrap"
    longhand TextStyle p
p TextStyle p
self Text
"white-space" [Ident Text
"nowrap"] = TextStyle p
-> TextStyle p -> Bool -> Bool -> Text -> Maybe (TextStyle p)
forall p.
PropertyParser p =>
TextStyle p
-> TextStyle p -> Bool -> Bool -> Text -> Maybe (TextStyle p)
setWhiteSpace TextStyle p
p TextStyle p
self Bool
True Bool
True Text
"nowrap"
    longhand TextStyle p
p TextStyle p
self Text
"white-space" [Ident Text
"pre-wrap"] = TextStyle p
-> TextStyle p -> Bool -> Bool -> Text -> Maybe (TextStyle p)
forall p.
PropertyParser p =>
TextStyle p
-> TextStyle p -> Bool -> Bool -> Text -> Maybe (TextStyle p)
setWhiteSpace TextStyle p
p TextStyle p
self Bool
False Bool
False Text
"normal"
    longhand TextStyle p
p TextStyle p
self Text
"white-space" [Ident Text
"pre-line"] = TextStyle p
-> TextStyle p -> Bool -> Bool -> Text -> Maybe (TextStyle p)
forall p.
PropertyParser p =>
TextStyle p
-> TextStyle p -> Bool -> Bool -> Text -> Maybe (TextStyle p)
setWhiteSpace TextStyle p
p TextStyle p
self Bool
True Bool
False Text
"normal"

    -- Capture `content` properties & anything else using counter(s) functions.
    -- This is important in Rhapsode for the sake of navigational markers.
    longhand TextStyle p
parent TextStyle p
self Text
key [Token]
value
        | Text
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"content" Bool -> Bool -> Bool
|| Text -> Token
Function Text
"counter" Token -> [Token] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Token]
value Bool -> Bool -> Bool
|| Text -> Token
Function Text
"counters" Token -> [Token] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Token]
value =
            TextStyle p -> Maybe (TextStyle p)
forall a. a -> Maybe a
Just (TextStyle p -> Maybe (TextStyle p))
-> TextStyle p -> Maybe (TextStyle p)
forall a b. (a -> b) -> a -> b
$ TextStyle p
self { counterProps :: [(Text, [Token])]
counterProps = Text -> [Token] -> [(Text, [Token])] -> [(Text, [Token])]
forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
insertList Text
key [Token]
value ([(Text, [Token])] -> [(Text, [Token])])
-> [(Text, [Token])] -> [(Text, [Token])]
forall a b. (a -> b) -> a -> b
$ TextStyle p -> [(Text, [Token])]
forall p. TextStyle p -> [(Text, [Token])]
counterProps TextStyle p
self }
        | Bool
otherwise = (\p
v -> TextStyle p
self {inner :: p
inner = p
v}) (p -> TextStyle p) -> Maybe p -> Maybe (TextStyle p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p -> p -> Text -> [Token] -> Maybe p
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand (TextStyle p -> p
forall p. TextStyle p -> p
inner TextStyle p
parent ) (TextStyle p -> p
forall p. TextStyle p -> p
inner TextStyle p
self) Text
key [Token]
value

insertList :: Eq a => a -> b -> [(a, b)] -> [(a, b)]
insertList :: a -> b -> [(a, b)] -> [(a, b)]
insertList a
key b
value [(a, b)]
list | Maybe b
Nothing <- a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
key [(a, b)]
list = (a
key, b
value) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
list
    | Bool
otherwise = [(a
k, if a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
key then b
value else b
v) | (a
k, b
v) <- [(a, b)]
list]

removeCounters :: [Token] -> [Token]
removeCounters :: [Token] -> [Token]
removeCounters (Function Text
"counter":Ident Text
_:Token
RightParen:[Token]
toks) = Text -> Token
String Text
"" Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token] -> [Token]
removeCounters [Token]
toks
removeCounters (Function Text
"counters":Ident Text
_:Token
Comma:String Text
_:[Token]
toks) = Text -> Token
String Text
"" Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token] -> [Token]
removeCounters [Token]
toks
removeCounters (Token
tok:[Token]
toks) = Token
tok Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token] -> [Token]
removeCounters [Token]
toks
removeCounters [] = []

setWhiteSpace :: PropertyParser p => TextStyle p -> TextStyle p -> Bool -> Bool -> Text -> Maybe (TextStyle p)
setWhiteSpace :: TextStyle p
-> TextStyle p -> Bool -> Bool -> Text -> Maybe (TextStyle p)
setWhiteSpace TextStyle p
parent TextStyle p
self Bool
collapse Bool
noNewlines Text
lowered = TextStyle p -> Maybe (TextStyle p)
forall a. a -> Maybe a
Just (TextStyle p -> Maybe (TextStyle p))
-> TextStyle p -> Maybe (TextStyle p)
forall a b. (a -> b) -> a -> b
$ TextStyle p
self {
        inner :: p
inner = TextStyle p -> p
forall p. TextStyle p -> p
inner TextStyle p
self p -> Maybe p -> p
forall a. a -> Maybe a -> a
`fromMaybe` p -> p -> Text -> [Token] -> Maybe p
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand (TextStyle p -> p
forall p. TextStyle p -> p
inner TextStyle p
parent) (TextStyle p -> p
forall p. TextStyle p -> p
inner TextStyle p
self) Text
"white-space" [Text -> Token
Ident Text
lowered],
        whiteSpaceCollapse :: Bool
whiteSpaceCollapse = Bool
collapse,
        newlineCollapse :: Bool
newlineCollapse = Bool
noNewlines
    }
parseCounters :: Integer -> [Token] -> Maybe [(Text, Integer)]
parseCounters :: Integer -> [Token] -> Maybe Counters
parseCounters Integer
_ [Ident Text
"none"] = Counters -> Maybe Counters
forall a. a -> Maybe a
Just []
parseCounters Integer
_ [Ident Text
"initial"] = Counters -> Maybe Counters
forall a. a -> Maybe a
Just []
parseCounters Integer
_ [] = Counters -> Maybe Counters
forall a. a -> Maybe a
Just []
parseCounters Integer
x (Ident Text
counter : Number Text
_ (NVInteger Integer
count') : [Token]
toks) =
    (:) (Text
counter, Integer
count') (Counters -> Counters) -> Maybe Counters -> Maybe Counters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> [Token] -> Maybe Counters
parseCounters Integer
x [Token]
toks
parseCounters Integer
x (Ident Text
counter : [Token]
toks) = (:) (Text
counter, Integer
x) (Counters -> Counters) -> Maybe Counters -> Maybe Counters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> [Token] -> Maybe Counters
parseCounters Integer
x [Token]
toks
parseCounters Integer
_ [Token]
_ = Maybe Counters
forall a. Maybe a
Nothing

-- | Returns inner `PropertyParser` with text properties applied.
resolve :: PropertyParser p => StyleTree (TextStyle p) -> StyleTree p
resolve :: StyleTree (TextStyle p) -> StyleTree p
resolve = StyleTree (TextStyle p) -> StyleTree p
forall p.
PropertyParser p =>
StyleTree (TextStyle p) -> StyleTree p
resolve' (StyleTree (TextStyle p) -> StyleTree p)
-> (StyleTree (TextStyle p) -> StyleTree (TextStyle p))
-> StyleTree (TextStyle p)
-> StyleTree p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleTree (TextStyle p) -> StyleTree (TextStyle p)
forall p. StyleTree (TextStyle p) -> StyleTree (TextStyle p)
collapseWS (StyleTree (TextStyle p) -> StyleTree (TextStyle p))
-> (StyleTree (TextStyle p) -> StyleTree (TextStyle p))
-> StyleTree (TextStyle p)
-> StyleTree (TextStyle p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleTree (TextStyle p) -> StyleTree (TextStyle p)
forall p. StyleTree (TextStyle p) -> StyleTree (TextStyle p)
applyCounters
resolve' :: PropertyParser p => StyleTree (TextStyle p) -> StyleTree p
resolve' :: StyleTree (TextStyle p) -> StyleTree p
resolve' = (TextStyle p -> p) -> StyleTree (TextStyle p) -> StyleTree p
forall p p'. (p -> p') -> StyleTree p -> StyleTree p'
treeMap ((TextStyle p -> p) -> StyleTree (TextStyle p) -> StyleTree p)
-> (TextStyle p -> p) -> StyleTree (TextStyle p) -> StyleTree p
forall a b. (a -> b) -> a -> b
$ \TextStyle {inner :: forall p. TextStyle p -> p
inner = p
inner', counterProps :: forall p. TextStyle p -> [(Text, [Token])]
counterProps = [(Text, [Token])]
props} -> (p -> (Text, [Token]) -> p) -> p -> [(Text, [Token])] -> p
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl p -> (Text, [Token]) -> p
forall p. PropertyParser p => p -> (Text, [Token]) -> p
resolveProp p
inner' [(Text, [Token])]
props
resolveProp :: PropertyParser p => p -> (Text, [Token]) -> p
resolveProp :: p -> (Text, [Token]) -> p
resolveProp p
sty (Text
key, [Token]
value) = p
sty p -> Maybe p -> p
forall a. a -> Maybe a -> a
`fromMaybe` p -> p -> Text -> [Token] -> Maybe p
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand p
forall a. PropertyParser a => a
temp p
sty Text
key [Token]
value

--------
---- Counters
--------
type Context = M.HashMap Text [([Integer], Integer)]

inheritCounters :: Context -> Context -> Context
inheritCounters :: Context -> Context -> Context
inheritCounters Context
counterSource Context
valueSource = ([([Integer], Integer)]
 -> [([Integer], Integer)] -> [([Integer], Integer)])
-> Context -> Context -> Context
forall k v1 v2 v3.
(Eq k, Hashable k) =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
M.intersectionWith [([Integer], Integer)]
-> [([Integer], Integer)] -> [([Integer], Integer)]
forall a b b. Eq a => [(a, b)] -> [(a, b)] -> [(a, b)]
cb Context
valueSource Context
counterSource -- indexed by name & el-path
    where cb :: [(a, b)] -> [(a, b)] -> [(a, b)]
cb [(a, b)]
val [(a, b)]
source = [(a, b)
counter | counter :: (a, b)
counter@(a
path, b
_) <- [(a, b)]
val, a
path a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a
p | (a
p, b
_) <- [(a, b)]
source]]

instantiateCounter :: Context -> Path -> Text -> Integer -> Context
instantiateCounter :: Context -> [Integer] -> Text -> Integer -> Context
instantiateCounter Context
counters [Integer]
path Text
name Integer
val = ([([Integer], Integer)]
 -> [([Integer], Integer)] -> [([Integer], Integer)])
-> Text -> [([Integer], Integer)] -> Context -> Context
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
M.insertWith [([Integer], Integer)]
-> [([Integer], Integer)] -> [([Integer], Integer)]
forall b. [([Integer], b)] -> [([Integer], b)] -> [([Integer], b)]
appendCounter Text
name [([Integer]
path, Integer
val)] Context
counters
    where
        appendCounter :: [([Integer], b)] -> [([Integer], b)] -> [([Integer], b)]
appendCounter [([Integer], b)]
new (old :: ([Integer], b)
old@((Integer
_:[Integer]
oldPath), b
_):[([Integer], b)]
olds)
            | [Integer]
oldPath [Integer] -> [Integer] -> Bool
forall a. Eq a => a -> a -> Bool
== [Integer] -> [Integer]
forall a. [a] -> [a]
tail [Integer]
path = [([Integer], b)]
new [([Integer], b)] -> [([Integer], b)] -> [([Integer], b)]
forall a. [a] -> [a] -> [a]
++ [([Integer], b)]
olds
            | Bool
otherwise =  [([Integer], b)]
new [([Integer], b)] -> [([Integer], b)] -> [([Integer], b)]
forall a. [a] -> [a] -> [a]
++ (([Integer], b)
old([Integer], b) -> [([Integer], b)] -> [([Integer], b)]
forall a. a -> [a] -> [a]
:[([Integer], b)]
olds)
        appendCounter [([Integer], b)]
new [] = [([Integer], b)]
new
        appendCounter [([Integer], b)]
new (([Integer], b)
_:[([Integer], b)]
olds) = [([Integer], b)]
new [([Integer], b)] -> [([Integer], b)] -> [([Integer], b)]
forall a. [a] -> [a] -> [a]
++ [([Integer], b)]
olds
instantiateCounters :: Path -> Counters -> Context -> Context
instantiateCounters :: [Integer] -> Counters -> Context -> Context
instantiateCounters [Integer]
path Counters
instruct Context
counters = (Context -> (Text, Integer) -> Context)
-> Context -> Counters -> Context
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Context -> (Text, Integer) -> Context
cb Context
counters Counters
instruct
    where cb :: Context -> (Text, Integer) -> Context
cb Context
counters' (Text
name, Integer
value) = Context -> [Integer] -> Text -> Integer -> Context
instantiateCounter Context
counters' [Integer]
path Text
name Integer
value

incrementCounter :: Context -> Path -> Text -> Integer -> Context
incrementCounter :: Context -> [Integer] -> Text -> Integer -> Context
incrementCounter Context
counters [Integer]
path Text
name Integer
val = ([([Integer], Integer)]
 -> [([Integer], Integer)] -> [([Integer], Integer)])
-> Text -> [([Integer], Integer)] -> Context -> Context
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
M.insertWith [([Integer], Integer)]
-> [([Integer], Integer)] -> [([Integer], Integer)]
forall b a. Num b => [(a, b)] -> [(a, b)] -> [(a, b)]
addCounter Text
name [([Integer]
path, Integer
val)] Context
counters
    where
        addCounter :: [(a, b)] -> [(a, b)] -> [(a, b)]
addCounter ((a
_, b
new):[(a, b)]
_) ((a
path', b
old):[(a, b)]
rest) = (a
path', b
new b -> b -> b
forall a. Num a => a -> a -> a
+ b
old)(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
rest
        addCounter [] [(a, b)]
old = [(a, b)]
old
        addCounter [(a, b)]
new [] = [(a, b)]
new
incrementCounters :: Path -> Counters -> Context -> Context
incrementCounters :: [Integer] -> Counters -> Context -> Context
incrementCounters [Integer]
path Counters
instruct Context
counters = (Context -> (Text, Integer) -> Context)
-> Context -> Counters -> Context
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Context -> (Text, Integer) -> Context
cb Context
counters Counters
instruct
    where cb :: Context -> (Text, Integer) -> Context
cb Context
counters' (Text
name, Integer
value) = Context -> [Integer] -> Text -> Integer -> Context
incrementCounter Context
counters' [Integer]
path Text
name Integer
value

setCounter :: Context -> Path -> Text -> Integer -> Context
setCounter :: Context -> [Integer] -> Text -> Integer -> Context
setCounter Context
counters [Integer]
path Text
name Integer
val = ([([Integer], Integer)]
 -> [([Integer], Integer)] -> [([Integer], Integer)])
-> Text -> [([Integer], Integer)] -> Context -> Context
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
M.insertWith [([Integer], Integer)]
-> [([Integer], Integer)] -> [([Integer], Integer)]
forall a b. [(a, b)] -> [(a, b)] -> [(a, b)]
setCounter' Text
name [([Integer]
path, Integer
val)] Context
counters
    where
        setCounter' :: [(a, b)] -> [(a, b)] -> [(a, b)]
setCounter' ((a
_, b
val'):[(a, b)]
_) ((a
path', b
_):[(a, b)]
rest) = (a
path', b
val')(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
rest
        setCounter' [] [(a, b)]
old = [(a, b)]
old
        setCounter' [(a, b)]
new [] = [(a, b)]
new
setCounters :: Path -> Counters -> Context -> Context
setCounters :: [Integer] -> Counters -> Context -> Context
setCounters [Integer]
path Counters
instruct Context
counters = (Context -> (Text, Integer) -> Context)
-> Context -> Counters -> Context
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Context -> (Text, Integer) -> Context
cb Context
counters Counters
instruct
    where cb :: Context -> (Text, Integer) -> Context
cb Context
counters' (Text
name, Integer
value) = Context -> [Integer] -> Text -> Integer -> Context
setCounter Context
counters' [Integer]
path Text
name Integer
value


renderCounters :: Context -> [Token] -> [Token]
renderCounters :: Context -> [Token] -> [Token]
renderCounters Context
counters (Function Text
"counter":Ident Text
name:Token
RightParen:[Token]
toks)
    | Just (([Integer]
_, Integer
count):[([Integer], Integer)]
_) <- Text
name Text -> Context -> Maybe [([Integer], Integer)]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`M.lookup` Context
counters =
        Text -> Token
String (String -> Text
Txt.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
count) Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Context -> [Token] -> [Token]
renderCounters Context
counters [Token]
toks
    | Bool
otherwise = Context -> [Token] -> [Token]
renderCounters Context
counters [Token]
toks
renderCounters Context
counters (Function Text
"counters":Ident Text
name:Token
Comma:String Text
sep:Token
RightParen:[Token]
toks)
    | Just [([Integer], Integer)]
counter <- Text
name Text -> Context -> Maybe [([Integer], Integer)]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`M.lookup` Context
counters = Text -> Token
String (Text -> [Text] -> Text
Txt.intercalate Text
sep [
        String -> Text
Txt.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
count | ([Integer]
_, Integer
count) <- [([Integer], Integer)] -> [([Integer], Integer)]
forall a. [a] -> [a]
reverse [([Integer], Integer)]
counter
    ]) Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Context -> [Token] -> [Token]
renderCounters Context
counters [Token]
toks
    | Bool
otherwise = Context -> [Token] -> [Token]
renderCounters Context
counters [Token]
toks
renderCounters Context
counters (Token
tok:[Token]
toks) = Token
tok Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Context -> [Token] -> [Token]
renderCounters Context
counters [Token]
toks
renderCounters Context
_ [] = []

applyCounters :: StyleTree (TextStyle p) -> StyleTree (TextStyle p)
applyCounters :: StyleTree (TextStyle p) -> StyleTree (TextStyle p)
applyCounters = (Context
 -> Context -> [Integer] -> TextStyle p -> (Context, TextStyle p))
-> Context -> StyleTree (TextStyle p) -> StyleTree (TextStyle p)
forall c p p'.
(c -> c -> [Integer] -> p -> (c, p'))
-> c -> StyleTree p -> StyleTree p'
treeOrder Context
-> Context -> [Integer] -> TextStyle p -> (Context, TextStyle p)
forall p.
Context
-> Context -> [Integer] -> TextStyle p -> (Context, TextStyle p)
applyCounters0 Context
forall k v. HashMap k v
M.empty
applyCounters0 :: Context -> Context -> Path -> TextStyle p -> (Context, TextStyle p)
applyCounters0 :: Context
-> Context -> [Integer] -> TextStyle p -> (Context, TextStyle p)
applyCounters0 Context
counterSource Context
valueSource [Integer]
path TextStyle p
node =
    let counters :: Context
counters = Context -> Context -> Context
inheritCounters Context
counterSource Context
valueSource Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
&
            [Integer] -> Counters -> Context -> Context
instantiateCounters [Integer]
path (TextStyle p -> Counters
forall p. TextStyle p -> Counters
counterReset TextStyle p
node) Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
&
            [Integer] -> Counters -> Context -> Context
incrementCounters [Integer]
path (TextStyle p -> Counters
forall p. TextStyle p -> Counters
counterIncrement TextStyle p
node) Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
&
            [Integer] -> Counters -> Context -> Context
setCounters [Integer]
path (TextStyle p -> Counters
forall p. TextStyle p -> Counters
counterSet TextStyle p
node)
    in (Context
counters, TextStyle p
node {
        counterProps :: [(Text, [Token])]
counterProps = [(Text
k, Context -> [Token] -> [Token]
renderCounters Context
counters [Token]
v) | (Text
k, [Token]
v) <- TextStyle p -> [(Text, [Token])]
forall p. TextStyle p -> [(Text, [Token])]
counterProps TextStyle p
node]
    })

--------
---- white-space
--------
content :: TextStyle p -> [Token]
content :: TextStyle p -> [Token]
content = [Token] -> Maybe [Token] -> [Token]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Token] -> [Token])
-> (TextStyle p -> Maybe [Token]) -> TextStyle p -> [Token]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, [Token])] -> Maybe [Token]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"content" ([(Text, [Token])] -> Maybe [Token])
-> (TextStyle p -> [(Text, [Token])])
-> TextStyle p
-> Maybe [Token]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextStyle p -> [(Text, [Token])]
forall p. TextStyle p -> [(Text, [Token])]
counterProps
setContent :: [Token] -> TextStyle p -> TextStyle p
setContent :: [Token] -> TextStyle p -> TextStyle p
setContent [Token]
value TextStyle p
self = TextStyle p
self {
        counterProps :: [(Text, [Token])]
counterProps = [(Text
k, if Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"content" then [Token]
value else [Token]
v) | (Text
k, [Token]
v) <- TextStyle p -> [(Text, [Token])]
forall p. TextStyle p -> [(Text, [Token])]
counterProps TextStyle p
self]
    }

collapseWS :: StyleTree (TextStyle p) -> StyleTree (TextStyle p)
collapseWS :: StyleTree (TextStyle p) -> StyleTree (TextStyle p)
collapseWS = (Bool -> Bool -> [Integer] -> TextStyle p -> (Bool, TextStyle p))
-> Bool -> StyleTree (TextStyle p) -> StyleTree (TextStyle p)
forall c p p'.
(c -> c -> [Integer] -> p -> (c, p'))
-> c -> StyleTree p -> StyleTree p'
treeOrder Bool -> Bool -> [Integer] -> TextStyle p -> (Bool, TextStyle p)
forall p.
Bool -> Bool -> [Integer] -> TextStyle p -> (Bool, TextStyle p)
collapseWS0 Bool
True
collapseWS0 :: Bool -> Bool -> Path -> TextStyle p -> (Bool, TextStyle p)
collapseWS0 :: Bool -> Bool -> [Integer] -> TextStyle p -> (Bool, TextStyle p)
collapseWS0 Bool
_ Bool
_ [Integer]
_ node :: TextStyle p
node@(TextStyle {whiteSpaceCollapse :: forall p. TextStyle p -> Bool
whiteSpaceCollapse = Bool
False, newlineCollapse :: forall p. TextStyle p -> Bool
newlineCollapse = Bool
False}) = (Bool
False, TextStyle p
node)
collapseWS0 Bool
_ Bool
inSpace [Integer]
_ node :: TextStyle p
node@(TextStyle {
        whiteSpaceCollapse :: forall p. TextStyle p -> Bool
whiteSpaceCollapse = Bool
wsCollapse,
        newlineCollapse :: forall p. TextStyle p -> Bool
newlineCollapse = Bool
nlCollapse
    }) = (Bool
trailingSpace, [Token] -> TextStyle p -> TextStyle p
forall p. [Token] -> TextStyle p -> TextStyle p
setContent [Token]
content' TextStyle p
node)
  where (Bool
trailingSpace, [Token]
content') = Bool -> Bool -> Bool -> [Token] -> (Bool, [Token])
collapseWSToks Bool
inSpace Bool
wsCollapse Bool
nlCollapse ([Token] -> (Bool, [Token])) -> [Token] -> (Bool, [Token])
forall a b. (a -> b) -> a -> b
$ TextStyle p -> [Token]
forall p. TextStyle p -> [Token]
content TextStyle p
node

collapseWSToks :: Bool -> Bool -> Bool -> [Token] -> (Bool, [Token])
collapseWSToks :: Bool -> Bool -> Bool -> [Token] -> (Bool, [Token])
collapseWSToks Bool
stripStart Bool
wsCollapse Bool
nlCollapse (String Text
txt:[Token]
toks) =
    let (Bool
trailingSpace, String
str') = Bool -> Bool -> Bool -> String -> (Bool, String)
collapseWSStr Bool
stripStart Bool
wsCollapse Bool
nlCollapse (String -> (Bool, String)) -> String -> (Bool, String)
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
txt
        (Bool
trailingSpace', [Token]
toks') = Bool -> Bool -> Bool -> [Token] -> (Bool, [Token])
collapseWSToks Bool
trailingSpace Bool
wsCollapse Bool
nlCollapse [Token]
toks
    in (Bool
trailingSpace', Text -> Token
String (String -> Text
Txt.pack String
str')Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
toks')
collapseWSToks Bool
_ Bool
wsCollapse Bool
nlCollapse (Token
tok:[Token]
toks) =
    let (Bool
trailingSpace, [Token]
toks') = Bool -> Bool -> Bool -> [Token] -> (Bool, [Token])
collapseWSToks Bool
False Bool
wsCollapse Bool
nlCollapse [Token]
toks
    in (Bool
trailingSpace, Token
tokToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
toks')
collapseWSToks Bool
trailingWS Bool
_ Bool
_ [] = (Bool
trailingWS, [])

collapseWSStr, collapseWSStr' :: Bool -> Bool -> Bool -> String -> (Bool, String)
collapseWSStr :: Bool -> Bool -> Bool -> String -> (Bool, String)
collapseWSStr Bool
_ Bool
wsCollapse Bool
False str :: String
str@(Char
'\n':String
_) = Bool -> Bool -> Bool -> String -> (Bool, String)
collapseWSStr' Bool
True Bool
wsCollapse Bool
True String
str
collapseWSStr Bool
True Bool
True Bool
nlCollapse (Char
ch:String
str) | Char -> Bool
isSpace Char
ch = Bool -> Bool -> Bool -> String -> (Bool, String)
collapseWSStr Bool
True Bool
True Bool
nlCollapse String
str
collapseWSStr Bool
False Bool
True Bool
nlCollapse str :: String
str@(Char
ch:String
_) | Char -> Bool
isSpace Char
ch = Bool -> Bool -> Bool -> String -> (Bool, String)
collapseWSStr' Bool
True Bool
True Bool
nlCollapse String
str
collapseWSStr Bool
_ Bool
wsCollapse Bool
nlCollapse String
str = Bool -> Bool -> Bool -> String -> (Bool, String)
collapseWSStr' Bool
False Bool
wsCollapse Bool
nlCollapse String
str
collapseWSStr' :: Bool -> Bool -> Bool -> String -> (Bool, String)
collapseWSStr' Bool
a Bool
b Bool
c (Char
d:String
ds) = let (Bool
trailing, String
ds') = Bool -> Bool -> Bool -> String -> (Bool, String)
collapseWSStr Bool
a Bool
b Bool
c String
ds in (Bool
trailing, Char
dChar -> String -> String
forall a. a -> [a] -> [a]
:String
ds')
collapseWSStr' Bool
a Bool
_ Bool
_ [] = (Bool
a, [])