{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
module Text.Lucius
    ( -- * Parsing
      lucius
    , luciusFile
    , luciusFileDebug
    , luciusFileReload
      -- ** Mixins
    , luciusMixin
    , Mixin
      -- ** Runtime
    , luciusRT
    , luciusRT'
    , luciusRTMinified
      -- *** Mixin
    , luciusRTMixin
    , RTValue (..)
    , -- * Datatypes
      Css
    , CssUrl
      -- * Type class
    , ToCss (..)
      -- * Rendering
    , renderCss
    , renderCssUrl
      -- * ToCss instances
      -- ** Color
    , Color (..)
    , colorRed
    , colorBlack
      -- ** Size
    , mkSize
    , AbsoluteUnit (..)
    , AbsoluteSize (..)
    , absoluteSize
    , EmSize (..)
    , ExSize (..)
    , PercentageSize (..)
    , percentageSize
    , PixelSize (..)
      -- * Internal
    , parseTopLevels
    , luciusUsedIdentifiers
    ) where

import Text.Internal.CssCommon
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.Applicative ((<$>))
import Control.Monad (when, unless)
import Data.Monoid (mconcat)
import Data.List (isSuffixOf)
import Control.Arrow (second)
import Text.Shakespeare (VarType)

-- |
--
-- >>> renderCss ([lucius|foo{bar:baz}|] undefined)
-- "foo{bar:baz}"
lucius :: QuasiQuoter
lucius :: QuasiQuoter
lucius = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter { quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
luciusFromString }

luciusFromString :: String -> Q Exp
luciusFromString :: String -> Q Exp
luciusFromString String
s =
    [TopLevel Unresolved] -> Q Exp
topLevelsToCassius
  ([TopLevel Unresolved] -> Q Exp) -> [TopLevel Unresolved] -> Q Exp
forall a b. (a -> b) -> a -> b
$ (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
$ Parsec String () [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 Parsec String () [TopLevel Unresolved]
parseTopLevels String
s String
s

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

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

parseBlock :: Parser (Block Unresolved)
parseBlock :: Parser (Block Unresolved)
parseBlock = do
    [Contents]
sel <- ParsecT String () Identity [Contents]
Parser (Selector Unresolved)
parseSelector
    Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
    Parser ()
whiteSpace
    [PairBlock]
pairsBlocks <- ([PairBlock] -> [PairBlock]) -> Parser [PairBlock]
parsePairsBlocks [PairBlock] -> [PairBlock]
forall a. a -> a
id
    let ([Attr Unresolved]
pairs, [Block Unresolved]
blocks, [Deref]
mixins) = [PairBlock] -> ([Attr Unresolved], [Block Unresolved], [Deref])
partitionPBs [PairBlock]
pairsBlocks
    Parser ()
whiteSpace
    Block Unresolved -> Parser (Block Unresolved)
forall (m :: * -> *) a. Monad m => a -> m a
return (Block Unresolved -> Parser (Block Unresolved))
-> Block Unresolved -> Parser (Block Unresolved)
forall a b. (a -> b) -> a -> b
$ Selector Unresolved
-> [Attr Unresolved]
-> ChildBlocks Unresolved
-> Mixins Unresolved
-> Block Unresolved
forall a.
Selector a -> [Attr a] -> ChildBlocks a -> Mixins a -> Block a
Block [Contents]
Selector Unresolved
sel [Attr Unresolved]
pairs ((Block Unresolved -> (Bool, Block Unresolved))
-> [Block Unresolved] -> [(Bool, Block Unresolved)]
forall a b. (a -> b) -> [a] -> [b]
map Block Unresolved -> (Bool, Block Unresolved)
detectAmp [Block Unresolved]
blocks) [Deref]
Mixins Unresolved
mixins

-- | 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 -> (Bool, Block Unresolved)
detectAmp (Block (Selector Unresolved
sel) [Attr Unresolved]
b ChildBlocks Unresolved
c Mixins Unresolved
d) =
    (Bool
hls, Selector Unresolved
-> [Attr Unresolved]
-> ChildBlocks Unresolved
-> Mixins Unresolved
-> Block Unresolved
forall a.
Selector a -> [Attr a] -> ChildBlocks a -> Mixins a -> Block a
Block [Contents]
Selector Unresolved
sel' [Attr Unresolved]
b ChildBlocks Unresolved
c Mixins Unresolved
d)
  where
    (Bool
hls, [Contents]
sel') =
        case Selector Unresolved
sel of
            (ContentRaw "&":rest):others -> (Bool
False, Contents
rest Contents -> [Contents] -> [Contents]
forall a. a -> [a] -> [a]
: [Contents]
others)
            (ContentRaw ('&':s):rest):others -> (Bool
False, (String -> Content
ContentRaw String
s Content -> Contents -> Contents
forall a. a -> [a] -> [a]
: Contents
rest) Contents -> [Contents] -> [Contents]
forall a. a -> [a] -> [a]
: [Contents]
others)
            Selector Unresolved
_ -> (Bool
True, [Contents]
Selector Unresolved
sel)

partitionPBs :: [PairBlock] -> ([Attr Unresolved], [Block Unresolved], [Deref])
partitionPBs :: [PairBlock] -> ([Attr Unresolved], [Block Unresolved], [Deref])
partitionPBs =
    ([Attr Unresolved] -> [Attr Unresolved])
-> ([Block Unresolved] -> [Block Unresolved])
-> ([Deref] -> [Deref])
-> [PairBlock]
-> ([Attr Unresolved], [Block Unresolved], [Deref])
forall c c c.
([Attr Unresolved] -> c)
-> ([Block Unresolved] -> c)
-> ([Deref] -> c)
-> [PairBlock]
-> (c, c, c)
go [Attr Unresolved] -> [Attr Unresolved]
forall a. a -> a
id [Block Unresolved] -> [Block Unresolved]
forall a. a -> a
id [Deref] -> [Deref]
forall a. a -> a
id
  where
    go :: ([Attr Unresolved] -> c)
-> ([Block Unresolved] -> c)
-> ([Deref] -> c)
-> [PairBlock]
-> (c, c, c)
go [Attr Unresolved] -> c
a [Block Unresolved] -> c
b [Deref] -> c
c [] = ([Attr Unresolved] -> c
a [], [Block Unresolved] -> c
b [], [Deref] -> c
c [])
    go [Attr Unresolved] -> c
a [Block Unresolved] -> c
b [Deref] -> c
c (PBAttr Attr Unresolved
x:[PairBlock]
xs) = ([Attr Unresolved] -> c)
-> ([Block Unresolved] -> c)
-> ([Deref] -> c)
-> [PairBlock]
-> (c, c, c)
go ([Attr Unresolved] -> c
a ([Attr Unresolved] -> c)
-> ([Attr Unresolved] -> [Attr Unresolved])
-> [Attr Unresolved]
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attr Unresolved
xAttr Unresolved -> [Attr Unresolved] -> [Attr Unresolved]
forall a. a -> [a] -> [a]
:)) [Block Unresolved] -> c
b [Deref] -> c
c [PairBlock]
xs
    go [Attr Unresolved] -> c
a [Block Unresolved] -> c
b [Deref] -> c
c (PBBlock Block Unresolved
x:[PairBlock]
xs) = ([Attr Unresolved] -> c)
-> ([Block Unresolved] -> c)
-> ([Deref] -> c)
-> [PairBlock]
-> (c, c, c)
go [Attr Unresolved] -> c
a ([Block Unresolved] -> c
b ([Block Unresolved] -> c)
-> ([Block Unresolved] -> [Block Unresolved])
-> [Block Unresolved]
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block Unresolved
xBlock Unresolved -> [Block Unresolved] -> [Block Unresolved]
forall a. a -> [a] -> [a]
:)) [Deref] -> c
c [PairBlock]
xs
    go [Attr Unresolved] -> c
a [Block Unresolved] -> c
b [Deref] -> c
c (PBMixin Deref
x:[PairBlock]
xs) = ([Attr Unresolved] -> c)
-> ([Block Unresolved] -> c)
-> ([Deref] -> c)
-> [PairBlock]
-> (c, c, c)
go [Attr Unresolved] -> c
a [Block Unresolved] -> c
b ([Deref] -> c
c ([Deref] -> c) -> ([Deref] -> [Deref]) -> [Deref] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Deref
xDeref -> [Deref] -> [Deref]
forall a. a -> [a] -> [a]
:)) [PairBlock]
xs

parseSelector :: Parser (Selector Unresolved)
parseSelector :: Parser (Selector Unresolved)
parseSelector =
    ([Contents] -> [Contents]) -> ParsecT String () Identity [Contents]
forall b. ([Contents] -> b) -> ParsecT String () Identity b
go [Contents] -> [Contents]
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 ([Contents] -> b) -> ([Contents] -> [Contents]) -> [Contents] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) (Contents -> Contents
trim Contents
c)
        (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',' ParsecT String () Identity Char
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Contents] -> b) -> ParsecT String () Identity b
go [Contents] -> b
front') ParsecT String () Identity b
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> b -> ParsecT String () Identity b
forall (m :: * -> *) a. Monad m => a -> m a
return ([Contents] -> b
front' [])

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

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

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

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

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

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

parseComment :: Parser Content
parseComment :: Parser Content
parseComment = do
    String
_ <- Parser String -> Parser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Parser String -> Parser String) -> Parser String -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"/*"
    String
