{-# 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 = GenParser tok [a1] a
-> [a1] -> FilePath -> [tok] -> Either ParseError a
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 (m :: * -> *). Quote m => PreConvert -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    PreConvert -> Code m PreConvert)
-> Lift PreConvert
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
$clift :: forall (m :: * -> *). Quote m => PreConvert -> m Exp
lift :: forall (m :: * -> *). Quote m => PreConvert -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => PreConvert -> Code m PreConvert
liftTyped :: forall (m :: * -> *). Quote m => PreConvert -> Code m PreConvert
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 (m :: * -> *). Quote m => WrapInsertion -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    WrapInsertion -> Code m WrapInsertion)
-> Lift WrapInsertion
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
$clift :: forall (m :: * -> *). Quote m => WrapInsertion -> m Exp
lift :: forall (m :: * -> *). Quote m => WrapInsertion -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
WrapInsertion -> Code m WrapInsertion
liftTyped :: forall (m :: * -> *).
Quote m =>
WrapInsertion -> Code m WrapInsertion
Lift

data PreConversion = ReadProcess String [String]
                   | Id
    deriving (forall (m :: * -> *). Quote m => PreConversion -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    PreConversion -> Code m PreConversion)
-> Lift PreConversion
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
$clift :: forall (m :: * -> *). Quote m => PreConversion -> m Exp
lift :: forall (m :: * -> *). Quote m => PreConversion -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
PreConversion -> Code m PreConversion
liftTyped :: forall (m :: * -> *).
Quote m =>
PreConversion -> Code m PreConversion
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 = Maybe PreConvert
forall a. Maybe a
Nothing
  , modifyFinalValue :: Maybe Exp
modifyFinalValue = Maybe Exp
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
            $(Char -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Char -> m Exp
lift Char
x1) $(Char -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Char -> m Exp
lift Char
x2) $(Char -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Char -> m Exp
lift Char
x3)
            $(Exp -> m Exp
forall {m :: * -> *}. Quote m => Exp -> m Exp
liftExp Exp
x4) $(Exp -> m Exp
forall {m :: * -> *}. Quote m => Exp -> m Exp
liftExp Exp
x5) $(Exp -> m Exp
forall {m :: * -> *}. Quote m => Exp -> m Exp
liftExp Exp
x6) $(Bool -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Bool -> m Exp
lift Bool
x7) $(Maybe PreConvert -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Maybe PreConvert -> m Exp
lift Maybe PreConvert
x8) $(Maybe Exp -> m Exp
forall {m :: * -> *}. Quote m => Maybe Exp -> m Exp
liftMExp Maybe Exp
x9)|]
      where
        liftExp :: Exp -> m Exp
liftExp (VarE Name
n) = [|VarE $(Name -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Name -> m Exp
lift Name
n)|]
        liftExp (ConE Name
n) = [|ConE $(Name -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Name -> m Exp
lift Name
n)|]
        liftExp Exp
_ = FilePath -> m 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|] m Exp -> m Exp -> m Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Exp -> m Exp
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 = m Exp -> Code m ShakespeareSettings
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (m Exp -> Code m ShakespeareSettings)
-> (ShakespeareSettings -> m Exp)
-> ShakespeareSettings
-> Code m ShakespeareSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShakespeareSettings -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => ShakespeareSettings -> 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
(Int -> Content -> ShowS)
-> (Content -> FilePath) -> ([Content] -> ShowS) -> Show Content
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Content -> ShowS
showsPrec :: Int -> Content -> ShowS
$cshow :: Content -> FilePath
show :: Content -> FilePath
$cshowList :: [Content] -> ShowS
showList :: [Content] -> ShowS
Show, Content -> Content -> Bool
(Content -> Content -> Bool)
-> (Content -> Content -> Bool) -> Eq Content
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Content -> Content -> Bool
== :: Content -> Content -> Bool
$c/= :: Content -> Content -> Bool
/= :: Content -> Content -> Bool
Eq)
type Contents = [Content]

eShowErrors :: Either ParseError c -> c
eShowErrors :: forall c. 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 (FilePath -> c
forall a. HasCallStack => FilePath -> a
error (FilePath -> c) -> (ParseError -> FilePath) -> ParseError -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> FilePath
forall a. Show a => a -> FilePath
show) c -> c
forall a. a -> a
id

