{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE EmptyDataDecls #-}
module Text.Internal.Css where
import Data.List (intersperse, intercalate)
import Data.Text.Lazy.Builder (Builder, singleton, toLazyText, fromLazyText, fromString)
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
import Data.Monoid (Monoid, mconcat, mappend, mempty)
import Data.Semigroup (Semigroup(..))
import Data.Text (Text)
import qualified Data.Text as T
import Language.Haskell.TH.Syntax
import System.IO.Unsafe (unsafePerformIO)
import Text.ParserCombinators.Parsec (Parser, parse)
import Text.Shakespeare.Base hiding (Scope)
import Language.Haskell.TH
import Control.Applicative ((<$>), (<*>))
import Control.Arrow ((***), second)
import Text.IndentToBrace (i2b)
import Data.Functor.Identity (runIdentity)
import Text.Shakespeare (VarType (..))
type CssUrl url = (url -> [(T.Text, T.Text)] -> T.Text) -> Css
type DList a = [a] -> [a]
data Resolved
data Unresolved
type family Selector a
type instance Selector Resolved = Builder
type instance Selector Unresolved = [Contents]
type family ChildBlocks a
type instance ChildBlocks Resolved = ()
type instance ChildBlocks Unresolved = [(HasLeadingSpace, Block Unresolved)]
type HasLeadingSpace = Bool
type family Str a
type instance Str Resolved = Builder
type instance Str Unresolved = Contents
type family Mixins a
type instance Mixins Resolved = ()
type instance Mixins Unresolved = [Deref]
data Block a = Block
{ Block a -> Selector a
blockSelector :: !(Selector a)
, Block a -> [Attr a]
blockAttrs :: ![Attr a]
, Block a -> ChildBlocks a
blockBlocks :: !(ChildBlocks a)
, Block a -> Mixins a
blockMixins :: !(Mixins a)
}
data Mixin = Mixin
{ Mixin -> [Attr Resolved]
mixinAttrs :: ![Attr Resolved]
, Mixin -> [Block Resolved]
mixinBlocks :: ![Block Resolved]
}
instance Semigroup Mixin where
Mixin a :: [Attr Resolved]
a x :: [Block Resolved]
x <> :: Mixin -> Mixin -> Mixin
<> Mixin b :: [Attr Resolved]
b y :: [Block Resolved]
y = [Attr Resolved] -> [Block Resolved] -> Mixin
Mixin ([Attr Resolved]
a [Attr Resolved] -> [Attr Resolved] -> [Attr Resolved]
forall a. [a] -> [a] -> [a]
++ [Attr Resolved]
b) ([Block Resolved]
x [Block Resolved] -> [Block Resolved] -> [Block Resolved]
forall a. [a] -> [a] -> [a]
++ [Block Resolved]
y)
instance Monoid Mixin where
mempty :: Mixin
mempty = [Attr Resolved] -> [Block Resolved] -> Mixin
Mixin [Attr Resolved]
forall a. Monoid a => a
mempty [Block Resolved]
forall a. Monoid a => a
mempty
data TopLevel a where
TopBlock :: !(Block a) -> TopLevel a
TopAtBlock :: !String
-> !(Str a)
-> ![Block a]
-> TopLevel a
TopAtDecl :: !String -> !(Str a) -> TopLevel a
TopVar :: !String -> !String -> TopLevel Unresolved
data Attr a = Attr
{ Attr a -> Str a
attrKey :: !(Str a)
, Attr a -> Str a
attrVal :: !(Str a)
}
data Css = CssWhitespace ![TopLevel Resolved]
| CssNoWhitespace ![TopLevel Resolved]
data Content = ContentRaw String
| ContentVar Deref
| ContentUrl Deref
| ContentUrlParam Deref
| ContentMixin Deref
deriving (Int -> Content -> ShowS
[Content] -> ShowS
Content -> String
(Int -> Content -> ShowS)
-> (Content -> String) -> ([Content] -> ShowS) -> Show Content
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Content] -> ShowS
$cshowList :: [Content] -> ShowS
show :: Content -> String
$cshow :: Content -> String
showsPrec :: Int -> Content -> ShowS
$cshowsPrec :: Int -> Content -> ShowS
Show, Content -> Content -> Bool
(Content -> Content -> Bool)
-> (Content -> Content -> Bool) -> Eq Content
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Content -> Content -> Bool
$c/= :: Content -> Content -> Bool
== :: Content -> Content -> Bool
$c== :: Content -> Content -> Bool
Eq)
type Contents = [Content]
data CDData url = CDPlain Builder
| CDUrl url
| CDUrlParam (url, [(Text, Text)])
| CDMixin Mixin
pack :: String -> Text
pack :: String -> Text
pack = String -> Text
T.pack
fromText :: Text -> Builder
fromText :: Text -> Builder
fromText = Text -> Builder
TLB.fromText
{-# NOINLINE fromText #-}
class ToCss a where
toCss :: a -> Builder
instance ToCss [Char] where toCss :: String -> Builder
toCss = Text -> Builder
fromLazyText (Text -> Builder) -> (String -> Text) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack
instance ToCss Text where toCss :: Text -> Builder
toCss = Text -> Builder
fromText
instance ToCss TL.Text where toCss :: Text -> Builder
toCss = Text -> Builder
fromLazyText
cssUsedIdentifiers :: Bool
-> Parser [TopLevel Unresolved]
-> String
-> [(Deref, VarType)]
cssUsedIdentifiers :: Bool
-> Parser [TopLevel Unresolved] -> String -> [(Deref, VarType)]
cssUsedIdentifiers toi2b :: Bool
toi2b parseBlocks :: Parser [TopLevel Unresolved]
parseBlocks s' :: String
s' =
[[(Deref, VarType)]] -> [(Deref, VarType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Deref, VarType)]] -> [(Deref, VarType)])
-> [[(Deref, VarType)]] -> [(Deref, VarType)]
forall a b. (a -> b) -> a -> b
$ (String -> [[(Deref, VarType)]])
-> ([[(Deref, VarType)]] -> [[(Deref, VarType)]])
-> Either String [[(Deref, VarType)]]
-> [[(Deref, VarType)]]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> [[(Deref, VarType)]]
forall a. HasCallStack => String -> a
error [[(Deref, VarType)]] -> [[(Deref, VarType)]]
forall a. a -> a
id (Either String [[(Deref, VarType)]] -> [[(Deref, VarType)]])
-> Either String [[(Deref, VarType)]] -> [[(Deref, VarType)]]
forall a b. (a -> b) -> a -> b
$ (Content -> Either String [(Deref, VarType)])
-> [Content] -> Either String [[(Deref, VarType)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([(String, String)] -> Content -> Either String [(Deref, VarType)]
getVars [(String, String)]
scope0) [Content]
contents
where
s :: String
s = if Bool
toi2b then ShowS
i2b String
s' else String
s'
a :: [TopLevel Unresolved]
a = (ParseError -> [TopLevel Unresolved])
-> ([TopLevel Unresolved] -> [TopLevel Unresolved])
-> Either ParseError [TopLevel Unresolved]
-> [TopLevel Unresolved]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> [TopLevel Unresolved]
forall a. HasCallStack => String -> a
error (String -> [TopLevel Unresolved])
-> (ParseError -> String) -> ParseError -> [TopLevel Unresolved]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show) [TopLevel Unresolved] -> [TopLevel Unresolved]
forall a. a -> a
id (Either ParseError [TopLevel Unresolved] -> [TopLevel Unresolved])
-> Either ParseError [TopLevel Unresolved] -> [TopLevel Unresolved]
forall a b. (a -> b) -> a -> b
$ Parser [TopLevel Unresolved]
-> String -> String -> Either ParseError [TopLevel Unresolved]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parser [TopLevel Unresolved]
parseBlocks String
s String
s
(scope0 :: [(String, String)]
scope0, contents :: [Content]
contents) = [TopLevel Unresolved] -> ([(String, String)], [Content])
go [TopLevel Unresolved]
a
go :: [TopLevel Unresolved]
-> (Scope, [Content])
go :: [TopLevel Unresolved] -> ([(String, String)], [Content])
go [] = ([], [])
go (TopAtDecl dec :: String
dec cs :: Str Unresolved
cs:rest :: [TopLevel Unresolved]
rest) =
([(String, String)]
scope, [Content]
rest'')
where
(scope :: [(String, String)]
scope, rest' :: [Content]
rest') = [TopLevel Unresolved] -> ([(String, String)], [Content])
go [TopLevel Unresolved]
rest
rest'' :: [Content]
rest'' =
String -> Content
ContentRaw ('@' Char -> ShowS
forall a. a -> [a] -> [a]
: String
dec String -> ShowS
forall a. [a] -> [a] -> [a]
++ " ")
Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
Str Unresolved
cs
[Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ String -> Content
ContentRaw ";"
Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
rest'
go (TopAtBlock _ _ blocks :: [Block Unresolved]
blocks:rest :: [TopLevel Unresolved]
rest) =
([(String, String)]
scope1 [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String, String)]
scope2, [Content]
rest1 [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
rest2)
where
(scope1 :: [(String, String)]
scope1, rest1 :: [Content]
rest1) = [TopLevel Unresolved] -> ([(String, String)], [Content])
go ((Block Unresolved -> TopLevel Unresolved)
-> [Block Unresolved] -> [TopLevel Unresolved]
forall a b. (a -> b) -> [a] -> [b]
map Block Unresolved -> TopLevel Unresolved
forall a. Block a -> TopLevel a
TopBlock [Block Unresolved]
blocks)
(scope2 :: [(String, String)]
scope2, rest2 :: [Content]
rest2) = [TopLevel Unresolved] -> ([(String, String)], [Content])
go [TopLevel Unresolved]
rest
go (TopBlock (Block x :: Selector Unresolved
x y :: [Attr Unresolved]
y z :: ChildBlocks Unresolved
z mixins :: Mixins Unresolved
mixins):rest :: [TopLevel Unresolved]
rest) =
([(String, String)]
scope1 [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String, String)]
scope2, [Content]
rest0 [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
rest1 [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
rest2 [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
restm)
where
rest0 :: [Content]
rest0 = [Content] -> [[Content]] -> [Content]
forall a. [a] -> [[a]] -> [a]
intercalate [String -> Content
ContentRaw ","] [[Content]]
Selector Unresolved
x [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ (Attr Unresolved -> [Content]) -> [Attr Unresolved] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Attr Unresolved -> [Content]
forall a a. (Str a ~ [a]) => Attr a -> [a]
go' [Attr Unresolved]
y
(scope1 :: [(String, String)]
scope1, rest1 :: [Content]
rest1) = [TopLevel Unresolved] -> ([(String, String)], [Content])
go (((Bool, Block Unresolved) -> TopLevel Unresolved)
-> [(Bool, Block Unresolved)] -> [TopLevel Unresolved]
forall a b. (a -> b) -> [a] -> [b]
map (Block Unresolved -> TopLevel Unresolved
forall a. Block a -> TopLevel a
TopBlock (Block Unresolved -> TopLevel Unresolved)
-> ((Bool, Block Unresolved) -> Block Unresolved)
-> (Bool, Block Unresolved)
-> TopLevel Unresolved
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, Block Unresolved) -> Block Unresolved
forall a b. (a, b) -> b
snd) [(Bool, Block Unresolved)]
ChildBlocks Unresolved
z)
(scope2 :: [(String, String)]
scope2, rest2 :: [Content]
rest2) = [TopLevel Unresolved] -> ([(String, String)], [Content])
go [TopLevel Unresolved]
rest
restm :: [Content]
restm = (Deref -> Content) -> [Deref] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Deref -> Content
ContentMixin [Deref]
Mixins Unresolved
mixins
go (TopVar k :: String
k v :: String
v:rest :: [TopLevel Unresolved]
rest) =
((String
k, String
v)(String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:[(String, String)]
scope, [Content]
rest')
where
(scope :: [(String, String)]
scope, rest' :: [Content]
rest') = [TopLevel Unresolved] -> ([(String, String)], [Content])
go [TopLevel Unresolved]
rest
go' :: Attr a -> [a]
go' (Attr k :: Str a
k v :: Str a
v) = [a]
Str a
k [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
Str a
v
cssFileDebug :: Bool
-> Q Exp
-> Parser [TopLevel Unresolved]
-> FilePath
-> Q Exp
cssFileDebug :: Bool -> Q Exp -> Parser [TopLevel Unresolved] -> String -> Q Exp
cssFileDebug toi2b :: Bool
toi2b parseBlocks' :: Q Exp
parseBlocks' parseBlocks :: Parser [TopLevel Unresolved]
parseBlocks fp :: String
fp = do
String
s <- String -> Q String
readFileQ String
fp
let vs :: [(Deref, VarType)]
vs = Bool
-> Parser [TopLevel Unresolved] -> String -> [(Deref, VarType)]
cssUsedIdentifiers Bool
toi2b Parser [TopLevel Unresolved]
parseBlocks String
s
[Exp]
c <- ((Deref, VarType) -> Q Exp) -> [(Deref, VarType)] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Deref, VarType) -> Q Exp
vtToExp [(Deref, VarType)]
vs
Exp
cr <- [|cssRuntime toi2b|]
Exp
parseBlocks'' <- Q Exp
parseBlocks'
Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Exp
cr Exp -> Exp -> Exp
`AppE` Exp
parseBlocks'' Exp -> Exp -> Exp
`AppE` (Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Lit
StringL String
fp) Exp -> Exp -> Exp
`AppE` [Exp] -> Exp
ListE [Exp]
c
combineSelectors :: HasLeadingSpace
-> [Contents]
-> [Contents]
-> [Contents]
combineSelectors :: Bool -> [[Content]] -> [[Content]] -> [[Content]]
combineSelectors hsl :: Bool
hsl a :: [[Content]]
a b :: [[Content]]
b = do
[Content]
a' <- [[Content]]
a
[Content]
b' <- [[Content]]
b
[Content] -> [[Content]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> [[Content]]) -> [Content] -> [[Content]]
forall a b. (a -> b) -> a -> b
$ [Content]
a' [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content] -> [Content]
addSpace [Content]
b'
where
addSpace :: [Content] -> [Content]
addSpace
| Bool
hsl = (String -> Content
ContentRaw " " Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:)
| Bool
otherwise = [Content] -> [Content]
forall a. a -> a
id
blockRuntime :: [(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Block Unresolved
-> Either String (DList (Block Resolved))
blockRuntime :: [(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Block Unresolved
-> Either String ([Block Resolved] -> [Block Resolved])
blockRuntime cd :: [(Deref, CDData url)]
cd render' :: url -> [(Text, Text)] -> Text
render' (Block x :: Selector Unresolved
x attrs :: [Attr Unresolved]
attrs z :: ChildBlocks Unresolved
z mixinsDerefs :: Mixins Unresolved
mixinsDerefs) = do
[Mixin]
mixins <- (Deref -> Either String Mixin) -> [Deref] -> Either String [Mixin]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Deref -> Either String Mixin
getMixin [Deref]
Mixins Unresolved
mixinsDerefs
[Builder]
x' <- (Content -> Either String Builder)
-> [Content] -> Either String [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> Either String Builder
go' ([Content] -> Either String [Builder])
-> [Content] -> Either String [Builder]
forall a b. (a -> b) -> a -> b
$ [Content] -> [[Content]] -> [Content]
forall a. [a] -> [[a]] -> [a]
intercalate [String -> Content
ContentRaw ","] [[Content]]
Selector Unresolved
x
[Attr Resolved]
attrs' <- (Attr Unresolved -> Either String (Attr Resolved))
-> [Attr Unresolved] -> Either String [Attr Resolved]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Attr Unresolved -> Either String (Attr Resolved)
resolveAttr [Attr Unresolved]
attrs
[[Block Resolved] -> [Block Resolved]]
z' <- ((Bool, Block Unresolved)
-> Either String ([Block Resolved] -> [Block Resolved]))
-> [(Bool, Block Unresolved)]
-> Either String [[Block Resolved] -> [Block Resolved]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([[Content]]
-> (Bool, Block Unresolved)
-> Either String ([Block Resolved] -> [Block Resolved])
subGo [[Content]]
Selector Unresolved
x) [(Bool, Block Unresolved)]
ChildBlocks Unresolved
z
([Block Resolved] -> [Block Resolved])
-> Either String ([Block Resolved] -> [Block Resolved])
forall a b. b -> Either a b
Right (([Block Resolved] -> [Block Resolved])
-> Either String ([Block Resolved] -> [Block Resolved]))
-> ([Block Resolved] -> [Block Resolved])
-> Either String ([Block Resolved] -> [Block Resolved])
forall a b. (a -> b) -> a -> b
$ \rest :: [Block Resolved]
rest -> $WBlock :: forall a.
Selector a -> [Attr a] -> ChildBlocks a -> Mixins a -> Block a
Block
{ blockSelector :: Selector Resolved
blockSelector = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
x'
, blockAttrs :: [Attr Resolved]
blockAttrs = [[Attr Resolved]] -> [Attr Resolved]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Attr Resolved]] -> [Attr Resolved])
-> [[Attr Resolved]] -> [Attr Resolved]
forall a b. (a -> b) -> a -> b
$ [Attr Resolved]
attrs' [Attr Resolved] -> [[Attr Resolved]] -> [[Attr Resolved]]
forall a. a -> [a] -> [a]
: (Mixin -> [Attr Resolved]) -> [Mixin] -> [[Attr Resolved]]
forall a b. (a -> b) -> [a] -> [b]
map Mixin -> [Attr Resolved]
mixinAttrs [Mixin]
mixins
, blockBlocks :: ChildBlocks Resolved
blockBlocks = ()
, blockMixins :: Mixins Resolved
blockMixins = ()
} Block Resolved -> [Block Resolved] -> [Block Resolved]
forall a. a -> [a] -> [a]
: (([Block Resolved] -> [Block Resolved])
-> [Block Resolved] -> [Block Resolved])
-> [Block Resolved]
-> [[Block Resolved] -> [Block Resolved]]
-> [Block Resolved]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Block Resolved] -> [Block Resolved])
-> [Block Resolved] -> [Block Resolved]
forall a b. (a -> b) -> a -> b
($) [Block Resolved]
rest [[Block Resolved] -> [Block Resolved]]
z'
where
go' :: Content -> Either String Builder
go' = [(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Content
-> Either String Builder
forall url.
[(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Content
-> Either String Builder
contentToBuilderRT [(Deref, CDData url)]
cd url -> [(Text, Text)] -> Text
render'
getMixin :: Deref -> Either String Mixin
getMixin d :: Deref
d =
case Deref -> [(Deref, CDData url)] -> Maybe (CDData url)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Deref
d [(Deref, CDData url)]
cd of
Nothing -> String -> Either String Mixin
forall a b. a -> Either a b
Left (String -> Either String Mixin) -> String -> Either String Mixin
forall a b. (a -> b) -> a -> b
$ "Mixin not found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Deref -> String
forall a. Show a => a -> String
show Deref
d
Just (CDMixin m :: Mixin
m) -> Mixin -> Either String Mixin
forall a b. b -> Either a b
Right Mixin
m
Just _ -> String -> Either String Mixin
forall a b. a -> Either a b
Left (String -> Either String Mixin) -> String -> Either String Mixin
forall a b. (a -> b) -> a -> b
$ "For " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Deref -> String
forall a. Show a => a -> String
show Deref
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", expected Mixin"
resolveAttr :: Attr Unresolved -> Either String (Attr Resolved)
resolveAttr :: Attr Unresolved -> Either String (Attr Resolved)
resolveAttr (Attr k :: Str Unresolved
k v :: Str Unresolved
v) = Builder -> Builder -> Attr Resolved
forall a. Str a -> Str a -> Attr a
Attr (Builder -> Builder -> Attr Resolved)
-> Either String Builder
-> Either String (Builder -> Attr Resolved)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> Either String [Builder] -> Either String Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> Either String Builder)
-> [Content] -> Either String [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> Either String Builder
go' [Content]
Str Unresolved
k) Either String (Builder -> Attr Resolved)
-> Either String Builder -> Either String (Attr Resolved)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> Either String [Builder] -> Either String Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> Either String Builder)
-> [Content] -> Either String [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> Either String Builder
go' [Content]
Str Unresolved
v)
subGo :: [Contents]
-> (HasLeadingSpace, Block Unresolved)
-> Either String (DList (Block Resolved))
subGo :: [[Content]]
-> (Bool, Block Unresolved)
-> Either String ([Block Resolved] -> [Block Resolved])
subGo x' :: [[Content]]
x' (hls :: Bool
hls, Block a :: Selector Unresolved
a b :: [Attr Unresolved]
b c :: ChildBlocks Unresolved
c d :: Mixins Unresolved
d) =
[(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Block Unresolved
-> Either String ([Block Resolved] -> [Block Resolved])
forall url.
[(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Block Unresolved
-> Either String ([Block Resolved] -> [Block Resolved])
blockRuntime [(Deref, CDData url)]
cd url -> [(Text, Text)] -> Text
render' (Selector Unresolved
-> [Attr Unresolved]
-> ChildBlocks Unresolved
-> Mixins Unresolved
-> Block Unresolved
forall a.
Selector a -> [Attr a] -> ChildBlocks a -> Mixins a -> Block a
Block [[Content]]
Selector Unresolved
a' [Attr Unresolved]
b ChildBlocks Unresolved
c Mixins Unresolved
d)
where
a' :: [[Content]]
a' = Bool -> [[Content]] -> [[Content]] -> [[Content]]
combineSelectors Bool
hls [[Content]]
x' [[Content]]
Selector Unresolved
a
contentToBuilderRT :: [(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Content
-> Either String Builder
contentToBuilderRT :: [(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Content
-> Either String Builder
contentToBuilderRT _ _ (ContentRaw s :: String
s) = Builder -> Either String Builder
forall a b. b -> Either a b
Right (Builder -> Either String Builder)
-> Builder -> Either String Builder
forall a b. (a -> b) -> a -> b
$ Text -> Builder
fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
s
contentToBuilderRT cd :: [(Deref, CDData url)]
cd _ (ContentVar d :: Deref
d) =
case Deref -> [(Deref, CDData url)] -> Maybe (CDData url)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Deref
d [(Deref, CDData url)]
cd of
Just (CDPlain s :: Builder
s) -> Builder -> Either String Builder
forall a b. b -> Either a b
Right Builder
s
_ -> String -> Either String Builder
forall a b. a -> Either a b
Left (String -> Either String Builder)
-> String -> Either String Builder
forall a b. (a -> b) -> a -> b
$ Deref -> String
forall a. Show a => a -> String
show Deref
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": expected CDPlain"
contentToBuilderRT cd :: [(Deref, CDData url)]
cd render' :: url -> [(Text, Text)] -> Text
render' (ContentUrl d :: Deref
d) =
case Deref -> [(Deref, CDData url)] -> Maybe (CDData url)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Deref
d [(Deref, CDData url)]
cd of
Just (CDUrl u :: url
u) -> Builder -> Either String Builder
forall a b. b -> Either a b
Right (Builder -> Either String Builder)
-> Builder -> Either String Builder
forall a b. (a -> b) -> a -> b
$ Text -> Builder
fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ url -> [(Text, Text)] -> Text
render' url
u []
_ -> String -> Either String Builder
forall a b. a -> Either a b
Left (String -> Either String Builder)
-> String -> Either String Builder
forall a b. (a -> b) -> a -> b
$ Deref -> String
forall a. Show a => a -> String
show Deref
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": expected CDUrl"
contentToBuilderRT cd :: [(Deref, CDData url)]
cd render' :: url -> [(Text, Text)] -> Text
render' (ContentUrlParam d :: Deref
d) =
case Deref -> [(Deref, CDData url)] -> Maybe (CDData url)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Deref
d [(Deref, CDData url)]
cd of
Just (CDUrlParam (u :: url
u, p :: [(Text, Text)]
p)) ->
Builder -> Either String Builder
forall a b. b -> Either a b
Right (Builder -> Either String Builder)
-> Builder -> Either String Builder
forall a b. (a -> b) -> a -> b
$ Text -> Builder
fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ url -> [(Text, Text)] -> Text
render' url
u [(Text, Text)]
p
_ -> String -> Either String Builder
forall a b. a -> Either a b
Left (String -> Either String Builder)
-> String -> Either String Builder
forall a b. (a -> b) -> a -> b
$ Deref -> String
forall a. Show a => a -> String
show Deref
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": expected CDUrlParam"
contentToBuilderRT _ _ ContentMixin{} = String -> Either String Builder
forall a b. a -> Either a b
Left "contentToBuilderRT ContentMixin"
cssRuntime :: Bool
-> Parser [TopLevel Unresolved]
-> FilePath
-> [(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Css
cssRuntime :: Bool
-> Parser [TopLevel Unresolved]
-> String
-> [(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Css
cssRuntime toi2b :: Bool
toi2b parseBlocks :: Parser [TopLevel Unresolved]
parseBlocks fp :: String
fp cd :: [(Deref, CDData url)]
cd render' :: url -> [(Text, Text)] -> Text
render' = IO Css -> Css
forall a. IO a -> a
unsafePerformIO (IO Css -> Css) -> IO Css -> Css
forall a b. (a -> b) -> a -> b
$ do
String
s' <- String -> IO String
readUtf8FileString String
fp
let s :: String
s = if Bool
toi2b then ShowS
i2b String
s' else String
s'
let a :: [TopLevel Unresolved]
a = (ParseError -> [TopLevel Unresolved])
-> ([TopLevel Unresolved] -> [TopLevel Unresolved])
-> Either ParseError [TopLevel Unresolved]
-> [TopLevel Unresolved]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> [TopLevel Unresolved]
forall a. HasCallStack => String -> a
error (String -> [TopLevel Unresolved])
-> (ParseError -> String) -> ParseError -> [TopLevel Unresolved]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show) [TopLevel Unresolved] -> [TopLevel Unresolved]
forall a. a -> a
id (Either ParseError [TopLevel Unresolved] -> [TopLevel Unresolved])
-> Either ParseError [TopLevel Unresolved] -> [TopLevel Unresolved]
forall a b. (a -> b) -> a -> b
$ Parser [TopLevel Unresolved]
-> String -> String -> Either ParseError [TopLevel Unresolved]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parser [TopLevel Unresolved]
parseBlocks String
s String
s
Css -> IO Css
forall (m :: * -> *) a. Monad m => a -> m a
return (Css -> IO Css) -> Css -> IO Css
forall a b. (a -> b) -> a -> b
$ [TopLevel Resolved] -> Css
CssWhitespace ([TopLevel Resolved] -> Css) -> [TopLevel Resolved] -> Css
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> [TopLevel Unresolved] -> [TopLevel Resolved]
goTop [] [TopLevel Unresolved]
a
where
goTop :: [(String, String)]
-> [TopLevel Unresolved]
-> [TopLevel Resolved]
goTop :: [(String, String)] -> [TopLevel Unresolved] -> [TopLevel Resolved]
goTop _ [] = []
goTop scope :: [(String, String)]
scope (TopAtDecl dec :: String
dec cs' :: Str Unresolved
cs':rest :: [TopLevel Unresolved]
rest) =
String -> Str Resolved -> TopLevel Resolved
forall a. String -> Str a -> TopLevel a
TopAtDecl String
dec Builder
Str Resolved
cs TopLevel Resolved -> [TopLevel Resolved] -> [TopLevel Resolved]
forall a. a -> [a] -> [a]
: [(String, String)] -> [TopLevel Unresolved] -> [TopLevel Resolved]
goTop [(String, String)]
scope [TopLevel Unresolved]
rest
where
cs :: Builder
cs = (String -> Builder)
-> ([Builder] -> Builder) -> Either String [Builder] -> Builder
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Builder
forall a. HasCallStack => String -> a
error [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Either String [Builder] -> Builder)
-> Either String [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ (Content -> Either String Builder)
-> [Content] -> Either String [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Content
-> Either String Builder
forall url.
[(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Content
-> Either String Builder
contentToBuilderRT [(Deref, CDData url)]
cd url -> [(Text, Text)] -> Text
render') [Content]
Str Unresolved
cs'
goTop scope :: [(String, String)]
scope (TopBlock b :: Block Unresolved
b:rest :: [TopLevel Unresolved]
rest) =
(Block Resolved -> TopLevel Resolved)
-> [Block Resolved] -> [TopLevel Resolved]
forall a b. (a -> b) -> [a] -> [b]
map Block Resolved -> TopLevel Resolved
forall a. Block a -> TopLevel a
TopBlock ((String -> [Block Resolved])
-> (([Block Resolved] -> [Block Resolved]) -> [Block Resolved])
-> Either String ([Block Resolved] -> [Block Resolved])
-> [Block Resolved]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> [Block Resolved]
forall a. HasCallStack => String -> a
error (([Block Resolved] -> [Block Resolved])
-> [Block Resolved] -> [Block Resolved]
forall a b. (a -> b) -> a -> b
$[]) (Either String ([Block Resolved] -> [Block Resolved])
-> [Block Resolved])
-> Either String ([Block Resolved] -> [Block Resolved])
-> [Block Resolved]
forall a b. (a -> b) -> a -> b
$ [(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Block Unresolved
-> Either String ([Block Resolved] -> [Block Resolved])
forall url.
[(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Block Unresolved
-> Either String ([Block Resolved] -> [Block Resolved])
blockRuntime ([(String, String)] -> [(Deref, CDData url)]
addScope [(String, String)]
scope) url -> [(Text, Text)] -> Text
render' Block Unresolved
b) [TopLevel Resolved] -> [TopLevel Resolved] -> [TopLevel Resolved]
forall a. [a] -> [a] -> [a]
++
[(String, String)] -> [TopLevel Unresolved] -> [TopLevel Resolved]
goTop [(String, String)]
scope [TopLevel Unresolved]
rest
goTop scope :: [(String, String)]
scope (TopAtBlock name :: String
name s' :: Str Unresolved
s' b :: [Block Unresolved]
b:rest :: [TopLevel Unresolved]
rest) =
String -> Str Resolved -> [Block Resolved] -> TopLevel Resolved
forall a. String -> Str a -> [Block a] -> TopLevel a
TopAtBlock String
name Builder
Str Resolved
s ((Block Unresolved -> [Block Resolved] -> [Block Resolved])
-> [Block Resolved] -> [Block Unresolved] -> [Block Resolved]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((String -> [Block Resolved] -> [Block Resolved])
-> (([Block Resolved] -> [Block Resolved])
-> [Block Resolved] -> [Block Resolved])
-> Either String ([Block Resolved] -> [Block Resolved])
-> [Block Resolved]
-> [Block Resolved]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> [Block Resolved] -> [Block Resolved]
forall a. HasCallStack => String -> a
error ([Block Resolved] -> [Block Resolved])
-> [Block Resolved] -> [Block Resolved]
forall a. a -> a
id (Either String ([Block Resolved] -> [Block Resolved])
-> [Block Resolved] -> [Block Resolved])
-> (Block Unresolved
-> Either String ([Block Resolved] -> [Block Resolved]))
-> Block Unresolved
-> [Block Resolved]
-> [Block Resolved]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Block Unresolved
-> Either String ([Block Resolved] -> [Block Resolved])
forall url.
[(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Block Unresolved
-> Either String ([Block Resolved] -> [Block Resolved])
blockRuntime ([(String, String)] -> [(Deref, CDData url)]
addScope [(String, String)]
scope) url -> [(Text, Text)] -> Text
render') [] [Block Unresolved]
b) TopLevel Resolved -> [TopLevel Resolved] -> [TopLevel Resolved]
forall a. a -> [a] -> [a]
:
[(String, String)] -> [TopLevel Unresolved] -> [TopLevel Resolved]
goTop [(String, String)]
scope [TopLevel Unresolved]
rest
where
s :: Builder
s = (String -> Builder)
-> ([Builder] -> Builder) -> Either String [Builder] -> Builder
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Builder
forall a. HasCallStack => String -> a
error [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Either String [Builder] -> Builder)
-> Either String [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ (Content -> Either String Builder)
-> [Content] -> Either String [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Content
-> Either String Builder
forall url.
[(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Content
-> Either String Builder
contentToBuilderRT [(Deref, CDData url)]
cd url -> [(Text, Text)] -> Text
render') [Content]
Str Unresolved
s'
goTop scope :: [(String, String)]
scope (TopVar k :: String
k v :: String
v:rest :: [TopLevel Unresolved]
rest) = [(String, String)] -> [TopLevel Unresolved] -> [TopLevel Resolved]
goTop ((String
k, String
v)(String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:[(String, String)]
scope) [TopLevel Unresolved]
rest
addScope :: [(String, String)] -> [(Deref, CDData url)]
addScope scope :: [(String, String)]
scope = ((String, String) -> (Deref, CDData url))
-> [(String, String)] -> [(Deref, CDData url)]
forall a b. (a -> b) -> [a] -> [b]
map (Ident -> Deref
DerefIdent (Ident -> Deref) -> (String -> Ident) -> String -> Deref
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Ident
Ident (String -> Deref)
-> (String -> CDData url)
-> (String, String)
-> (Deref, CDData url)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Builder -> CDData url
forall url. Builder -> CDData url
CDPlain (Builder -> CDData url)
-> (String -> Builder) -> String -> CDData url
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
fromString) [(String, String)]
scope [(Deref, CDData url)]
-> [(Deref, CDData url)] -> [(Deref, CDData url)]
forall a. [a] -> [a] -> [a]
++ [(Deref, CDData url)]
cd
vtToExp :: (Deref, VarType) -> Q Exp
vtToExp :: (Deref, VarType) -> Q Exp
vtToExp (d :: Deref
d, vt :: VarType
vt) = do
Exp
d' <- Deref -> Q Exp
forall t. Lift t => t -> Q Exp
lift Deref
d
Exp
c' <- VarType -> Q Exp
c VarType
vt
Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
TupE
#if MIN_VERSION_template_haskell(2,16,0)
$ map Just
#endif
[Exp
d', Exp
c' Exp -> Exp -> Exp
`AppE` Scope -> Deref -> Exp
derefToExp [] Deref
d]
where
c :: VarType -> Q Exp
c :: VarType -> Q Exp
c VTPlain = [|CDPlain . toCss|]
c VTUrl = [|CDUrl|]
c VTUrlParam = [|CDUrlParam|]
c VTMixin = [|CDMixin|]
getVars :: [(String, String)] -> Content -> Either String [(Deref, VarType)]
getVars :: [(String, String)] -> Content -> Either String [(Deref, VarType)]
getVars _ ContentRaw{} = [(Deref, VarType)] -> Either String [(Deref, VarType)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
getVars scope :: [(String, String)]
scope (ContentVar d :: Deref
d) =
case Deref -> [(String, String)] -> Maybe String
forall b. Deref -> [(String, b)] -> Maybe String
lookupD Deref
d [(String, String)]
scope of
Just _ -> [(Deref, VarType)] -> Either String [(Deref, VarType)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Nothing -> [(Deref, VarType)] -> Either String [(Deref, VarType)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Deref
d, VarType
VTPlain)]
getVars scope :: [(String, String)]
scope (ContentUrl d :: Deref
d) =
case Deref -> [(String, String)] -> Maybe String
forall b. Deref -> [(String, b)] -> Maybe String
lookupD Deref
d [(String, String)]
scope of
Nothing -> [(Deref, VarType)] -> Either String [(Deref, VarType)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Deref
d, VarType
VTUrl)]
Just s :: String
s -> String -> Either String [(Deref, VarType)]
forall a b. a -> Either a b
Left (String -> Either String [(Deref, VarType)])
-> String -> Either String [(Deref, VarType)]
forall a b. (a -> b) -> a -> b
$ "Expected URL for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
getVars scope :: [(String, String)]
scope (ContentUrlParam d :: Deref
d) =
case Deref -> [(String, String)] -> Maybe String
forall b. Deref -> [(String, b)] -> Maybe String
lookupD Deref
d [(String, String)]
scope of
Nothing -> [(Deref, VarType)] -> Either String [(Deref, VarType)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Deref
d, VarType
VTUrlParam)]
Just s :: String
s -> String -> Either String [(Deref, VarType)]
forall a b. a -> Either a b
Left (String -> Either String [(Deref, VarType)])
-> String -> Either String [(Deref, VarType)]
forall a b. (a -> b) -> a -> b
$ "Expected URLParam for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
getVars scope :: [(String, String)]
scope (ContentMixin d :: Deref
d) =
case Deref -> [(String, String)] -> Maybe String
forall b. Deref -> [(String, b)] -> Maybe String
lookupD Deref
d [(String, String)]
scope of
Nothing -> [(Deref, VarType)] -> Either String [(Deref, VarType)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Deref
d, VarType
VTMixin)]
Just s :: String
s -> String -> Either String [(Deref, VarType)]
forall a b. a -> Either a b
Left (String -> Either String [(Deref, VarType)])
-> String -> Either String [(Deref, VarType)]
forall a b. (a -> b) -> a -> b
$ "Expected Mixin for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
lookupD :: Deref -> [(String, b)] -> Maybe String
lookupD :: Deref -> [(String, b)] -> Maybe String
lookupD (DerefIdent (Ident s :: String
s)) scope :: [(String, b)]
scope =
case String -> [(String, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s [(String, b)]
scope of
Nothing -> Maybe String
forall a. Maybe a
Nothing
Just _ -> String -> Maybe String
forall a. a -> Maybe a
Just String
s
lookupD _ _ = Maybe String
forall a. Maybe a
Nothing
compressTopLevel :: TopLevel Unresolved
-> TopLevel Unresolved
compressTopLevel :: TopLevel Unresolved -> TopLevel Unresolved
compressTopLevel (TopBlock b :: Block Unresolved
b) = Block Unresolved -> TopLevel Unresolved
forall a. Block a -> TopLevel a
TopBlock (Block Unresolved -> TopLevel Unresolved)
-> Block Unresolved -> TopLevel Unresolved
forall a b. (a -> b) -> a -> b
$ Block Unresolved -> Block Unresolved
compressBlock Block Unresolved
b
compressTopLevel (TopAtBlock name :: String
name s :: Str Unresolved
s b :: [Block Unresolved]
b) = String
-> Str Unresolved -> [Block Unresolved] -> TopLevel Unresolved
forall a. String -> Str a -> [Block a] -> TopLevel a
TopAtBlock String
name Str Unresolved
s ([Block Unresolved] -> TopLevel Unresolved)
-> [Block Unresolved] -> TopLevel Unresolved
forall a b. (a -> b) -> a -> b
$ (Block Unresolved -> Block Unresolved)
-> [Block Unresolved] -> [Block Unresolved]
forall a b. (a -> b) -> [a] -> [b]
map Block Unresolved -> Block Unresolved
compressBlock [Block Unresolved]
b
compressTopLevel x :: TopLevel Unresolved
x@TopAtDecl{} = TopLevel Unresolved
x
compressTopLevel x :: TopLevel Unresolved
x@TopVar{} = TopLevel Unresolved
x
compressBlock :: Block Unresolved
-> Block Unresolved
compressBlock :: Block Unresolved -> Block Unresolved
compressBlock (Block x :: Selector Unresolved
x y :: [Attr Unresolved]
y blocks :: ChildBlocks Unresolved
blocks mixins :: Mixins Unresolved
mixins) =
Selector Unresolved
-> [Attr Unresolved]
-> ChildBlocks Unresolved
-> Mixins Unresolved
-> Block Unresolved
forall a.
Selector a -> [Attr a] -> ChildBlocks a -> Mixins a -> Block a
Block (([Content] -> [Content]) -> [[Content]] -> [[Content]]
forall a b. (a -> b) -> [a] -> [b]
map [Content] -> [Content]
cc [[Content]]
Selector Unresolved
x) ((Attr Unresolved -> Attr Unresolved)
-> [Attr Unresolved] -> [Attr Unresolved]
forall a b. (a -> b) -> [a] -> [b]
map Attr Unresolved -> Attr Unresolved
forall a a.
(Str a ~ [Content], Str a ~ [Content]) =>
Attr a -> Attr a
go [Attr Unresolved]
y) (((Bool, Block Unresolved) -> (Bool, Block Unresolved))
-> [(Bool, Block Unresolved)] -> [(Bool, Block Unresolved)]
forall a b. (a -> b) -> [a] -> [b]
map ((Block Unresolved -> Block Unresolved)
-> (Bool, Block Unresolved) -> (Bool, Block Unresolved)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Block Unresolved -> Block Unresolved
compressBlock) [(Bool, Block Unresolved)]
ChildBlocks Unresolved
blocks) Mixins Unresolved
mixins
where
go :: Attr a -> Attr a
go (Attr k :: Str a
k v :: Str a
v) = Str a -> Str a -> Attr a
forall a. Str a -> Str a -> Attr a
Attr ([Content] -> [Content]
cc [Content]
Str a
k) ([Content] -> [Content]
cc [Content]
Str a
v)
cc :: [Content] -> [Content]
cc [] = []
cc (ContentRaw a :: String
a:ContentRaw b :: String
b:c :: [Content]
c) = [Content] -> [Content]
cc ([Content] -> [Content]) -> [Content] -> [Content]
forall a b. (a -> b) -> a -> b
$ String -> Content
ContentRaw (String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b) Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
c
cc (a :: Content
a:b :: [Content]
b) = Content
a Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content] -> [Content]
cc [Content]
b
blockToMixin :: Name
-> Scope
-> Block Unresolved
-> Q Exp
blockToMixin :: Name -> [(String, String)] -> Block Unresolved -> Q Exp
blockToMixin r :: Name
r scope :: [(String, String)]
scope (Block _sel :: Selector Unresolved
_sel props :: [Attr Unresolved]
props subblocks :: ChildBlocks Unresolved
subblocks mixins :: Mixins Unresolved
mixins) =
[|Mixin
{ mixinAttrs = concat
$ $(listE $ map go props)
: map mixinAttrs $mixinsE
, mixinBlocks = []
}|]
where
mixinsE :: Q Exp
mixinsE = Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
ListE ([Exp] -> Exp) -> [Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ (Deref -> Exp) -> [Deref] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map (Scope -> Deref -> Exp
derefToExp []) [Deref]
Mixins Unresolved
mixins
go :: Attr Unresolved -> Q Exp
go (Attr x :: Str Unresolved
x y :: Str Unresolved
y) = Name -> Q Exp
conE 'Attr
Q Exp -> Q Exp -> Q Exp
`appE` (Name -> [(String, String)] -> [Content] -> Q Exp
contentsToBuilder Name
r [(String, String)]
scope [Content]
Str Unresolved
x)
Q Exp -> Q Exp -> Q Exp
`appE` (Name -> [(String, String)] -> [Content] -> Q Exp
contentsToBuilder Name
r [(String, String)]
scope [Content]
Str Unresolved
y)
subGo :: Block Unresolved -> Q Exp
subGo (Block sel' :: Selector Unresolved
sel' b :: [Attr Unresolved]
b c :: ChildBlocks Unresolved
c d :: Mixins Unresolved
d) = Name -> [(String, String)] -> Block Unresolved -> Q Exp
blockToCss Name
r [(String, String)]
scope (Block Unresolved -> Q Exp) -> Block Unresolved -> Q Exp
forall a b. (a -> b) -> a -> b
$ Selector Unresolved
-> [Attr Unresolved]
-> ChildBlocks Unresolved
-> Mixins Unresolved
-> Block Unresolved
forall a.
Selector a -> [Attr a] -> ChildBlocks a -> Mixins a -> Block a
Block Selector Unresolved
sel' [Attr Unresolved]
b ChildBlocks Unresolved
c Mixins Unresolved
d
blockToCss :: Name
-> Scope
-> Block Unresolved
-> Q Exp
blockToCss :: Name -> [(String, String)] -> Block Unresolved -> Q Exp
blockToCss r :: Name
r scope :: [(String, String)]
scope (Block sel :: Selector Unresolved
sel props :: [Attr Unresolved]
props subblocks :: ChildBlocks Unresolved
subblocks mixins :: Mixins Unresolved
mixins) =
[|((Block
{ blockSelector = $(selectorToBuilder r scope sel)
, blockAttrs = concat
$ $(listE $ map go props)
: map mixinAttrs $mixinsE
, blockBlocks = ()
, blockMixins = ()
} :: Block Resolved):)
. foldr (.) id $(listE $ map subGo subblocks)
. (concatMap mixinBlocks $mixinsE ++)
|]
where
mixinsE :: Q Exp
mixinsE = Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
ListE ([Exp] -> Exp) -> [Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ (Deref -> Exp) -> [Deref] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map (Scope -> Deref -> Exp
derefToExp []) [Deref]
Mixins Unresolved
mixins
go :: Attr Unresolved -> Q Exp
go (Attr x :: Str Unresolved
x y :: Str Unresolved
y) = Name -> Q Exp
conE 'Attr
Q Exp -> Q Exp -> Q Exp
`appE` (Name -> [(String, String)] -> [Content] -> Q Exp
contentsToBuilder Name
r [(String, String)]
scope [Content]
Str Unresolved
x)
Q Exp -> Q Exp -> Q Exp
`appE` (Name -> [(String, String)] -> [Content] -> Q Exp
contentsToBuilder Name
r [(String, String)]
scope [Content]
Str Unresolved
y)
subGo :: (Bool, Block Unresolved) -> Q Exp
subGo (hls :: Bool
hls, Block sel' :: Selector Unresolved
sel' b :: [Attr Unresolved]
b c :: ChildBlocks Unresolved
c d :: Mixins Unresolved
d) =
Name -> [(String, String)] -> Block Unresolved -> Q Exp
blockToCss Name
r [(String, String)]
scope (Block Unresolved -> Q Exp) -> Block Unresolved -> Q Exp
forall a b. (a -> b) -> a -> b
$ Selector Unresolved
-> [Attr Unresolved]
-> ChildBlocks Unresolved
-> Mixins Unresolved
-> Block Unresolved
forall a.
Selector a -> [Attr a] -> ChildBlocks a -> Mixins a -> Block a
Block [[Content]]
Selector Unresolved
sel'' [Attr Unresolved]
b ChildBlocks Unresolved
c Mixins Unresolved
d
where
sel'' :: [[Content]]
sel'' = Bool -> [[Content]] -> [[Content]] -> [[Content]]
combineSelectors Bool
hls [[Content]]
Selector Unresolved
sel [[Content]]
Selector Unresolved
sel'
selectorToBuilder :: Name -> Scope -> [Contents] -> Q Exp
selectorToBuilder :: Name -> [(String, String)] -> [[Content]] -> Q Exp
selectorToBuilder r :: Name
r scope :: [(String, String)]
scope sels :: [[Content]]
sels =
Name -> [(String, String)] -> [Content] -> Q Exp
contentsToBuilder Name
r [(String, String)]
scope ([Content] -> Q Exp) -> [Content] -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Content] -> [[Content]] -> [Content]
forall a. [a] -> [[a]] -> [a]
intercalate [String -> Content
ContentRaw ","] [[Content]]
sels
contentsToBuilder :: Name -> Scope -> [Content] -> Q Exp
contentsToBuilder :: Name -> [(String, String)] -> [Content] -> Q Exp
contentsToBuilder r :: Name
r scope :: [(String, String)]
scope contents :: [Content]
contents =
Q Exp -> Q Exp -> Q Exp
appE [|mconcat|] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Q Exp] -> Q Exp
listE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ (Content -> Q Exp) -> [Content] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> [(String, String)] -> Content -> Q Exp
contentToBuilder Name
r [(String, String)]
scope) [Content]
contents
contentToBuilder :: Name -> Scope -> Content -> Q Exp
contentToBuilder :: Name -> [(String, String)] -> Content -> Q Exp
contentToBuilder _ _ (ContentRaw x :: String
x) =
[|fromText . pack|] Q Exp -> Q Exp -> Q Exp
`appE` Lit -> Q Exp
litE (String -> Lit
StringL String
x)
contentToBuilder _ scope :: [(String, String)]
scope (ContentVar d :: Deref
d) =
case Deref
d of
DerefIdent (Ident s :: String
s)
| Just val :: String
val <- String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s [(String, String)]
scope -> [|fromText . pack|] Q Exp -> Q Exp -> Q Exp
`appE` Lit -> Q Exp
litE (String -> Lit
StringL String
val)
_ -> [|toCss|] Q Exp -> Q Exp -> Q Exp
`appE` Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Scope -> Deref -> Exp
derefToExp [] Deref
d)
contentToBuilder r :: Name
r _ (ContentUrl u :: Deref
u) =
[|fromText|] Q Exp -> Q Exp -> Q Exp
`appE`
(Name -> Q Exp
varE Name
r Q Exp -> Q Exp -> Q Exp
`appE` Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Scope -> Deref -> Exp
derefToExp [] Deref
u) Q Exp -> Q Exp -> Q Exp
`appE` [Q Exp] -> Q Exp
listE [])
contentToBuilder r :: Name
r _ (ContentUrlParam u :: Deref
u) =
[|fromText|] Q Exp -> Q Exp -> Q Exp
`appE`
([|uncurry|] Q Exp -> Q Exp -> Q Exp
`appE` Name -> Q Exp
varE Name
r Q Exp -> Q Exp -> Q Exp
`appE` Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Scope -> Deref -> Exp
derefToExp [] Deref
u))
contentToBuilder _ _ ContentMixin{} = String -> Q Exp
forall a. HasCallStack => String -> a
error "contentToBuilder on ContentMixin"
type Scope = [(String, String)]
topLevelsToCassius :: [TopLevel Unresolved]
-> Q Exp
topLevelsToCassius :: [TopLevel Unresolved] -> Q Exp
topLevelsToCassius a :: [TopLevel Unresolved]
a = do
Name
r <- String -> Q Name
newName "_render"
[PatQ] -> Q Exp -> Q Exp
lamE [Name -> PatQ
varP Name
r] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Q Exp -> Q Exp -> Q Exp
appE [|CssNoWhitespace . foldr ($) []|] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ ([Exp] -> Exp) -> Q [Exp] -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Exp] -> Exp
ListE (Q [Exp] -> Q Exp) -> Q [Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> [(String, String)] -> [TopLevel Unresolved] -> Q [Exp]
go Name
r [] [TopLevel Unresolved]
a
where
go :: Name -> [(String, String)] -> [TopLevel Unresolved] -> Q [Exp]
go _ _ [] = [Exp] -> Q [Exp]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go r :: Name
r scope :: [(String, String)]
scope (TopBlock b :: Block Unresolved
b:rest :: [TopLevel Unresolved]
rest) = do
Exp
e <- [|(++) $ map TopBlock ($(blockToCss r scope b) [])|]
[Exp]
es <- Name -> [(String, String)] -> [TopLevel Unresolved] -> Q [Exp]
go Name
r [(String, String)]
scope [TopLevel Unresolved]
rest
[Exp] -> Q [Exp]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Exp] -> Q [Exp]) -> [Exp] -> Q [Exp]
forall a b. (a -> b) -> a -> b
$ Exp
e Exp -> [Exp] -> [Exp]
forall a. a -> [a] -> [a]
: [Exp]
es
go r :: Name
r scope :: [(String, String)]
scope (TopAtBlock name :: String
name s :: Str Unresolved
s b :: [Block Unresolved]
b:rest :: [TopLevel Unresolved]
rest) = do
let s' :: Q Exp
s' = Name -> [(String, String)] -> [Content] -> Q Exp
contentsToBuilder Name
r [(String, String)]
scope [Content]
Str Unresolved
s
Exp
e <- [|(:) $ TopAtBlock $(lift name) $(s') $(blocksToCassius r scope b)|]
[Exp]
es <- Name -> [(String, String)] -> [TopLevel Unresolved] -> Q [Exp]
go Name
r [(String, String)]
scope [TopLevel Unresolved]
rest
[Exp] -> Q [Exp]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Exp] -> Q [Exp]) -> [Exp] -> Q [Exp]
forall a b. (a -> b) -> a -> b
$ Exp
e Exp -> [Exp] -> [Exp]
forall a. a -> [a] -> [a]
: [Exp]
es
go r :: Name
r scope :: [(String, String)]
scope (TopAtDecl dec :: String
dec cs :: Str Unresolved
cs:rest :: [TopLevel Unresolved]
rest) = do
Exp
e <- [|(:) $ TopAtDecl $(lift dec) $(contentsToBuilder r scope cs)|]
[Exp]
es <- Name -> [(String, String)] -> [TopLevel Unresolved] -> Q [Exp]
go Name
r [(String, String)]
scope [TopLevel Unresolved]
rest
[Exp] -> Q [Exp]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Exp] -> Q [Exp]) -> [Exp] -> Q [Exp]
forall a b. (a -> b) -> a -> b
$ Exp
e Exp -> [Exp] -> [Exp]
forall a. a -> [a] -> [a]
: [Exp]
es
go r :: Name
r scope :: [(String, String)]
scope (TopVar k :: String
k v :: String
v:rest :: [TopLevel Unresolved]
rest) = Name -> [(String, String)] -> [TopLevel Unresolved] -> Q [Exp]
go Name
r ((String
k, String
v) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
scope) [TopLevel Unresolved]
rest
blocksToCassius :: Name
-> Scope
-> [Block Unresolved]
-> Q Exp
blocksToCassius :: Name -> [(String, String)] -> [Block Unresolved] -> Q Exp
blocksToCassius r :: Name
r scope :: [(String, String)]
scope a :: [Block Unresolved]
a = do
Q Exp -> Q Exp -> Q Exp
appE [|foldr ($) []|] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Q Exp] -> Q Exp
listE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ (Block Unresolved -> Q Exp) -> [Block Unresolved] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> [(String, String)] -> Block Unresolved -> Q Exp
blockToCss Name
r [(String, String)]
scope) [Block Unresolved]
a
renderCss :: Css -> TL.Text
renderCss :: Css -> Text
renderCss css :: Css
css =
Builder -> Text
toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ (TopLevel Resolved -> Builder) -> [TopLevel Resolved] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map TopLevel Resolved -> Builder
go [TopLevel Resolved]
tops
where
(haveWhiteSpace :: Bool
haveWhiteSpace, tops :: [TopLevel Resolved]
tops) =
case Css
css of
CssWhitespace x :: [TopLevel Resolved]
x -> (Bool
True, [TopLevel Resolved]
x)
CssNoWhitespace x :: [TopLevel Resolved]
x -> (Bool
False, [TopLevel Resolved]
x)
go :: TopLevel Resolved -> Builder
go (TopBlock x :: Block Resolved
x) = Bool -> Builder -> Block Resolved -> Builder
renderBlock Bool
haveWhiteSpace Builder
forall a. Monoid a => a
mempty Block Resolved
x
go (TopAtBlock name :: String
name s :: Str Resolved
s x :: [Block Resolved]
x) =
Text -> Builder
fromText (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ["@", String
name, " "]) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
Builder
Str Resolved
s Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
Builder
startBlock Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
(Builder -> Builder -> Builder) -> Builder -> [Builder] -> Builder
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend Builder
endBlock ((Block Resolved -> Builder) -> [Block Resolved] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Builder -> Block Resolved -> Builder
renderBlock Bool
haveWhiteSpace (String -> Builder
fromString " ")) [Block Resolved]
x)
go (TopAtDecl dec :: String
dec cs :: Str Resolved
cs) = Text -> Builder
fromText (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ["@", String
dec, " "]) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
Builder
Str Resolved
cs Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
Builder
endDecl
startBlock :: Builder
startBlock
| Bool
haveWhiteSpace = String -> Builder
fromString " {\n"
| Bool
otherwise = Char -> Builder
singleton '{'
endBlock :: Builder
endBlock
| Bool
haveWhiteSpace = String -> Builder
fromString "}\n"
| Bool
otherwise = Char -> Builder
singleton '}'
endDecl :: Builder
endDecl
| Bool
haveWhiteSpace = String -> Builder
fromString ";\n"
| Bool
otherwise = Char -> Builder
singleton ';'
renderBlock :: Bool
-> Builder
-> Block Resolved
-> Builder
renderBlock :: Bool -> Builder -> Block Resolved -> Builder
renderBlock haveWhiteSpace :: Bool
haveWhiteSpace indent :: Builder
indent (Block sel :: Selector Resolved
sel attrs :: [Attr Resolved]
attrs () ())
| [Attr Resolved] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Attr Resolved]
attrs = Builder
forall a. Monoid a => a
mempty
| Bool
otherwise = Builder
startSelect
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
Selector Resolved
sel
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
startBlock
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
endDecl ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ (Attr Resolved -> Builder) -> [Attr Resolved] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Attr Resolved -> Builder
renderAttr [Attr Resolved]
attrs)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
endBlock
where
renderAttr :: Attr Resolved -> Builder
renderAttr (Attr k :: Str Resolved
k v :: Str Resolved
v) = Builder
startDecl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
Str Resolved
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
colon Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
Str Resolved
v
colon :: Builder
colon
| Bool
haveWhiteSpace = String -> Builder
fromString ": "
| Bool
otherwise = Char -> Builder
singleton ':'
startSelect :: Builder
startSelect
| Bool
haveWhiteSpace = Builder
indent
| Bool
otherwise = Builder
forall a. Monoid a => a
mempty
startBlock :: Builder
startBlock
| Bool
haveWhiteSpace = String -> Builder
fromString " {\n"
| Bool
otherwise = Char -> Builder
singleton '{'
endBlock :: Builder
endBlock
| Bool
haveWhiteSpace = String -> Builder
fromString ";\n" Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
indent Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
fromString "}\n"
| Bool
otherwise = Char -> Builder
singleton '}'
startDecl :: Builder
startDecl
| Bool
haveWhiteSpace = Builder
indent Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
fromString " "
| Bool
otherwise = Builder
forall a. Monoid a => a
mempty
endDecl :: Builder
endDecl
| Bool
haveWhiteSpace = String -> Builder
fromString ";\n"
| Bool
otherwise = Char -> Builder
singleton ';'
instance Lift Mixin where
lift :: Mixin -> Q Exp
lift (Mixin a :: [Attr Resolved]
a b :: [Block Resolved]
b) = [|Mixin a b|]
instance Lift (Attr Unresolved) where
lift :: Attr Unresolved -> Q Exp
lift (Attr k :: Str Unresolved
k v :: Str Unresolved
v) = [|Attr k v :: Attr Unresolved |]
instance Lift (Attr Resolved) where
lift :: Attr Resolved -> Q Exp
lift (Attr k :: Str Resolved
k v :: Str Resolved
v) = [|Attr $(liftBuilder k) $(liftBuilder v) :: Attr Resolved |]
liftBuilder :: Builder -> Q Exp
liftBuilder :: Builder -> Q Exp
liftBuilder b :: Builder
b = [|fromText $ pack $(lift $ TL.unpack $ toLazyText b)|]
instance Lift Content where
lift :: Content -> Q Exp
lift (ContentRaw s :: String
s) = [|ContentRaw s|]
lift (ContentVar d :: Deref
d) = [|ContentVar d|]
lift (ContentUrl d :: Deref
d) = [|ContentUrl d|]
lift (ContentUrlParam d :: Deref
d) = [|ContentUrlParam d|]
lift (ContentMixin m :: Deref
m) = [|ContentMixin m|]
instance Lift (Block Unresolved) where
lift :: Block Unresolved -> Q Exp
lift (Block a :: Selector Unresolved
a b :: [Attr Unresolved]
b c :: ChildBlocks Unresolved
c d :: Mixins Unresolved
d) = [|Block a b c d|]
instance Lift (Block Resolved) where
lift :: Block Resolved -> Q Exp
lift (Block a :: Selector Resolved
a b :: [Attr Resolved]
b () ()) = [|Block $(liftBuilder a) b () ()|]