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

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

data Resolved = Resolved | Unresolved

-- Should mixins keep order (new version) or not (deprecated version)
data Order = Ordered | Unordered deriving ((forall (m :: * -> *). Quote m => Order -> m Exp)
-> (forall (m :: * -> *). Quote m => Order -> Code m Order)
-> Lift Order
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Order -> m Exp
forall (m :: * -> *). Quote m => Order -> Code m Order
$clift :: forall (m :: * -> *). Quote m => Order -> m Exp
lift :: forall (m :: * -> *). Quote m => Order -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Order -> Code m Order
liftTyped :: forall (m :: * -> *). Quote m => Order -> Code m Order
Lift)

type HasLeadingSpace = Bool

type family Str (a :: Resolved)
type instance Str 'Resolved = Builder
type instance Str 'Unresolved = Contents

data Block (a :: Resolved) where
  BlockResolved :: 
    { Block 'Resolved -> Builder
brSelectors :: !Builder
    , Block 'Resolved -> [Attr 'Resolved]
brAttrs     :: ![Attr 'Resolved]
    } -> Block 'Resolved
  BlockUnresolved ::
    { Block 'Unresolved -> [Contents]
buSelectors      :: ![Contents]
    , Block 'Unresolved -> [Either (Attr 'Unresolved) Deref]
buAttrsAndMixins :: ![Either (Attr 'Unresolved) Deref]
    , Block 'Unresolved -> [(Bool, Block 'Unresolved)]
