{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
-- | NOTE: This module should be considered internal, and will be hidden in
-- future releases.
module Text.Shakespeare
    ( ShakespeareSettings (..)
    , PreConvert (..)
    , WrapInsertion (..)
    , PreConversion (..)
    , defaultShakespeareSettings
    , shakespeare
    , shakespeareFile
    , shakespeareFileReload
    -- * low-level
    , shakespeareFromString
    , shakespeareUsedIdentifiers
    , RenderUrl
    , VarType (..)
    , Deref
    , Parser

    , preFilter
      -- * Internal
      -- can we remove this?
    , shakespeareRuntime
    , pack'
    ) where

import Data.List (intersperse)
import Data.Char (isAlphaNum, isSpace)
import Text.ParserCombinators.Parsec hiding (Line, parse, Parser)
import Text.Parsec.Prim (modifyState, Parsec)
import Language.Haskell.TH.Quote (QuasiQuoter (..))
import Language.Haskell.TH (appE)
import Language.Haskell.TH.Lift () -- Import orphan Lift Name instance
import Language.Haskell.TH.Syntax
import Data.Text.Lazy.Builder (Builder, fromText)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid
#endif
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.Text as TS
import Text.Shakespeare.Base

import System.Directory (getModificationTime)
import Data.Time (UTCTime)
import Data.IORef
import qualified Data.Map as M
import GHC.Generics (Generic)
import Data.Typeable (Typeable)
import Data.Data (Data)

-- for pre conversion
import System.Process (readProcessWithExitCode)
import System.Exit (ExitCode(..))

-- | A parser with a user state of [String]
type Parser = Parsec String [String]
-- | run a parser with a user state of [String]
parse ::  GenParser tok [a1] a -> SourceName -> [tok] -> Either ParseError a
parse :: GenParser tok [a1] a -> SourceName -> [tok] -> Either ParseError a
parse GenParser tok [a1] a
p = GenParser tok [a1] a
-> [a1] -> SourceName -> [tok] -> Either ParseError a
forall tok st a.
GenParser tok st a
-> st -> SourceName -> [tok] -> Either ParseError a
runParser GenParser tok [a1] a
p []

-- | Coffeescript, TypeScript, and other languages compiles down to Javascript.
-- Previously we waited until the very end, at the rendering stage to perform this compilation.
-- Lets call is a post-conversion
-- This had the advantage that all Haskell values were inserted first:
-- for example a value could be inserted that Coffeescript would compile into Javascript.
-- While that is perhaps a safer approach, the advantage is not used in practice:
-- it was that way mainly for ease of implementation.
-- The down-side is the template must be compiled down to Javascript during every request.
-- If instead we do a pre-conversion to compile down to Javascript,
-- we only need to perform the compilation once.
--
-- The problem then is the insertion of Haskell values: we need a hole for
-- them. This can be done with variables known to the language.
-- During the pre-conversion we first modify all Haskell insertions
-- So #{a} is change to shakespeare_var_a
-- Then we can place the Haskell values in a function wrapper that exposes
-- those variables: (function(shakespeare_var_a){ ... shakespeare_var_a ...})
-- TypeScript can compile that, and then we tack an application of the
-- Haskell values onto the result: (#{a})
--
-- preEscapeIgnoreBalanced is used to not insert backtacks for variable already inside strings or backticks.
-- coffeescript will happily ignore the interpolations, and backticks would not be treated as escaping in that context.
-- preEscapeIgnoreLine was added to ignore comments (which in Coffeescript begin with a '#')

data PreConvert = PreConvert
    { PreConvert -> PreConversion
preConvert :: PreConversion
    , PreConvert -> SourceName
preEscapeIgnoreBalanced :: [Char]
    , PreConvert -> SourceName
preEscapeIgnoreLine :: [Char]
    , PreConvert -> Maybe WrapInsertion
wrapInsertion :: Maybe WrapInsertion
    }
    deriving PreConvert -> Q Exp
PreConvert -> Q (TExp PreConvert)
(PreConvert -> Q Exp)
-> (PreConvert -> Q (TExp PreConvert)) -> Lift PreConvert
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: PreConvert -> Q (TExp PreConvert)
$cliftTyped :: PreConvert -> Q (TExp PreConvert)
lift :: PreConvert -> Q Exp
$clift :: PreConvert -> Q Exp
Lift

data WrapInsertion = WrapInsertion {
      WrapInsertion -> Maybe SourceName
wrapInsertionIndent     :: Maybe String
    , WrapInsertion -> SourceName
wrapInsertionStartBegin :: String
    , WrapInsertion -> SourceName
wrapInsertionSeparator  :: String
    , WrapInsertion -> SourceName
wrapInsertionStartClose :: String
    , WrapInsertion -> SourceName
wrapInsertionEnd :: String
    , WrapInsertion -> Bool
wrapInsertionAddParens :: Bool
    }
    deriving WrapInsertion -> Q Exp
WrapInsertion -> Q (TExp WrapInsertion)
(WrapInsertion -> Q Exp)
-> (WrapInsertion -> Q (TExp WrapInsertion)) -> Lift WrapInsertion
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: WrapInsertion -> Q (TExp WrapInsertion)
$cliftTyped :: WrapInsertion -> Q (TExp WrapInsertion)
lift :: WrapInsertion -> Q Exp
$clift :: WrapInsertion -> Q Exp
Lift

data PreConversion = ReadProcess String [String]
                   | Id
    deriving PreConversion -> Q Exp
PreConversion -> Q (TExp PreConversion)
(PreConversion -> Q Exp)
-> (PreConversion -> Q (TExp PreConversion)) -> Lift PreConversion
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: PreConversion -> Q (TExp PreConversion)
$cliftTyped :: PreConversion -> Q (TExp PreConversion)
lift :: PreConversion -> Q Exp
$clift :: PreConversion -> Q Exp
Lift


data ShakespeareSettings = ShakespeareSettings
    { ShakespeareSettings -> Char
varChar :: Char
    , ShakespeareSettings -> Char
urlChar :: Char
    , ShakespeareSettings -> Char
intChar :: Char
    , ShakespeareSettings -> Exp
toBuilder :: Exp
    , ShakespeareSettings -> Exp
wrap :: Exp
    , ShakespeareSettings -> Exp
unwrap :: Exp
    , ShakespeareSettings -> Bool
justVarInterpolation :: Bool
    , ShakespeareSettings -> Maybe PreConvert
preConversion :: Maybe PreConvert
    , ShakespeareSettings -> Maybe Exp
modifyFinalValue :: Maybe Exp
    -- ^ A transformation applied to the final expression. Most often, this
    -- would be used to force the type of the expression to help make more
    -- meaningful error messages.
    }

defaultShakespeareSettings :: ShakespeareSettings
defaultShakespeareSettings :: ShakespeareSettings
defaultShakespeareSettings = ShakespeareSettings :: Char
-> Char
-> Char
-> Exp
-> Exp
-> Exp
-> Bool
-> Maybe PreConvert
-> Maybe Exp
-> ShakespeareSettings
ShakespeareSettings {
    varChar :: Char
varChar = Char
'#'
  , urlChar :: Char
urlChar = Char
'@'
  , intChar :: Char
intChar = Char
'^'
  , justVarInterpolation :: Bool
justVarInterpolation = Bool
False
  , preConversion :: Maybe PreConvert
preConversion = Maybe PreConvert
forall a. Maybe a
Nothing
  , modifyFinalValue :: Maybe Exp
modifyFinalValue = Maybe Exp
forall a. Maybe a
Nothing
}

instance Lift ShakespeareSettings where
    lift :: ShakespeareSettings -> Q Exp
lift (ShakespeareSettings Char
x1 Char
x2 Char
x3 Exp
x4 Exp
x5 Exp
x6 Bool
x7 Maybe PreConvert
x8 Maybe Exp
x9) =
        [|ShakespeareSettings
            $(lift x1) $(lift x2) $(lift x3)
            $(liftExp x4) $(liftExp x5) $(liftExp x6) $(lift x7) $(lift x8) $(liftMExp x9)|]
      where
        liftExp :: Exp -> Q Exp
liftExp (VarE Name
n) = [|VarE $(lift n)|]
        liftExp (ConE Name
n) = [|ConE $(lift n)|]
        liftExp Exp
_ = SourceName -> Q Exp
forall a. HasCallStack => SourceName -> a
error SourceName
"liftExp only supports VarE and ConE"
        liftMExp :: Maybe Exp -> Q Exp
liftMExp Maybe Exp
Nothing = [|Nothing|]
        liftMExp (Just Exp
e) = [|Just|] Q Exp -> Q Exp -> Q Exp
`appE` Exp -> Q Exp
liftExp Exp
e
#if MIN_VERSION_template_haskell(2,17,0)
    liftTyped = unsafeCodeCoerce . lift
#elif MIN_VERSION_template_haskell(2,16,0)
    liftTyped :: ShakespeareSettings -> Q (TExp ShakespeareSettings)
liftTyped = Q Exp -> Q (TExp ShakespeareSettings)
forall a. Q Exp -> Q (TExp a)
unsafeTExpCoerce (Q Exp -> Q (TExp ShakespeareSettings))
-> (ShakespeareSettings -> Q Exp)
-> ShakespeareSettings
-> Q (TExp ShakespeareSettings)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShakespeareSettings -> Q Exp
forall t. Lift t => t -> Q Exp
lift
#endif

type QueryParameters = [(TS.Text, TS.Text)]
type RenderUrl url = (url -> QueryParameters -> TS.Text)
type Shakespeare url = RenderUrl url -> Builder

data Content = ContentRaw String
             | ContentVar Deref
             | ContentUrl Deref
             | ContentUrlParam Deref
             | ContentMix Deref
    deriving (Int -> Content -> ShowS
[Content] -> ShowS
Content -> SourceName
(Int -> Content -> ShowS)
-> (Content -> SourceName) -> ([Content] -> ShowS) -> Show Content
forall a.
(Int -> a -> ShowS)
-> (a -> SourceName) -> ([a] -> ShowS) -> Show a
showList :: [Content] -> ShowS
$cshowList :: [Content] -> ShowS
show :: Content -> SourceName
$cshow :: Content -> SourceName
showsPrec :: Int -> Content -> ShowS
$cshowsPrec :: Int -> Content -> ShowS
Show, Content -> Content -> Bool
(Content -> Content -> Bool)
-> (Content -> Content -> Bool) -> Eq Content
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Content -> Content -> Bool
$c/= :: Content -> Content -> Bool
== :: Content -> Content -> Bool
$c== :: Content -> Content -> Bool
Eq)
type Contents = [Content]

eShowErrors :: Either ParseError c -> c
eShowErrors :: Either ParseError c -> c
eShowErrors = (ParseError -> c) -> (c -> c) -> Either ParseError c -> c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (SourceName -> c
forall a. HasCallStack => SourceName -> a
error (SourceName -> c) -> (ParseError -> SourceName) -> ParseError -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> SourceName
forall a. Show a => a -> SourceName
show) c -> c
forall a. a -> a
id

contentFromString :: ShakespeareSettings -> String -> [Content]
contentFromString :: ShakespeareSettings -> SourceName -> [Content]
contentFromString ShakespeareSettings
_ SourceName
"" = []
contentFromString ShakespeareSettings
rs SourceName
s =
    [Content] -> [Content]
compressContents ([Content] -> [Content]) -> [Content] -> [Content]
forall a b. (a -> b) -> a -> b
$ Either ParseError [Content] -> [Content]
forall c. Either ParseError c -> c
eShowErrors (Either ParseError [Content] -> [Content])
-> Either ParseError [Content] -> [Content]
forall a b. (a -> b) -> a -> b
$ GenParser Char [SourceName] [Content]
-> SourceName -> SourceName -> Either ParseError [Content]
forall tok a1 a.
GenParser tok [a1] a -> SourceName -> [tok] -> Either ParseError a
parse (ShakespeareSettings -> GenParser Char [SourceName] [Content]
parseContents ShakespeareSettings
rs) SourceName
s SourceName
s
  where
    compressContents :: Contents -> Contents
    compressContents :: [Content] -> [Content]
compressContents [] = []
    compressContents (ContentRaw SourceName
x:ContentRaw SourceName
y:[Content]
z) =
        [Content] -> [Content]
compressContents ([Content] -> [Content]) -> [Content] -> [Content]
forall a b. (a -> b) -> a -> b
$ SourceName -> Content
ContentRaw (SourceName
x SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
y) Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
z
    compressContents (Content
x:[Content]
y) = Content
x Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content] -> [Content]
compressContents [Content]
y

parseContents :: ShakespeareSettings -> Parser Contents
parseContents :: ShakespeareSettings -> GenParser Char [SourceName] [Content]
parseContents = ParsecT SourceName [SourceName] Identity Content
-> GenParser Char [SourceName] [Content]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT SourceName [SourceName] Identity Content
 -> GenParser Char [SourceName] [Content])