_ <- ParsecT String () Identity Char -> Parser String -> Parser 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 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (Parser String -> Parser String) -> Parser String -> Parser String
forall a b. (a -> b) -> a -> b
$ Parser String -> Parser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Parser String -> Parser String) -> Parser String -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"*/"
    Content -> Parser Content
forall (m :: * -> *) a. Monad m => a -> m a
return (Content -> Parser Content) -> Content -> Parser Content
forall a b. (a -> b) -> a -> b
$ String -> Content
ContentRaw String
""

luciusFile :: FilePath -> Q Exp
luciusFile :: String -> Q Exp
luciusFile String
fp = do
    String
contents <- String -> Q String
readFileRecompileQ String
fp
    String -> Q Exp
luciusFromString String
contents

luciusFileDebug, luciusFileReload :: FilePath -> Q Exp
luciusFileDebug :: String -> Q Exp
luciusFileDebug = Bool
-> Q Exp
-> Parsec String () [TopLevel Unresolved]
-> String
-> Q Exp
cssFileDebug Bool
False [|parseTopLevels|] Parsec String () [TopLevel Unresolved]
parseTopLevels
luciusFileReload :: String -> Q Exp
luciusFileReload = String -> Q Exp
luciusFileDebug

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

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

luciusRT' :: TL.Text
          -> Either String ([(Text, Text)] -> Either String [TopLevel Resolved])
