{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}

module Text.Internal.Lucius where

import Text.Shakespeare.Base
import Language.Haskell.TH.Quote (QuasiQuoter (..))
import Language.Haskell.TH.Syntax
import Data.Text (Text, unpack)
import qualified Data.Text.Lazy as TL
import Text.ParserCombinators.Parsec hiding (Line)
import Text.Internal.Css
import Data.Char (isSpace, toLower, toUpper)
import Numeric (readHex)
import Control.Monad (when, unless)
import Data.List (isSuffixOf)
import Control.Arrow (second)
import Text.Shakespeare (VarType)

luciusWithOrder :: Order -> QuasiQuoter
luciusWithOrder :: Order -> QuasiQuoter
luciusWithOrder Order
order = QuasiQuoter { quoteExp :: String -> Q Exp
quoteExp = Order -> String -> Q Exp
luciusFromString Order
order}

luciusFromString :: Order -> String -> Q Exp
luciusFromString :: Order -> String -> Q Exp
luciusFromString Order
order String
s =
    [TopLevel 'Unresolved] -> Q Exp
topLevelsToCassius
  forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (Order -> Parser [TopLevel 'Unresolved]
parseTopLevels Order
order) String
s String
s

whiteSpace :: Parser ()
whiteSpace :: Parser ()
whiteSpace = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser ()
whiteSpace1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()

whiteSpace1 :: Parser ()
whiteSpace1 :: Parser ()
whiteSpace1 =
    ((forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t\n\r" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Parser Content
parseComment forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()))

parseBlock :: Order -> Parser (Block 'Unresolved)
parseBlock :: Order -> Parser (Block 'Unresolved)
parseBlock Order
order = do
    [Contents]
sel <- Parser [Contents]
parseSelector
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
    Parser ()
whiteSpace
    [PairBlock]
pairsBlocks <- Order -> ([PairBlock] -> [PairBlock]) -> Parser [PairBlock]
parsePairsBlocks Order
order forall a. a -> a
id
    let ([Either (Attr 'Unresolved) Deref]
attrs, [Block 'Unresolved]
blocks) = Order
-> [PairBlock]
-> ([Either (Attr 'Unresolved) Deref], [Block 'Unresolved])
partitionPBs Order
order [PairBlock]
pairsBlocks
    Parser ()
whiteSpace
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Contents]
-> [Either (Attr 'Unresolved) Deref]
-> [(HasLeadingSpace, Block 'Unresolved)]
-> Block 'Unresolved
BlockUnresolved [Contents]
sel [Either (Attr 'Unresolved) Deref]
attrs (forall a b. (a -> b) -> [a] -> [b]
map Block 'Unresolved -> (HasLeadingSpace, Block 'Unresolved)
detectAmp [Block 'Unresolved]
blocks)

-- | Looks for an & at the beginning of a selector and, if present, indicates
-- that we should not have a leading space. Otherwise, we should have the
-- leading space.
detectAmp :: Block 'Unresolved -> (Bool, Block 'Unresolved)
detectAmp :: Block 'Unresolved -> (HasLeadingSpace, Block 'Unresolved)
detectAmp (BlockUnresolved ([Contents]
sel) [Either (Attr 'Unresolved) Deref]
b [(HasLeadingSpace, Block 'Unresolved)]
c) =
    (HasLeadingSpace
hls, [Contents]
-> [Either (Attr 'Unresolved) Deref]
-> [(HasLeadingSpace, Block 'Unresolved)]
-> Block 'Unresolved
BlockUnresolved [Contents]
sel' [Either (Attr 'Unresolved) Deref]
b [(HasLeadingSpace, Block 'Unresolved)]
c)
  where
    (HasLeadingSpace
hls, [Contents]
sel') =
        case [Contents]
sel of
            (ContentRaw String
"&":Contents
rest):[Contents]
others -> (HasLeadingSpace
False, Contents
rest forall a. a -> [a] -> [a]
: [Contents]
others)
            (ContentRaw (Char
'&':String
s):Contents
rest):[Contents]
others -> (HasLeadingSpace
False, (String -> Content
ContentRaw String
s forall a. a -> [a] -> [a]
: Contents
rest) forall a. a -> [a] -> [a]
: [Contents]
others)
            [Contents]
_ -> (HasLeadingSpace
True, [Contents]
sel)

partitionPBs ::
     Order
  -> [PairBlock]
  -> ([Either (Attr 'Unresolved) Deref], [Block 'Unresolved])
partitionPBs :: Order
-> [PairBlock]
-> ([Either (Attr 'Unresolved) Deref], [Block 'Unresolved])
partitionPBs Order
order = ([Either (Attr 'Unresolved) Deref]
 -> [Either (Attr 'Unresolved) Deref])
-> ([Block 'Unresolved] -> [Block 'Unresolved])
-> ([Either (Attr 'Unresolved) Deref]
    -> [Either (Attr 'Unresolved) Deref])
-> [PairBlock]
-> ([Either (Attr 'Unresolved) Deref], [Block 'Unresolved])
go forall a. a -> a
id forall a. a -> a
id forall a. a -> a
id
  where
    -- We append the unordered legacy mixins 'c' to the end of the ordered list 'a'
    go :: ([Either (Attr 'Unresolved) Deref]
 -> [Either (Attr 'Unresolved) Deref])
-> ([Block 'Unresolved] -> [Block 'Unresolved])
-> ([Either (Attr 'Unresolved) Deref]
    -> [Either (Attr 'Unresolved) Deref])
-> [PairBlock]
-> ([Either (Attr 'Unresolved) Deref], [Block 'Unresolved])
go [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
a [Block 'Unresolved] -> [Block 'Unresolved]
b [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
c [] = ([Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
a forall a b. (a -> b) -> a -> b
$ [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
c [], [Block 'Unresolved] -> [Block 'Unresolved]
b [])
    go [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
a [Block 'Unresolved] -> [Block 'Unresolved]
b [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
c (PBAttr Attr 'Unresolved
x:[PairBlock]
xs) = ([Either (Attr 'Unresolved) Deref]
 -> [Either (Attr 'Unresolved) Deref])
-> ([Block 'Unresolved] -> [Block 'Unresolved])
-> ([Either (Attr 'Unresolved) Deref]
    -> [Either (Attr 'Unresolved) Deref])
-> [PairBlock]
-> ([Either (Attr 'Unresolved) Deref], [Block 'Unresolved])
go ([Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall a b. a -> Either a b
Left Attr 'Unresolved
x)forall a. a -> [a] -> [a]
:)) [Block 'Unresolved] -> [Block 'Unresolved]
b [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
c [PairBlock]
xs
    go [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
a [Block 'Unresolved] -> [Block 'Unresolved]
b [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
c (PBBlock Block 'Unresolved
x:[PairBlock]
xs) = ([Either (Attr 'Unresolved) Deref]
 -> [Either (Attr 'Unresolved) Deref])
-> ([Block 'Unresolved] -> [Block 'Unresolved])
-> ([Either (Attr 'Unresolved) Deref]
    -> [Either (Attr 'Unresolved) Deref])
-> [PairBlock]
-> ([Either (Attr 'Unresolved) Deref], [Block 'Unresolved])
go [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
a ([Block 'Unresolved] -> [Block 'Unresolved]
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block 'Unresolved
xforall a. a -> [a] -> [a]
:)) [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
c [PairBlock]
xs
    go [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
a [Block 'Unresolved] -> [Block 'Unresolved]
b [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
c (PBMixin Deref
x:[PairBlock]
xs) = case Order
order of
      -- If we are interested in order, then we collect attributes and mixins in one list 'a'.
      Order
Ordered   -> ([Either (Attr 'Unresolved) Deref]
 -> [Either (Attr 'Unresolved) Deref])
-> ([Block 'Unresolved] -> [Block 'Unresolved])
-> ([Either (Attr 'Unresolved) Deref]
    -> [Either (Attr 'Unresolved) Deref])
-> [PairBlock]
-> ([Either (Attr 'Unresolved) Deref], [Block 'Unresolved])
go ([Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall a b. b -> Either a b
Right Deref
x)forall a. a -> [a] -> [a]
:)) [Block 'Unresolved] -> [Block 'Unresolved]
b [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
c [PairBlock]
xs
      -- Otherwise (legacy style) we collect mixins in a separate list 'c'.
      Order
Unordered -> ([Either (Attr 'Unresolved) Deref]
 -> [Either (Attr 'Unresolved) Deref])
-> ([Block 'Unresolved] -> [Block 'Unresolved])
-> ([Either (Attr 'Unresolved) Deref]
    -> [Either (Attr 'Unresolved) Deref])
-> [PairBlock]
-> ([Either (Attr 'Unresolved) Deref], [Block 'Unresolved])
go [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
a [Block 'Unresolved] -> [Block 'Unresolved]
b ([Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. b -> Either a b
Right Deref
xforall a. a -> [a] -> [a]
:)) [PairBlock]
xs

parseSelector :: Parser [Contents]
parseSelector :: Parser [Contents]
parseSelector =
    forall {b}. ([Contents] -> b) -> ParsecT String () Identity b
go forall a. a -> a
id
  where
    go :: ([Contents] -> b) -> ParsecT String () Identity b
go [Contents] -> b
front = do
        Contents
c <- String -> Parser Contents
parseContents String
"{,"
        let front' :: [Contents] -> b
front' = [Contents] -> b
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) (Contents -> Contents
trim Contents
c)
        (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Contents] -> b) -> ParsecT String () Identity b
go [Contents] -> b
front') forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return ([Contents] -> b
front' [])

trim :: Contents -> Contents
trim :: Contents -> Contents
trim =
    forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasLeadingSpace -> Contents -> Contents
trim' HasLeadingSpace
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasLeadingSpace -> Contents -> Contents
trim' HasLeadingSpace
True
  where
    trim' :: HasLeadingSpace -> Contents -> Contents
trim' HasLeadingSpace
_ [] = []
    trim' HasLeadingSpace
b (ContentRaw String
s:Contents
rest) =
        let s' :: String
s' = HasLeadingSpace -> String -> String
trimS HasLeadingSpace
b String
s
         in if forall (t :: * -> *) a. Foldable t => t a -> HasLeadingSpace
null String
s' then HasLeadingSpace -> Contents -> Contents
trim' HasLeadingSpace
b Contents
rest else String -> Content
ContentRaw String
s' forall a. a -> [a] -> [a]
: Contents
rest
    trim' HasLeadingSpace
_ Contents
x = Contents
x
    trimS :: HasLeadingSpace -> String -> String
trimS HasLeadingSpace
True = forall a. (a -> HasLeadingSpace) -> [a] -> [a]
dropWhile Char -> HasLeadingSpace
isSpace
    trimS HasLeadingSpace
False = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> HasLeadingSpace) -> [a] -> [a]
dropWhile Char -> HasLeadingSpace
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

data PairBlock = PBAttr (Attr 'Unresolved)
               | PBBlock (Block 'Unresolved)
               | PBMixin Deref
parsePairsBlocks :: Order -> ([PairBlock] -> [PairBlock]) -> Parser [PairBlock]
parsePairsBlocks :: Order -> ([PairBlock] -> [PairBlock]) -> Parser [PairBlock]
parsePairsBlocks Order
order [PairBlock] -> [PairBlock]
front = (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([PairBlock] -> [PairBlock]
front [])) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do
    HasLeadingSpace
isBlock <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall {u}. ParsecT String u Identity HasLeadingSpace
checkIfBlock
    PairBlock
x <- ParsecT String () Identity PairBlock
grabMixin forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (if HasLeadingSpace
isBlock then ParsecT String () Identity PairBlock
grabBlock else ParsecT String () Identity PairBlock
grabPair)
    Order -> ([PairBlock] -> [PairBlock]) -> Parser [PairBlock]
parsePairsBlocks Order
order forall a b. (a -> b) -> a -> b
$ [PairBlock] -> [PairBlock]
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) PairBlock
x)
  where
    grabBlock :: ParsecT String () Identity PairBlock
grabBlock = do
        Block 'Unresolved
b <- Order -> Parser (Block 'Unresolved)
parseBlock Order
order
        Parser ()
whiteSpace
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Block 'Unresolved -> PairBlock
PBBlock Block 'Unresolved
b
    grabPair :: ParsecT String () Identity PairBlock
grabPair = Attr 'Unresolved -> PairBlock
PBAttr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Attr 'Unresolved)
parsePair
    grabMixin :: ParsecT String () Identity PairBlock
grabMixin = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do
        Parser ()
whiteSpace
        Right Deref
x <- forall a. UserParser a (Either String Deref)
parseCaret
        Parser ()
whiteSpace
        (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Parser ()
whiteSpace
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Deref -> PairBlock
PBMixin Deref
x
    checkIfBlock :: ParsecT String u Identity HasLeadingSpace
checkIfBlock = do
        forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"#@{};"
        (forall a. UserParser a (Either String Deref)
parseHash forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity HasLeadingSpace
checkIfBlock)
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall a. UserParser a (Either String (Deref, HasLeadingSpace))
parseAt forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity HasLeadingSpace
checkIfBlock)
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return HasLeadingSpace
True)
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
";}" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return HasLeadingSpace
False)
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity HasLeadingSpace
checkIfBlock)
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"checkIfBlock"

parsePair :: Parser (Attr 'Unresolved)
parsePair :: Parser (Attr 'Unresolved)
parsePair = do
    Contents
key <- String -> Parser Contents
parseContents String
":"
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
    Parser ()
whiteSpace
    Contents
val <- String -> Parser Contents
parseContents String
";}"
    (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Parser ()
whiteSpace
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Contents -> Contents -> Attr 'Unresolved
AttrUnresolved Contents
key Contents
val

parseContents :: String -> Parser Contents
parseContents :: String -> Parser Contents
parseContents = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parser Content
parseContent

parseContent :: String -> Parser Content
parseContent :: String -> Parser Content
parseContent String
restricted =
    forall {a}. ParsecT String a Identity Content
parseHash' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {a}. ParsecT String a Identity Content
parseAt' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Content
parseComment forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Content
parseBack forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Content
parseChar
  where
    parseHash' :: ParsecT String a Identity Content
parseHash' = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Content
ContentRaw Deref -> Content
ContentVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. UserParser a (Either String Deref)
parseHash
    parseAt' :: ParsecT String a Identity Content
parseAt' =
        forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Content
ContentRaw (Deref, HasLeadingSpace) -> Content
go forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. UserParser a (Either String (Deref, HasLeadingSpace))
parseAt
      where
        go :: (Deref, HasLeadingSpace) -> Content
go (Deref
d, HasLeadingSpace
False) = Deref -> Content
ContentUrl Deref
d
        go (Deref
d, HasLeadingSpace
True) = Deref -> Content
ContentUrlParam Deref
d
    parseBack :: Parser Content
parseBack = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do
        Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
        String
hex <- forall a. Int -> Parser a -> Parser [a]
atMost Int
6 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> HasLeadingSpace) -> ParsecT s u m Char
satisfy Char -> HasLeadingSpace
isHex
        (Int
int, String
_):[(Int, String)]
_ <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => ReadS a
readHex forall a b. (a -> b) -> a -> b
$ forall a. (a -> HasLeadingSpace) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> HasLeadingSpace
== Char
'0') String
hex
        forall (f :: * -> *).
Applicative f =>
HasLeadingSpace -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
hex forall a. Ord a => a -> a -> HasLeadingSpace
< Int
6) forall a b. (a -> b) -> a -> b
$
            ((forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\r\n" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> HasLeadingSpace) -> ParsecT s u m Char
satisfy Char -> HasLeadingSpace
isSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()))
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Content
ContentRaw [forall a. Enum a => Int -> a
toEnum Int
int]
    parseChar :: Parser Content
parseChar = (String -> Content
ContentRaw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
restricted

isHex :: Char -> Bool
isHex :: Char -> HasLeadingSpace
isHex Char
c =
    (Char
'0' forall a. Ord a => a -> a -> HasLeadingSpace
<= Char
c HasLeadingSpace -> HasLeadingSpace -> HasLeadingSpace
&& Char
c forall a. Ord a => a -> a -> HasLeadingSpace
<= Char
'9') HasLeadingSpace -> HasLeadingSpace -> HasLeadingSpace
||
    (Char
'A' forall a. Ord a => a -> a -> HasLeadingSpace
<= Char
c HasLeadingSpace -> HasLeadingSpace -> HasLeadingSpace
&& Char
c forall a. Ord a => a -> a -> HasLeadingSpace
<= Char
'F') HasLeadingSpace -> HasLeadingSpace -> HasLeadingSpace
||
    (Char
'a' forall a. Ord a => a -> a -> HasLeadingSpace
<= Char
c HasLeadingSpace -> HasLeadingSpace -> HasLeadingSpace
&& Char
c forall a. Ord a => a -> a -> HasLeadingSpace
<= Char
'f')

atMost :: Int -> Parser a -> Parser [a]
atMost :: forall a. Int -> Parser a -> Parser [a]
atMost Int
0 Parser a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []
atMost Int
i Parser a
p = (do
    a
c <- Parser a
p
    [a]
s <- forall a. Int -> Parser a -> Parser [a]
atMost (Int
i forall a. Num a => a -> a -> a
- Int
1) Parser a
p
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a
c forall a. a -> [a] -> [a]
: [a]
s) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return []

parseComment :: Parser Content
parseComment :: Parser Content
parseComment = do
    String
_ <- forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"/*"
    String
_ <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar forall a b. (a -> b) -> a -> b
$ forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"*/"
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Content
ContentRaw String
""

luciusFileWithOrd :: Order -> FilePath -> Q Exp
luciusFileWithOrd :: Order -> String -> Q Exp
luciusFileWithOrd Order
order String
fp = do
    String
contents <- String -> Q String
readFileRecompileQ String
fp
    Order -> String -> Q Exp
luciusFromString Order
order String
contents

luciusFileDebugWithOrder :: Order -> FilePath -> Q Exp
luciusFileDebugWithOrder :: Order -> String -> Q Exp
luciusFileDebugWithOrder Order
order =
  HasLeadingSpace
-> Q Exp -> Parser [TopLevel 'Unresolved] -> String -> Q Exp
cssFileDebug HasLeadingSpace
False [|parseTopLevels order|] (Order -> Parser [TopLevel 'Unresolved]
parseTopLevels Order
order)

parseTopLevels :: Order -> Parser [TopLevel 'Unresolved]
parseTopLevels :: Order -> Parser [TopLevel 'Unresolved]
parseTopLevels Order
order =
    ([TopLevel 'Unresolved] -> [TopLevel 'Unresolved])
-> Parser [TopLevel 'Unresolved]
go forall a. a -> a
id
  where
    go :: ([TopLevel 'Unresolved] -> [TopLevel 'Unresolved])
-> Parser [TopLevel 'Unresolved]
go [TopLevel 'Unresolved] -> [TopLevel 'Unresolved]
front = do
        let string' :: String -> ParsecT s u m ()
string' String
s = forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            ignore :: Parser ()
ignore = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Parser ()
whiteSpace1 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {s} {m :: * -> *} {u}.
Stream s m Char =>
String -> ParsecT s u m ()
string' String
"<!--" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {s} {m :: * -> *} {u}.
Stream s m Char =>
String -> ParsecT s u m ()
string' String
"-->")
                        forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Parser ()
ignore
        [TopLevel 'Unresolved]
tl <- ((ParsecT String () Identity (TopLevel 'Unresolved)
charset forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity (TopLevel 'Unresolved)
media forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity (TopLevel 'Unresolved)
impor forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity (TopLevel 'Unresolved)
supports forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity (TopLevel 'Unresolved)
topAtBlock forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {st}. GenParser Char st (TopLevel 'Unresolved)
var forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: Resolved). Block a -> TopLevel a
TopBlock (Order -> Parser (Block 'Unresolved)
parseBlock Order
order)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TopLevel 'Unresolved
x -> ([TopLevel 'Unresolved] -> [TopLevel 'Unresolved])
-> Parser [TopLevel 'Unresolved]
go ([TopLevel 'Unresolved] -> [TopLevel 'Unresolved]
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) TopLevel 'Unresolved
x))
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map TopLevel 'Unresolved -> TopLevel 'Unresolved
compressTopLevel forall a b. (a -> b) -> a -> b
$ [TopLevel 'Unresolved] -> [TopLevel 'Unresolved]
front [])
        Parser ()
ignore
        forall (m :: * -> *) a. Monad m => a -> m a
return [TopLevel 'Unresolved]
tl
    charset :: ParsecT String () Identity (TopLevel 'Unresolved)
charset = do
        forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ String -> Parser ()
stringCI String
"@charset "
        Contents
cs <- String -> Parser Contents
parseContents String
";"
        Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';'
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: Resolved). String -> Str a -> TopLevel a
TopAtDecl String
"charset" Contents
cs
    media :: ParsecT String () Identity (TopLevel 'Unresolved)
media = do
        forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ String -> Parser ()
stringCI String
"@media "
        Contents
selector <- String -> Parser Contents
parseContents String
"{"
        Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
        [Block 'Unresolved]
b <- ([Block 'Unresolved] -> [Block 'Unresolved])
-> ParsecT String () Identity [Block 'Unresolved]
parseBlocks forall a. a -> a
id
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: Resolved). String -> Str a -> [Block a] -> TopLevel a
TopAtBlock String
"media" Contents
selector [Block 'Unresolved]
b
    impor :: ParsecT String () Identity (TopLevel 'Unresolved)
impor = do
        forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ String -> Parser ()
stringCI String
"@import ";
        Contents
val <- String -> Parser Contents
parseContents String
";"
        Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';'
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: Resolved). String -> Str a -> TopLevel a
TopAtDecl String
"import" Contents
val
    supports :: ParsecT String () Identity (TopLevel 'Unresolved)
supports = do
        forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ String -> Parser ()
stringCI String
"@supports "
        Contents
selector <- String -> Parser Contents
parseContents String
"{"
        Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
        [Block 'Unresolved]
b <- ([Block 'Unresolved] -> [Block 'Unresolved])
-> ParsecT String () Identity [Block 'Unresolved]
parseBlocks forall a. a -> a
id
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: Resolved). String -> Str a -> [Block a] -> TopLevel a
TopAtBlock String
"supports" Contents
selector [Block 'Unresolved]
b
    var :: GenParser Char st (TopLevel 'Unresolved)
var = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do
        Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'@'
        HasLeadingSpace
isPage <- (forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"page " forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return HasLeadingSpace
True) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                  (forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"font-face " forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return HasLeadingSpace
True) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                    forall (m :: * -> *) a. Monad m => a -> m a
return HasLeadingSpace
False
        forall (f :: * -> *).
Applicative f =>
HasLeadingSpace -> f () -> f ()
when HasLeadingSpace
isPage forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"page is not a variable"
        String
k <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
":"
        Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
        String
v <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
";"
        Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';'
        let trimS :: String -> String
trimS = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> HasLeadingSpace) -> [a] -> [a]
dropWhile Char -> HasLeadingSpace
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> HasLeadingSpace) -> [a] -> [a]
dropWhile Char -> HasLeadingSpace
isSpace
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> String -> TopLevel 'Unresolved
TopVar (String -> String
trimS String
k) (String -> String
trimS String
v)
    topAtBlock :: ParsecT String () Identity (TopLevel 'Unresolved)
topAtBlock = do
        (String
name, Contents
selector) <- forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do
            Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'@'
            String
name <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
" \t"
            String
_ <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t"
            forall (f :: * -> *).
Applicative f =>
HasLeadingSpace -> f () -> f ()
unless (String
"keyframes" forall a. Eq a => [a] -> [a] -> HasLeadingSpace
`isSuffixOf` String
name) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"only accepting keyframes"
            Contents
selector <- String -> Parser Contents
parseContents String
"{"
            Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
            forall (m :: * -> *) a. Monad m => a -> m a
return (String
name, Contents
selector)
        [Block 'Unresolved]
b <- ([Block 'Unresolved] -> [Block 'Unresolved])
-> ParsecT String () Identity [Block 'Unresolved]
parseBlocks forall a. a -> a
id
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: Resolved). String -> Str a -> [Block a] -> TopLevel a
TopAtBlock String
name Contents
selector [Block 'Unresolved]
b
    parseBlocks :: ([Block 'Unresolved] -> [Block 'Unresolved])
-> ParsecT String () Identity [Block 'Unresolved]
parseBlocks [Block 'Unresolved] -> [Block 'Unresolved]
front = do
        Parser ()
whiteSpace
        (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map Block 'Unresolved -> Block 'Unresolved
compressBlock forall a b. (a -> b) -> a -> b
$ [Block 'Unresolved] -> [Block 'Unresolved]
front []))
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((Order -> Parser (Block 'Unresolved)
parseBlock Order
order) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Block 'Unresolved
x -> ([Block 'Unresolved] -> [Block 'Unresolved])
-> ParsecT String () Identity [Block 'Unresolved]
parseBlocks ([Block 'Unresolved] -> [Block 'Unresolved]
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Block 'Unresolved
x))

stringCI :: String -> Parser ()
stringCI :: String -> Parser ()
stringCI [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
stringCI (Char
c:String
cs) = (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char (Char -> Char
toLower Char
c) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char (Char -> Char
toUpper Char
c)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Parser ()
stringCI String
cs

luciusRTWithOrder'::
     Order -- ^ Should we keep attributes and mixins order or not
  -> TL.Text
  -> Either String ([(Text, Text)] -> Either String [TopLevel 'Resolved])
luciusRTWithOrder' :: Order
-> Text
-> Either
     String ([(Text, Text)] -> Either String [TopLevel 'Resolved])
luciusRTWithOrder' Order
order =
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, RTValue)] -> Either String [TopLevel 'Resolved])
-> [(Text, Text)] -> Either String [TopLevel 'Resolved]
go) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Order
-> Text
-> Either
     String ([(Text, RTValue)] -> Either String [TopLevel 'Resolved])
luciusRTInternal Order
order
  where
    go :: ([(Text, RTValue)] -> Either String [TopLevel 'Resolved])
       -> ([(Text, Text)] -> Either String [TopLevel 'Resolved])
    go :: ([(Text, RTValue)] -> Either String [TopLevel 'Resolved])
-> [(Text, Text)] -> Either String [TopLevel 'Resolved]
go [(Text, RTValue)] -> Either String [TopLevel 'Resolved]
f = [(Text, RTValue)] -> Either String [TopLevel 'Resolved]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> RTValue
RTVRaw)

luciusRTInternal ::
     Order
  -> TL.Text
  -> Either String ([(Text, RTValue)]
  -> Either String [TopLevel 'Resolved])
luciusRTInternal :: Order
-> Text
-> Either
     String ([(Text, RTValue)] -> Either String [TopLevel 'Resolved])
luciusRTInternal Order
order Text
tl =
    case forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (Order -> Parser [TopLevel 'Unresolved]
parseTopLevels Order
order) (Text -> String
TL.unpack Text
tl) (Text -> String
TL.unpack Text
tl) of
        Left ParseError
s -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ParseError
s
        Right [TopLevel 'Unresolved]
tops -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \[(Text, RTValue)]
scope -> [(Text, RTValue)]
-> [TopLevel 'Unresolved] -> Either String [TopLevel 'Resolved]
go [(Text, RTValue)]
scope [TopLevel 'Unresolved]
tops
  where
    go :: [(Text, RTValue)]
       -> [TopLevel 'Unresolved]
       -> Either String [TopLevel 'Resolved]
    go :: [(Text, RTValue)]
-> [TopLevel 'Unresolved] -> Either String [TopLevel 'Resolved]
go [(Text, RTValue)]
_ [] = forall a b. b -> Either a b
Right []
    go [(Text, RTValue)]
scope (TopAtDecl String
dec Str 'Unresolved
cs':[TopLevel 'Unresolved]
rest) = do
        let scope' :: [(Deref, CDData Any)]
scope' = forall a b. (a -> b) -> [a] -> [b]
map forall {url}. (Text, RTValue) -> (Deref, CDData url)
goScope [(Text, RTValue)]
scope
            render :: a
render = forall a. HasCallStack => String -> a
error String
"luciusRT has no URLs"
        [Builder]
cs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall url.
[(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Content
-> Either String Builder
contentToBuilderRT [(Deref, CDData Any)]
scope' forall {a}. a
render) Str 'Unresolved
cs'
        [TopLevel 'Resolved]
rest' <- [(Text, RTValue)]
-> [TopLevel 'Unresolved] -> Either String [TopLevel 'Resolved]
go [(Text, RTValue)]
scope [TopLevel 'Unresolved]
rest
        forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (a :: Resolved). String -> Str a -> TopLevel a
TopAtDecl String
dec (forall a. Monoid a => [a] -> a
mconcat [Builder]
cs) forall a. a -> [a] -> [a]
: [TopLevel 'Resolved]
rest'
    go [(Text, RTValue)]
scope (TopBlock Block 'Unresolved
b:[TopLevel 'Unresolved]
rest) = do
        [Block 'Resolved]
b' <- [(Text, RTValue)]
-> Block 'Unresolved -> Either String [Block 'Resolved]
goBlock [(Text, RTValue)]
scope Block 'Unresolved
b
        [TopLevel 'Resolved]
rest' <- [(Text, RTValue)]
-> [TopLevel 'Unresolved] -> Either String [TopLevel 'Resolved]
go [(Text, RTValue)]
scope [TopLevel 'Unresolved]
rest
        forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (a :: Resolved). Block a -> TopLevel a
TopBlock [Block 'Resolved]
b' forall a. [a] -> [a] -> [a]
++ [TopLevel 'Resolved]
rest'
    go [(Text, RTValue)]
scope (TopAtBlock String
name Str 'Unresolved
m' [Block 'Unresolved]
bs:[TopLevel 'Unresolved]
rest) = do
        let scope' :: [(Deref, CDData Any)]
scope' = forall a b. (a -> b) -> [a] -> [b]
map forall {url}. (Text, RTValue) -> (Deref, CDData url)
goScope [(Text, RTValue)]
scope
            render :: a
render = forall a. HasCallStack => String -> a
error String
"luciusRT has no URLs"
        [Builder]
m <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall url.
[(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Content
-> Either String Builder
contentToBuilderRT [(Deref, CDData Any)]
scope' forall {a}. a
render) Str 'Unresolved
m'
        [[Block 'Resolved]]
bs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([(Text, RTValue)]
-> Block 'Unresolved -> Either String [Block 'Resolved]
goBlock [(Text, RTValue)]
scope) [Block 'Unresolved]
bs
        [TopLevel 'Resolved]
rest' <- [(Text, RTValue)]
-> [TopLevel 'Unresolved] -> Either String [TopLevel 'Resolved]
go [(Text, RTValue)]
scope [TopLevel 'Unresolved]
rest
        forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (a :: Resolved). String -> Str a -> [Block a] -> TopLevel a
TopAtBlock String
name (forall a. Monoid a => [a] -> a
mconcat [Builder]
m) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Block 'Resolved]]
bs') forall a. a -> [a] -> [a]
: [TopLevel 'Resolved]
rest'
    go [(Text, RTValue)]
scope (TopVar String
k String
v:[TopLevel 'Unresolved]
rest) = [(Text, RTValue)]
-> [TopLevel 'Unresolved] -> Either String [TopLevel 'Resolved]
go ((String -> Text
pack String
k, Text -> RTValue
RTVRaw forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
v)forall a. a -> [a] -> [a]
:[(Text, RTValue)]
scope) [TopLevel 'Unresolved]
rest

    goBlock :: [(Text, RTValue)]
            -> Block 'Unresolved
            -> Either String [Block 'Resolved]
    goBlock :: [(Text, RTValue)]
-> Block 'Unresolved -> Either String [Block 'Resolved]
goBlock [(Text, RTValue)]
scope =
        forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ [])) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall url.
[(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Block 'Unresolved
-> Either String ([Block 'Resolved] -> [Block 'Resolved])
blockRuntime [(Deref, CDData Any)]
scope' (forall a. HasCallStack => String -> a
error String
"luciusRT has no URLs")
      where
        scope' :: [(Deref, CDData Any)]
scope' = forall a b. (a -> b) -> [a] -> [b]
map forall {url}. (Text, RTValue) -> (Deref, CDData url)
goScope [(Text, RTValue)]
scope

    goScope :: (Text, RTValue) -> (Deref, CDData url)
goScope (Text
k, RTValue
rt) =
        (Ident -> Deref
DerefIdent (String -> Ident
Ident forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
k), CDData url
cd)
      where
        cd :: CDData url
cd =
            case RTValue
rt of
                RTVRaw Text
t -> forall url. Builder -> CDData url
CDPlain forall a b. (a -> b) -> a -> b
$ Text -> Builder
fromText Text
t
                RTVMixin Mixin
m -> forall url. Mixin -> CDData url
CDMixin Mixin
m

luciusRTWithOrder :: Order -> TL.Text -> [(Text, Text)] -> Either String TL.Text
luciusRTWithOrder :: Order -> Text -> [(Text, Text)] -> Either String Text
luciusRTWithOrder Order
order Text
tl [(Text, Text)]
scope =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css -> Text
renderCss forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TopLevel 'Resolved] -> Css
CssWhitespace) forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
scope) (Order
-> Text
-> Either
     String ([(Text, Text)] -> Either String [TopLevel 'Resolved])
luciusRTWithOrder' Order
order Text
tl)

luciusRTMixinWithOrder ::
     Order
  -> TL.Text -- ^ template
  -> Bool -- ^ minify?
  -> [(Text, RTValue)] -- ^ scope
  -> Either String TL.Text
luciusRTMixinWithOrder :: Order
-> Text
-> HasLeadingSpace
-> [(Text, RTValue)]
-> Either String Text
luciusRTMixinWithOrder Order
order Text
tl HasLeadingSpace
minify [(Text, RTValue)]
scope =
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css -> Text
renderCss forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TopLevel 'Resolved] -> Css
cw) forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. (a -> b) -> a -> b
$ [(Text, RTValue)]
scope) (Order
-> Text
-> Either
     String ([(Text, RTValue)] -> Either String [TopLevel 'Resolved])
luciusRTInternal Order
order Text
tl)
  where
    cw :: [TopLevel 'Resolved] -> Css
cw | HasLeadingSpace
minify = [TopLevel 'Resolved] -> Css
CssNoWhitespace
       | HasLeadingSpace
otherwise = [TopLevel 'Resolved] -> Css
CssWhitespace

data RTValue = RTVRaw Text
             | RTVMixin Mixin

luciusRTMinifiedWithOrder :: Order -> TL.Text -> [(Text, Text)] -> Either String TL.Text
luciusRTMinifiedWithOrder :: Order -> Text -> [(Text, Text)] -> Either String Text
luciusRTMinifiedWithOrder Order
order Text
tl [(Text, Text)]
scope =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css -> Text
renderCss forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TopLevel 'Resolved] -> Css
CssNoWhitespace) forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
scope) (Order
-> Text
-> Either
     String ([(Text, Text)] -> Either String [TopLevel 'Resolved])
luciusRTWithOrder' Order
order Text
tl)

-- | Determine which identifiers are used by the given template, useful for
-- creating systems like yesod devel.
luciusUsedIdentifiers :: Order -> String -> [(Deref, VarType)]
luciusUsedIdentifiers :: Order -> String -> [(Deref, VarType)]
luciusUsedIdentifiers Order
order = HasLeadingSpace
-> Parser [TopLevel 'Unresolved] -> String -> [(Deref, VarType)]
cssUsedIdentifiers HasLeadingSpace
False (Order -> Parser [TopLevel 'Unresolved]
parseTopLevels Order
order)

luciusMixinWithOrder :: Order -> QuasiQuoter
luciusMixinWithOrder :: Order -> QuasiQuoter
luciusMixinWithOrder Order
order = QuasiQuoter { quoteExp :: String -> Q Exp
quoteExp = Order -> String -> Q Exp
luciusMixinFromString Order
order}

luciusMixinFromString :: Order -> String -> Q Exp
luciusMixinFromString :: Order -> String -> Q Exp
luciusMixinFromString Order
order String
s' = do
    Name
r <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"_render"
    case forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Block 'Unresolved -> Block 'Unresolved
compressBlock forall a b. (a -> b) -> a -> b
$ forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (Order -> Parser (Block 'Unresolved)
parseBlock Order
order) String
s String
s of
        Left ParseError
e -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ParseError
e
        Right Block 'Unresolved
block -> Name -> Scope -> Block 'Unresolved -> Q Exp
blockToMixin Name
r [] Block 'Unresolved
block
  where
    s :: String
s = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"mixin{", String
s', String
"}"]