{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# 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.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 p :: 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
    }

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
    }

data PreConversion = ReadProcess String [String]
                   | Id
  


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 = '#'
  , urlChar :: Char
urlChar = '@'
  , intChar :: Char
intChar = '^'
  , 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 PreConvert where
    lift :: PreConvert -> Q Exp
lift (PreConvert convert :: PreConversion
convert ignore :: SourceName
ignore comment :: SourceName
comment wrapInsertion :: Maybe WrapInsertion
wrapInsertion) =
        [|PreConvert $(lift convert) $(lift ignore) $(lift comment) $(lift wrapInsertion)|]

instance Lift WrapInsertion where
    lift :: WrapInsertion -> Q Exp
lift (WrapInsertion indent :: Maybe SourceName
indent sb :: SourceName
sb sep :: SourceName
sep sc :: SourceName
sc e :: SourceName
e wp :: Bool
wp) =
        [|WrapInsertion $(lift indent) $(lift sb) $(lift sep) $(lift sc) $(lift e) $(lift wp)|]

instance Lift PreConversion where
    lift :: PreConversion -> Q Exp
lift (ReadProcess command :: SourceName
command args :: [SourceName]
args) =
        [|ReadProcess $(lift command) $(lift args)|]
    lift Id = [|Id|]

instance Lift ShakespeareSettings where
    lift :: ShakespeareSettings -> Q Exp
lift (ShakespeareSettings x1 :: Char
x1 x2 :: Char
x2 x3 :: Char
x3 x4 :: Exp
x4 x5 :: Exp
x5 x6 :: Exp
x6 x7 :: Bool
x7 x8 :: Maybe PreConvert
x8 x9 :: 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 n :: Name
n) = [|VarE $(liftName n)|]
        liftExp (ConE n :: Name
n) = [|ConE $(liftName n)|]
        liftExp _ = SourceName -> Q Exp
forall a. HasCallStack => SourceName -> a
error "liftExp only supports VarE and ConE"
        liftMExp :: Maybe Exp -> Q Exp
liftMExp Nothing = [|Nothing|]
        liftMExp (Just e :: Exp
e) = [|Just|] Q Exp -> Q Exp -> Q Exp
`appE` Exp -> Q Exp
liftExp Exp
e
        liftName :: Name -> Q Exp
liftName (Name (OccName a :: SourceName
a) b :: NameFlavour
b) = [|Name (OccName $(lift a)) $(liftFlavour b)|]
        liftFlavour :: NameFlavour -> Q Exp
liftFlavour NameS = [|NameS|]
        liftFlavour (NameQ (ModName a :: SourceName
a)) = [|NameQ (ModName $(lift a))|]
        liftFlavour (NameU _) = SourceName -> Q Exp
forall a. HasCallStack => SourceName -> a
error "liftFlavour NameU" -- [|NameU $(lift $ fromIntegral a)|]
        liftFlavour (NameL _) = SourceName -> Q Exp
forall a. HasCallStack => SourceName -> a
error "liftFlavour NameL" -- [|NameU $(lift $ fromIntegral a)|]
        liftFlavour (NameG ns :: NameSpace
ns (PkgName p :: SourceName
p) (ModName m :: SourceName
m)) = [|NameG $(liftNS ns) (PkgName $(lift p)) (ModName $(lift m))|]
        liftNS :: NameSpace -> Q Exp