luciusRT' :: Text
-> Either
     String ([(Text, Text)] -> Either String [TopLevel Resolved])
luciusRT' =
    (String
 -> Either
      String ([(Text, Text)] -> Either String [TopLevel Resolved]))
-> (([(Text, RTValue)] -> Either String [TopLevel Resolved])
    -> Either
         String ([(Text, Text)] -> Either String [TopLevel Resolved]))
-> Either
     String ([(Text, RTValue)] -> Either String [TopLevel Resolved])
-> Either
     String ([(Text, Text)] -> Either String [TopLevel Resolved])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String
-> Either
     String ([(Text, Text)] -> Either String [TopLevel Resolved])
forall a b. a -> Either a b
Left (([(Text, Text)] -> Either String [TopLevel Resolved])
-> Either
     String ([(Text, Text)] -> Either String [TopLevel Resolved])
forall a b. b -> Either a b
Right (([(Text, Text)] -> Either String [TopLevel Resolved])
 -> Either
      String ([(Text, Text)] -> Either String [TopLevel Resolved]))
-> (([(Text, RTValue)] -> Either String [TopLevel Resolved])
    -> [(Text, Text)] -> Either String [TopLevel Resolved])
-> ([(Text, RTValue)] -> Either String [TopLevel Resolved])
-> Either
     String ([(Text, Text)] -> Either String [TopLevel Resolved])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, RTValue)] -> Either String [TopLevel Resolved])
-> [(Text, Text)] -> Either String [TopLevel Resolved]
go) (Either
   String ([(Text, RTValue)] -> Either String [TopLevel Resolved])
 -> Either
      String ([(Text, Text)] -> Either String [TopLevel Resolved]))
-> (Text
    -> Either
         String ([(Text, RTValue)] -> Either String [TopLevel Resolved]))
-> Text
-> Either
     String ([(Text, Text)] -> Either String [TopLevel Resolved])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Either
     String ([(Text, RTValue)] -> Either String [TopLevel Resolved])
luciusRTInternal
  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 ([(Text, RTValue)] -> Either String [TopLevel Resolved])
