{-# LANGUAGE OverloadedStrings #-}
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)]
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"
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
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
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
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]
})
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, [])