{-# OPTIONS_HADDOCK hide #-}
-- | This module is only being exposed to work around a GHC bug, its API is not stable

{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# 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]

-- FIXME great use case for data kinds
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]
    }
    deriving Mixin -> Q Exp
Mixin -> Q (TExp Mixin)
(Mixin -> Q Exp) -> (Mixin -> Q (TExp Mixin)) -> Lift Mixin
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Mixin -> Q (TExp Mixin)
$cliftTyped :: Mixin -> Q (TExp Mixin)
lift :: Mixin -> Q Exp
$clift :: Mixin -> Q Exp
Lift
instance Semigroup Mixin where
    Mixin [Attr Resolved]
a [Block Resolved]
x <> :: Mixin -> Mixin -> Mixin
<> Mixin [Attr Resolved]
b [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 -- name e.g., media
               -> !(Str a) -- selector
               -> ![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, Content -> Q Exp
Content -> Q (TExp Content)
(Content -> Q Exp) -> (Content -> Q (TExp Content)) -> Lift Content
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Content -> Q (TExp Content)
$cliftTyped :: Content -> Q (TExp Content)
lift :: Content -> Q Exp
$clift :: Content -> Q Exp
Lift)

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

-- | Determine which identifiers are used by the given template, useful for
-- creating systems like yesod devel.
cssUsedIdentifiers :: Bool -- ^ perform the indent-to-brace conversion
                   -> Parser [TopLevel Unresolved]
                   -> String
                   -> [(Deref, VarType)]
cssUsedIdentifiers :: Bool
-> Parser [TopLevel Unresolved] -> String -> [(Deref, VarType)]
cssUsedIdentifiers Bool
toi2b Parser [TopLevel Unresolved]
parseBlocks 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
    ([(String, String)]
scope0, [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 String
dec Str Unresolved
cs:[TopLevel Unresolved]
rest) =
        ([(String, String)]
scope, [Content]
rest'')
      where
        ([(String, String)]
scope, [Content]
rest') = [TopLevel Unresolved] -> ([(String, String)], [Content])
go [TopLevel Unresolved]
rest
        rest'' :: [Content]
rest'' =
            String -> Content
ContentRaw (Char
'@' Char -> ShowS
forall a. a -> [a] -> [a]
: String
dec String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ")
          Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
Str Unresolved
cs
         [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ String -> Content
ContentRaw String
";"
          Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
rest'
    go (TopAtBlock String
_ Str Unresolved
_ [Block Unresolved]
blocks:[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
        ([(String, String)]
scope1, [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)
        ([(String, String)]
scope2, [Content]
rest2) = [TopLevel Unresolved] -> ([(String, String)], [Content])
go [TopLevel Unresolved]
rest
    go (TopBlock (Block Selector Unresolved
x [Attr Unresolved]
y ChildBlocks Unresolved
z Mixins Unresolved
mixins):[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 String
","] [[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
        ([(String, String)]
scope1, [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)
        ([(String, String)]
scope2, [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 String
k String
v:[TopLevel Unresolved]
rest) =
        ((String
k, String
v)(String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:[(String, String)]
scope, [Content]
rest')
      where
        ([(String, String)]
scope, [Content]
rest') = [TopLevel Unresolved] -> ([(String, String)], [Content])
go [TopLevel Unresolved]
rest
    go' :: Attr a -> [a]
go' (Attr Str a
k Str a
v) = [a]
Str a
k [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
Str a
v

cssFileDebug :: Bool -- ^ perform the indent-to-brace conversion
             -> Q Exp
             -> Parser [TopLevel Unresolved]
             -> FilePath
             -> Q Exp
cssFileDebug :: Bool -> Q Exp -> Parser [TopLevel Unresolved] -> String -> Q Exp
cssFileDebug Bool
toi2b Q Exp
parseBlocks' Parser [TopLevel Unresolved]
parseBlocks 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 Bool
hsl [[Content]]
a [[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 String
" " 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))
-- FIXME share code with blockToCss
blockRuntime :: [(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' (Block Selector Unresolved
x [Attr Unresolved]
attrs ChildBlocks Unresolved
z 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 String
","] [[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 -- FIXME use difflists again
    ([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
$ \[Block Resolved]
rest -> Block :: 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'
    {-
    (:) (Css' (mconcat $ map go' $ intercalate [ContentRaw "," ] x) (map go'' y))
    . foldr (.) id (map (subGo x) 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 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
            Maybe (CDData url)
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
$ String
"Mixin not found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Deref -> String
forall a. Show a => a -> String
show Deref
d
            Just (CDMixin Mixin
m) -> Mixin -> Either String Mixin
forall a b. b -> Either a b
Right Mixin
m
            Just CDData url
_ -> 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
$ String
"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]
++ String
", expected Mixin"

    resolveAttr :: Attr Unresolved -> Either String (Attr Resolved)
    resolveAttr :: Attr Unresolved -> Either String (Attr Resolved)
resolveAttr (Attr Str Unresolved
k 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] -- ^ parent selectors
          -> (HasLeadingSpace, Block Unresolved)
          -> Either String (DList (Block Resolved))
    subGo :: [[Content]]
-> (Bool, Block Unresolved)
-> Either String ([Block Resolved] -> [Block Resolved])
subGo [[Content]]
x' (Bool
hls, Block Selector Unresolved
a [Attr Unresolved]
b ChildBlocks Unresolved
c 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 [(Deref, CDData url)]
_ url -> [(Text, Text)] -> Text
_ (ContentRaw 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 [(Deref, CDData url)]
cd url -> [(Text, Text)] -> Text
_ (ContentVar 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 Builder
s) -> Builder -> Either String Builder
forall a b. b -> Either a b
Right Builder
s
        Maybe (CDData url)
_ -> 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]
++ String
": expected CDPlain"
contentToBuilderRT [(Deref, CDData url)]
cd url -> [(Text, Text)] -> Text
render' (ContentUrl 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 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 []
        Maybe (CDData url)
_ -> 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]
++ String
": expected CDUrl"
contentToBuilderRT [(Deref, CDData url)]
cd url -> [(Text, Text)] -> Text
render' (ContentUrlParam 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 (url
u, [(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
        Maybe (CDData url)
_ -> 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]
++ String
": expected CDUrlParam"
contentToBuilderRT [(Deref, CDData url)]
_ url -> [(Text, Text)] -> Text
_ ContentMixin{} = String -> Either String Builder
forall a b. a -> Either a b
Left String
"contentToBuilderRT ContentMixin"

cssRuntime :: Bool -- ^ i2b?
           -> 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 Bool
toi2b Parser [TopLevel Unresolved]
parseBlocks String
fp [(Deref, CDData url)]
cd 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)] -- ^ scope
          -> [TopLevel Unresolved]
          -> [TopLevel Resolved]
    goTop :: [(String, String)] -> [TopLevel Unresolved] -> [TopLevel Resolved]
goTop [(String, String)]
_ [] = []
    goTop [(String, String)]
scope (TopAtDecl String
dec Str Unresolved
cs':[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 [(String, String)]
scope (TopBlock Block Unresolved
b:[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 [(String, String)]
scope (TopAtBlock String
name Str Unresolved
s' [Block Unresolved]
b:[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 [(String, String)]
scope (TopVar String
k String
v:[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 [(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 (Deref
d, 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
$ [Maybe Exp] -> Exp
TupE
#if MIN_VERSION_template_haskell(2,16,0)
      ([Maybe Exp] -> Exp) -> [Maybe Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ (Exp -> Maybe Exp) -> [Exp] -> [Maybe Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Maybe Exp
forall a. a -> Maybe a
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 VarType
VTPlain = [|CDPlain . toCss|]
    c VarType
VTUrl = [|CDUrl|]
    c VarType
VTUrlParam = [|CDUrlParam|]
    c VarType
VTMixin = [|CDMixin|]

getVars :: [(String, String)] -> Content -> Either String [(Deref, VarType)]
getVars :: [(String, String)] -> Content -> Either String [(Deref, VarType)]
getVars [(String, String)]
_ ContentRaw{} = [(Deref, VarType)] -> Either String [(Deref, VarType)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
getVars [(String, String)]
scope (ContentVar Deref
d) =
    case Deref -> [(String, String)] -> Maybe String
forall b. Deref -> [(String, b)] -> Maybe String
lookupD Deref
d [(String, String)]
scope of
        Just String
_ -> [(Deref, VarType)] -> Either String [(Deref, VarType)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        Maybe String
Nothing -> [(Deref, VarType)] -> Either String [(Deref, VarType)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Deref
d, VarType
VTPlain)]
getVars [(String, String)]
scope (ContentUrl Deref
d) =
    case Deref -> [(String, String)] -> Maybe String
forall b. Deref -> [(String, b)] -> Maybe String
lookupD Deref
d [(String, String)]
scope of
        Maybe String
Nothing -> [(Deref, VarType)] -> Either String [(Deref, VarType)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Deref
d, VarType
VTUrl)]
        Just 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
$ String
"Expected URL for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
getVars [(String, String)]
scope (ContentUrlParam Deref
d) =
    case Deref -> [(String, String)] -> Maybe String
forall b. Deref -> [(String, b)] -> Maybe String
lookupD Deref
d [(String, String)]
scope of
        Maybe String
Nothing -> [(Deref, VarType)] -> Either String [(Deref, VarType)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Deref
d, VarType
VTUrlParam)]
        Just 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
$ String
"Expected URLParam for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
getVars [(String, String)]
scope (ContentMixin Deref
d) =
    case Deref -> [(String, String)] -> Maybe String
forall b. Deref -> [(String, b)] -> Maybe String
lookupD Deref
d [(String, String)]
scope of
        Maybe String
Nothing -> [(Deref, VarType)] -> Either String [(Deref, VarType)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Deref
d, VarType
VTMixin)]
        Just 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
$ String
"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 String
s)) [(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
        Maybe b
Nothing -> Maybe String
forall a. Maybe a
Nothing
        Just b
_ -> String -> Maybe String
forall a. a -> Maybe a
Just String
s
lookupD Deref
_ [(String, b)]
_ = Maybe String
forall a. Maybe a
Nothing

compressTopLevel :: TopLevel Unresolved
                 -> TopLevel Unresolved
compressTopLevel :: TopLevel Unresolved -> TopLevel Unresolved
compressTopLevel (TopBlock 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 String
name Str Unresolved
s [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 Selector Unresolved
x [Attr Unresolved]
y ChildBlocks Unresolved
blocks 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 Str a
k 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 String
a:ContentRaw String
b:[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 (Content
a:[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 Name
r [(String, String)]
scope (Block Selector Unresolved
_sel [Attr Unresolved]
props ChildBlocks Unresolved
subblocks Mixins Unresolved
mixins) =
    [|Mixin
        { mixinAttrs    = concat
                        $ $(listE $ map go props)
                        : map mixinAttrs $mixinsE
        -- FIXME too many complications to implement sublocks for now...
        , mixinBlocks   = [] -- foldr (.) id $(listE $ map subGo subblocks) []
        }|]
      {-
      . 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 Str Unresolved
x 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 Selector Unresolved
sel' [Attr Unresolved]
b ChildBlocks Unresolved
c 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 Name
r [(String, String)]
scope (Block Selector Unresolved
sel [Attr Unresolved]
props ChildBlocks Unresolved
subblocks 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 Str Unresolved
x 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 (Bool
hls, Block Selector Unresolved
sel' [Attr Unresolved]
b ChildBlocks Unresolved
c 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 Name
r [(String, String)]
scope [[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 String
","] [[Content]]
sels

contentsToBuilder :: Name -> Scope -> [Content] -> Q Exp
contentsToBuilder :: Name -> [(String, String)] -> [Content] -> Q Exp
contentsToBuilder Name
r [(String, String)]
scope [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 Name
_ [(String, String)]
_ (ContentRaw String
x) =
    [|fromText . pack|] Q Exp -> Q Exp -> Q Exp
`appE` Lit -> Q Exp
litE (String -> Lit
StringL String
x)
contentToBuilder Name
_ [(String, String)]
scope (ContentVar Deref
d) =
    case Deref
d of
        DerefIdent (Ident String
s)
            | Just 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)
        Deref
_ -> [|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 Name
r [(String, String)]
_ (ContentUrl 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 Name
r [(String, String)]
_ (ContentUrlParam 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 Name
_ [(String, String)]
_ ContentMixin{} = String -> Q Exp
forall a. HasCallStack => String -> a
error String
"contentToBuilder on ContentMixin"

type Scope = [(String, String)]

topLevelsToCassius :: [TopLevel Unresolved]
                   -> Q Exp
topLevelsToCassius :: [TopLevel Unresolved] -> Q Exp
topLevelsToCassius [TopLevel Unresolved]
a = do
    Name
r <- String -> Q Name
newName String
"_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 Name
_ [(String, String)]
_ [] = [Exp] -> Q [Exp]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    go Name
r [(String, String)]
scope (TopBlock Block Unresolved
b:[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 Name
r [(String, String)]
scope (TopAtBlock String
name Str Unresolved
s [Block Unresolved]
b:[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 Name
r [(String, String)]
scope (TopAtDecl String
dec Str Unresolved
cs:[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 Name
r [(String, String)]
scope (TopVar String
k String
v:[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 Name
r [(String, String)]
scope [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 =
    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
    (Bool
haveWhiteSpace, [TopLevel Resolved]
tops) =
        case Css
css of
            CssWhitespace [TopLevel Resolved]
x -> (Bool
True, [TopLevel Resolved]
x)
            CssNoWhitespace [TopLevel Resolved]
x -> (Bool
False, [TopLevel Resolved]
x)
    go :: TopLevel Resolved -> Builder
go (TopBlock Block Resolved
x) = Bool -> Builder -> Block Resolved -> Builder
renderBlock Bool
haveWhiteSpace Builder
forall a. Monoid a => a
mempty Block Resolved
x
    go (TopAtBlock String
name Str Resolved
s [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
"@", String
name, String
" "]) 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 String
"    ")) [Block Resolved]
x)
    go (TopAtDecl String
dec 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
"@", String
dec, String
" "]) 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 String
" {\n"
        | Bool
otherwise = Char -> Builder
singleton Char
'{'

    endBlock :: Builder
endBlock
        | Bool
haveWhiteSpace = String -> Builder
fromString String
"}\n"
        | Bool
otherwise = Char -> Builder
singleton Char
'}'

    endDecl :: Builder
endDecl
        | Bool
haveWhiteSpace = String -> Builder
fromString String
";\n"
        | Bool
otherwise = Char -> Builder
singleton Char
';'

renderBlock :: Bool -- ^ have whitespace?
            -> Builder -- ^ indentation
            -> Block Resolved
            -> Builder
renderBlock :: Bool -> Builder -> Block Resolved -> Builder
renderBlock Bool
haveWhiteSpace Builder
indent (Block Selector Resolved
sel [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 Str Resolved
k 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 String
": "
        | Bool
otherwise = Char -> Builder
singleton Char
':'

    startSelect :: Builder
startSelect
        | Bool
haveWhiteSpace = Builder
indent
        | Bool
otherwise = Builder
forall a. Monoid a => a
mempty

    startBlock :: Builder
startBlock
        | Bool
haveWhiteSpace = String -> Builder
fromString String
" {\n"
        | Bool
otherwise = Char -> Builder
singleton Char
'{'

    endBlock :: Builder
endBlock
        | Bool
haveWhiteSpace = String -> Builder
fromString String
";\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 String
"}\n"
        | Bool
otherwise = Char -> Builder
singleton Char
'}'

    startDecl :: Builder
startDecl
        | Bool
haveWhiteSpace = Builder
indent Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
fromString String
"    "
        | Bool
otherwise = Builder
forall a. Monoid a => a
mempty

    endDecl :: Builder
endDecl
        | Bool
haveWhiteSpace = String -> Builder
fromString String
";\n"
        | Bool
otherwise = Char -> Builder
singleton Char
';'

deriving instance Lift (Attr Unresolved)
instance Lift (Attr Resolved) where
    lift :: Attr Resolved -> Q Exp
lift (Attr Str Resolved
k Str Resolved
v) = [|Attr $(liftBuilder k) $(liftBuilder v) :: Attr Resolved |]
#if MIN_VERSION_template_haskell(2,17,0)
    liftTyped = unsafeCodeCoerce . lift
#elif MIN_VERSION_template_haskell(2,16,0)
    liftTyped :: Attr Resolved -> Q (TExp (Attr Resolved))
liftTyped = Q Exp -> Q (TExp (Attr Resolved))
forall a. Q Exp -> Q (TExp a)
unsafeTExpCoerce (Q Exp -> Q (TExp (Attr Resolved)))
-> (Attr Resolved -> Q Exp)
-> Attr Resolved
-> Q (TExp (Attr Resolved))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr Resolved -> Q Exp
forall t. Lift t => t -> Q Exp
lift
#endif

#if MIN_VERSION_template_haskell(2,17,0)
liftBuilder :: Quote m => Builder -> m Exp
#else
liftBuilder :: Builder -> Q Exp
#endif
liftBuilder :: Builder -> Q Exp
liftBuilder Builder
b = [|fromText $ pack $(lift $ TL.unpack $ toLazyText b)|]

deriving instance Lift (Block Unresolved)
instance Lift (Block Resolved) where
    lift :: Block Resolved -> Q Exp
lift (Block Selector Resolved
a [Attr Resolved]
b () ()) = [|Block $(liftBuilder a) b () ()|]
#if MIN_VERSION_template_haskell(2,17,0)
    liftTyped = unsafeCodeCoerce . lift
#elif MIN_VERSION_template_haskell(2,16,0)
    liftTyped :: Block Resolved -> Q (TExp (Block Resolved))
liftTyped = Q Exp -> Q (TExp (Block Resolved))
forall a. Q Exp -> Q (TExp a)
unsafeTExpCoerce (Q Exp -> Q (TExp (Block Resolved)))
-> (Block Resolved -> Q Exp)
-> Block Resolved
-> Q (TExp (Block Resolved))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block Resolved -> Q Exp
forall t. Lift t => t -> Q Exp
lift
#endif