{-# 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 :: forall tok a1 a.
GenParser tok [a1] a -> FilePath -> [tok] -> Either ParseError a
parse GenParser tok [a1] a
p = forall tok st a.
GenParser tok st a
-> st -> FilePath -> [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 -> FilePath
preEscapeIgnoreBalanced :: [Char]
    , PreConvert -> FilePath
preEscapeIgnoreLine :: [Char]
    , PreConvert -> Maybe WrapInsertion
wrapInsertion :: Maybe WrapInsertion
    }
    deriving forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => PreConvert -> m Exp
forall (m :: * -> *). Quote m => PreConvert -> Code m PreConvert
liftTyped :: forall (m :: * -> *). Quote m => PreConvert -> Code m PreConvert
$cliftTyped :: forall (m :: * -> *). Quote m => PreConvert -> Code m PreConvert
lift :: forall (m :: * -> *). Quote m => PreConvert -> m Exp
$clift :: forall (m :: * -> *). Quote m => PreConvert -> m Exp
Lift

data WrapInsertion = WrapInsertion {
      WrapInsertion -> Maybe FilePath
wrapInsertionIndent     :: Maybe String
    , WrapInsertion -> FilePath
wrapInsertionStartBegin :: String
    , WrapInsertion -> FilePath
wrapInsertionSeparator  :: String
    , WrapInsertion -> FilePath
wrapInsertionStartClose :: String
    , WrapInsertion -> FilePath
wrapInsertionEnd :: String
    , WrapInsertion -> Bool
wrapInsertionAddParens :: Bool
    }
    deriving forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => WrapInsertion -> m Exp
forall (m :: * -> *).
Quote m =>
WrapInsertion -> Code m WrapInsertion
liftTyped :: forall (m :: * -> *).
Quote m =>
WrapInsertion -> Code m WrapInsertion
$cliftTyped :: forall (m :: * -> *).
Quote m =>
WrapInsertion -> Code m WrapInsertion
lift :: forall (m :: * -> *). Quote m => WrapInsertion -> m Exp
$clift :: forall (m :: * -> *). Quote m => WrapInsertion -> m Exp
Lift

data PreConversion = ReadProcess String [String]
                   | Id
    deriving forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => PreConversion -> m Exp
forall (m :: * -> *).
Quote m =>
PreConversion -> Code m PreConversion
liftTyped :: forall (m :: * -> *).
Quote m =>
PreConversion -> Code m PreConversion
$cliftTyped :: forall (m :: * -> *).
Quote m =>
PreConversion -> Code m PreConversion
lift :: forall (m :: * -> *). Quote m => PreConversion -> m Exp
$clift :: forall (m :: * -> *). Quote m => PreConversion -> m 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 {
    varChar :: Char
varChar = Char
'#'
  , urlChar :: Char
urlChar = Char
'@'
  , intChar :: Char
intChar = Char
'^'
  , justVarInterpolation :: Bool
justVarInterpolation = Bool
False
  , preConversion :: Maybe PreConvert
preConversion = forall a. Maybe a
Nothing
  , modifyFinalValue :: Maybe Exp
modifyFinalValue = forall a. Maybe a
Nothing
}

instance Lift ShakespeareSettings where
    lift :: forall (m :: * -> *). Quote m => ShakespeareSettings -> m 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 -> m Exp
liftExp (VarE Name
n) = [|VarE $(lift n)|]
        liftExp (ConE Name
n) = [|ConE $(lift n)|]
        liftExp Exp
_ = forall a. HasCallStack => FilePath -> a
error FilePath
"liftExp only supports VarE and ConE"
        liftMExp :: Maybe Exp -> m Exp
liftMExp Maybe Exp
Nothing = [|Nothing|]
        liftMExp (Just Exp
e) = [|Just|] forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` forall {m :: * -> *}. Quote m => Exp -> m Exp
liftExp Exp
e
#if MIN_VERSION_template_haskell(2,17,0)
    liftTyped :: forall (m :: * -> *).
Quote m =>
ShakespeareSettings -> Code m ShakespeareSettings
liftTyped = forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift
#elif MIN_VERSION_template_haskell(2,16,0)
    liftTyped = unsafeTExpCoerce . 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 -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Content] -> ShowS
$cshowList :: [Content] -> ShowS
show :: Content -> FilePath
$cshow :: Content -> FilePath
showsPrec :: Int -> Content -> ShowS
$cshowsPrec :: Int -> Content -> ShowS
Show, Content -> Content -> Bool
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 :: forall c. Either ParseError c -> c
eShowErrors = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => FilePath -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) forall a. a -> a
id

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

parseContents :: ShakespeareSettings -> Parser Contents
parseContents :: ShakespeareSettings -> Parser [Content]
parseContents = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShakespeareSettings -> Parser Content
parseContent
  where
    parseContent :: ShakespeareSettings -> Parser Content
    parseContent :: ShakespeareSettings -> Parser 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
..} =
        forall {a}. ParsecT FilePath a Identity Content
parseVar' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {a}. ParsecT FilePath a Identity Content
parseUrl' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {a}. ParsecT FilePath a Identity Content
parseInt' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {a}. ParsecT FilePath a Identity Content
parseChar'
      where
        parseVar' :: ParsecT FilePath a Identity Content
parseVar' = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> Content
ContentRaw Deref -> Content
ContentVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. Char -> UserParser a (Either FilePath Deref)
parseVar Char
varChar
        parseUrl' :: ParsecT FilePath a Identity Content
parseUrl' = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> Content
ContentRaw (Deref, Bool) -> Content
contentUrl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a.
Char -> Char -> UserParser a (Either FilePath (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 FilePath a Identity Content
parseInt' = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> Content
ContentRaw Deref -> Content
ContentMix forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. Char -> UserParser a (Either FilePath Deref)
parseInt Char
intChar
        parseChar' :: ParsecT FilePath u Identity Content
parseChar' = FilePath -> Content
ContentRaw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> 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 :: FilePath -> [FilePath] -> FilePath -> Maybe FilePath -> IO FilePath
readProcessError FilePath
cmd [FilePath]
args FilePath
input Maybe FilePath
mfp = do
  (ExitCode
ex, FilePath
output, FilePath
err) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode FilePath
cmd [FilePath]
args FilePath
input
  case ExitCode
ex of
   ExitCode
ExitSuccess   ->
     case FilePath
err of
       [] -> forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
output
       FilePath
msg -> forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"stderr received during readProcess:" forall a. [a] -> [a] -> [a]
++ FilePath
displayCmd forall a. [a] -> [a] -> [a]
++ FilePath
"\n\n" forall a. [a] -> [a] -> [a]
++ FilePath
msg
   ExitFailure Int
r ->
    forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"exit code " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Int
r forall a. [a] -> [a] -> [a]
++ FilePath
" from readProcess: " forall a. [a] -> [a] -> [a]
++ FilePath
displayCmd forall a. [a] -> [a] -> [a]
++ FilePath
"\n\n"
      forall a. [a] -> [a] -> [a]
++ FilePath
"stderr:\n" forall a. [a] -> [a] -> [a]
++ FilePath
err
  where
    displayCmd :: FilePath
displayCmd = FilePath
cmd forall a. [a] -> [a] -> [a]
++ Char
' 'forall a. a -> [a] -> [a]
:[FilePath] -> FilePath
unwords (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> FilePath
show [FilePath]
args) forall a. [a] -> [a] -> [a]
++
        case Maybe FilePath
mfp of
          Maybe FilePath
Nothing -> FilePath
""
          Just FilePath
fp -> Char
' 'forall a. a -> [a] -> [a]
:FilePath
fp

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

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

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

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

    parseConvertWrapInsertion :: Maybe a
-> PreConvert
-> ParsecT FilePath [FilePath] Identity ([FilePath], [FilePath])
parseConvertWrapInsertion Maybe a
Nothing = ShowS
-> PreConvert
-> ParsecT FilePath [FilePath] Identity ([FilePath], [FilePath])
parseConvert forall a. a -> a
id
    parseConvertWrapInsertion (Just a
_) = ShowS
-> PreConvert
-> ParsecT FilePath [FilePath] Identity ([FilePath], [FilePath])
parseConvert ShowS
shakespeare_var_conversion

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

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

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

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

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

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

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

contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp
contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp
contentsToShakespeare ShakespeareSettings
rs [Content]
a = do
    Name
r <- forall (m :: * -> *). Quote m => FilePath -> m Name
newName FilePath
"_render"
    [Exp]
c <- 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
        []  -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Exp -> Exp -> Exp
AppE forall a b. (a -> b) -> a -> b
$ ShakespeareSettings -> Exp
wrap ShakespeareSettings
rs) [|mempty|]
        [Exp
x] -> forall (m :: * -> *) a. Monad m => a -> m a
return Exp
x
        [Exp]
_   -> do
              Exp
mc <- [|mconcat|]
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exp
mc Exp -> Exp -> Exp
`AppE` [Exp] -> Exp
ListE [Exp]
c
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id Exp -> Exp -> Exp
AppE forall a b. (a -> b) -> a -> b
$ ShakespeareSettings -> Maybe Exp
modifyFinalValue ShakespeareSettings
rs) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return 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 FilePath
s') = do
            Exp
ts <- [|fromText . pack'|]
            forall (m :: * -> *) a. Monad m => a -> m a
return 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 (FilePath -> Lit
StringL FilePath
s'))
        contentToBuilder Name
_ (ContentVar Deref
d) =
            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|]
            forall (m :: * -> *) a. Monad m => a -> m a
return 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|]
            forall (m :: * -> *) a. Monad m => a -> m a
return 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) =
            forall (m :: * -> *) a. Monad m => a -> m a
return 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 { quoteExp :: FilePath -> Q Exp
quoteExp = ShakespeareSettings -> FilePath -> Q Exp
shakespeareFromString ShakespeareSettings
r }

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

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

data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin
    deriving (Int -> VarType -> ShowS
[VarType] -> ShowS
VarType -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [VarType] -> ShowS
$cshowList :: [VarType] -> ShowS
show :: VarType -> FilePath
$cshow :: VarType -> FilePath
showsPrec :: Int -> VarType -> ShowS
$cshowsPrec :: Int -> VarType -> ShowS
Show, VarType -> VarType -> Bool
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
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
Ord, Int -> VarType
VarType -> Int
VarType -> [VarType]
VarType -> VarType
VarType -> VarType -> [VarType]
VarType -> VarType -> VarType -> [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
forall a. a -> a -> Bounded a
maxBound :: VarType
$cmaxBound :: VarType
minBound :: VarType
$cminBound :: VarType
Bounded, Typeable, Typeable VarType
VarType -> DataType
VarType -> Constr
(forall b. Data b => b -> b) -> VarType -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> VarType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> VarType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> VarType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> VarType -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, 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 -> FilePath -> [(Deref, VarType)]
shakespeareUsedIdentifiers ShakespeareSettings
settings = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Content -> [(Deref, VarType)]
getVars forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShakespeareSettings -> FilePath -> [Content]
contentFromString ShakespeareSettings
settings

type MTime = UTCTime

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

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

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

shakespeareFileReload :: ShakespeareSettings -> FilePath -> Q Exp
shakespeareFileReload :: ShakespeareSettings -> FilePath -> Q Exp
shakespeareFileReload ShakespeareSettings
settings FilePath
fp = do
    FilePath
str <- FilePath -> Q FilePath
readFileQ FilePath
fp
    FilePath
s <- forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> ShakespeareSettings -> FilePath -> IO FilePath
preFilter (forall a. a -> Maybe a
Just FilePath
fp) ShakespeareSettings
settings FilePath
str
    let b :: [(Deref, VarType)]
b = ShakespeareSettings -> FilePath -> [(Deref, VarType)]
shakespeareUsedIdentifiers ShakespeareSettings
settings FilePath
s
    [Exp]
c <- 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|]
    forall (m :: * -> *) a. Monad m => a -> m a
return 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' <- forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift Deref
d
        Exp
c' <- VarType -> Q Exp
c VarType
vt
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Maybe Exp] -> Exp
TupE
#if MIN_VERSION_template_haskell(2,16,0)
          forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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 :: forall a b. Show a => FilePath -> a -> b
nothingError FilePath
expected a
d = forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"expected " forall a. [a] -> [a] -> [a]
++ FilePath
expected forall a. [a] -> [a] -> [a]
++ FilePath
" but got Nothing for: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show a
d

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

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

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