contentFromString :: ShakespeareSettings -> String -> [Content]
contentFromString :: ShakespeareSettings -> FilePath -> [Content]
contentFromString ShakespeareSettings
_ FilePath
"" = []
contentFromString ShakespeareSettings
rs FilePath
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 [FilePath] [Content]
-> FilePath -> FilePath -> Either ParseError [Content]
forall tok a1 a.
GenParser tok [a1] a -> FilePath -> [tok] -> Either ParseError a
parse (ShakespeareSettings -> GenParser Char [FilePath] [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 ([Content] -> [Content]) -> [Content] -> [Content]
forall a b. (a -> b) -> a -> b
$ FilePath -> Content
ContentRaw (FilePath
x FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
y) Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
z
    compressContents (Content
x:[Content]
y) = Content
x Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content] -> [Content]
compressContents [Content]
y

parseContents :: ShakespeareSettings -> Parser Contents
parseContents :: ShakespeareSettings -> GenParser Char [FilePath] [Content]
parseContents = ParsecT FilePath [FilePath] Identity Content
-> GenParser Char [FilePath] [Content]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT FilePath [FilePath] Identity Content
 -> GenParser Char [FilePath] [Content])
-> (ShakespeareSettings
    -> ParsecT FilePath [FilePath] Identity Content)