buBlocks         :: ![(HasLeadingSpace, Block 'Unresolved)]
    } -> Block 'Unresolved

data Mixin = Mixin
    { Mixin -> [Attr 'Resolved]
mixinAttrs :: ![Attr 'Resolved]
    , Mixin -> [(Bool, Block 'Resolved)]
mixinBlocks :: ![(HasLeadingSpace, Block 'Resolved)]
    }
    deriving (forall (m :: * -> *). Quote m => Mixin -> m Exp)
-> (forall (m :: * -> *). Quote m => Mixin -> Code m Mixin)
-> Lift Mixin
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Mixin -> m Exp
forall (m :: * -> *). Quote m => Mixin -> Code m Mixin
$clift :: forall (m :: * -> *). Quote m => Mixin -> m Exp
lift :: forall (m :: * -> *). Quote m => Mixin -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Mixin -> Code m Mixin
liftTyped :: forall (m :: * -> *). Quote m => Mixin -> Code m Mixin
Lift
instance Semigroup Mixin where
    Mixin [Attr 'Resolved]
a [(Bool, Block 'Resolved)]
x <> :: Mixin -> Mixin -> Mixin
<> Mixin [Attr 'Resolved]
b [(Bool, Block 'Resolved)]
y = [Attr 'Resolved] -> [(Bool, Block 'Resolved)] -> Mixin
Mixin ([Attr 'Resolved]
a [Attr 'Resolved] -> [Attr 'Resolved] -> [Attr 'Resolved]
forall a. [a] -> [a] -> [a]
++ [Attr 'Resolved]
b) ([(Bool, Block 'Resolved)]
x [(Bool, Block 'Resolved)]
-> [(Bool, Block 'Resolved)] -> [(Bool, Block 'Resolved)]
forall a. [a] -> [a] -> [a]
++ [(Bool, Block 'Resolved)]
y)
instance Monoid Mixin where
    mempty :: Mixin
mempty = [Attr 'Resolved] -> [(Bool, Block 'Resolved)] -> Mixin
Mixin [Attr 'Resolved]
forall a. Monoid a => a
mempty [(Bool, Block 'Resolved)]
forall a. Monoid a => a
mempty

data TopLevel (a :: Resolved) 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 :: Resolved) where
  AttrResolved ::
    { Attr 'Resolved -> Builder
attrResKey :: !Builder
    , Attr 'Resolved -> Builder
attrResVal :: !Builder
    } -> Attr 'Resolved
  AttrUnresolved ::
    { Attr 'Unresolved -> Contents
attrUnresKey :: !Contents
    , Attr 'Unresolved -> Contents
attrUnresVal :: !Contents
    } -> Attr 'Unresolved

data Css = CssWhitespace ![TopLevel 'Resolved]
         | CssNoWhitespace ![TopLevel 'Resolved]

data Content = ContentRaw String
             | ContentVar Deref
             | ContentUrl Deref
             | ContentUrlParam Deref
             | ContentMixin Deref
    deriving (Int -> Content -> ShowS
Contents -> ShowS
Content -> String
(Int -> Content -> ShowS)
-> (Content -> String) -> (Contents -> ShowS) -> Show Content
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Content -> ShowS
showsPrec :: Int -> Content -> ShowS
$cshow :: Content -> String
show :: Content -> String
$cshowList :: Contents -> ShowS
showList :: Contents -> ShowS
Show, Content -> Content -> Bool
(Content -> Content -> Bool)
-> (Content -> Content -> Bool) -> Eq Content
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Content -> Content -> Bool
== :: Content -> Content -> Bool
$c/= :: Content -> Content -> Bool
/= :: Content -> Content -> Bool
Eq, (forall (m :: * -> *). Quote m => Content -> m Exp)
-> (forall (m :: * -> *). Quote m => Content -> Code m Content)
-> Lift Content
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Content -> m Exp
forall (m :: * -> *). Quote m => Content -> Code m Content
$clift :: forall (m :: * -> *). Quote m => Content -> m Exp
lift :: forall (m :: * -> *). Quote m => Content -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Content -> Code m Content
liftTyped :: forall (m :: * -> *). Quote m => Content -> Code m Content
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)])
-> Contents -> Either String [[(Deref, VarType)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([(String, String)] -> Content -> Either String [(Deref, VarType)]
getVars [(String, String)]
scope0) Contents
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, Contents
contents) = [TopLevel 'Unresolved] -> ([(String, String)], Contents)
go [TopLevel 'Unresolved]
a

    go :: [TopLevel 'Unresolved] -> (Scope, [Content])
    go :: [TopLevel 'Unresolved] -> ([(String, String)], Contents)
go [] = ([], [])
    go (TopAtDecl String
dec Str 'Unresolved
cs:[TopLevel 'Unresolved]
rest) =
        ([(String, String)]
scope, Contents
rest'')
      where
        ([(String, String)]
scope, Contents
rest') = [TopLevel 'Unresolved] -> ([(String, String)], Contents)
go [TopLevel 'Unresolved]
rest
        rest'' :: Contents
rest'' =
            String -> Content
ContentRaw (Char
'@' Char -> ShowS
forall a. a -> [a] -> [a]
: String
dec String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ")
          Content -> Contents -> Contents
forall a. a -> [a] -> [a]
: Contents
Str 'Unresolved
cs
         Contents -> Contents -> Contents
forall a. [a] -> [a] -> [a]
++ String -> Content
ContentRaw String
";"
          Content -> Contents -> Contents
forall a. a -> [a] -> [a]
: Contents
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, Contents
rest1 Contents -> Contents -> Contents
forall a. [a] -> [a] -> [a]
++ Contents
rest2)
      where
        ([(String, String)]
scope1, Contents
rest1) = [TopLevel 'Unresolved] -> ([(String, String)], Contents)
go ((Block 'Unresolved -> TopLevel 'Unresolved)
-> [Block 'Unresolved] -> [TopLevel 'Unresolved]
forall a b. (a -> b) -> [a] -> [b]
map Block 'Unresolved -> TopLevel 'Unresolved
forall (a :: Resolved). Block a -> TopLevel a
TopBlock [Block 'Unresolved]
blocks)
        ([(String, String)]
scope2, Contents
rest2) = [TopLevel 'Unresolved] -> ([(String, String)], Contents)
go [TopLevel 'Unresolved]
rest
    go (TopBlock (BlockUnresolved [Contents]
x [Either (Attr 'Unresolved) Deref]
y [(Bool, Block 'Unresolved)]
z):[TopLevel 'Unresolved]
rest) =
        ([(String, String)]
scope1 [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String, String)]
scope2, Contents
rest0 Contents -> Contents -> Contents
forall a. [a] -> [a] -> [a]
++ Contents
rest1 Contents -> Contents -> Contents
forall a. [a] -> [a] -> [a]
++ Contents
rest2)
      where
        rest0 :: Contents
rest0 = Contents -> [Contents] -> Contents
forall a. [a] -> [[a]] -> [a]
intercalate [String -> Content
ContentRaw String
","] [Contents]
x Contents -> Contents -> Contents
forall a. [a] -> [a] -> [a]
++ (Either (Attr 'Unresolved) Deref -> Contents)
-> [Either (Attr 'Unresolved) Deref] -> Contents
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Either (Attr 'Unresolved) Deref -> Contents
go' [Either (Attr 'Unresolved) Deref]
y
        ([(String, String)]
scope1, Contents
rest1) = [TopLevel 'Unresolved] -> ([(String, String)], Contents)
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 :: Resolved). 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)]
z)
        ([(String, String)]
scope2, Contents
rest2) = [TopLevel 'Unresolved] -> ([(String, String)], Contents)
go [TopLevel 'Unresolved]
rest
    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, Contents
rest')
      where
        ([(String, String)]
scope, Contents
rest') = [TopLevel 'Unresolved] -> ([(String, String)], Contents)
go [TopLevel 'Unresolved]
rest
    go' :: Either (Attr 'Unresolved) Deref -> [Content]
    go' :: Either (Attr 'Unresolved) Deref -> Contents
go' (Left (AttrUnresolved Contents
k Contents
v)) = Contents
k Contents -> Contents -> Contents
forall a. [a] -> [a] -> [a]
++ (Contents
v :: [Content])
    go' (Right Deref
m) = [Deref -> Content
ContentMixin Deref
m]

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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Deref, VarType) -> Q Exp
vtToExp [(Deref, VarType)]
vs
    Exp
cr <- [|cssRuntime toi2b|]
    Exp
parseBlocks'' <- Q Exp
parseBlocks'
    Exp -> Q Exp
forall a. a -> Q a
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

runtimePrependSelector :: Builder -> (HasLeadingSpace, Block 'Resolved) -> Block 'Resolved
runtimePrependSelector :: Builder -> (Bool, Block 'Resolved) -> Block 'Resolved
runtimePrependSelector Builder
builder (Bool
hsl, BlockResolved Builder
x [Attr 'Resolved]
b) =
    Builder -> [Attr 'Resolved] -> Block 'Resolved
BlockResolved (Builder
builder Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
addSpace Builder
x) [Attr 'Resolved]
b
  where
    addSpace :: Builder -> Builder
addSpace = if Bool
hsl then (Char -> Builder
TLB.singleton Char
' ' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) else Builder -> Builder
forall a. a -> a
id

combineSelectors :: HasLeadingSpace
                 -> [Contents]
                 -> [Contents]
                 -> [Contents]
combineSelectors :: Bool -> [Contents] -> [Contents] -> [Contents]
combineSelectors Bool
hsl [Contents]
a [Contents]
b = do
    Contents
a' <- [Contents]
a
    Contents
b' <- [Contents]
b
    Contents -> [Contents]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Contents -> [Contents]) -> Contents -> [Contents]
forall a b. (a -> b) -> a -> b
$ Contents
a' Contents -> Contents -> Contents
forall a. [a] -> [a] -> [a]
++ Contents -> Contents
addSpace Contents
b'
  where
    addSpace :: Contents -> Contents
addSpace
        | Bool
hsl = (String -> Content
ContentRaw String
" " Content -> Contents -> Contents
forall a. a -> [a] -> [a]
:)
        | Bool
otherwise = Contents -> Contents
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 :: forall url.
[(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Block 'Unresolved
-> Either String (DList (Block 'Resolved))
blockRuntime [(Deref, CDData url)]
cd url -> [(Text, Text)] -> Text
render' (BlockUnresolved [Contents]
x [Either (Attr 'Unresolved) Deref]
attrsAndMixins [(Bool, Block 'Unresolved)]
z) = do
    [Builder]
x' <- (Content -> Either String Builder)
-> Contents -> Either String [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content -> Either String Builder
go' (Contents -> Either String [Builder])
-> Contents -> Either String [Builder]
forall a b. (a -> b) -> a -> b
$ Contents -> [Contents] -> Contents
forall a. [a] -> [[a]] -> [a]
intercalate [String -> Content
ContentRaw String
","] [Contents]
x
    [[Attr 'Resolved]]
attrs' <- (Either (Attr 'Unresolved) Deref -> Either String [Attr 'Resolved])
-> [Either (Attr 'Unresolved) Deref]
-> Either String [[Attr 'Resolved]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Attr 'Unresolved -> Either String [Attr 'Resolved])
-> (Deref -> Either String [Attr 'Resolved])
-> Either (Attr 'Unresolved) Deref
-> Either String [Attr 'Resolved]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Attr 'Unresolved -> Either String [Attr 'Resolved]
resolveAttr Deref -> Either String [Attr 'Resolved]
getMixinAttrs) [Either (Attr 'Unresolved) Deref]
attrsAndMixins
    [[(Bool, Block 'Resolved)]]
blocks' <- (Either (Attr 'Unresolved) Deref
 -> Either String [(Bool, Block 'Resolved)])
-> [Either (Attr 'Unresolved) Deref]
-> Either String [[(Bool, Block 'Resolved)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Attr 'Unresolved -> Either String [(Bool, Block 'Resolved)])
-> (Deref -> Either String [(Bool, Block 'Resolved)])
-> Either (Attr 'Unresolved) Deref
-> Either String [(Bool, Block 'Resolved)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either String [(Bool, Block 'Resolved)]
-> Attr 'Unresolved -> Either String [(Bool, Block 'Resolved)]
forall a b. a -> b -> a
const (Either String [(Bool, Block 'Resolved)]
 -> Attr 'Unresolved -> Either String [(Bool, Block 'Resolved)])
-> Either String [(Bool, Block 'Resolved)]
-> Attr 'Unresolved
-> Either String [(Bool, Block 'Resolved)]
forall a b. (a -> b) -> a -> b
$ [(Bool, Block 'Resolved)]
-> Either String [(Bool, Block 'Resolved)]
forall a b. b -> Either a b
Right []) Deref -> Either String [(Bool, Block 'Resolved)]
getMixinBlocks) [Either (Attr 'Unresolved) Deref]
attrsAndMixins
    [DList (Block 'Resolved)]
z' <- ((Bool, Block 'Unresolved)
 -> Either String (DList (Block 'Resolved)))
-> [(Bool, Block 'Unresolved)]
-> Either String [DList (Block 'Resolved)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Contents]
-> (Bool, Block 'Unresolved)
-> Either String (DList (Block 'Resolved))
subGo [Contents]
x) [(Bool, Block 'Unresolved)]
z -- FIXME use difflists again
    DList (Block 'Resolved) -> Either String (DList (Block 'Resolved))
forall a b. b -> Either a b
Right (DList (Block 'Resolved)
 -> Either String (DList (Block 'Resolved)))
-> DList (Block 'Resolved)
-> Either String (DList (Block 'Resolved))
forall a b. (a -> b) -> a -> b
$ \[Block 'Resolved]
rest -> BlockResolved
        { brSelectors :: Builder
brSelectors = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
x'
        , brAttrs :: [Attr 'Resolved]
brAttrs     = [[Attr 'Resolved]] -> [Attr 'Resolved]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Attr 'Resolved]]
attrs'
        }
        Block 'Resolved -> DList (Block 'Resolved)
forall a. a -> [a] -> [a]
: ((Bool, Block 'Resolved) -> Block 'Resolved)
-> [(Bool, Block 'Resolved)] -> [Block 'Resolved]
forall a b. (a -> b) -> [a] -> [b]
map (Builder -> (Bool, Block 'Resolved) -> Block 'Resolved
runtimePrependSelector (Builder -> (Bool, Block 'Resolved) -> Block 'Resolved)
-> Builder -> (Bool, Block 'Resolved) -> Block 'Resolved
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
x') ([[(Bool, Block 'Resolved)]] -> [(Bool, Block 'Resolved)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Bool, Block 'Resolved)]]
blocks')
        [Block 'Resolved] -> DList (Block 'Resolved)
forall a. [a] -> [a] -> [a]
++ (DList (Block 'Resolved) -> DList (Block 'Resolved))
-> [Block 'Resolved]
-> [DList (Block 'Resolved)]
-> [Block 'Resolved]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr DList (Block 'Resolved) -> DList (Block 'Resolved)
forall a b. (a -> b) -> a -> b
($) [Block 'Resolved]
rest [DList (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 -> 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"

    getMixinAttrs :: Deref -> Either String [Attr 'Resolved]
    getMixinAttrs :: Deref -> Either String [Attr 'Resolved]
getMixinAttrs = (Mixin -> [Attr 'Resolved])
-> Either String Mixin -> Either String [Attr 'Resolved]
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Mixin -> [Attr 'Resolved]
mixinAttrs (Either String Mixin -> Either String [Attr 'Resolved])
-> (Deref -> Either String Mixin)
-> Deref
-> Either String [Attr 'Resolved]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Deref -> Either String Mixin
getMixin

    getMixinBlocks :: Deref -> Either String [(HasLeadingSpace, Block 'Resolved)]
    getMixinBlocks :: Deref -> Either String [(Bool, Block 'Resolved)]
getMixinBlocks = (Mixin -> [(Bool, Block 'Resolved)])
-> Either String Mixin -> Either String [(Bool, Block 'Resolved)]
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Mixin -> [(Bool, Block 'Resolved)]
mixinBlocks (Either String Mixin -> Either String [(Bool, Block 'Resolved)])
-> (Deref -> Either String Mixin)
-> Deref
-> Either String [(Bool, Block 'Resolved)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Deref -> Either String Mixin
getMixin

    resolveAttr :: Attr 'Unresolved -> Either String [Attr 'Resolved]
    resolveAttr :: Attr 'Unresolved -> Either String [Attr 'Resolved]
resolveAttr (AttrUnresolved Contents
k Contents
v) =
      let eAttr :: Either String (Attr 'Resolved)
eAttr = Builder -> Builder -> Attr 'Resolved
AttrResolved (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)
-> Contents -> Either String [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content -> Either String Builder
go' Contents
k) Either String (Builder -> Attr 'Resolved)
-> Either String Builder -> Either String (Attr 'Resolved)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
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)
-> Contents -> Either String [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content -> Either String Builder
go' Contents
v)
       in (Attr 'Resolved -> [Attr 'Resolved])
-> Either String (Attr 'Resolved) -> Either String [Attr 'Resolved]
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attr 'Resolved -> [Attr 'Resolved] -> [Attr 'Resolved]
forall a. a -> [a] -> [a]
:[]) Either String (Attr 'Resolved)
eAttr

    subGo :: [Contents] -- ^ parent selectors
          -> (HasLeadingSpace, Block 'Unresolved)
          -> Either String (DList (Block 'Resolved))
    subGo :: [Contents]
-> (Bool, Block 'Unresolved)
-> Either String (DList (Block 'Resolved))
subGo [Contents]
x' (Bool
hls, BlockUnresolved [Contents]
a [Either (Attr 'Unresolved) Deref]
b [(Bool, Block 'Unresolved)]
c) =
        let a' :: [Contents]
a' = Bool -> [Contents] -> [Contents] -> [Contents]
combineSelectors Bool
hls [Contents]
x' [Contents]
a
         in [(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Block 'Unresolved
-> Either String (DList (Block 'Resolved))
forall url.
[(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Block 'Unresolved
-> Either String (DList (Block 'Resolved))
blockRuntime [(Deref, CDData url)]
cd url -> [(Text, Text)] -> Text
render' ([Contents]
-> [Either (Attr 'Unresolved) Deref]
-> [(Bool, Block 'Unresolved)]
-> Block 'Unresolved
BlockUnresolved [Contents]
a' [Either (Attr 'Unresolved) Deref]
b [(Bool, Block 'Unresolved)]
c)

contentToBuilderRT :: [(Deref, CDData url)]
                   -> (url -> [(Text, Text)] -> Text)
                   -> Content
                   -> Either String Builder
contentToBuilderRT :: forall url.
[(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 :: forall url.
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 a. a -> IO a
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 :: Resolved). 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)
-> Contents -> Either String [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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') Contents
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 :: Resolved). Block a -> TopLevel a
TopBlock ((String -> [Block 'Resolved])
-> (DList (Block 'Resolved) -> [Block 'Resolved])
-> Either String (DList (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 (DList (Block 'Resolved) -> DList (Block 'Resolved)
forall a b. (a -> b) -> a -> b
$ []) (Either String (DList (Block 'Resolved)) -> [Block 'Resolved])
-> Either String (DList (Block 'Resolved)) -> [Block 'Resolved]
forall a b. (a -> b) -> a -> b
$ [(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Block 'Unresolved
-> Either String (DList (Block 'Resolved))
forall url.
[(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Block 'Unresolved
-> Either String (DList (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 :: Resolved). String -> Str a -> [Block a] -> TopLevel a
TopAtBlock String
name Builder
Str 'Resolved
s ((Block 'Unresolved -> DList (Block 'Resolved))
-> [Block 'Resolved] -> [Block 'Unresolved] -> [Block 'Resolved]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((String -> DList (Block 'Resolved))
-> (DList (Block 'Resolved) -> DList (Block 'Resolved))
-> Either String (DList (Block 'Resolved))
-> DList (Block 'Resolved)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> DList (Block 'Resolved)
forall a. HasCallStack => String -> a
error DList (Block 'Resolved) -> DList (Block 'Resolved)
forall a. a -> a
id (Either String (DList (Block 'Resolved))
 -> DList (Block 'Resolved))
-> (Block 'Unresolved -> Either String (DList (Block 'Resolved)))
-> Block 'Unresolved
-> DList (Block 'Resolved)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Block 'Unresolved
-> Either String (DList (Block 'Resolved))
forall url.
[(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Block 'Unresolved
-> Either String (DList (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)
-> Contents -> Either String [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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') Contents
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 b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
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 (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Deref -> m Exp
lift Deref
d
    Exp
c' <- VarType -> Q Exp
c VarType
vt
    Exp -> Q Exp
forall a. a -> Q a
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 a. a -> Either String a
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 a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return []
        Maybe String
Nothing -> [(Deref, VarType)] -> Either String [(Deref, VarType)]
forall a. a -> Either String a
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 a. a -> Either String a
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 a. a -> Either String a
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 a. a -> Either String a
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 :: forall b. 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 :: Resolved). 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 :: Resolved). 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 (BlockUnresolved [Contents]
x [Either (Attr 'Unresolved) Deref]
y [(Bool, Block 'Unresolved)]
blocks) =
    [Contents]
-> [Either (Attr 'Unresolved) Deref]
-> [(Bool, Block 'Unresolved)]
-> Block 'Unresolved
BlockUnresolved ((Contents -> Contents) -> [Contents] -> [Contents]
forall a b. (a -> b) -> [a] -> [b]
map Contents -> Contents
cc [Contents]
x) ((Either (Attr 'Unresolved) Deref
 -> Either (Attr 'Unresolved) Deref)
-> [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
forall a b. (a -> b) -> [a] -> [b]
map Either (Attr 'Unresolved) Deref -> Either (Attr 'Unresolved) Deref
go [Either (Attr 'Unresolved) Deref]
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 b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Block 'Unresolved -> Block 'Unresolved
compressBlock) [(Bool, Block 'Unresolved)]
blocks)
  where
    go :: Either (Attr 'Unresolved) Deref -> Either (Attr 'Unresolved) Deref
    go :: Either (Attr 'Unresolved) Deref -> Either (Attr 'Unresolved) Deref
go (Left (AttrUnresolved Contents
k Contents
v)) = Attr 'Unresolved -> Either (Attr 'Unresolved) Deref
forall a b. a -> Either a b
Left (Attr 'Unresolved -> Either (Attr 'Unresolved) Deref)
-> Attr 'Unresolved -> Either (Attr 'Unresolved) Deref
forall a b. (a -> b) -> a -> b
$ Contents -> Contents -> Attr 'Unresolved
AttrUnresolved (Contents -> Contents
cc Contents
k) (Contents -> Contents
cc Contents
v)
    go (Right Deref
m) = Deref -> Either (Attr 'Unresolved) Deref
forall a b. b -> Either a b
Right Deref
m
    cc :: Contents -> Contents
    cc :: Contents -> Contents
cc [] = []
    cc (ContentRaw String
a:ContentRaw String
b:Contents
c) = Contents -> Contents
cc (Contents -> Contents) -> Contents -> Contents
forall a b. (a -> b) -> a -> b
$ String -> Content
ContentRaw (String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b) Content -> Contents -> Contents
forall a. a -> [a] -> [a]
: Contents
c
    cc (Content
a:Contents
b) = Content
a Content -> Contents -> Contents
forall a. a -> [a] -> [a]
: Contents -> Contents
cc Contents
b

blockToMixin :: Name
             -> Scope
             -> Block 'Unresolved
             -> Q Exp
blockToMixin :: Name -> [(String, String)] -> Block 'Unresolved -> Q Exp
blockToMixin Name
r [(String, String)]
scope (BlockUnresolved [Contents]
_sel [Either (Attr 'Unresolved) Deref]
props [(Bool, Block 'Unresolved)]
subblocks) =
    -- TODO: preserve the CPS in @mixinBlocks@ below
    [| let attrsAndMixins = $(Name
-> [(String, String)] -> [Either (Attr 'Unresolved) Deref] -> Q Exp
processAttrsAndDerefs Name
r [(String, String)]
scope [Either (Attr 'Unresolved) Deref]
props)
        in Mixin
            { mixinAttrs =
                concatMap (either (:[]) mixinAttrs) attrsAndMixins
            , mixinBlocks =
                concat $
                  $([Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ ((Bool, Block 'Unresolved) -> Q Exp)
-> [(Bool, Block 'Unresolved)] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Block 'Unresolved) -> Q Exp
subGo [(Bool, Block 'Unresolved)]
subblocks)
                  ++ map (either (const []) mixinBlocks) attrsAndMixins
            }
    |]
  where
    -- We don't use the @hls@ to combine selectors, because the parent
    -- selector for a mixin is the dummy @mixin@ selector. But we may want
    -- to know later if the block needs a leading space, because the mixin
    -- might include an @&@ which needs to mix correctly with the parent
    -- block's selector.
    subGo :: (Bool, Block 'Unresolved) -> Q Exp
subGo (Bool
hls, BlockUnresolved [Contents]
sel' [Either (Attr 'Unresolved) Deref]
b [(Bool, Block 'Unresolved)]
c) =
      [| map (\x -> ($(Bool -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Bool -> m Exp
lift Bool
hls), x))
           $ $(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
$ [Contents]
-> [Either (Attr 'Unresolved) Deref]
-> [(Bool, Block 'Unresolved)]
-> Block 'Unresolved
BlockUnresolved [Contents]
sel' [Either (Attr 'Unresolved) Deref]
b [(Bool, Block 'Unresolved)]
c) []
      |]
        
blockToCss :: Name
           -> Scope
           -> Block 'Unresolved
           -> ExpQ
blockToCss :: Name -> [(String, String)] -> Block 'Unresolved -> Q Exp
blockToCss Name
r [(String, String)]
scope (BlockUnresolved [Contents]
sel [Either (Attr 'Unresolved) Deref]
props [(Bool, Block 'Unresolved)]
subblocks) =
    [| let attrsAndMixins = $(Name
-> [(String, String)] -> [Either (Attr 'Unresolved) Deref] -> Q Exp
processAttrsAndDerefs Name
r [(String, String)]
scope [Either (Attr 'Unresolved) Deref]
props)
           selToBuilder = $(Name -> [(String, String)] -> [Contents] -> Q Exp
selectorToBuilder Name
r [(String, String)]
scope [Contents]
sel)
       in ( BlockResolved
            { brSelectors = selToBuilder
            , brAttrs     = concatMap (either (:[]) mixinAttrs) attrsAndMixins
            }:)
          . foldr (.) id $([Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ ((Bool, Block 'Unresolved) -> Q Exp)
-> [(Bool, Block 'Unresolved)] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Block 'Unresolved) -> Q Exp
subGo [(Bool, Block 'Unresolved)]
subblocks)
          . (fmap
                (runtimePrependSelector selToBuilder)
                (concatMap (either (const []) mixinBlocks) attrsAndMixins) ++)
    |]
  where
    subGo :: (HasLeadingSpace, Block 'Unresolved) -> Q Exp
    subGo :: (Bool, Block 'Unresolved) -> Q Exp
subGo (Bool
hls, BlockUnresolved [Contents]
sel' [Either (Attr 'Unresolved) Deref]
b [(Bool, Block 'Unresolved)]
c) =
        let sel'' :: [Contents]
sel'' = Bool -> [Contents] -> [Contents] -> [Contents]
combineSelectors Bool
hls [Contents]
sel [Contents]
sel'
         in 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
$ [Contents]
-> [Either (Attr 'Unresolved) Deref]
-> [(Bool, Block 'Unresolved)]
-> Block 'Unresolved
BlockUnresolved [Contents]
sel'' [Either (Attr 'Unresolved) Deref]
b [(Bool, Block 'Unresolved)]
c


processAttrsAndDerefs ::
     Name
  -> Scope
  -> [Either (Attr 'Unresolved) Deref]
  -> Q Exp -- ^ Either (Attr 'Resolved) Mixin
processAttrsAndDerefs :: Name
-> [(String, String)] -> [Either (Attr 'Unresolved) Deref] -> Q Exp
processAttrsAndDerefs Name
r [(String, String)]
scope [Either (Attr 'Unresolved) Deref]
props = [Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ (Either (Attr 'Unresolved) Deref -> Q Exp)
-> [Either (Attr 'Unresolved) Deref] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
map Either (Attr 'Unresolved) Deref -> Q Exp
go [Either (Attr 'Unresolved) Deref]
props
  where
    go :: Either (Attr 'Unresolved) Deref -> Q Exp
go (Right Deref
deref) = Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'Right Exp -> Exp -> Exp
`AppE` (Scope -> Deref -> Exp
derefToExp [] Deref
deref)
    go (Left (AttrUnresolved Contents
x Contents
y)) =
          Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE 'Left Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE`
            ( Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE 'AttrResolved
                Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` (Name -> [(String, String)] -> Contents -> Q Exp
contentsToBuilder Name
r [(String, String)]
scope Contents
x)
                Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` (Name -> [(String, String)] -> Contents -> Q Exp
contentsToBuilder Name
r [(String, String)]
scope Contents
y)
            )

selectorToBuilder :: Name -> Scope -> [Contents] -> Q Exp
selectorToBuilder :: Name -> [(String, String)] -> [Contents] -> Q Exp
selectorToBuilder Name
r [(String, String)]
scope [Contents]
sels =
    Name -> [(String, String)] -> Contents -> Q Exp
contentsToBuilder Name
r [(String, String)]
scope (Contents -> Q Exp) -> Contents -> Q Exp
forall a b. (a -> b) -> a -> b
$ Contents -> [Contents] -> Contents
forall a. [a] -> [[a]] -> [a]
intercalate [String -> Content
ContentRaw String
","] [Contents]
sels

contentsToBuilder :: Name -> Scope -> [Content] -> Q Exp
contentsToBuilder :: Name -> [(String, String)] -> Contents -> Q Exp
contentsToBuilder Name
r [(String, String)]
scope Contents
contents =
    Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE [|mconcat|] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ (Content -> Q Exp) -> Contents -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> [(String, String)] -> Content -> Q Exp
contentToBuilder Name
r [(String, String)]
scope) Contents
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
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Lit -> Q Exp
forall (m :: * -> *). Quote m => Lit -> m 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
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Lit -> Q Exp
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (String -> Lit
StringL String
val)
        Deref
_ -> [|toCss|] Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Exp -> Q Exp
forall a. a -> Q a
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
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE`
        (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
r Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Scope -> Deref -> Exp
derefToExp [] Deref
u) Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` [Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE [])
contentToBuilder Name
r [(String, String)]
_ (ContentUrlParam Deref
u) =
    [|fromText|] Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE`
        ([|uncurry|] Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
r Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Exp -> Q Exp
forall a. a -> Q a
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
forall (m :: * -> *). Quote m => String -> m Name
newName String
"_render"
    [Q Pat] -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
lamE [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
r] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m 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 a b. (a -> b) -> Q a -> Q b
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 a. a -> Q a
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 ($(Name -> [(String, String)] -> Block 'Unresolved -> Q Exp
blockToCss Name
r [(String, String)]
scope Block 'Unresolved
b) [])|]
        [Exp]
es <- Name -> [(String, String)] -> [TopLevel 'Unresolved] -> Q [Exp]
go Name
r [(String, String)]
scope [TopLevel 'Unresolved]
rest
        [Exp] -> Q [Exp]
forall a. a -> Q a
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)] -> Contents -> Q Exp
contentsToBuilder Name
r [(String, String)]
scope Contents
Str 'Unresolved
s
        Exp
e <- [|(:) $ TopAtBlock $(String -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => String -> m Exp
lift String
name) $(Q Exp
s') $(Name -> [(String, String)] -> [Block 'Unresolved] -> Q Exp
blocksToCassius Name
r [(String, String)]
scope [Block 'Unresolved]
b)|]
        [Exp]
es <- Name -> [(String, String)] -> [TopLevel 'Unresolved] -> Q [Exp]
go Name
r [(String, String)]
scope [TopLevel 'Unresolved]
rest
        [Exp] -> Q [Exp]
forall a. a -> Q a
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 $(String -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => String -> m Exp
lift String
dec) $(Name -> [(String, String)] -> Contents -> Q Exp
contentsToBuilder Name
r [(String, String)]
scope Contents
Str 'Unresolved
cs)|]
        [Exp]
es <- Name -> [(String, String)] -> [TopLevel 'Unresolved] -> Q [Exp]
go Name
r [(String, String)]
scope [TopLevel 'Unresolved]
rest
        [Exp] -> Q [Exp]
forall a. a -> Q a
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
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE [|foldr ($) []|] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m 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 a b. (a -> b -> b) -> b -> [a] -> b
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 (BlockResolved Builder
sel [Attr 'Resolved]
attrs)
    | [Attr 'Resolved] -> Bool
forall a. [a] -> 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
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 (AttrResolved Builder
k Builder
v) = Builder
startDecl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
colon Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
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
';'

instance Lift (Attr a) where
  lift :: forall (m :: * -> *). Quote m => Attr a -> m Exp
lift = \case
    AttrResolved Builder
k Builder
v -> [|AttrResolved $(Builder -> m Exp
forall (m :: * -> *). Quote m => Builder -> m Exp
liftBuilder Builder
k) $(Builder -> m Exp
forall (m :: * -> *). Quote m => Builder -> m Exp
liftBuilder Builder
v)|]
    AttrUnresolved Contents
k Contents
v -> [|AttrUnresolved k v|]
#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped :: forall (m :: * -> *). Quote m => Attr a -> Code m (Attr a)
liftTyped = m Exp -> Code m (Attr a)
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (m Exp -> Code m (Attr a))
-> (Attr a -> m Exp) -> Attr a -> Code m (Attr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr a -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Attr a -> m Exp
lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped = unsafeTExpCoerce . lift
#endif

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

instance Lift (Block a) where
  lift :: forall (m :: * -> *). Quote m => Block a -> m Exp
lift = \case
    BlockResolved Builder
a [Attr 'Resolved]
b -> [|BlockResolved $(Builder -> m Exp
forall (m :: * -> *). Quote m => Builder -> m Exp
liftBuilder Builder
a) b|]
    BlockUnresolved [Contents]
a [Either (Attr 'Unresolved) Deref]
b [(Bool, Block 'Unresolved)]
c -> [|BlockUnresolved a b c|]
#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped :: forall (m :: * -> *). Quote m => Block a -> Code m (Block a)
liftTyped = m Exp -> Code m (Block a)
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (m Exp -> Code m (Block a))
-> (Block a -> m Exp) -> Block a -> Code m (Block a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block a -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Block a -> m Exp
lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped = unsafeTExpCoerce . lift
#endif