{-# 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 :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
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
  ([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 (Order -> Parsec String () [TopLevel 'Unresolved]
parseTopLevels Order
order) 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 :: Order -> Parser (Block 'Unresolved)
parseBlock :: Order -> Parser (Block 'Unresolved)
parseBlock Order
order = do
    [Contents]
sel <- Parser [Contents]
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 <- Order -> ([PairBlock] -> [PairBlock]) -> Parser [PairBlock]
parsePairsBlocks Order
order [PairBlock] -> [PairBlock]
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
    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
$ [Contents]
-> [Either (Attr 'Unresolved) Deref]
-> [(HasLeadingSpace, Block 'Unresolved)]
-> Block 'Unresolved
BlockUnresolved [Contents]
sel [Either (Attr 'Unresolved) Deref]
attrs ((Block 'Unresolved -> (HasLeadingSpace, Block 'Unresolved))
-> [Block 'Unresolved] -> [(HasLeadingSpace, Block 'Unresolved)]
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 Contents -> [Contents] -> [Contents]
forall a. a -> [a] -> [a]
: [Contents]
others)
            (ContentRaw (Char
'&':String
s):Contents
rest):[Contents]
others -> (HasLeadingSpace
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)
            [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 [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
forall a. a -> a
id [Block 'Unresolved] -> [Block 'Unresolved]
forall a. a -> a
id [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
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 ([Either (Attr 'Unresolved) Deref]
 -> [Either (Attr 'Unresolved) Deref])
-> [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
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 ([Either (Attr 'Unresolved) Deref]
 -> [Either (Attr 'Unresolved) Deref])
-> ([Either (Attr 'Unresolved) Deref]
    -> [Either (Attr 'Unresolved) Deref])
-> [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Attr 'Unresolved -> Either (Attr 'Unresolved) Deref
forall a b. a -> Either a b
Left Attr 'Unresolved
x)Either (Attr 'Unresolved) Deref
-> [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
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 ([Block 'Unresolved] -> [Block 'Unresolved])
-> ([Block 'Unresolved] -> [Block 'Unresolved])
-> [Block 'Unresolved]
-> [Block 'Unresolved]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block 'Unresolved
xBlock 'Unresolved -> [Block 'Unresolved] -> [Block 'Unresolved]
forall 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 ([Either (Attr 'Unresolved) Deref]
 -> [Either (Attr 'Unresolved) Deref])
-> ([Either (Attr 'Unresolved) Deref]
    -> [Either (Attr 'Unresolved) Deref])
-> [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Deref -> Either (Attr 'Unresolved) Deref
forall a b. b -> Either a b
Right Deref
x)Either (Attr 'Unresolved) Deref
-> [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
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 ([Either (Attr 'Unresolved) Deref]
 -> [Either (Attr 'Unresolved) Deref])
-> ([Either (Attr 'Unresolved) Deref]
    -> [Either (Attr 'Unresolved) Deref])
-> [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Deref -> Either (Attr 'Unresolved) Deref
forall a b. b -> Either a b
Right Deref
xEither (Attr 'Unresolved) Deref
-> [Either (Attr 'Unresolved) Deref]
-> [Either (Attr 'Unresolved) Deref]
forall a. a -> [a] -> [a]
:)) [PairBlock]
xs

parseSelector :: Parser [Contents]
parseSelector :: Parser [Contents]
parseSelector =
    ([Contents] -> [Contents]) -> Parser [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
. HasLeadingSpace -> Contents -> Contents
trim' HasLeadingSpace
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
. 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 String -> HasLeadingSpace
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' Content -> Contents -> Contents
forall a. a -> [a] -> [a]
: Contents
rest
    trim' HasLeadingSpace
_ Contents
x = Contents
x
    trimS :: HasLeadingSpace -> String -> String
trimS HasLeadingSpace
True = (Char -> HasLeadingSpace) -> String -> String
forall a. (a -> HasLeadingSpace) -> [a] -> [a]
dropWhile Char -> HasLeadingSpace
isSpace
    trimS HasLeadingSpace
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 -> HasLeadingSpace) -> String -> String
forall a. (a -> HasLeadingSpace) -> [a] -> [a]
dropWhile Char -> HasLeadingSpace
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 :: Order -> ([PairBlock] -> [PairBlock]) -> Parser [PairBlock]
parsePairsBlocks :: Order -> ([PairBlock] -> [PairBlock]) -> Parser [PairBlock]
parsePairsBlocks Order
order [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
    HasLeadingSpace
isBlock <- ParsecT String () Identity HasLeadingSpace
-> ParsecT String () Identity HasLeadingSpace
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT String () Identity HasLeadingSpace
forall u. ParsecT String u Identity HasLeadingSpace
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 HasLeadingSpace
isBlock then GenParser Char () PairBlock
grabBlock else GenParser Char () PairBlock
grabPair)
    Order -> ([PairBlock] -> [PairBlock]) -> Parser [PairBlock]
parsePairsBlocks Order
order (([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 <- Order -> Parser (Block 'Unresolved)
parseBlock Order
order
        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 HasLeadingSpace
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 HasLeadingSpace
-> ParsecT String u Identity HasLeadingSpace
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity HasLeadingSpace
checkIfBlock)
            ParsecT String u Identity HasLeadingSpace
-> ParsecT String u Identity HasLeadingSpace
-> ParsecT String u Identity HasLeadingSpace
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, HasLeadingSpace))
forall a. UserParser a (Either String (Deref, HasLeadingSpace))
parseAt UserParser u (Either String (Deref, HasLeadingSpace))
-> ParsecT String u Identity HasLeadingSpace
-> ParsecT String u Identity HasLeadingSpace
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity HasLeadingSpace
checkIfBlock)
            ParsecT String u Identity HasLeadingSpace
-> ParsecT String u Identity HasLeadingSpace
-> ParsecT String u Identity HasLeadingSpace
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 HasLeadingSpace
-> ParsecT String u Identity HasLeadingSpace
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasLeadingSpace -> ParsecT String u Identity HasLeadingSpace
forall (m :: * -> *) a. Monad m => a -> m a
return HasLeadingSpace
True)
            ParsecT String u Identity HasLeadingSpace
-> ParsecT String u Identity HasLeadingSpace
-> ParsecT String u Identity HasLeadingSpace
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 HasLeadingSpace
-> ParsecT String u Identity HasLeadingSpace
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasLeadingSpace -> ParsecT String u Identity HasLeadingSpace
forall (m :: * -> *) a. Monad m => a -> m a
return HasLeadingSpace
False)
            ParsecT String u Identity HasLeadingSpace
-> ParsecT String u Identity HasLeadingSpace
-> ParsecT String u Identity HasLeadingSpace
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 HasLeadingSpace
-> ParsecT String u Identity HasLeadingSpace
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity HasLeadingSpace
checkIfBlock)
            ParsecT String u Identity HasLeadingSpace
-> ParsecT String u Identity HasLeadingSpace
-> ParsecT String u Identity HasLeadingSpace
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 HasLeadingSpace
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
$ Contents -> Contents -> Attr 'Unresolved
AttrUnresolved Contents
key Contents
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, HasLeadingSpace) -> Content)
-> Either String (Deref, HasLeadingSpace)
-> Content
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Content
ContentRaw (Deref, HasLeadingSpace) -> Content
go (Either String (Deref, HasLeadingSpace) -> Content)
-> ParsecT
     String a Identity (Either String (Deref, HasLeadingSpace))
-> 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, HasLeadingSpace))
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 = 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 -> HasLeadingSpace) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> HasLeadingSpace) -> ParsecT s u m Char
satisfy Char -> HasLeadingSpace
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 -> HasLeadingSpace) -> String -> String
forall a. (a -> HasLeadingSpace) -> [a] -> [a]
dropWhile (Char -> Char -> HasLeadingSpace
forall a. Eq a => a -> a -> HasLeadingSpace
== Char
'0') String
hex
        HasLeadingSpace -> Parser () -> Parser ()
forall (f :: * -> *).
Applicative f =>
HasLeadingSpace -> f () -> f ()
when (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
hex Int -> Int -> HasLeadingSpace
forall a. Ord a => a -> a -> HasLeadingSpace
< 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 -> HasLeadingSpace) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> HasLeadingSpace) -> ParsecT s u m Char
satisfy Char -> HasLeadingSpace
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 -> HasLeadingSpace
isHex Char
c =
    (Char
'0' Char -> Char -> HasLeadingSpace
forall a. Ord a => a -> a -> HasLeadingSpace
<= Char
c HasLeadingSpace -> HasLeadingSpace -> HasLeadingSpace
&& Char
c Char -> Char -> HasLeadingSpace
forall a. Ord a => a -> a -> HasLeadingSpace
<= Char
'9') HasLeadingSpace -> HasLeadingSpace -> HasLeadingSpace
||
    (Char
'A' Char -> Char -> HasLeadingSpace
forall a. Ord a => a -> a -> HasLeadingSpace
<= Char
c HasLeadingSpace -> HasLeadingSpace -> HasLeadingSpace
&& Char
c Char -> Char -> HasLeadingSpace
forall a. Ord a => a -> a -> HasLeadingSpace
<= Char
'F') HasLeadingSpace -> HasLeadingSpace -> HasLeadingSpace
||
    (Char
'a' Char -> Char -> HasLeadingSpace
forall a. Ord a => a -> a -> HasLeadingSpace
<= Char
c HasLeadingSpace -> HasLeadingSpace -> HasLeadingSpace
&& Char
c Char -> Char -> HasLeadingSpace
forall a. Ord a => a -> a -> HasLeadingSpace
<= 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
""

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
-> Parsec String () [TopLevel 'Unresolved]
-> String
-> Q Exp
cssFileDebug HasLeadingSpace
False [|parseTopLevels order|] (Order -> Parsec String () [TopLevel 'Unresolved]
parseTopLevels Order
order)

parseTopLevels :: Order -> Parser [TopLevel 'Unresolved]
parseTopLevels :: Order -> Parsec String () [TopLevel 'Unresolved]
parseTopLevels Order
order =
    ([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 :: Resolved). Block a -> TopLevel a
TopBlock (Order -> Parser (Block 'Unresolved)
parseBlock Order
order)) 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 :: Resolved). 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 :: Resolved). 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 :: Resolved). 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 :: Resolved). 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
'@'
        HasLeadingSpace
isPage <- (GenParser Char st HasLeadingSpace
-> GenParser Char st HasLeadingSpace
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st HasLeadingSpace
 -> GenParser Char st HasLeadingSpace)
-> GenParser Char st HasLeadingSpace
-> GenParser Char st HasLeadingSpace
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 HasLeadingSpace
-> GenParser Char st HasLeadingSpace
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasLeadingSpace -> GenParser Char st HasLeadingSpace
forall (m :: * -> *) a. Monad m => a -> m a
return HasLeadingSpace
True) GenParser Char st HasLeadingSpace
-> GenParser Char st HasLeadingSpace
-> GenParser Char st HasLeadingSpace
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                  (GenParser Char st HasLeadingSpace
-> GenParser Char st HasLeadingSpace
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st HasLeadingSpace
 -> GenParser Char st HasLeadingSpace)
-> GenParser Char st HasLeadingSpace
-> GenParser Char st HasLeadingSpace
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 HasLeadingSpace
-> GenParser Char st HasLeadingSpace
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasLeadingSpace -> GenParser Char st HasLeadingSpace
forall (m :: * -> *) a. Monad m => a -> m a
return HasLeadingSpace
True) GenParser Char st HasLeadingSpace
-> GenParser Char st HasLeadingSpace
-> GenParser Char st HasLeadingSpace
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                    HasLeadingSpace -> GenParser Char st HasLeadingSpace
forall (m :: * -> *) a. Monad m => a -> m a
return HasLeadingSpace
False
        HasLeadingSpace
-> ParsecT String st Identity () -> ParsecT String st Identity ()
forall (f :: * -> *).
Applicative f =>
HasLeadingSpace -> f () -> f ()
when HasLeadingSpace
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 -> HasLeadingSpace) -> String -> String
forall a. (a -> HasLeadingSpace) -> [a] -> [a]
dropWhile Char -> HasLeadingSpace
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 -> HasLeadingSpace) -> String -> String
forall a. (a -> HasLeadingSpace) -> [a] -> [a]
dropWhile Char -> HasLeadingSpace
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"
            HasLeadingSpace -> Parser () -> Parser ()
forall (f :: * -> *).
Applicative f =>
HasLeadingSpace -> f () -> f ()
unless (String
"keyframes" String -> String -> HasLeadingSpace
forall a. Eq a => [a] -> [a] -> HasLeadingSpace
`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 :: Resolved). 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
<|> ((Order -> Parser (Block 'Unresolved)
parseBlock Order
order) 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

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 =
    (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
. 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 ([(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 ::
     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 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 (Order -> Parsec String () [TopLevel 'Unresolved]
parseTopLevels Order
order) (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 :: Resolved). 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 :: Resolved). 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 :: Resolved). 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

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 =
  (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) (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 =
    (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) (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 =
  (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) (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
-> Parsec String () [TopLevel 'Unresolved]
-> String
-> [(Deref, VarType)]
cssUsedIdentifiers HasLeadingSpace
False (Order -> Parsec String () [TopLevel 'Unresolved]
parseTopLevels Order
order)

luciusMixinWithOrder :: Order -> QuasiQuoter
luciusMixinWithOrder :: Order -> QuasiQuoter
luciusMixinWithOrder Order
order = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
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 <- 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 (Order -> Parser (Block 'Unresolved)
parseBlock Order
order) 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
"}"]