-> ShakespeareSettings
-> GenParser Char [FilePath] [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShakespeareSettings -> ParsecT FilePath [FilePath] Identity Content
parseContent
  where
    parseContent :: ShakespeareSettings -> Parser Content
    parseContent :: ShakespeareSettings -> ParsecT FilePath [FilePath] Identity Content
parseContent ShakespeareSettings {Bool
Char
Maybe Exp
Maybe PreConvert
Exp
varChar :: ShakespeareSettings -> Char
urlChar :: ShakespeareSettings -> Char
intChar :: ShakespeareSettings -> Char
toBuilder :: ShakespeareSettings -> Exp
wrap :: ShakespeareSettings -> Exp
unwrap :: ShakespeareSettings -> Exp
justVarInterpolation :: ShakespeareSettings -> Bool
preConversion :: ShakespeareSettings -> Maybe PreConvert
modifyFinalValue :: ShakespeareSettings -> Maybe Exp
varChar :: Char
urlChar :: Char
intChar :: Char
toBuilder :: Exp
wrap :: Exp
unwrap :: Exp
justVarInterpolation :: Bool
preConversion :: Maybe PreConvert
modifyFinalValue :: Maybe Exp
..} =
        ParsecT FilePath [FilePath] Identity Content
forall {a}. ParsecT FilePath a Identity Content
parseVar' ParsecT FilePath [FilePath] Identity Content
-> ParsecT FilePath [FilePath] Identity Content
-> ParsecT FilePath [FilePath] Identity Content
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT FilePath [FilePath] Identity Content
forall {a}. ParsecT FilePath a Identity Content
parseUrl' ParsecT FilePath [FilePath] Identity Content
-> ParsecT FilePath [FilePath] Identity Content
-> ParsecT FilePath [FilePath] Identity Content
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT FilePath [FilePath] Identity Content
forall {a}. ParsecT FilePath a Identity Content
parseInt' ParsecT FilePath [FilePath] Identity Content
-> ParsecT FilePath [FilePath] Identity Content
-> ParsecT FilePath [FilePath] Identity Content
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT FilePath [FilePath] Identity Content
forall {a}. ParsecT FilePath a Identity Content
parseChar'
      where
        parseVar' :: ParsecT FilePath a Identity Content
parseVar' = (FilePath -> Content)
-> (Deref -> Content) -> Either FilePath Deref -> Content
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> Content
ContentRaw Deref -> Content
ContentVar (Either FilePath Deref -> Content)
-> ParsecT FilePath a Identity (Either FilePath Deref)
-> ParsecT FilePath a Identity Content
forall a b.
(a -> b)
-> ParsecT FilePath a Identity a -> ParsecT FilePath a Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Char -> ParsecT FilePath a Identity (Either FilePath Deref)
forall a. Char -> UserParser a (Either FilePath Deref)
parseVar Char
varChar
        parseUrl' :: ParsecT FilePath a Identity Content
parseUrl' = (FilePath -> Content)
-> ((Deref, Bool) -> Content)
-> Either FilePath (Deref, Bool)
-> Content
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> Content
ContentRaw (Deref, Bool) -> Content
contentUrl (Either FilePath (Deref, Bool) -> Content)
-> ParsecT FilePath a Identity (Either FilePath (Deref, Bool))
-> ParsecT FilePath a Identity Content
forall a b.
(a -> b)
-> ParsecT FilePath a Identity a -> ParsecT FilePath a Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Char
-> Char
-> ParsecT FilePath a Identity (Either FilePath (Deref, Bool))
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' = (FilePath -> Content)
-> (Deref -> Content) -> Either FilePath Deref -> Content
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> Content
ContentRaw Deref -> Content
ContentMix (Either FilePath Deref -> Content)
-> ParsecT FilePath a Identity (Either FilePath Deref)
-> ParsecT FilePath a Identity Content
forall a b.
(a -> b)
-> ParsecT FilePath a Identity a -> ParsecT FilePath a Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Char -> ParsecT FilePath a Identity (Either FilePath Deref)
forall a. Char -> UserParser a (Either FilePath Deref)
parseInt Char
intChar
        parseChar' :: ParsecT FilePath u Identity Content
parseChar' = FilePath -> Content
ContentRaw (FilePath -> Content)
-> ParsecT FilePath u Identity FilePath
-> ParsecT FilePath u Identity Content
forall a b.
(a -> b)
-> ParsecT FilePath u Identity a -> ParsecT FilePath u Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT FilePath u Identity Char
-> ParsecT FilePath u Identity FilePath
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (FilePath -> ParsecT FilePath u Identity Char
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
       [] -> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
output
       FilePath
msg -> FilePath -> IO FilePath
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"stderr received during readProcess:" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
displayCmd FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"\n\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
msg
   ExitFailure Int
r ->
    FilePath -> IO FilePath
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"exit code " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
r FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" from readProcess: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
displayCmd FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"\n\n"
      FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"stderr:\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
err
  where
    displayCmd :: FilePath
displayCmd = FilePath
cmd FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:[FilePath] -> FilePath
unwords (ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
forall a. Show a => a -> FilePath
show [FilePath]
args) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
        case Maybe FilePath
mfp of
          Maybe FilePath
Nothing -> FilePath
""
          Just FilePath
fp -> Char
' 'Char -> ShowS
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
varChar :: ShakespeareSettings -> Char
urlChar :: ShakespeareSettings -> Char
intChar :: ShakespeareSettings -> Char
toBuilder :: ShakespeareSettings -> Exp
wrap :: ShakespeareSettings -> Exp
unwrap :: ShakespeareSettings -> Exp
justVarInterpolation :: ShakespeareSettings -> Bool
preConversion :: ShakespeareSettings -> Maybe PreConvert
modifyFinalValue :: ShakespeareSettings -> Maybe Exp
varChar :: Char
urlChar :: Char
intChar :: Char
toBuilder :: Exp
wrap :: Exp
unwrap :: Exp
justVarInterpolation :: Bool
preConversion :: Maybe PreConvert
modifyFinalValue :: Maybe Exp
..} FilePath
template =
    case Maybe PreConvert
preConversion of
      Maybe PreConvert
Nothing -> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
template
      Just pre :: PreConvert
pre@(PreConvert PreConversion
convert FilePath
_ FilePath
_ Maybe WrapInsertion
mWrapI) ->
        if (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace FilePath
template then FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
template else
          let ([FilePath]
groups, [FilePath]
rvars) = Either ParseError ([FilePath], [FilePath])
-> ([FilePath], [FilePath])
forall c. Either ParseError c -> c
eShowErrors (Either ParseError ([FilePath], [FilePath])
 -> ([FilePath], [FilePath]))
-> Either ParseError ([FilePath], [FilePath])
-> ([FilePath], [FilePath])
forall a b. (a -> b) -> a -> b
$ GenParser Char [FilePath] ([FilePath], [FilePath])
-> FilePath
-> FilePath
-> Either ParseError ([FilePath], [FilePath])
forall tok a1 a.
GenParser tok [a1] a -> FilePath -> [tok] -> Either ParseError a
parse
                                  (Maybe WrapInsertion
-> PreConvert -> GenParser Char [FilePath] ([FilePath], [FilePath])
forall {a}.
Maybe a
-> PreConvert -> GenParser Char [FilePath] ([FilePath], [FilePath])
parseConvertWrapInsertion Maybe WrapInsertion
mWrapI PreConvert
pre)
                                  FilePath
template
                                  FilePath
template
              vars :: [FilePath]
vars = [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse [FilePath]
rvars
              parsed :: FilePath
parsed = [FilePath] -> FilePath
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 ShowS -> IO FilePath -> IO FilePath
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` case PreConversion
convert of
                  PreConversion
Id -> FilePath -> IO FilePath
forall a. a -> IO a
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 FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
line) FilePath
str
      where
        mapLines :: ShowS -> ShowS
mapLines ShowS
f = [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> (FilePath -> [FilePath]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
f ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
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
'@'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'{'Char -> ShowS
forall a. a -> [a] -> [a]
:FilePath
str)
    shakespeare_var_conversion (Char
_:Char
'{':FilePath
str) = FilePath
shakespeare_prefix FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAlphaNum (ShowS
forall a. HasCallStack => [a] -> [a]
init FilePath
str)
    shakespeare_var_conversion FilePath
err = ShowS
forall a. HasCallStack => FilePath -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ FilePath
"did not expect: " FilePath -> ShowS
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
wrapInsertionIndent :: WrapInsertion -> Maybe FilePath
wrapInsertionStartBegin :: WrapInsertion -> FilePath
wrapInsertionSeparator :: WrapInsertion -> FilePath
wrapInsertionStartClose :: WrapInsertion -> FilePath
wrapInsertionEnd :: WrapInsertion -> FilePath
wrapInsertionAddParens :: WrapInsertion -> Bool
wrapInsertionIndent :: Maybe FilePath
wrapInsertionStartBegin :: FilePath
wrapInsertionSeparator :: FilePath
wrapInsertionStartClose :: FilePath
wrapInsertionEnd :: FilePath
wrapInsertionAddParens :: Bool
..}) [FilePath]
vars FilePath
str =
         (if Bool
wrapInsertionAddParens then FilePath
"(" else FilePath
"")
      FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
removeTrailingSemiColon
      FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> (if Bool
wrapInsertionAddParens then FilePath
")" else FilePath
"")
      FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"("
      FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat (FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
intersperse FilePath
", " [FilePath]
vars)
      FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
");\n"
        where
          removeTrailingSemiColon :: FilePath
removeTrailingSemiColon = ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
             (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';' Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c) (ShowS
forall a. [a] -> [a]
reverse 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
wrapInsertionIndent :: WrapInsertion -> Maybe FilePath
wrapInsertionStartBegin :: WrapInsertion -> FilePath
wrapInsertionSeparator :: WrapInsertion -> FilePath
wrapInsertionStartClose :: WrapInsertion -> FilePath
wrapInsertionEnd :: WrapInsertion -> FilePath
wrapInsertionAddParens :: WrapInsertion -> Bool
wrapInsertionIndent :: Maybe FilePath
wrapInsertionStartBegin :: FilePath
wrapInsertionSeparator :: FilePath
wrapInsertionStartClose :: FilePath
wrapInsertionEnd :: FilePath
wrapInsertionAddParens :: Bool
..}) [FilePath]
vars FilePath
str =
         FilePath
wrapInsertionStartBegin
      FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat (FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
intersperse FilePath
wrapInsertionSeparator ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
shakespeare_var_conversion [FilePath]
vars)
      FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
wrapInsertionStartClose
      FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Maybe FilePath -> ShowS
addIndent Maybe FilePath
wrapInsertionIndent FilePath
str
      FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
wrapInsertionEnd

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

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

        mainParser :: ParsecT FilePath [FilePath] Identity FilePath
mainParser =
            ParsecT FilePath [FilePath] Identity FilePath
parseVar' ParsecT FilePath [FilePath] Identity FilePath
-> ParsecT FilePath [FilePath] Identity FilePath
-> ParsecT FilePath [FilePath] Identity FilePath
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' ParsecT FilePath [FilePath] Identity FilePath
-> ParsecT FilePath [FilePath] Identity FilePath
-> ParsecT FilePath [FilePath] Identity FilePath
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' ParsecT FilePath [FilePath] Identity FilePath
-> ParsecT FilePath [FilePath] Identity FilePath
-> ParsecT FilePath [FilePath] Identity FilePath
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            FilePath -> ParsecT FilePath [FilePath] Identity FilePath
forall {s} {m :: * -> *} {u}.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
parseCommentLine FilePath
preEscapeIgnoreLine ParsecT FilePath [FilePath] Identity FilePath
-> ParsecT FilePath [FilePath] Identity FilePath
-> ParsecT FilePath [FilePath] Identity FilePath
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            FilePath
-> FilePath -> ParsecT FilePath [FilePath] Identity FilePath
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)  = FilePath -> ParsecT s [FilePath] m FilePath
forall a. a -> ParsecT s [FilePath] m a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
str
        recordRight (Right FilePath
str) = ([FilePath] -> [FilePath]) -> ParsecT s [FilePath] m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState (\[FilePath]
vars -> FilePath
strFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
vars) ParsecT s [FilePath] m ()
-> ParsecT s [FilePath] m FilePath
-> ParsecT s [FilePath] m FilePath
forall a b.
ParsecT s [FilePath] m a
-> ParsecT s [FilePath] m b -> ParsecT s [FilePath] m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> ParsecT s [FilePath] m FilePath
forall a. a -> ParsecT s [FilePath] m a
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 <- FilePath -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m Char
oneOf FilePath
cs
          FilePath
comment <- ParsecT s u m Char -> ParsecT s u m FilePath
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 FilePath)
-> ParsecT s u m Char -> ParsecT s u m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m Char
noneOf FilePath
newLine
          FilePath -> ParsecT s u m FilePath
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> ParsecT s u m FilePath)
-> FilePath -> ParsecT s u m FilePath
forall a b. (a -> b) -> a -> b
$ Char
begin Char -> ShowS
forall a. a -> [a] -> [a]
: FilePath
comment

        parseVar' :: (Parsec String [String]) String
        parseVar' :: ParsecT FilePath [FilePath] Identity FilePath
parseVar' = Either FilePath FilePath
-> ParsecT FilePath [FilePath] Identity FilePath
forall {m :: * -> *} {s}.
Monad m =>
Either FilePath FilePath -> ParsecT s [FilePath] m FilePath
recordRight (Either FilePath FilePath
 -> ParsecT FilePath [FilePath] Identity FilePath)
-> ParsecT FilePath [FilePath] Identity (Either FilePath FilePath)
-> ParsecT FilePath [FilePath] Identity FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Char
-> ParsecT FilePath [FilePath] Identity (Either FilePath FilePath)
forall a. Char -> UserParser a (Either FilePath FilePath)
parseVarString Char
varChar
        parseUrl' :: ParsecT FilePath [FilePath] Identity FilePath
parseUrl' = Either FilePath FilePath
-> ParsecT FilePath [FilePath] Identity FilePath
forall {m :: * -> *} {s}.
Monad m =>
Either FilePath FilePath -> ParsecT s [FilePath] m FilePath
recordRight (Either FilePath FilePath
 -> ParsecT FilePath [FilePath] Identity FilePath)
-> ParsecT FilePath [FilePath] Identity (Either FilePath FilePath)
-> ParsecT FilePath [FilePath] Identity FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Char
-> Char
-> ParsecT FilePath [FilePath] Identity (Either FilePath FilePath)
forall a. Char -> Char -> UserParser a (Either FilePath FilePath)
parseUrlString Char
urlChar Char
'?'
        parseInt' :: ParsecT FilePath [FilePath] Identity FilePath
parseInt' = Either FilePath FilePath
-> ParsecT FilePath [FilePath] Identity FilePath
forall {m :: * -> *} {s}.
Monad m =>
Either FilePath FilePath -> ParsecT s [FilePath] m FilePath
recordRight (Either FilePath FilePath
 -> ParsecT FilePath [FilePath] Identity FilePath)
-> ParsecT FilePath [FilePath] Identity (Either FilePath FilePath)
-> ParsecT FilePath [FilePath] Identity FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Char
-> ParsecT FilePath [FilePath] Identity (Either FilePath FilePath)
forall a. Char -> UserParser a (Either FilePath FilePath)
parseIntString Char
intChar
        parseChar' :: FilePath -> FilePath -> ParsecT s u m FilePath
parseChar' FilePath
comments FilePath
ignores =
            ParsecT s u m Char -> ParsecT s u m FilePath
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (FilePath -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m Char
noneOf ([Char
varChar, Char
urlChar, Char
intChar] FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
comments FilePath -> ShowS
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 <- FilePath -> Q Name
forall (m :: * -> *). Quote m => FilePath -> m Name
newName FilePath
"_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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Exp -> Exp -> Exp
AppE (Exp -> Exp -> Exp) -> Exp -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ ShakespeareSettings -> Exp
wrap ShakespeareSettings
rs) [|mempty|]
        [Exp
x] -> Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
x
        [Exp]
_   -> do
              Exp
mc <- [|mconcat|]
              Exp -> Q Exp
forall a. a -> Q a
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 a b. (a -> b) -> Q a -> Q b
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 a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
        if ShakespeareSettings -> Bool
justVarInterpolation ShakespeareSettings
rs
            then Exp
compiledTemplate
            else [Pat] -> Exp -> Exp
LamE [Name -> Pat
VarP Name
r] Exp
compiledTemplate
      where
        contentToBuilder :: Name -> Content -> Q Exp
        contentToBuilder :: Name -> Content -> Q Exp
contentToBuilder Name
_ (ContentRaw FilePath
s') = do
            Exp
ts <- [|fromText . pack'|]
            Exp -> Q Exp
forall a. a -> Q a
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 (FilePath -> Lit
StringL FilePath
s'))
        contentToBuilder Name
_ (ContentVar Deref
d) =
            Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (ShakespeareSettings -> Exp
toBuilder ShakespeareSettings
rs Exp -> Exp -> Exp
`AppE` Scope -> Deref -> Exp
derefToExp [] Deref
d)
        contentToBuilder Name
r (ContentUrl Deref
d) = do
            Exp
ts <- [|fromText|]
            Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ ShakespeareSettings -> Exp
wrap ShakespeareSettings
rs Exp -> Exp -> Exp
`AppE` (Exp
ts Exp -> Exp -> Exp
`AppE` (Name -> Exp
VarE Name
r Exp -> Exp -> Exp
`AppE` Scope -> Deref -> Exp
derefToExp [] Deref
d Exp -> Exp -> Exp
`AppE` [Exp] -> Exp
ListE []))
        contentToBuilder Name
r (ContentUrlParam Deref
d) = do
            Exp
ts <- [|fromText|]
            Exp
up <- [|\r' (u, p) -> r' u p|]
            Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ ShakespeareSettings -> Exp
wrap ShakespeareSettings
rs Exp -> Exp -> Exp
`AppE` (Exp
ts Exp -> Exp -> Exp
`AppE` (Exp
up Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
r Exp -> Exp -> Exp
`AppE` Scope -> Deref -> Exp
derefToExp [] Deref
d))
        contentToBuilder Name
r (ContentMix Deref
d) =
            Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
              if ShakespeareSettings -> Bool
justVarInterpolation ShakespeareSettings
rs
                then Scope -> Deref -> Exp
derefToExp [] Deref
d
                else Scope -> Deref -> Exp
derefToExp [] Deref
d Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
r

shakespeare :: ShakespeareSettings -> QuasiQuoter
shakespeare :: ShakespeareSettings -> QuasiQuoter
shakespeare ShakespeareSettings
r = QuasiQuoter { 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 <- IO FilePath -> Q FilePath
forall a. IO a -> Q a
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO (IO FilePath -> Q FilePath) -> IO FilePath -> Q FilePath
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> ShakespeareSettings -> FilePath -> IO FilePath
preFilter Maybe FilePath
forall a. Maybe a
Nothing ShakespeareSettings
r (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$
#ifdef WINDOWS
          filter (/='\r')
#endif
          FilePath
str
    ShakespeareSettings -> [Content] -> Q Exp
contentsToShakespeare ShakespeareSettings
r ([Content] -> Q Exp) -> [Content] -> Q Exp
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 Q FilePath -> (FilePath -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
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
(Int -> VarType -> ShowS)
-> (VarType -> FilePath) -> ([VarType] -> ShowS) -> Show VarType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarType -> ShowS
showsPrec :: Int -> VarType -> ShowS
$cshow :: VarType -> FilePath
show :: VarType -> FilePath
$cshowList :: [VarType] -> ShowS
showList :: [VarType] -> ShowS
Show, VarType -> VarType -> Bool
(VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool) -> Eq VarType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VarType -> VarType -> Bool
== :: VarType -> VarType -> Bool
$c/= :: VarType -> VarType -> Bool
/= :: 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
$ccompare :: VarType -> VarType -> Ordering
compare :: VarType -> VarType -> Ordering
$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
>= :: VarType -> VarType -> Bool
$cmax :: VarType -> VarType -> VarType
max :: VarType -> VarType -> VarType
$cmin :: VarType -> VarType -> VarType
min :: VarType -> VarType -> 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
$csucc :: VarType -> VarType
succ :: VarType -> VarType
$cpred :: VarType -> VarType
pred :: VarType -> VarType
$ctoEnum :: Int -> VarType
toEnum :: Int -> VarType
$cfromEnum :: VarType -> Int
fromEnum :: VarType -> Int
$cenumFrom :: VarType -> [VarType]
enumFrom :: VarType -> [VarType]
$cenumFromThen :: VarType -> VarType -> [VarType]
enumFromThen :: VarType -> VarType -> [VarType]
$cenumFromTo :: VarType -> VarType -> [VarType]
enumFromTo :: VarType -> VarType -> [VarType]
$cenumFromThenTo :: VarType -> VarType -> VarType -> [VarType]
enumFromThenTo :: VarType -> VarType -> VarType -> [VarType]
Enum, VarType
VarType -> VarType -> Bounded VarType
forall a. a -> a -> Bounded a
$cminBound :: VarType
minBound :: VarType
$cmaxBound :: VarType
maxBound :: VarType
Bounded, Typeable, Typeable VarType
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 -> Constr
VarType -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VarType -> c VarType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VarType -> c VarType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VarType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VarType
$ctoConstr :: VarType -> Constr
toConstr :: VarType -> Constr
$cdataTypeOf :: VarType -> DataType
dataTypeOf :: VarType -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VarType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VarType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VarType)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VarType)
$cgmapT :: (forall b. Data b => b -> b) -> VarType -> VarType
gmapT :: (forall b. Data b => b -> b) -> VarType -> VarType
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VarType -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VarType -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> VarType -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> VarType -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> VarType -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> VarType -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VarType -> m VarType
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VarType -> m 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
$cfrom :: forall x. VarType -> Rep VarType x
from :: forall x. VarType -> Rep VarType x
$cto :: forall x. Rep VarType x -> VarType
to :: forall x. Rep VarType x -> VarType
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 = (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)])
-> (FilePath -> [Content]) -> FilePath -> [(Deref, VarType)]
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 = IO (IORef (Map FilePath (MTime, [Content])))
-> IORef (Map FilePath (MTime, [Content]))
forall a. IO a -> a
unsafePerformIO (IO (IORef (Map FilePath (MTime, [Content])))
 -> IORef (Map FilePath (MTime, [Content])))
-> IO (IORef (Map FilePath (MTime, [Content])))
-> IORef (Map FilePath (MTime, [Content]))
forall a b. (a -> b) -> a -> b
$ Map FilePath (MTime, [Content])
-> IO (IORef (Map FilePath (MTime, [Content])))
forall a. a -> IO (IORef a)
newIORef Map FilePath (MTime, [Content])
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 <- IORef (Map FilePath (MTime, [Content]))
-> IO (Map FilePath (MTime, [Content]))
forall a. IORef a -> IO a
readIORef IORef (Map FilePath (MTime, [Content]))
reloadMapRef
  Maybe (MTime, [Content]) -> IO (Maybe (MTime, [Content]))
forall a. a -> IO a
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
$ FilePath
-> Map FilePath (MTime, [Content]) -> Maybe (MTime, [Content])
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) = IORef (Map FilePath (MTime, [Content]))
-> (Map FilePath (MTime, [Content])
    -> (Map FilePath (MTime, [Content]), [Content]))
-> IO [Content]
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (Map FilePath (MTime, [Content]))
reloadMapRef
  (\Map FilePath (MTime, [Content])
reloadMap -> (FilePath
-> (MTime, [Content])
-> Map FilePath (MTime, [Content])
-> Map FilePath (MTime, [Content])
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 <- IO FilePath -> Q FilePath
forall a. IO a -> Q a
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO (IO FilePath -> Q FilePath) -> IO FilePath -> Q FilePath
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> ShakespeareSettings -> FilePath -> IO FilePath
preFilter (FilePath -> Maybe FilePath
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 <- ((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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Deref, VarType) -> Q Exp
vtToExp [(Deref, VarType)]
b
    Exp
rt <- [|shakespeareRuntime settings fp|]
    Exp
wrap' <- [|\x -> $(Exp -> Q Exp
forall a. a -> Q a
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
settings) . x|]
    Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Exp
wrap' Exp -> Exp -> Exp
`AppE` (Exp
rt Exp -> Exp -> Exp
`AppE` [Exp] -> Exp
ListE [Exp]
c)
  where
    vtToExp :: (Deref, VarType) -> Q Exp
    vtToExp :: (Deref, VarType) -> Q Exp
vtToExp (Deref
d, VarType
vt) = do
        Exp
d' <- Deref -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Deref -> m Exp
lift Deref
d
        Exp
c' <- VarType -> Q Exp
c VarType
vt
        Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Maybe Exp] -> Exp
TupE
#if MIN_VERSION_template_haskell(2,16,0)
          ([Maybe Exp] -> Exp) -> [Maybe Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ (Exp -> Maybe Exp) -> [Exp] -> [Maybe Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Maybe Exp
forall a. a -> Maybe a
Just
#endif
          [Exp
d', Exp
c' Exp -> Exp -> Exp
`AppE` Scope -> Deref -> Exp
derefToExp [] Deref
d]
      where
        c :: VarType -> Q Exp
        c :: VarType -> Q Exp
c VarType
VTPlain = [|EPlain . $(Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
          Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ ShakespeareSettings -> Exp
unwrap ShakespeareSettings
settings) (Name -> Exp
VarE '(.)) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ ShakespeareSettings -> Exp
toBuilder ShakespeareSettings
settings))|]
        c VarType
VTUrl = [|EUrl|]
        c VarType
VTUrlParam = [|EUrlParam|]
        c VarType
VTMixin = [|\x -> EMixin $ \r -> $(Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ ShakespeareSettings -> Exp
unwrap ShakespeareSettings
settings) $ x r|]



nothingError :: Show a => String -> a -> b
nothingError :: forall a b. Show a => FilePath -> a -> b
nothingError FilePath
expected a
d = FilePath -> b
forall a. HasCallStack => FilePath -> a
error (FilePath -> b) -> FilePath -> b
forall a b. (a -> b) -> a -> b
$ FilePath
"expected " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
expected FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" but got Nothing for: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> FilePath
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' = 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 a. IO a -> IO a
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
$ 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 MTime -> MTime -> Bool
forall a. Eq a => a -> a -> Bool
== MTime
lastMtime then Builder -> IO Builder
forall a. a -> IO a
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 a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Content] -> Builder
go' (IO [Content] -> IO Builder) -> IO [Content] -> IO Builder
forall a b. (a -> b) -> a -> b
$ MTime -> IO [Content]
newContent MTime
mtime
      Maybe (MTime, [Content])
Nothing -> ([Content] -> Builder) -> IO [Content] -> IO Builder
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Content] -> Builder
go' (IO [Content] -> IO Builder) -> IO [Content] -> IO Builder
forall a b. (a -> b) -> a -> b
$ MTime -> IO [Content]
newContent MTime
mtime
  where
    newContent :: MTime -> IO [Content]
newContent MTime
mtime = do
        FilePath
str <- FilePath -> IO FilePath
readUtf8FileString FilePath
fp
        FilePath
s <- Maybe FilePath -> ShakespeareSettings -> FilePath -> IO FilePath
preFilter (FilePath -> Maybe FilePath
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' = [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 FilePath
s) = Text -> Builder
fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
TS.pack FilePath
s
    go (ContentVar Deref
d) =
        case Deref -> [(Deref, VarExp url)] -> Maybe (VarExp url)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Deref
d [(Deref, VarExp url)]
cd of
            Just (EPlain Builder
s) -> Builder
s
            Maybe (VarExp url)
_ -> FilePath -> Deref -> Builder
forall a b. Show a => FilePath -> a -> b
nothingError FilePath
"EPlain" Deref
d
    go (ContentUrl Deref
d) =
        case Deref -> [(Deref, VarExp url)] -> Maybe (VarExp url)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Deref
d [(Deref, VarExp url)]
cd of
            Just (EUrl url
u) -> Text -> Builder
fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ RenderUrl url
render' url
u []
            Maybe (VarExp url)
_ -> FilePath -> Deref -> Builder
forall a b. Show a => FilePath -> a -> b
nothingError FilePath
"EUrl" Deref
d
    go (ContentUrlParam Deref
d) =
        case Deref -> [(Deref, VarExp url)] -> Maybe (VarExp url)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Deref
d [(Deref, VarExp url)]
cd of
            Just (EUrlParam (url
u, [(Text, Text)]
p)) ->
                Text -> Builder
fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ RenderUrl url
render' url
u [(Text, Text)]
p
            Maybe (VarExp url)
_ -> FilePath -> Deref -> Builder
forall a b. Show a => FilePath -> a -> b
nothingError FilePath
"EUrlParam" Deref
d
    go (ContentMix Deref
d) =
        case Deref -> [(Deref, VarExp url)] -> Maybe (VarExp url)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Deref
d [(Deref, VarExp url)]
cd of
            Just (EMixin Shakespeare url
m) -> Shakespeare url
m RenderUrl url
render'
            Maybe (VarExp url)
_ -> FilePath -> Deref -> Builder
forall a b. Show a => FilePath -> a -> b
nothingError FilePath
"EMixin" Deref
d