-> ([(Text, Text)] -> [(Text, RTValue)])
-> [(Text, Text)]
-> Either String [TopLevel Resolved]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> (Text, RTValue))
-> [(Text, Text)] -> [(Text, RTValue)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> RTValue) -> (Text, Text) -> (Text, RTValue)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> RTValue
RTVRaw)

luciusRTInternal
    :: TL.Text
    -> Either String ([(Text, RTValue)] -> Either String [TopLevel Resolved])
luciusRTInternal :: Text
-> Either
     String ([(Text, RTValue)] -> Either String [TopLevel Resolved])
luciusRTInternal Text
tl =
    case Parsec String () [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 Parsec String () [TopLevel Unresolved]
parseTopLevels (Text -> String
TL.unpack Text
tl) (Text -> String
TL.unpack Text
tl) of
        Left ParseError
s -> String
-> Either
     String ([(Text, RTValue)] -> Either String [TopLevel Resolved])
forall a b. a -> Either a b
Left (String
 -> Either
      String ([(Text, RTValue)] -> Either String [TopLevel Resolved]))
-> String
-> Either
     String ([(Text, RTValue)] -> Either String [TopLevel Resolved])
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
s
        Right [TopLevel Unresolved]
tops -> ([(Text, RTValue)] -> Either String [TopLevel Resolved])
-> Either
     String ([(Text, RTValue)] -> Either String [TopLevel Resolved])
forall a b. b -> Either a b
Right (([(Text, RTValue)] -> Either String [TopLevel Resolved])
 -> Either
      String ([(Text, RTValue)] -> Either String [TopLevel Resolved]))
-> ([(Text, RTValue)] -> Either String [TopLevel Resolved])
-> Either
     String ([(Text, RTValue)] -> Either String [TopLevel Resolved])
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)]
_ [] = [TopLevel Resolved] -> Either String [TopLevel Resolved]
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' = ((Text, RTValue) -> (Deref, CDData Any))
-> [(Text, RTValue)] -> [(Deref, CDData Any)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, RTValue) -> (Deref, CDData Any)
forall url. (Text, RTValue) -> (Deref, CDData url)
goScope [(Text, RTValue)]
scope
            render :: a
render = String -> a
forall a. HasCallStack => String -> a
error String
"luciusRT has no URLs"
        [Builder]
cs <- (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)
mapM ([(Deref, CDData Any)]
-> (Any -> [(Text, Text)] -> Text)
-> Content
-> Either String Builder
forall url.
[(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Content
-> Either String Builder
contentToBuilderRT [(Deref, CDData Any)]
scope' Any -> [(Text, Text)] -> Text
forall a. a
render) Contents
Str Unresolved
cs'
        [TopLevel Resolved]
rest' <- [(Text, RTValue)]
-> [TopLevel Unresolved] -> Either String [TopLevel Resolved]
go [(Text, RTValue)]
scope [TopLevel Unresolved]
rest
        [TopLevel Resolved] -> Either String [TopLevel Resolved]
forall a b. b -> Either a b
Right ([TopLevel Resolved] -> Either String [TopLevel Resolved])
-> [TopLevel Resolved] -> Either String [TopLevel Resolved]
forall a b. (a -> b) -> a -> b
$ String -> Str Resolved -> TopLevel Resolved
forall a. String -> Str a -> TopLevel a
TopAtDecl String
dec ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
cs) TopLevel Resolved -> [TopLevel Resolved] -> [TopLevel Resolved]
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
        [TopLevel Resolved] -> Either String [TopLevel Resolved]
forall a b. b -> Either a b
Right ([TopLevel Resolved] -> Either String [TopLevel Resolved])
-> [TopLevel Resolved] -> Either String [TopLevel Resolved]
forall a b. (a -> b) -> a -> b
$ (Block Resolved -> TopLevel Resolved)
-> [Block Resolved] -> [TopLevel Resolved]
forall a b. (a -> b) -> [a] -> [b]
map Block Resolved -> TopLevel Resolved
forall a. Block a -> TopLevel a
TopBlock [Block Resolved]
b' [TopLevel Resolved] -> [TopLevel Resolved] -> [TopLevel Resolved]
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' = ((Text, RTValue) -> (Deref, CDData Any))
-> [(Text, RTValue)] -> [(Deref, CDData Any)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, RTValue) -> (Deref, CDData Any)
forall url. (Text, RTValue) -> (Deref, CDData url)
goScope [(Text, RTValue)]
scope
            render :: a
render = String -> a
forall a. HasCallStack => String -> a
error String
"luciusRT has no URLs"
        [Builder]
m <- (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)
mapM ([(Deref, CDData Any)]
-> (Any -> [(Text, Text)] -> Text)
-> Content
-> Either String Builder
forall url.
[(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Content
-> Either String Builder
contentToBuilderRT [(Deref, CDData Any)]
scope' Any -> [(Text, Text)] -> Text
forall a. a
render) Contents
Str Unresolved
m'
        [[Block Resolved]]
bs' <- (Block Unresolved -> Either String [Block Resolved])
-> [Block Unresolved] -> Either String [[Block Resolved]]
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
        [TopLevel Resolved] -> Either String [TopLevel Resolved]
forall a b. b -> Either a b
Right ([TopLevel Resolved] -> Either String [TopLevel Resolved])
-> [TopLevel Resolved] -> Either String [TopLevel Resolved]
forall a b. (a -> b) -> a -> b
$ String -> Str Resolved -> [Block Resolved] -> TopLevel Resolved
forall a. String -> Str a -> [Block a] -> TopLevel a
TopAtBlock String
name ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
m) ([[Block Resolved]] -> [Block Resolved]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Block Resolved]]
bs') TopLevel Resolved -> [TopLevel Resolved] -> [TopLevel Resolved]
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 (Text -> RTValue) -> Text -> RTValue
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
v)(Text, RTValue) -> [(Text, RTValue)] -> [(Text, RTValue)]
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 =
        (String -> Either String [Block Resolved])