-> (ShakespeareSettings
    -> ParsecT SourceName [SourceName] Identity Content)
-> ShakespeareSettings
-> GenParser Char [SourceName] [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShakespeareSettings
-> ParsecT SourceName [SourceName] Identity Content
parseContent
  where
    parseContent :: ShakespeareSettings -> Parser Content
    parseContent :: ShakespeareSettings
-> ParsecT SourceName [SourceName] Identity Content
parseContent ShakespeareSettings {Bool
Char
Maybe Exp
Maybe PreConvert
Exp
modifyFinalValue :: Maybe Exp
preConversion :: Maybe PreConvert
justVarInterpolation :: Bool
unwrap :: Exp
wrap :: Exp
toBuilder :: Exp
intChar :: Char
urlChar :: Char
varChar :: Char
modifyFinalValue :: ShakespeareSettings -> Maybe Exp
preConversion :: ShakespeareSettings -> Maybe PreConvert
justVarInterpolation :: ShakespeareSettings -> Bool
unwrap :: ShakespeareSettings -> Exp
wrap :: ShakespeareSettings -> Exp
toBuilder :: ShakespeareSettings -> Exp
intChar :: ShakespeareSettings -> Char
urlChar :: ShakespeareSettings -> Char
varChar :: ShakespeareSettings -> Char
..} =
        ParsecT SourceName [SourceName] Identity Content
forall a. ParsecT SourceName a Identity Content
parseVar' ParsecT SourceName [SourceName] Identity Content
-> ParsecT SourceName [SourceName] Identity Content
-> ParsecT SourceName [SourceName] Identity Content
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT SourceName [SourceName] Identity Content
forall a. ParsecT SourceName a Identity Content
parseUrl' ParsecT SourceName [SourceName] Identity Content
-> ParsecT SourceName [SourceName] Identity Content
-> ParsecT SourceName [SourceName] Identity Content
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT SourceName [SourceName] Identity Content
forall a. ParsecT SourceName a Identity Content
parseInt' ParsecT SourceName [SourceName] Identity Content
-> ParsecT SourceName [SourceName] Identity Content
-> ParsecT SourceName [SourceName] Identity Content
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT SourceName [SourceName] Identity Content
forall a. ParsecT SourceName a Identity Content
parseChar'
      where
        parseVar' :: ParsecT SourceName a Identity Content
parseVar' = (SourceName -> Content)
-> (Deref -> Content) -> Either SourceName Deref -> Content
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SourceName -> Content
ContentRaw Deref -> Content
ContentVar (Either SourceName Deref -> Content)
-> ParsecT SourceName a Identity (Either SourceName Deref)
-> ParsecT SourceName a Identity Content
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Char -> ParsecT SourceName a Identity (Either SourceName Deref)
forall a. Char -> UserParser a (Either SourceName Deref)
parseVar Char
varChar
        parseUrl' :: ParsecT SourceName a Identity Content
parseUrl' = (SourceName -> Content)
-> ((Deref, Bool) -> Content)
-> Either SourceName (Deref, Bool)
-> Content
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SourceName -> Content
ContentRaw (Deref, Bool) -> Content
contentUrl (Either SourceName (Deref, Bool) -> Content)
-> ParsecT SourceName a Identity (Either SourceName (Deref, Bool))
-> ParsecT SourceName a Identity Content
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Char
-> Char
-> ParsecT SourceName a Identity (Either SourceName (Deref, Bool))
forall a.
Char -> Char -> UserParser a (Either SourceName (Deref, Bool))
parseUrl Char
urlChar Char
'?'
          where
            contentUrl :: (Deref, Bool) -> Content
contentUrl (Deref
d, Bool
False) = Deref -> Content
ContentUrl Deref
d
            contentUrl (Deref
d, Bool
True) = Deref -> Content
ContentUrlParam Deref
d

        parseInt' :: ParsecT SourceName a Identity Content
parseInt' = (SourceName -> Content)
-> (Deref -> Content) -> Either SourceName Deref -> Content
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SourceName -> Content
ContentRaw Deref -> Content
ContentMix (Either SourceName Deref -> Content)
-> ParsecT SourceName a Identity (Either SourceName Deref)
-> ParsecT SourceName a Identity Content
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Char -> ParsecT SourceName a Identity (Either SourceName Deref)
forall a. Char -> UserParser a (Either SourceName Deref)
parseInt Char
intChar
        parseChar' :: ParsecT SourceName u Identity Content
parseChar' = SourceName -> Content
ContentRaw (SourceName -> Content)
-> ParsecT SourceName u Identity SourceName
-> ParsecT SourceName u Identity Content
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT SourceName u Identity Char
-> ParsecT SourceName u Identity SourceName
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (SourceName -> ParsecT SourceName u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m Char
noneOf [Char
varChar, Char
urlChar, Char
intChar])


-- | calls 'error' when there is stderr or exit code failure
readProcessError :: FilePath -> [String] -> String
                 -> Maybe FilePath -- ^ for error reporting
                 -> IO String
readProcessError :: SourceName
-> [SourceName] -> SourceName -> Maybe SourceName -> IO SourceName
readProcessError SourceName
cmd [SourceName]
args SourceName
input Maybe SourceName
mfp = do
  (ExitCode
ex, SourceName
output, SourceName
err) <- SourceName
-> [SourceName]
-> SourceName
-> IO (ExitCode, SourceName, SourceName)
readProcessWithExitCode SourceName
cmd [SourceName]
args SourceName
input
  case ExitCode
ex of
   ExitCode
ExitSuccess   ->
     case SourceName
err of
       [] -> SourceName -> IO SourceName
forall (m :: * -> *) a. Monad m => a -> m a
return SourceName
output
       SourceName
msg -> SourceName -> IO SourceName
forall a. HasCallStack => SourceName -> a
error (SourceName -> IO SourceName) -> SourceName -> IO SourceName
forall a b. (a -> b) -> a -> b
$ SourceName
"stderr received during readProcess:" SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
displayCmd SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
"\n\n" SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
msg
   ExitFailure Int
r ->
    SourceName -> IO SourceName
forall a. HasCallStack => SourceName -> a
error (SourceName -> IO SourceName) -> SourceName -> IO SourceName
forall a b. (a -> b) -> a -> b
$ SourceName
"exit code " SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> SourceName
forall a. Show a => a -> SourceName
show Int
r SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
" from readProcess: " SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
displayCmd SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
"\n\n"
      SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
"stderr:\n" SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
err
  where
    displayCmd :: SourceName
displayCmd = SourceName
cmd SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:[SourceName] -> SourceName
unwords (ShowS -> [SourceName] -> [SourceName]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
forall a. Show a => a -> SourceName
show [SourceName]
args) SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++
        case Maybe SourceName
mfp of
          Maybe SourceName
Nothing -> SourceName
""
          Just SourceName
fp -> Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:SourceName
fp

preFilter :: Maybe FilePath -- ^ for error reporting
          -> ShakespeareSettings
          -> String
          -> IO String
preFilter :: Maybe SourceName
-> ShakespeareSettings -> SourceName -> IO SourceName
preFilter Maybe SourceName
mfp ShakespeareSettings {Bool
Char
Maybe Exp
Maybe PreConvert
Exp
modifyFinalValue :: Maybe Exp
preConversion :: Maybe PreConvert
justVarInterpolation :: Bool
unwrap :: Exp
wrap :: Exp
toBuilder :: Exp
intChar :: Char
urlChar :: Char
varChar :: Char
modifyFinalValue :: ShakespeareSettings -> Maybe Exp
preConversion :: ShakespeareSettings -> Maybe PreConvert
justVarInterpolation :: ShakespeareSettings -> Bool
unwrap :: ShakespeareSettings -> Exp
wrap :: ShakespeareSettings -> Exp
toBuilder :: ShakespeareSettings -> Exp
intChar :: ShakespeareSettings -> Char
urlChar :: ShakespeareSettings -> Char
varChar :: ShakespeareSettings -> Char
..} SourceName
template =
    case Maybe PreConvert
preConversion of
      Maybe PreConvert
Nothing -> SourceName -> IO SourceName
forall (m :: * -> *) a. Monad m => a -> m a
return SourceName
template
      Just pre :: PreConvert
pre@(PreConvert PreConversion
convert SourceName
_ SourceName
_ Maybe WrapInsertion
mWrapI) ->
        if (Char -> Bool) -> SourceName -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace SourceName
template then SourceName -> IO SourceName
forall (m :: * -> *) a. Monad m => a -> m a
return SourceName
template else
          let ([SourceName]
groups, [SourceName]
rvars) = Either ParseError ([SourceName], [SourceName])
-> ([SourceName], [SourceName])
forall c. Either ParseError c -> c
eShowErrors (Either ParseError ([SourceName], [SourceName])
 -> ([SourceName], [SourceName]))
-> Either ParseError ([SourceName], [SourceName])
-> ([SourceName], [SourceName])
forall a b. (a -> b) -> a -> b
$ GenParser Char [SourceName] ([SourceName], [SourceName])
-> SourceName
-> SourceName
-> Either ParseError ([SourceName], [SourceName])
forall tok a1 a.
GenParser tok [a1] a -> SourceName -> [tok] -> Either ParseError a
parse
                                  (Maybe WrapInsertion
-> PreConvert
-> GenParser Char [SourceName] ([SourceName], [SourceName])
forall a.
Maybe a
-> PreConvert
-> GenParser Char [SourceName] ([SourceName], [SourceName])
parseConvertWrapInsertion Maybe WrapInsertion
mWrapI PreConvert
pre)
                                  SourceName
template
                                  SourceName
template
              vars :: [SourceName]
vars = [SourceName] -> [SourceName]
forall a. [a] -> [a]
reverse [SourceName]
rvars
              parsed :: SourceName
parsed = [SourceName] -> SourceName
forall a. Monoid a => [a] -> a
mconcat [SourceName]
groups
              withVars :: SourceName
withVars = (Maybe WrapInsertion -> [SourceName] -> ShowS
addVars Maybe WrapInsertion
mWrapI [SourceName]
vars SourceName
parsed)
          in  Maybe WrapInsertion -> [SourceName] -> ShowS
applyVars Maybe WrapInsertion
mWrapI [SourceName]
vars ShowS -> IO SourceName -> IO SourceName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` case PreConversion
convert of
                  PreConversion
Id -> SourceName -> IO SourceName
forall (m :: * -> *) a. Monad m => a -> m a
return SourceName
withVars
                  ReadProcess SourceName
command [SourceName]
args ->
                    SourceName
-> [SourceName] -> SourceName -> Maybe SourceName -> IO SourceName
readProcessError SourceName
command [SourceName]
args SourceName
withVars Maybe SourceName
mfp
  where
    addIndent :: Maybe String -> String -> String
    addIndent :: Maybe SourceName -> ShowS
addIndent Maybe SourceName
Nothing SourceName
str = SourceName
str
    addIndent (Just SourceName
indent) SourceName
str = ShowS -> ShowS
mapLines (\SourceName
line -> SourceName
indent SourceName -> ShowS
forall a. Semigroup a => a -> a -> a
<> SourceName
line) SourceName
str
      where
        mapLines :: ShowS -> ShowS
mapLines ShowS
f = [SourceName] -> SourceName
unlines ([SourceName] -> SourceName)
-> (SourceName -> [SourceName]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [SourceName] -> [SourceName]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
f ([SourceName] -> [SourceName])
-> (SourceName -> [SourceName]) -> SourceName -> [SourceName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceName -> [SourceName]
lines

    shakespeare_prefix :: SourceName
shakespeare_prefix = SourceName
"shakespeare_var_"
    shakespeare_var_conversion :: ShowS
shakespeare_var_conversion (Char
'@':Char
'?':Char
'{':SourceName
str) = ShowS
shakespeare_var_conversion (Char
'@'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'{'Char -> ShowS
forall a. a -> [a] -> [a]
:SourceName
str)
    shakespeare_var_conversion (Char
_:Char
'{':SourceName
str) = SourceName
shakespeare_prefix SourceName -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAlphaNum (ShowS
forall a. [a] -> [a]
init SourceName
str)
    shakespeare_var_conversion SourceName
err = ShowS
forall a. HasCallStack => SourceName -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ SourceName
"did not expect: " SourceName -> ShowS
forall a. Semigroup a => a -> a -> a
<> SourceName
err

    applyVars :: Maybe WrapInsertion -> [SourceName] -> ShowS
applyVars Maybe WrapInsertion
_      [] SourceName
str = SourceName
str
    applyVars Maybe WrapInsertion
Nothing [SourceName]
_ SourceName
str = SourceName
str
    applyVars (Just WrapInsertion {Bool
SourceName
Maybe SourceName
wrapInsertionAddParens :: Bool
wrapInsertionEnd :: SourceName
wrapInsertionStartClose :: SourceName
wrapInsertionSeparator :: SourceName
wrapInsertionStartBegin :: SourceName
wrapInsertionIndent :: Maybe SourceName
wrapInsertionAddParens :: WrapInsertion -> Bool
wrapInsertionEnd :: WrapInsertion -> SourceName
wrapInsertionStartClose :: WrapInsertion -> SourceName
wrapInsertionSeparator :: WrapInsertion -> SourceName
wrapInsertionStartBegin :: WrapInsertion -> SourceName
wrapInsertionIndent :: WrapInsertion -> Maybe SourceName
..}) [SourceName]
vars SourceName
str =
         (if Bool
wrapInsertionAddParens then SourceName
"(" else SourceName
"")
      SourceName -> ShowS
forall a. Semigroup a => a -> a -> a
<> SourceName
removeTrailingSemiColon
      SourceName -> ShowS
forall a. Semigroup a => a -> a -> a
<> (if Bool
wrapInsertionAddParens then SourceName
")" else SourceName
"")
      SourceName -> ShowS
forall a. Semigroup a => a -> a -> a
<> SourceName
"("
      SourceName -> ShowS
forall a. Semigroup a => a -> a -> a
<> [SourceName] -> SourceName
forall a. Monoid a => [a] -> a
mconcat (SourceName -> [SourceName] -> [SourceName]
forall a. a -> [a] -> [a]
intersperse SourceName
", " [SourceName]
vars)
      SourceName -> ShowS
forall a. Semigroup a => a -> a -> a
<> SourceName
");\n"
        where
          removeTrailingSemiColon :: SourceName
removeTrailingSemiColon = ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
             (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';' Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c) (ShowS
forall a. [a] -> [a]
reverse SourceName
str)

    addVars :: Maybe WrapInsertion -> [SourceName] -> ShowS
addVars Maybe WrapInsertion
_      [] SourceName
str = SourceName
str
    addVars Maybe WrapInsertion
Nothing [SourceName]
_ SourceName
str = SourceName
str
    addVars (Just WrapInsertion {Bool
SourceName
Maybe SourceName
wrapInsertionAddParens :: Bool
wrapInsertionEnd :: SourceName
wrapInsertionStartClose :: SourceName
wrapInsertionSeparator :: SourceName
wrapInsertionStartBegin :: SourceName
wrapInsertionIndent :: Maybe SourceName
wrapInsertionAddParens :: WrapInsertion -> Bool
wrapInsertionEnd :: WrapInsertion -> SourceName
wrapInsertionStartClose :: WrapInsertion -> SourceName
wrapInsertionSeparator :: WrapInsertion -> SourceName
wrapInsertionStartBegin :: WrapInsertion -> SourceName
wrapInsertionIndent :: WrapInsertion -> Maybe SourceName
..}) [SourceName]
vars SourceName
str =
         SourceName
wrapInsertionStartBegin
      SourceName -> ShowS
forall a. Semigroup a => a -> a -> a
<> [SourceName] -> SourceName
forall a. Monoid a => [a] -> a
mconcat (SourceName -> [SourceName] -> [SourceName]
forall a. a -> [a] -> [a]
intersperse SourceName
wrapInsertionSeparator ([SourceName] -> [SourceName]) -> [SourceName] -> [SourceName]
forall a b. (a -> b) -> a -> b
$ ShowS -> [SourceName] -> [SourceName]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
shakespeare_var_conversion [SourceName]
vars)
      SourceName -> ShowS
forall a. Semigroup a => a -> a -> a
<> SourceName
wrapInsertionStartClose
      SourceName -> ShowS
forall a. Semigroup a => a -> a -> a
<> Maybe SourceName -> ShowS
addIndent Maybe SourceName
wrapInsertionIndent SourceName
str
      SourceName -> ShowS
forall a. Semigroup a => a -> a -> a
<> SourceName
wrapInsertionEnd

    parseConvertWrapInsertion :: Maybe a
-> PreConvert
-> GenParser Char [SourceName] ([SourceName], [SourceName])
parseConvertWrapInsertion Maybe a
Nothing = ShowS
-> PreConvert
-> GenParser Char [SourceName] ([SourceName], [SourceName])
parseConvert ShowS
forall a. a -> a
id
    parseConvertWrapInsertion (Just a
_) = ShowS
-> PreConvert
-> GenParser Char [SourceName] ([SourceName], [SourceName])
parseConvert ShowS
shakespeare_var_conversion

    parseConvert :: ShowS
-> PreConvert
-> GenParser Char [SourceName] ([SourceName], [SourceName])
parseConvert ShowS
varConvert PreConvert {SourceName
Maybe WrapInsertion
PreConversion
wrapInsertion :: Maybe WrapInsertion
preEscapeIgnoreLine :: SourceName
preEscapeIgnoreBalanced :: SourceName
preConvert :: PreConversion
wrapInsertion :: PreConvert -> Maybe WrapInsertion
preEscapeIgnoreLine :: PreConvert -> SourceName
preEscapeIgnoreBalanced :: PreConvert -> SourceName
preConvert :: PreConvert -> PreConversion
..} = do
        [SourceName]
str <- ParsecT SourceName [SourceName] Identity SourceName
-> ParsecT SourceName [SourceName] Identity [SourceName]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT SourceName [SourceName] Identity SourceName
 -> ParsecT SourceName [SourceName] Identity [SourceName])
-> ParsecT SourceName [SourceName] Identity SourceName
-> ParsecT SourceName [SourceName] Identity [SourceName]
forall a b. (a -> b) -> a -> b
$ [ParsecT SourceName [SourceName] Identity SourceName]
-> ParsecT SourceName [SourceName] Identity SourceName
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT SourceName [SourceName] Identity SourceName]
 -> ParsecT SourceName [SourceName] Identity SourceName)
-> [ParsecT SourceName [SourceName] Identity SourceName]
-> ParsecT SourceName [SourceName] Identity SourceName
forall a b. (a -> b) -> a -> b
$
          (Char -> ParsecT SourceName [SourceName] Identity SourceName)
-> SourceName
-> [ParsecT SourceName [SourceName] Identity SourceName]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT SourceName [SourceName] Identity SourceName
-> ParsecT SourceName [SourceName] Identity SourceName
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT SourceName [SourceName] Identity SourceName
 -> ParsecT SourceName [SourceName] Identity SourceName)
-> (Char -> ParsecT SourceName [SourceName] Identity SourceName)
-> Char
-> ParsecT SourceName [SourceName] Identity SourceName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ParsecT SourceName [SourceName] Identity SourceName
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m SourceName
escapedParse) SourceName
preEscapeIgnoreBalanced [ParsecT SourceName [SourceName] Identity SourceName]
-> [ParsecT SourceName [SourceName] Identity SourceName]
-> [ParsecT SourceName [SourceName] Identity SourceName]
forall a. [a] -> [a] -> [a]
++ [ParsecT SourceName [SourceName] Identity SourceName
mainParser]
        [SourceName]
st <- ParsecT SourceName [SourceName] Identity [SourceName]
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
        ([SourceName], [SourceName])
-> GenParser Char [SourceName] ([SourceName], [SourceName])
forall (m :: * -> *) a. Monad m => a -> m a
return ([SourceName]
str, [SourceName]
st)

      where
        escapedParse :: Char -> ParsecT s u m SourceName
escapedParse Char
ignoreC = do
            Char
_<- Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
ignoreC
            SourceName
inside <- ParsecT s u m Char -> ParsecT s u m SourceName
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT s u m Char -> ParsecT s u m SourceName)
-> ParsecT s u m Char -> ParsecT s u m SourceName
forall a b. (a -> b) -> a -> b
$ SourceName -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m Char
noneOf [Char
ignoreC]
            Char
_<- Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
ignoreC
            SourceName -> ParsecT s u m SourceName
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceName -> ParsecT s u m SourceName)
-> SourceName -> ParsecT s u m SourceName
forall a b. (a -> b) -> a -> b
$ Char
ignoreCChar -> ShowS
forall a. a -> [a] -> [a]
:SourceName
inside SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
ignoreC]

        mainParser :: ParsecT SourceName [SourceName] Identity SourceName
mainParser =
            ParsecT SourceName [SourceName] Identity SourceName
parseVar' ParsecT SourceName [SourceName] Identity SourceName
-> ParsecT SourceName [SourceName] Identity SourceName
-> ParsecT SourceName [SourceName] Identity SourceName
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            ParsecT SourceName [SourceName] Identity SourceName
parseUrl' ParsecT SourceName [SourceName] Identity SourceName
-> ParsecT SourceName [SourceName] Identity SourceName
-> ParsecT SourceName [SourceName] Identity SourceName
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            ParsecT SourceName [SourceName] Identity SourceName
parseInt' ParsecT SourceName [SourceName] Identity SourceName
-> ParsecT SourceName [SourceName] Identity SourceName
-> ParsecT SourceName [SourceName] Identity SourceName
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            SourceName -> ParsecT SourceName [SourceName] Identity SourceName
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m SourceName
parseCommentLine SourceName
preEscapeIgnoreLine ParsecT SourceName [SourceName] Identity SourceName
-> ParsecT SourceName [SourceName] Identity SourceName
-> ParsecT SourceName [SourceName] Identity SourceName
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            SourceName
-> SourceName
-> ParsecT SourceName [SourceName] Identity SourceName
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> SourceName -> ParsecT s u m SourceName
parseChar' SourceName
preEscapeIgnoreLine SourceName
preEscapeIgnoreBalanced

        recordRight :: Either SourceName SourceName -> ParsecT s [SourceName] m SourceName
recordRight (Left SourceName
str)  = SourceName -> ParsecT s [SourceName] m SourceName
forall (m :: * -> *) a. Monad m => a -> m a
return SourceName
str
        recordRight (Right SourceName
str) = ([SourceName] -> [SourceName]) -> ParsecT s [SourceName] m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState (\[SourceName]
vars -> SourceName
strSourceName -> [SourceName] -> [SourceName]
forall a. a -> [a] -> [a]
:[SourceName]
vars) ParsecT s [SourceName] m ()
-> ParsecT s [SourceName] m SourceName
-> ParsecT s [SourceName] m SourceName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SourceName -> ParsecT s [SourceName] m SourceName
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
varConvert SourceName
str)

        newLine :: SourceName
newLine = SourceName
"\r\n"
        parseCommentLine :: SourceName -> ParsecT s u m SourceName
parseCommentLine SourceName
cs = do
          Char
begin <- SourceName -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m Char
oneOf SourceName
cs
          SourceName
comment <- ParsecT s u m Char -> ParsecT s u m SourceName
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT s u m Char -> ParsecT s u m SourceName)
-> ParsecT s u m Char -> ParsecT s u m SourceName
forall a b. (a -> b) -> a -> b
$ SourceName -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m Char
noneOf SourceName
newLine
          SourceName -> ParsecT s u m SourceName
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceName -> ParsecT s u m SourceName)
-> SourceName -> ParsecT s u m SourceName
forall a b. (a -> b) -> a -> b
$ Char
begin Char -> ShowS
forall a. a -> [a] -> [a]
: SourceName
comment

        parseVar' :: (Parsec String [String]) String
        parseVar' :: ParsecT SourceName [SourceName] Identity SourceName
parseVar' = Either SourceName SourceName
-> ParsecT SourceName [SourceName] Identity SourceName
forall (m :: * -> *) s.
Monad m =>
Either SourceName SourceName -> ParsecT s [SourceName] m SourceName
recordRight (Either SourceName SourceName
 -> ParsecT SourceName [SourceName] Identity SourceName)
-> ParsecT
     SourceName [SourceName] Identity (Either SourceName SourceName)
-> ParsecT SourceName [SourceName] Identity SourceName
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Char
-> ParsecT
     SourceName [SourceName] Identity (Either SourceName SourceName)
forall a. Char -> UserParser a (Either SourceName SourceName)
parseVarString Char
varChar
        parseUrl' :: ParsecT SourceName [SourceName] Identity SourceName
parseUrl' = Either SourceName SourceName
-> ParsecT SourceName [SourceName] Identity SourceName
forall (m :: * -> *) s.
Monad m =>
Either SourceName SourceName -> ParsecT s [SourceName] m SourceName
recordRight (Either SourceName SourceName
 -> ParsecT SourceName [SourceName] Identity SourceName)
-> ParsecT
     SourceName [SourceName] Identity (Either SourceName SourceName)
-> ParsecT SourceName [SourceName] Identity SourceName
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Char
-> Char
-> ParsecT
     SourceName [SourceName] Identity (Either SourceName SourceName)
forall a.
Char -> Char -> UserParser a (Either SourceName SourceName)
parseUrlString Char
urlChar Char
'?'
        parseInt' :: ParsecT SourceName [SourceName] Identity SourceName
parseInt' = Either SourceName SourceName
-> ParsecT SourceName [SourceName] Identity SourceName
forall (m :: * -> *) s.
Monad m =>
Either SourceName SourceName -> ParsecT s [SourceName] m SourceName
recordRight (Either SourceName SourceName
 -> ParsecT SourceName [SourceName] Identity SourceName)
-> ParsecT
     SourceName [SourceName] Identity (Either SourceName SourceName)
-> ParsecT SourceName [SourceName] Identity SourceName
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Char
-> ParsecT
     SourceName [SourceName] Identity (Either SourceName SourceName)
forall a. Char -> UserParser a (Either SourceName SourceName)
parseIntString Char
intChar
        parseChar' :: SourceName -> SourceName -> ParsecT s u m SourceName
parseChar' SourceName
comments SourceName
ignores =
            ParsecT s u m Char -> ParsecT s u m SourceName
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (SourceName -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m Char
noneOf ([Char
varChar, Char
urlChar, Char
intChar] SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
comments SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
ignores))

pack' :: String -> TS.Text
pack' :: SourceName -> Text
pack' = SourceName -> Text
TS.pack

contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp
contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp
contentsToShakespeare ShakespeareSettings
rs [Content]
a = do
    Name
r <- SourceName -> Q Name
newName SourceName
"_render"
    [Exp]
c <- (Content -> Q Exp) -> [Content] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Name -> Content -> Q Exp
contentToBuilder Name
r) [Content]
a
    Exp
compiledTemplate <- case [Exp]
c of
        -- Make sure we convert this mempty using toBuilder to pin down the
        -- type appropriately
        []  -> (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Exp -> Exp -> Exp
AppE (Exp -> Exp -> Exp) -> Exp -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ ShakespeareSettings -> Exp
wrap ShakespeareSettings
rs) [|mempty|]
        [Exp
x] -> Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
x
        [Exp]
_   -> do
              Exp
mc <- [|mconcat|]
              Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Exp
mc Exp -> Exp -> Exp
`AppE` [Exp] -> Exp
ListE [Exp]
c
    (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Exp -> Exp) -> (Exp -> Exp -> Exp) -> Maybe Exp -> Exp -> Exp
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Exp -> Exp
forall a. a -> a
id Exp -> Exp -> Exp
AppE (Maybe Exp -> Exp -> Exp) -> Maybe Exp -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ ShakespeareSettings -> Maybe Exp
modifyFinalValue ShakespeareSettings
rs) (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
        if ShakespeareSettings -> Bool
justVarInterpolation ShakespeareSettings
rs
            then Exp
compiledTemplate
            else [Pat] -> Exp -> Exp
LamE [Name -> Pat
VarP Name
r] Exp
compiledTemplate
      where
        contentToBuilder :: Name -> Content -> Q Exp
        contentToBuilder :: Name -> Content -> Q Exp
contentToBuilder Name
_ (ContentRaw SourceName
s') = do
            Exp
ts <- [|fromText . pack'|]
            Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ ShakespeareSettings -> Exp
wrap ShakespeareSettings
rs Exp -> Exp -> Exp
`AppE` (Exp
ts Exp -> Exp -> Exp
`AppE` Lit -> Exp
LitE (SourceName -> Lit
StringL SourceName
s'))
        contentToBuilder Name
_ (ContentVar Deref
d) =
            Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (ShakespeareSettings -> Exp
toBuilder ShakespeareSettings
rs Exp -> Exp -> Exp
`AppE` Scope -> Deref -> Exp
derefToExp [] Deref
d)
        contentToBuilder Name
r (ContentUrl Deref
d) = do
            Exp
ts <- [|fromText|]
            Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ ShakespeareSettings -> Exp
wrap ShakespeareSettings
rs Exp -> Exp -> Exp
`AppE` (Exp
ts Exp -> Exp -> Exp
`AppE` (Name -> Exp
VarE Name
r Exp -> Exp -> Exp
`AppE` Scope -> Deref -> Exp
derefToExp [] Deref
d Exp -> Exp -> Exp
`AppE` [Exp] -> Exp
ListE []))
        contentToBuilder Name
r (ContentUrlParam Deref
d) = do
            Exp
ts <- [|fromText|]
            Exp
up <- [|\r' (u, p) -> r' u p|]
            Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ ShakespeareSettings -> Exp
wrap ShakespeareSettings
rs Exp -> Exp -> Exp
`AppE` (Exp
ts Exp -> Exp -> Exp
`AppE` (Exp
up Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
r Exp -> Exp -> Exp
`AppE` Scope -> Deref -> Exp
derefToExp [] Deref
d))
        contentToBuilder Name
r (ContentMix Deref
d) =
            Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
              if ShakespeareSettings -> Bool
justVarInterpolation ShakespeareSettings
rs
                then Scope -> Deref -> Exp
derefToExp [] Deref
d
                else Scope -> Deref -> Exp
derefToExp [] Deref
d Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
r

shakespeare :: ShakespeareSettings -> QuasiQuoter
shakespeare :: ShakespeareSettings -> QuasiQuoter
shakespeare ShakespeareSettings
r = QuasiQuoter :: (SourceName -> Q Exp)
-> (SourceName -> Q Pat)
-> (SourceName -> Q Type)
-> (SourceName -> Q [Dec])
-> QuasiQuoter
QuasiQuoter { quoteExp :: SourceName -> Q Exp
quoteExp = ShakespeareSettings -> SourceName -> Q Exp
shakespeareFromString ShakespeareSettings
r }

shakespeareFromString :: ShakespeareSettings -> String -> Q Exp
shakespeareFromString :: ShakespeareSettings -> SourceName -> Q Exp
shakespeareFromString ShakespeareSettings
r SourceName
str = do
    SourceName
s <- IO SourceName -> Q SourceName
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO (IO SourceName -> Q SourceName) -> IO SourceName -> Q SourceName
forall a b. (a -> b) -> a -> b
$ Maybe SourceName
-> ShakespeareSettings -> SourceName -> IO SourceName
preFilter Maybe SourceName
forall a. Maybe a
Nothing ShakespeareSettings
r (SourceName -> IO SourceName) -> SourceName -> IO SourceName
forall a b. (a -> b) -> a -> b
$
#ifdef WINDOWS
          filter (/='\r')
#endif
          SourceName
str
    ShakespeareSettings -> [Content] -> Q Exp
contentsToShakespeare ShakespeareSettings
r ([Content] -> Q Exp) -> [Content] -> Q Exp
forall a b. (a -> b) -> a -> b
$ ShakespeareSettings -> SourceName -> [Content]
contentFromString ShakespeareSettings
r SourceName
s

shakespeareFile :: ShakespeareSettings -> FilePath -> Q Exp
shakespeareFile :: ShakespeareSettings -> SourceName -> Q Exp
shakespeareFile ShakespeareSettings
r SourceName
fp = SourceName -> Q SourceName
readFileRecompileQ SourceName
fp Q SourceName -> (SourceName -> Q Exp) -> Q Exp
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ShakespeareSettings -> SourceName -> Q Exp
shakespeareFromString ShakespeareSettings
r

data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin
    deriving (Int -> VarType -> ShowS
[VarType] -> ShowS
VarType -> SourceName
(Int -> VarType -> ShowS)
-> (VarType -> SourceName) -> ([VarType] -> ShowS) -> Show VarType
forall a.
(Int -> a -> ShowS)
-> (a -> SourceName) -> ([a] -> ShowS) -> Show a
showList :: [VarType] -> ShowS
$cshowList :: [VarType] -> ShowS
show :: VarType -> SourceName
$cshow :: VarType -> SourceName
showsPrec :: Int -> VarType -> ShowS
$cshowsPrec :: Int -> VarType -> ShowS
Show, VarType -> VarType -> Bool
(VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool) -> Eq VarType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VarType -> VarType -> Bool
$c/= :: VarType -> VarType -> Bool
== :: VarType -> VarType -> Bool
$c== :: VarType -> VarType -> Bool
Eq, Eq VarType
Eq VarType
-> (VarType -> VarType -> Ordering)
-> (VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool)
-> (VarType -> VarType -> VarType)
-> (VarType -> VarType -> VarType)
-> Ord VarType
VarType -> VarType -> Bool
VarType -> VarType -> Ordering
VarType -> VarType -> VarType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VarType -> VarType -> VarType
$cmin :: VarType -> VarType -> VarType
max :: VarType -> VarType -> VarType
$cmax :: VarType -> VarType -> VarType
>= :: VarType -> VarType -> Bool
$c>= :: VarType -> VarType -> Bool
> :: VarType -> VarType -> Bool
$c> :: VarType -> VarType -> Bool
<= :: VarType -> VarType -> Bool
$c<= :: VarType -> VarType -> Bool
< :: VarType -> VarType -> Bool
$c< :: VarType -> VarType -> Bool
compare :: VarType -> VarType -> Ordering
$ccompare :: VarType -> VarType -> Ordering
$cp1Ord :: Eq VarType
Ord, Int -> VarType
VarType -> Int
VarType -> [VarType]
VarType -> VarType
VarType -> VarType -> [VarType]
VarType -> VarType -> VarType -> [VarType]
(VarType -> VarType)
-> (VarType -> VarType)
-> (Int -> VarType)
-> (VarType -> Int)
-> (VarType -> [VarType])
-> (VarType -> VarType -> [VarType])
-> (VarType -> VarType -> [VarType])
-> (VarType -> VarType -> VarType -> [VarType])
-> Enum VarType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VarType -> VarType -> VarType -> [VarType]
$cenumFromThenTo :: VarType -> VarType -> VarType -> [VarType]
enumFromTo :: VarType -> VarType -> [VarType]
$cenumFromTo :: VarType -> VarType -> [VarType]
enumFromThen :: VarType -> VarType -> [VarType]
$cenumFromThen :: VarType -> VarType -> [VarType]
enumFrom :: VarType -> [VarType]
$cenumFrom :: VarType -> [VarType]
fromEnum :: VarType -> Int
$cfromEnum :: VarType -> Int
toEnum :: Int -> VarType
$ctoEnum :: Int -> VarType
pred :: VarType -> VarType
$cpred :: VarType -> VarType
succ :: VarType -> VarType
$csucc :: VarType -> VarType
Enum, VarType
VarType -> VarType -> Bounded VarType
forall a. a -> a -> Bounded a
maxBound :: VarType
$cmaxBound :: VarType
minBound :: VarType
$cminBound :: VarType
Bounded, Typeable, Typeable VarType
DataType
Constr
Typeable VarType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> VarType -> c VarType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c VarType)
-> (VarType -> Constr)
-> (VarType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c VarType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VarType))
-> ((forall b. Data b => b -> b) -> VarType -> VarType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> VarType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> VarType -> r)
-> (forall u. (forall d. Data d => d -> u) -> VarType -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> VarType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> VarType -> m VarType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> VarType -> m VarType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> VarType -> m VarType)
-> Data VarType
VarType -> DataType
VarType -> Constr
(forall b. Data b => b -> b) -> VarType -> VarType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VarType -> c VarType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VarType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> VarType -> u
forall u. (forall d. Data d => d -> u) -> VarType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VarType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VarType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> VarType -> m VarType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VarType -> m VarType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VarType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VarType -> c VarType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VarType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VarType)
$cVTMixin :: Constr
$cVTUrlParam :: Constr
$cVTUrl :: Constr
$cVTPlain :: Constr
$tVarType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> VarType -> m VarType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VarType -> m VarType
gmapMp :: (forall d. Data d => d -> m d) -> VarType -> m VarType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VarType -> m VarType
gmapM :: (forall d. Data d => d -> m d) -> VarType -> m VarType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> VarType -> m VarType
gmapQi :: Int -> (forall d. Data d => d -> u) -> VarType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> VarType -> u
gmapQ :: (forall d. Data d => d -> u) -> VarType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> VarType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VarType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VarType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VarType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VarType -> r
gmapT :: (forall b. Data b => b -> b) -> VarType -> VarType
$cgmapT :: (forall b. Data b => b -> b) -> VarType -> VarType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VarType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VarType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c VarType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VarType)
dataTypeOf :: VarType -> DataType
$cdataTypeOf :: VarType -> DataType
toConstr :: VarType -> Constr
$ctoConstr :: VarType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VarType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VarType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VarType -> c VarType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VarType -> c VarType
$cp1Data :: Typeable VarType
Data, (forall x. VarType -> Rep VarType x)
-> (forall x. Rep VarType x -> VarType) -> Generic VarType
forall x. Rep VarType x -> VarType
forall x. VarType -> Rep VarType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VarType x -> VarType
$cfrom :: forall x. VarType -> Rep VarType x
Generic)

getVars :: Content -> [(Deref, VarType)]
getVars :: Content -> [(Deref, VarType)]
getVars ContentRaw{} = []
getVars (ContentVar Deref
d) = [(Deref
d, VarType
VTPlain)]
getVars (ContentUrl Deref
d) = [(Deref
d, VarType
VTUrl)]
getVars (ContentUrlParam Deref
d) = [(Deref
d, VarType
VTUrlParam)]
getVars (ContentMix Deref
d) = [(Deref
d, VarType
VTMixin)]

data VarExp url = EPlain Builder
                | EUrl url
                | EUrlParam (url, QueryParameters)
                | EMixin (Shakespeare url)

-- | Determine which identifiers are used by the given template, useful for
-- creating systems like yesod devel.
shakespeareUsedIdentifiers :: ShakespeareSettings -> String -> [(Deref, VarType)]
shakespeareUsedIdentifiers :: ShakespeareSettings -> SourceName -> [(Deref, VarType)]
shakespeareUsedIdentifiers ShakespeareSettings
settings = (Content -> [(Deref, VarType)]) -> [Content] -> [(Deref, VarType)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Content -> [(Deref, VarType)]
getVars ([Content] -> [(Deref, VarType)])
-> (SourceName -> [Content]) -> SourceName -> [(Deref, VarType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShakespeareSettings -> SourceName -> [Content]
contentFromString ShakespeareSettings
settings

type MTime = UTCTime

{-# NOINLINE reloadMapRef #-}
reloadMapRef :: IORef (M.Map FilePath (MTime, [Content]))
reloadMapRef :: IORef (Map SourceName (MTime, [Content]))
reloadMapRef = IO (IORef (Map SourceName (MTime, [Content])))
-> IORef (Map SourceName (MTime, [Content]))
forall a. IO a -> a
unsafePerformIO (IO (IORef (Map SourceName (MTime, [Content])))
 -> IORef (Map SourceName (MTime, [Content])))
-> IO (IORef (Map SourceName (MTime, [Content])))
-> IORef (Map SourceName (MTime, [Content]))
forall a b. (a -> b) -> a -> b
$ Map SourceName (MTime, [Content])
-> IO (IORef (Map SourceName (MTime, [Content])))
forall a. a -> IO (IORef a)
newIORef Map SourceName (MTime, [Content])
forall k a. Map k a
M.empty

lookupReloadMap :: FilePath -> IO (Maybe (MTime, [Content]))
lookupReloadMap :: SourceName -> IO (Maybe (MTime, [Content]))
lookupReloadMap SourceName
fp = do
  Map SourceName (MTime, [Content])
reloads <- IORef (Map SourceName (MTime, [Content]))
-> IO (Map SourceName (MTime, [Content]))
forall a. IORef a -> IO a
readIORef IORef (Map SourceName (MTime, [Content]))
reloadMapRef
  Maybe (MTime, [Content]) -> IO (Maybe (MTime, [Content]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MTime, [Content]) -> IO (Maybe (MTime, [Content])))
-> Maybe (MTime, [Content]) -> IO (Maybe (MTime, [Content]))
forall a b. (a -> b) -> a -> b
$ SourceName
-> Map SourceName (MTime, [Content]) -> Maybe (MTime, [Content])
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SourceName
fp Map SourceName (MTime, [Content])
reloads

insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content]
insertReloadMap :: SourceName -> (MTime, [Content]) -> IO [Content]
insertReloadMap SourceName
fp (MTime
mt, [Content]
content) = IORef (Map SourceName (MTime, [Content]))
-> (Map SourceName (MTime, [Content])
    -> (Map SourceName (MTime, [Content]), [Content]))
-> IO [Content]
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (Map SourceName (MTime, [Content]))
reloadMapRef
  (\Map SourceName (MTime, [Content])
reloadMap -> (SourceName
-> (MTime, [Content])
-> Map SourceName (MTime, [Content])
-> Map SourceName (MTime, [Content])
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert SourceName
fp (MTime
mt, [Content]
content) Map SourceName (MTime, [Content])
reloadMap, [Content]
content))

shakespeareFileReload :: ShakespeareSettings -> FilePath -> Q Exp
shakespeareFileReload :: ShakespeareSettings -> SourceName -> Q Exp
shakespeareFileReload ShakespeareSettings
settings SourceName
fp = do
    SourceName
str <- SourceName -> Q SourceName
readFileQ SourceName
fp
    SourceName
s <- IO SourceName -> Q SourceName
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO (IO SourceName -> Q SourceName) -> IO SourceName -> Q SourceName
forall a b. (a -> b) -> a -> b
$ Maybe SourceName
-> ShakespeareSettings -> SourceName -> IO SourceName
preFilter (SourceName -> Maybe SourceName
forall a. a -> Maybe a
Just SourceName
fp) ShakespeareSettings
settings SourceName
str
    let b :: [(Deref, VarType)]
b = ShakespeareSettings -> SourceName -> [(Deref, VarType)]
shakespeareUsedIdentifiers ShakespeareSettings
settings SourceName
s
    [Exp]
c <- ((Deref, VarType) -> Q Exp) -> [(Deref, VarType)] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Deref, VarType) -> Q Exp
vtToExp [(Deref, VarType)]
b
    Exp
rt <- [|shakespeareRuntime settings fp|]
    Exp
wrap' <- [|\x -> $(return $ wrap settings) . x|]
    Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Exp
wrap' Exp -> Exp -> Exp
`AppE` (Exp
rt Exp -> Exp -> Exp
`AppE` [Exp] -> Exp
ListE [Exp]
c)
  where
    vtToExp :: (Deref, VarType) -> Q Exp
    vtToExp :: (Deref, VarType) -> Q Exp
vtToExp (Deref
d, VarType
vt) = do
        Exp
d' <- Deref -> Q Exp
forall t. Lift t => t -> Q Exp
lift Deref
d
        Exp
c' <- VarType -> Q Exp
c VarType
vt
        Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Maybe Exp] -> Exp
TupE
#if MIN_VERSION_template_haskell(2,16,0)
          ([Maybe Exp] -> Exp) -> [Maybe Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ (Exp -> Maybe Exp) -> [Exp] -> [Maybe Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Maybe Exp
forall a. a -> Maybe a
Just
#endif
          [Exp
d', Exp
c' Exp -> Exp -> Exp
`AppE` Scope -> Deref -> Exp
derefToExp [] Deref
d]
      where
        c :: VarType -> Q Exp
        c :: VarType -> Q Exp
c VarType
VTPlain = [|EPlain . $(return $
          InfixE (Just $ unwrap settings) (VarE '(.)) (Just $ toBuilder settings))|]
        c VarType
VTUrl = [|EUrl|]
        c VarType
VTUrlParam = [|EUrlParam|]
        c VarType
VTMixin = [|\x -> EMixin $ \r -> $(return $ unwrap settings) $ x r|]



nothingError :: Show a => String -> a -> b
nothingError :: SourceName -> a -> b
nothingError SourceName
expected a
d = SourceName -> b
forall a. HasCallStack => SourceName -> a
error (SourceName -> b) -> SourceName -> b
forall a b. (a -> b) -> a -> b
$ SourceName
"expected " SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
expected SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
" but got Nothing for: " SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> SourceName
forall a. Show a => a -> SourceName
show a
d

shakespeareRuntime :: ShakespeareSettings -> FilePath -> [(Deref, VarExp url)] -> Shakespeare url
shakespeareRuntime :: ShakespeareSettings
-> SourceName -> [(Deref, VarExp url)] -> Shakespeare url
shakespeareRuntime ShakespeareSettings
settings SourceName
fp [(Deref, VarExp url)]
cd RenderUrl url
render' = IO Builder -> Builder
forall a. IO a -> a
unsafePerformIO (IO Builder -> Builder) -> IO Builder -> Builder
forall a b. (a -> b) -> a -> b
$ do
    MTime
mtime <- IO MTime -> IO MTime
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO (IO MTime -> IO MTime) -> IO MTime -> IO MTime
forall a b. (a -> b) -> a -> b
$ SourceName -> IO MTime
getModificationTime SourceName
fp
    Maybe (MTime, [Content])
mdata <- SourceName -> IO (Maybe (MTime, [Content]))
lookupReloadMap SourceName
fp
    case Maybe (MTime, [Content])
mdata of
      Just (MTime
lastMtime, [Content]
lastContents) ->
        if MTime
mtime MTime -> MTime -> Bool
forall a. Eq a => a -> a -> Bool
== MTime
lastMtime then Builder -> IO Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> IO Builder) -> Builder -> IO Builder
forall a b. (a -> b) -> a -> b
$ [Content] -> Builder
go' [Content]
lastContents
          else ([Content] -> Builder) -> IO [Content] -> IO Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Content] -> Builder
go' (IO [Content] -> IO Builder) -> IO [Content] -> IO Builder
forall a b. (a -> b) -> a -> b
$ MTime -> IO [Content]
newContent MTime
mtime
      Maybe (MTime, [Content])
Nothing -> ([Content] -> Builder) -> IO [Content] -> IO Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Content] -> Builder
go' (IO [Content] -> IO Builder) -> IO [Content] -> IO Builder
forall a b. (a -> b) -> a -> b
$ MTime -> IO [Content]
newContent MTime
mtime
  where
    newContent :: MTime -> IO [Content]
newContent MTime
mtime = do
        SourceName
str <- SourceName -> IO SourceName
readUtf8FileString SourceName
fp
        SourceName
s <- Maybe SourceName
-> ShakespeareSettings -> SourceName -> IO SourceName
preFilter (SourceName -> Maybe SourceName
forall a. a -> Maybe a
Just SourceName
fp) ShakespeareSettings
settings SourceName
str
        SourceName -> (MTime, [Content]) -> IO [Content]
insertReloadMap SourceName
fp (MTime
mtime, ShakespeareSettings -> SourceName -> [Content]
contentFromString ShakespeareSettings
settings SourceName
s)

    go' :: [Content] -> Builder
go' = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> ([Content] -> [Builder]) -> [Content] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content -> Builder) -> [Content] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Content -> Builder
go

    go :: Content -> Builder
    go :: Content -> Builder
go (ContentRaw SourceName
s) = Text -> Builder
fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ SourceName -> Text
TS.pack SourceName
s
    go (ContentVar Deref
d) =
        case Deref -> [(Deref, VarExp url)] -> Maybe (VarExp url)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Deref
d [(Deref, VarExp url)]
cd of
            Just (EPlain Builder
s) -> Builder
s
            Maybe (VarExp url)
_ -> SourceName -> Deref -> Builder
forall a b. Show a => SourceName -> a -> b
nothingError SourceName
"EPlain" Deref
d
    go (ContentUrl Deref
d) =
        case Deref -> [(Deref, VarExp url)] -> Maybe (VarExp url)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Deref
d [(Deref, VarExp url)]
cd of
            Just (EUrl url
u) -> Text -> Builder
fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ RenderUrl url
render' url
u []
            Maybe (VarExp url)
_ -> SourceName -> Deref -> Builder
forall a b. Show a => SourceName -> a -> b
nothingError SourceName
"EUrl" Deref
d
    go (ContentUrlParam Deref
d) =
        case Deref -> [(Deref, VarExp url)] -> Maybe (VarExp url)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Deref
d [(Deref, VarExp url)]
cd of
            Just (EUrlParam (url
u, [(Text, Text)]
p)) ->
                Text -> Builder
fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ RenderUrl url
render' url
u [(Text, Text)]
p
            Maybe (VarExp url)
_ -> SourceName -> Deref -> Builder
forall a b. Show a => SourceName -> a -> b
nothingError SourceName
"EUrlParam" Deref
d
    go (ContentMix Deref
d) =
        case Deref -> [(Deref, VarExp url)] -> Maybe (VarExp url)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Deref
d [(Deref, VarExp url)]
cd of
            Just (EMixin Shakespeare url
m) -> Shakespeare url
m RenderUrl url
render'
            Maybe (VarExp url)
_ -> SourceName -> Deref -> Builder
forall a b. Show a => SourceName -> a -> b
nothingError SourceName
"EMixin" Deref
d