liftNS VarName = [|VarName|]
        liftNS DataName = [|DataName|]

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 _ "" = []
contentFromString rs :: ShakespeareSettings
rs s :: 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 x :: SourceName
x:ContentRaw y :: SourceName
y:z :: [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 (x :: Content
x:y :: [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 {..} =
        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 '?'
          where
            contentUrl :: (Deref, Bool) -> Content
contentUrl (d :: Deref
d, False) = Deref -> Content
ContentUrl Deref
d
            contentUrl (d :: Deref
d, 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 cmd :: SourceName
cmd args :: [SourceName]
args input :: SourceName
input mfp :: Maybe SourceName
mfp = do
  (ex :: ExitCode
ex, output :: SourceName
output, err :: SourceName
err) <- SourceName
-> [SourceName]
-> SourceName
-> IO (ExitCode, SourceName, SourceName)
readProcessWithExitCode SourceName
cmd [SourceName]
args SourceName
input
  case ExitCode
ex of
   ExitSuccess   ->
     case SourceName
err of
       [] -> SourceName -> IO SourceName
forall (m :: * -> *) a. Monad m => a -> m a
return SourceName
output
       msg :: SourceName
msg -> SourceName -> IO SourceName
forall a. HasCallStack => SourceName -> a
error (SourceName -> IO SourceName) -> SourceName -> IO SourceName
forall a b. (a -> b) -> a -> b
$ "stderr received during readProcess:" SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
displayCmd SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n\n" SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
msg
   ExitFailure r :: Int
r ->
    SourceName -> IO SourceName
forall a. HasCallStack => SourceName -> a
error (SourceName -> IO SourceName) -> SourceName -> IO SourceName
forall a b. (a -> b) -> a -> b
$ "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]
++ " from readProcess: " SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
displayCmd SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n\n"
      SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ "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 -> 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
          Nothing -> ""
          Just fp :: SourceName
fp -> ' '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 mfp :: Maybe SourceName
mfp ShakespeareSettings {..} template :: SourceName
template =
    case Maybe PreConvert
preConversion of
      Nothing -> SourceName -> IO SourceName
forall (m :: * -> *) a. Monad m => a -> m a
return SourceName
template
      Just pre :: PreConvert
pre@(PreConvert convert :: PreConversion
convert _ _ mWrapI :: 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 (groups :: [SourceName]
groups, rvars :: [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
                  Id -> SourceName -> IO SourceName
forall (m :: * -> *) a. Monad m => a -> m a
return SourceName
withVars
                  ReadProcess command :: SourceName
command args :: [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 Nothing str :: SourceName
str = SourceName
str
    addIndent (Just indent :: SourceName
indent) str :: SourceName
str = ShowS -> ShowS
mapLines (\line :: SourceName
line -> SourceName
indent SourceName -> ShowS
forall a. Semigroup a => a -> a -> a
<> SourceName
line) SourceName
str
      where
        mapLines :: ShowS -> ShowS
mapLines f :: 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 = "shakespeare_var_"
    shakespeare_var_conversion :: ShowS
shakespeare_var_conversion ('@':'?':'{':str :: SourceName
str) = ShowS
shakespeare_var_conversion ('@'Char -> ShowS
forall a. a -> [a] -> [a]
:'{'Char -> ShowS
forall a. a -> [a] -> [a]
:SourceName
str)
    shakespeare_var_conversion (_:'{':str :: 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 err :: SourceName
err = ShowS
forall a. HasCallStack => SourceName -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ "did not expect: " SourceName -> ShowS
forall a. Semigroup a => a -> a -> a
<> SourceName
err

    applyVars :: Maybe WrapInsertion -> [SourceName] -> ShowS
applyVars _      [] str :: SourceName
str = SourceName
str
    applyVars Nothing _ str :: SourceName
str = SourceName
str
    applyVars (Just WrapInsertion {..}) vars :: [SourceName]
vars str :: SourceName
str =
         (if Bool
wrapInsertionAddParens then "(" else "")
      SourceName -> ShowS
forall a. Semigroup a => a -> a -> a
<> SourceName
removeTrailingSemiColon
      SourceName -> ShowS
forall a. Semigroup a => a -> a -> a
<> (if Bool
wrapInsertionAddParens then ")" else "")
      SourceName -> ShowS
forall a. Semigroup a => a -> a -> a
<> "("
      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]
vars)
      SourceName -> ShowS
forall a. Semigroup a => a -> a -> a
<> ");\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 (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ';' Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c) (ShowS
forall a. [a] -> [a]
reverse SourceName
str)

    addVars :: Maybe WrapInsertion -> [SourceName] -> ShowS
addVars _      [] str :: SourceName
str = SourceName
str
    addVars Nothing _ str :: SourceName
str = SourceName
str
    addVars (Just WrapInsertion {..}) vars :: [SourceName]
vars str :: 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 Nothing = ShowS
-> PreConvert
-> GenParser Char [SourceName] ([SourceName], [SourceName])
parseConvert ShowS
forall a. a -> a
id
    parseConvertWrapInsertion (Just _) = ShowS
-> PreConvert
-> GenParser Char [SourceName] ([SourceName], [SourceName])
parseConvert ShowS
shakespeare_var_conversion

    parseConvert :: ShowS
-> PreConvert
-> GenParser Char [SourceName] ([SourceName], [SourceName])
parseConvert varConvert :: ShowS
varConvert PreConvert {..} = 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 ignoreC :: 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 str :: SourceName
str)  = SourceName -> ParsecT s [SourceName] m SourceName
forall (m :: * -> *) a. Monad m => a -> m a
return SourceName
str
        recordRight (Right str :: SourceName
str) = ([SourceName] -> [SourceName]) -> ParsecT s [SourceName] m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState (\vars :: [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 = "\r\n"
        parseCommentLine :: SourceName -> ParsecT s u m SourceName
parseCommentLine cs :: 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 '?'
        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' comments :: SourceName
comments ignores :: 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 rs :: ShakespeareSettings
rs a :: [Content]
a = do
    Name
r <- SourceName -> Q Name
newName "_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|]
        [x :: Exp
x] -> Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
x
        _   -> 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 _ (ContentRaw s' :: 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 _ (ContentVar d :: 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 r :: Name
r (ContentUrl d :: 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 r :: Name
r (ContentUrlParam d :: 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 r :: Name
r (ContentMix d :: 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 r :: 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 r :: ShakespeareSettings
r str :: 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 r :: ShakespeareSettings
r fp :: 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 d :: Deref
d) = [(Deref
d, VarType
VTPlain)]
getVars (ContentUrl d :: Deref
d) = [(Deref
d, VarType
VTUrl)]
getVars (ContentUrlParam d :: Deref
d) = [(Deref
d, VarType
VTUrlParam)]
getVars (ContentMix d :: 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 settings :: 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 fp :: 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 fp :: SourceName
fp (mt :: MTime
mt, content :: [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
  (\reloadMap :: 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 settings :: ShakespeareSettings
settings fp :: 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 (d :: Deref
d, vt :: 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
$ [Exp] -> Exp
TupE
#if MIN_VERSION_template_haskell(2,16,0)
          $ map 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 VTPlain = [|EPlain . $(return $
          InfixE (Just $ unwrap settings) (VarE '(.)) (Just $ toBuilder settings))|]
        c VTUrl = [|EUrl|]
        c VTUrlParam = [|EUrlParam|]
        c VTMixin = [|\x -> EMixin $ \r -> $(return $ unwrap settings) $ x r|]



nothingError :: Show a => String -> a -> b
nothingError :: SourceName -> a -> b
nothingError expected :: SourceName
expected d :: a
d = SourceName -> b
forall a. HasCallStack => SourceName -> a
error (SourceName -> b) -> SourceName -> b
forall a b. (a -> b) -> a -> b
$ "expected " SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
expected SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ " 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 settings :: ShakespeareSettings
settings fp :: SourceName
fp cd :: [(Deref, VarExp url)]
cd render' :: 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 (lastMtime :: MTime
lastMtime, lastContents :: [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
      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
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 s :: SourceName
s) = Text -> Builder
fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ SourceName -> Text
TS.pack SourceName
s
    go (ContentVar d :: 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 s :: Builder
s) -> Builder
s
            _ -> SourceName -> Deref -> Builder
forall a b. Show a => SourceName -> a -> b
nothingError "EPlain" Deref
d
    go (ContentUrl d :: 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 u :: url
u) -> Text -> Builder
fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ RenderUrl url
render' url
u []
            _ -> SourceName -> Deref -> Builder
forall a b. Show a => SourceName -> a -> b
nothingError "EUrl" Deref
d
    go (ContentUrlParam d :: 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 (u :: url
u, p :: QueryParameters
p)) ->
                Text -> Builder
fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ RenderUrl url
render' url
u QueryParameters
p
            _ -> SourceName -> Deref -> Builder
forall a b. Show a => SourceName -> a -> b
nothingError "EUrlParam" Deref
d
    go (ContentMix d :: 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 m :: Shakespeare url
m) -> Shakespeare url
m RenderUrl url
render'
            _ -> SourceName -> Deref -> Builder
forall a b. Show a => SourceName -> a -> b
nothingError "EMixin" Deref
d