-> (([Block Resolved] -> [Block Resolved])
    -> Either String [Block Resolved])
-> Either String ([Block Resolved] -> [Block Resolved])
-> Either String [Block Resolved]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String [Block Resolved]
forall a b. a -> Either a b
Left ([Block Resolved] -> Either String [Block Resolved]
forall a b. b -> Either a b
Right ([Block Resolved] -> Either String [Block Resolved])
-> (([Block Resolved] -> [Block Resolved]) -> [Block Resolved])
-> ([Block Resolved] -> [Block Resolved])
-> Either String [Block Resolved]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Block Resolved] -> [Block Resolved])
-> [Block Resolved] -> [Block Resolved]
forall a b. (a -> b) -> a -> b
$ [])) (Either String ([Block Resolved] -> [Block Resolved])
 -> Either String [Block Resolved])
-> (Block Unresolved
    -> Either String ([Block Resolved] -> [Block Resolved]))
-> Block Unresolved
-> Either String [Block Resolved]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Deref, CDData Any)]
-> (Any -> [(Text, Text)] -> Text)
-> Block Unresolved
-> Either String ([Block Resolved] -> [Block Resolved])
forall url.
[(Deref, CDData url)]
-> (url -> [(Text, Text)] -> Text)
-> Block Unresolved
-> Either String ([Block Resolved] -> [Block Resolved])
blockRuntime [(Deref, CDData Any)]
scope' (String -> Any -> [(Text, Text)] -> Text
forall a. HasCallStack => String -> a
error String
"luciusRT has no URLs")
      where
        scope' :: [(Deref, CDData Any)]
scope' = ((Text, RTValue) -> (Deref, CDData Any))
-> [(Text, RTValue)] -> [(Deref, CDData Any)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, RTValue) -> (Deref, CDData Any)
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 (String -> Ident) -> String -> 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 -> Builder -> CDData url
forall url. Builder -> CDData url
CDPlain (Builder -> CDData url) -> Builder -> CDData url
forall a b. (a -> b) -> a -> b
$ Text -> Builder
fromText Text
t
                RTVMixin Mixin
m -> Mixin -> CDData url
forall url. Mixin -> CDData url
CDMixin Mixin
m

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

-- | Runtime Lucius with mixin support.
--
-- Since 1.0.6
luciusRTMixin :: TL.Text -- ^ template
              -> Bool -- ^ minify?
              -> [(Text, RTValue)] -- ^ scope
              -> Either String TL.Text
luciusRTMixin :: Text -> Bool -> [(Text, RTValue)] -> Either String Text
luciusRTMixin Text
tl Bool
minify [(Text, RTValue)]
scope =
    (String -> Either String Text)
-> ([TopLevel Resolved] -> Either String Text)
-> Either String [TopLevel Resolved]
-> Either String Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String Text
forall a b. a -> Either a b
Left (Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text)
-> ([TopLevel Resolved] -> Text)
-> [TopLevel Resolved]
-> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css -> Text
renderCss (Css -> Text)
-> ([TopLevel Resolved] -> Css) -> [TopLevel Resolved] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TopLevel Resolved] -> Css
cw) (Either String [TopLevel Resolved] -> Either String Text)
-> Either String [TopLevel Resolved] -> Either String Text
forall a b. (a -> b) -> a -> b
$ (String -> Either String [TopLevel Resolved])
-> (([(Text, RTValue)] -> Either String [TopLevel Resolved])
    -> Either String [TopLevel Resolved])
-> Either
     String ([(Text, RTValue)] -> Either String [TopLevel Resolved])
-> Either String [TopLevel Resolved]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String [TopLevel Resolved]
forall a b. a -> Either a b
Left (([(Text, RTValue)] -> Either String [TopLevel Resolved])
-> [(Text, RTValue)] -> Either String [TopLevel Resolved]
forall a b. (a -> b) -> a -> b
$ [(Text, RTValue)]
scope) (Text
-> Either
     String ([(Text, RTValue)] -> Either String [TopLevel Resolved])
luciusRTInternal Text
tl)
  where
    cw :: [TopLevel Resolved] -> Css
cw
        | Bool
minify = [TopLevel Resolved] -> Css
CssNoWhitespace
        | Bool
otherwise = [TopLevel Resolved] -> Css
CssWhitespace

data RTValue = RTVRaw Text
             | RTVMixin Mixin

-- | Same as 'luciusRT', but output has no added whitespace.
--
-- Since 1.0.3
luciusRTMinified :: TL.Text -> [(Text, Text)] -> Either String TL.Text
luciusRTMinified :: Text -> [(Text, Text)] -> Either String Text
luciusRTMinified Text
tl [(Text, Text)]
scope = (String -> Either String Text)
-> ([TopLevel Resolved] -> Either String Text)
-> Either String [TopLevel Resolved]
-> Either String Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String Text
forall a b. a -> Either a b
Left (Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text)
-> ([TopLevel Resolved] -> Text)
-> [TopLevel Resolved]
-> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css -> Text
renderCss (Css -> Text)
-> ([TopLevel Resolved] -> Css) -> [TopLevel Resolved] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TopLevel Resolved] -> Css
CssNoWhitespace) (Either String [TopLevel Resolved] -> Either String Text)
-> Either String [TopLevel Resolved] -> Either String Text
forall a b. (a -> b) -> a -> b
$ (String -> Either String [TopLevel Resolved])
-> (([(Text, Text)] -> Either String [TopLevel Resolved])
    -> Either String [TopLevel Resolved])
-> Either
     String ([(Text, Text)] -> Either String [TopLevel Resolved])
-> Either String [TopLevel Resolved]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String [TopLevel Resolved]
forall a b. a -> Either a b
Left (([(Text, Text)] -> Either String [TopLevel Resolved])
-> [(Text, Text)] -> Either String [TopLevel Resolved]
forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
scope) (Text
-> Either
     String ([(Text, Text)] -> Either String [TopLevel Resolved])
luciusRT' Text
tl)

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

luciusMixin :: QuasiQuoter
luciusMixin :: QuasiQuoter
luciusMixin = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter { quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
luciusMixinFromString }

luciusMixinFromString :: String -> Q Exp
luciusMixinFromString :: String -> Q Exp
luciusMixinFromString String
s' = do
    Name
r <- String -> Q Name
newName String
"_render"
    case (Block Unresolved -> Block Unresolved)
-> Either ParseError (Block Unresolved)
-> Either ParseError (Block Unresolved)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Block Unresolved -> Block Unresolved
compressBlock (Either ParseError (Block Unresolved)
 -> Either ParseError (Block Unresolved))
-> Either ParseError (Block Unresolved)
-> Either ParseError (Block Unresolved)
forall a b. (a -> b) -> a -> b
$ Parser (Block Unresolved)
-> String -> String -> Either ParseError (Block Unresolved)
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parser (Block Unresolved)
parseBlock String
s String
s of
        Left ParseError
e -> String -> Q Exp
forall a. HasCallStack => String -> a
error (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ ParseError -> String
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 = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"mixin{", String
s', String
"}"]