{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
module Text.Hamlet
    ( -- * Plain HTML
      Html
    , shamlet
    , shamletFile
    , xshamlet
    , xshamletFile
      -- * Hamlet
    , HtmlUrl
    , Render
    , hamlet
    , hamletFile
    , hamletFileReload
    , xhamlet
    , xhamletFile
      -- * I18N Hamlet
    , HtmlUrlI18n
    , Translate
    , ihamlet
    , ihamletFile
    , ihamletFileReload
      -- * Type classes
    , ToAttributes (..)
      -- * Internal, for making more
    , HamletSettings (..)
    , NewlineStyle (..)
    , hamletWithSettings
    , hamletFileWithSettings
    , defaultHamletSettings
    , xhtmlHamletSettings
    , Env (..)
    , HamletRules (..)
    , hamletRules
    , ihamletRules
    , htmlRules
    , CloseStyle (..)
      -- * Used by generated code
    , condH
    , maybeH
    , asHtmlUrl
    , attrsToHtml
     -- * low-level
    , hamletFromString
    ) where

import Text.Shakespeare.Base
import Text.Hamlet.Parse
#if MIN_VERSION_template_haskell(2,9,0)
import Language.Haskell.TH.Syntax hiding (Module)
#else
import Language.Haskell.TH.Syntax
#endif
import Language.Haskell.TH.Quote
import Data.Char (isUpper, isDigit)
import Data.Maybe (fromMaybe)
import Data.Text (Text, pack)
import qualified Data.Text.Lazy as TL
import Text.Blaze.Html (Html, toHtml)
import Text.Blaze.Internal (preEscapedText)
import qualified Data.Foldable as F
import Control.Monad (mplus)
import Data.Monoid (mempty, mappend, mconcat)
import Control.Arrow ((***))
import Data.List (intercalate)

import Data.IORef
import qualified Data.Map as M
import System.IO.Unsafe (unsafePerformIO)
import System.Directory (getModificationTime)
import Data.Time (UTCTime)
import Text.Blaze.Html (preEscapedToHtml)

-- | Convert some value to a list of attribute pairs.
class ToAttributes a where
    toAttributes :: a -> [(Text, Text)]
instance ToAttributes (Text, Text) where
    toAttributes = return
instance ToAttributes (String, String) where
    toAttributes (k, v) = [(pack k, pack v)]
instance ToAttributes [(Text, Text)] where
    toAttributes = id
instance ToAttributes [(String, String)] where
    toAttributes = map (pack *** pack)

attrsToHtml :: [(Text, Text)] -> Html
attrsToHtml =
    foldr go mempty
  where
    go (k, v) rest =
        toHtml " "
        `mappend` preEscapedText k
        `mappend` preEscapedText (pack "=\"")
        `mappend` toHtml v
        `mappend` preEscapedText (pack "\"")
        `mappend` rest

type Render url = url -> [(Text, Text)] -> Text
type Translate msg = msg -> Html

-- | A function generating an 'Html' given a URL-rendering function.
type HtmlUrl url = Render url -> Html

-- | A function generating an 'Html' given a message translator and a URL rendering function.
type HtmlUrlI18n msg url = Translate msg -> Render url -> Html

docsToExp :: Env -> HamletRules -> Scope -> [Doc] -> Q Exp
docsToExp env hr scope docs = do
    exps <- mapM (docToExp env hr scope) docs
    case exps of
        [] -> [|return ()|]
        [x] -> return x
        _ -> return $ DoE $ map NoBindS exps

unIdent :: Ident -> String
unIdent (Ident s) = s

bindingPattern :: Binding -> Q (Pat, [(Ident, Exp)])
bindingPattern (BindAs i@(Ident s) b) = do
    name <- newName s
    (pattern, scope) <- bindingPattern b
    return (AsP name pattern, (i, VarE name):scope)
bindingPattern (BindVar i@(Ident s))
    | s == "_" = return (WildP, [])
    | all isDigit s = do
        return (LitP $ IntegerL $ read s, [])
    | otherwise = do
        name <- newName s
        return (VarP name, [(i, VarE name)])
bindingPattern (BindTuple is) = do
    (patterns, scopes) <- fmap unzip $ mapM bindingPattern is
    return (TupP patterns, concat scopes)
bindingPattern (BindList is) = do
    (patterns, scopes) <- fmap unzip $ mapM bindingPattern is
    return (ListP patterns, concat scopes)
bindingPattern (BindConstr con is) = do
    (patterns, scopes) <- fmap unzip $ mapM bindingPattern is
    return (ConP (mkConName con) patterns, concat scopes)
bindingPattern (BindRecord con fields wild) = do
    let f (Ident field,b) =
           do (p,s) <- bindingPattern b
              return ((mkName field,p),s)
    (patterns, scopes) <- fmap unzip $ mapM f fields
    (patterns1, scopes1) <- if wild
       then bindWildFields con $ map fst fields
       else return ([],[])
    return (RecP (mkConName con) (patterns++patterns1), concat scopes ++ scopes1)

mkConName :: DataConstr -> Name
mkConName = mkName . conToStr

conToStr :: DataConstr -> String
conToStr (DCUnqualified (Ident x)) = x
conToStr (DCQualified (Module xs) (Ident x)) = intercalate "." $ xs ++ [x]

-- Wildcards bind all of the unbound fields to variables whose name
-- matches the field name.
--
-- For example: data R = C { f1, f2 :: Int }
-- C {..}           is equivalent to   C {f1=f1, f2=f2}
-- C {f1 = a, ..}   is equivalent to   C {f1=a,  f2=f2}
-- C {f2 = a, ..}   is equivalent to   C {f1=f1, f2=a}
bindWildFields :: DataConstr -> [Ident] -> Q ([(Name, Pat)], [(Ident, Exp)])
bindWildFields conName fields = do
  fieldNames <- recordToFieldNames conName
  let available n     = nameBase n `notElem` map unIdent fields
  let remainingFields = filter available fieldNames
  let mkPat n = do
        e <- newName (nameBase n)
        return ((n,VarP e), (Ident (nameBase n), VarE e))
  fmap unzip $ mapM mkPat remainingFields

-- Important note! reify will fail if the record type is defined in the
-- same module as the reify is used. This means quasi-quoted Hamlet
-- literals will not be able to use wildcards to match record types
-- defined in the same module.
recordToFieldNames :: DataConstr -> Q [Name]
recordToFieldNames conStr = do
  -- use 'lookupValueName' instead of just using 'mkName' so we reify the
  -- data constructor and not the type constructor if their names match.
  Just conName                <- lookupValueName $ conToStr conStr
#if MIN_VERSION_template_haskell(2,11,0)
  DataConI _ _ typeName         <- reify conName
  TyConI (DataD _ _ _ _ cons _) <- reify typeName
#else
  DataConI _ _ typeName _     <- reify conName
  TyConI (DataD _ _ _ cons _) <- reify typeName
#endif
  [fields] <- return [fields | RecC name fields <- cons, name == conName]
  return [fieldName | (fieldName, _, _) <- fields]

docToExp :: Env -> HamletRules -> Scope -> Doc -> Q Exp
docToExp env hr scope (DocForall list idents inside) = do
    let list' = derefToExp scope list
    (pat, extraScope) <- bindingPattern idents
    let scope' = extraScope ++ scope
    mh <- [|F.mapM_|]
    inside' <- docsToExp env hr scope' inside
    let lam = LamE [pat] inside'
    return $ mh `AppE` lam `AppE` list'
docToExp env hr scope (DocWith [] inside) = do
    inside' <- docsToExp env hr scope inside
    return $ inside'
docToExp env hr scope (DocWith ((deref, idents):dis) inside) = do
    let deref' = derefToExp scope deref
    (pat, extraScope) <- bindingPattern idents
    let scope' = extraScope ++ scope
    inside' <- docToExp env hr scope' (DocWith dis inside)
    let lam = LamE [pat] inside'
    return $ lam `AppE` deref'
docToExp env hr scope (DocMaybe val idents inside mno) = do
    let val' = derefToExp scope val
    (pat, extraScope) <- bindingPattern idents
    let scope' = extraScope ++ scope
    inside' <- docsToExp env hr scope' inside
    let inside'' = LamE [pat] inside'
    ninside' <- case mno of
                    Nothing -> [|Nothing|]
                    Just no -> do
                        no' <- docsToExp env hr scope no
                        j <- [|Just|]
                        return $ j `AppE` no'
    mh <- [|maybeH|]
    return $ mh `AppE` val' `AppE` inside'' `AppE` ninside'
docToExp env hr scope (DocCond conds final) = do
    conds' <- mapM go conds
    final' <- case final of
                Nothing -> [|Nothing|]
                Just f -> do
                    f' <- docsToExp env hr scope f
                    j <- [|Just|]
                    return $ j `AppE` f'
    ch <- [|condH|]
    return $ ch `AppE` ListE conds' `AppE` final'
  where
    go :: (Deref, [Doc]) -> Q Exp
    go (d, docs) = do
        let d' = derefToExp ((specialOrIdent, VarE 'or):scope) d
        docs' <- docsToExp env hr scope docs
        return $ TupE [d', docs']
docToExp env hr scope (DocCase deref cases) = do
    let exp_ = derefToExp scope deref
    matches <- mapM toMatch cases
    return $ CaseE exp_ matches
  where
    toMatch :: (Binding, [Doc]) -> Q Match
    toMatch (idents, inside) = do
        (pat, extraScope) <- bindingPattern idents
        let scope' = extraScope ++ scope
        insideExp <- docsToExp env hr scope' inside
        return $ Match pat (NormalB insideExp) []
docToExp env hr v (DocContent c) = contentToExp env hr v c

contentToExp :: Env -> HamletRules -> Scope -> Content -> Q Exp
contentToExp _ hr _ (ContentRaw s) = do
    os <- [|preEscapedText . pack|]
    let s' = LitE $ StringL s
    return $ hrFromHtml hr `AppE` (os `AppE` s')
contentToExp _ hr scope (ContentVar d) = do
    str <- [|toHtml|]
    return $ hrFromHtml hr `AppE` (str `AppE` derefToExp scope d)
contentToExp env hr scope (ContentUrl hasParams d) =
    case urlRender env of
        Nothing -> error "URL interpolation used, but no URL renderer provided"
        Just wrender -> wrender $ \render -> do
            let render' = return render
            ou <- if hasParams
                    then [|\(u, p) -> $(render') u p|]
                    else [|\u -> $(render') u []|]
            let d' = derefToExp scope d
            pet <- [|toHtml|]
            return $ hrFromHtml hr `AppE` (pet `AppE` (ou `AppE` d'))
contentToExp env hr scope (ContentEmbed d) = hrEmbed hr env $ derefToExp scope d
contentToExp env hr scope (ContentMsg d) =
    case msgRender env of
        Nothing -> error "Message interpolation used, but no message renderer provided"
        Just wrender -> wrender $ \render ->
            return $ hrFromHtml hr `AppE` (render `AppE` derefToExp scope d)
contentToExp _ hr scope (ContentAttrs d) = do
    html <- [|attrsToHtml . toAttributes|]
    return $ hrFromHtml hr `AppE` (html `AppE` derefToExp scope d)

-- | "Simple Hamlet" quasi-quoter. May only be used to generate expressions.
--
-- Generated expressions have type 'Html'.
--
-- @
-- >>> 'putStrLn' ('Text.Blaze.Html.Renderer.renderHtml' ['shamlet'|\<div\>Hello, world!|])
-- \<div\>Hello, world!\</div\>
-- @
shamlet :: QuasiQuoter
shamlet = hamletWithSettings htmlRules defaultHamletSettings

-- | Like 'shamlet', but produces XHTML.
xshamlet :: QuasiQuoter
xshamlet = hamletWithSettings htmlRules xhtmlHamletSettings

htmlRules :: Q HamletRules
htmlRules = do
    i <- [|id|]
    return $ HamletRules i ($ (Env Nothing Nothing)) (\_ b -> return b)

-- | Hamlet quasi-quoter. May only be used to generate expressions.
--
-- Generated expression have type @'HtmlUrl' url@, for some @url@.
--
-- @
-- data MyRoute = Home
--
-- render :: 'Render' MyRoute
-- render Home _ = \"/home\"
--
-- >>> 'putStrLn' ('Text.Blaze.Html.Renderer.String.renderHtml' (['hamlet'|\<a href=@{Home}\>Home|] render))
-- \<a href="\/home"\>Home\<\/a\>
-- @
hamlet :: QuasiQuoter
hamlet = hamletWithSettings hamletRules defaultHamletSettings

-- | Like 'hamlet', but produces XHTML.
xhamlet :: QuasiQuoter
xhamlet = hamletWithSettings hamletRules xhtmlHamletSettings

asHtmlUrl :: HtmlUrl url -> HtmlUrl url
asHtmlUrl = id

hamletRules :: Q HamletRules
hamletRules = do
    i <- [|id|]
    let ur f = do
            r <- newName "_render"
            let env = Env
                    { urlRender = Just ($ (VarE r))
                    , msgRender = Nothing
                    }
            h <- f env
            return $ LamE [VarP r] h
    return $ HamletRules i ur em
  where
    em (Env (Just urender) Nothing) e = do
        asHtmlUrl' <- [|asHtmlUrl|]
        urender $ \ur' -> return ((asHtmlUrl' `AppE` e) `AppE` ur')
    em _ _ = error "bad Env"

-- | Hamlet quasi-quoter with internationalization. May only be used to generate
-- expressions.
--
-- Generated expressions have type @'HtmlUrlI18n' msg url@, for some @msg@ and
-- @url@.
--
-- @
-- data MyMsg = Hi | Bye
--
-- data MyRoute = Home
--
-- renderEnglish :: 'Translate' MyMsg
-- renderEnglish Hi  = \"hi\"
-- renderEnglish Bye = \"bye\"
--
-- renderUrl :: 'Render' MyRoute
-- renderUrl Home _ = \"/home\"
--
-- >>> 'putStrLn' ('Text.Blaze.Html.Renderer.renderHtml' (['ihamlet'|@{Home} _{Hi} _{Bye}|] renderEnglish renderUrl))
-- \<div\>/home hi bye \<div\>
-- @
ihamlet :: QuasiQuoter
ihamlet = hamletWithSettings ihamletRules defaultHamletSettings

ihamletRules :: Q HamletRules
ihamletRules = do
    i <- [|id|]
    let ur f = do
            u <- newName "_urender"
            m <- newName "_mrender"
            let env = Env
                    { urlRender = Just ($ (VarE u))
                    , msgRender = Just ($ (VarE m))
                    }
            h <- f env
            return $ LamE [VarP m, VarP u] h
    return $ HamletRules i ur em
  where
    em (Env (Just urender) (Just mrender)) e =
          urender $ \ur' -> mrender $ \mr -> return (e `AppE` mr `AppE` ur')
    em _ _ = error "bad Env"

-- | Quasiquoter that follows XHTML serialization rules and supports i18n.
--
-- @since 2.0.10
ixhamlet :: QuasiQuoter
ixhamlet = hamletWithSettings ihamletRules xhtmlHamletSettings

hamletWithSettings :: Q HamletRules -> HamletSettings -> QuasiQuoter
hamletWithSettings hr set =
    QuasiQuoter
        { quoteExp = hamletFromString hr set
        }

data HamletRules = HamletRules
    { hrFromHtml :: Exp
    , hrWithEnv :: (Env -> Q Exp) -> Q Exp
    , hrEmbed :: Env -> Exp -> Q Exp
    }

data Env = Env
    { urlRender :: Maybe ((Exp -> Q Exp) -> Q Exp)
    , msgRender :: Maybe ((Exp -> Q Exp) -> Q Exp)
    }

hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp
hamletFromString qhr set s = do
    hr <- qhr
    hrWithEnv hr $ \env -> docsToExp env hr [] $ docFromString set s

docFromString :: HamletSettings -> String -> [Doc]
docFromString set s =
    case parseDoc set s of
        Error s' -> error s'
        Ok (_, d) -> d

hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp
hamletFileWithSettings qhr set fp = do
#ifdef GHC_7_4
    qAddDependentFile fp
#endif
    contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp
    hamletFromString qhr set contents

-- | Like 'hamlet', but reads an external file at compile time.
--
-- @
-- $('hamletFile' \"foo.hamlet\") :: 'HtmlUrl' MyRoute
-- @
hamletFile :: FilePath -> Q Exp
hamletFile = hamletFileWithSettings hamletRules defaultHamletSettings

-- | Like 'hamletFile', but the external file is parsed at runtime. Allows for
-- more rapid development, but should not be used in production.
hamletFileReload :: FilePath -> Q Exp
hamletFileReload = hamletFileReloadWithSettings runtimeRules defaultHamletSettings
  where runtimeRules = HamletRuntimeRules { hrrI18n = False }

-- | Like 'ihamletFile', but the external file is parsed at runtime. Allows for
-- more rapid development, but should not be used in production.
ihamletFileReload :: FilePath -> Q Exp
ihamletFileReload = hamletFileReloadWithSettings runtimeRules defaultHamletSettings
  where runtimeRules = HamletRuntimeRules { hrrI18n = True }

-- | Like 'hamletFile', but produces XHTML.
xhamletFile :: FilePath -> Q Exp
xhamletFile = hamletFileWithSettings hamletRules xhtmlHamletSettings

-- | Like 'shamlet', but reads an external file at compile time.
--
-- @
-- $('shamletFile' \"foo.hamlet\") :: 'Html'
-- @
shamletFile :: FilePath -> Q Exp
shamletFile = hamletFileWithSettings htmlRules defaultHamletSettings

-- | Like 'shamletFile', but produces XHTML.
xshamletFile :: FilePath -> Q Exp
xshamletFile = hamletFileWithSettings htmlRules xhtmlHamletSettings

-- | Like 'ihamlet', but reads an external file at compile time.
--
-- @
-- $('ihamletFile' \"foo.hamlet\") :: 'HtmlUrlI18n' MyMsg MyRoute
-- @
ihamletFile :: FilePath -> Q Exp
ihamletFile = hamletFileWithSettings ihamletRules defaultHamletSettings

varName :: Scope -> String -> Exp
varName _ "" = error "Illegal empty varName"
varName scope v@(_:_) = fromMaybe (strToExp v) $ lookup (Ident v) scope

strToExp :: String -> Exp
strToExp s@(c:_)
    | all isDigit s = LitE $ IntegerL $ read s
    | isUpper c = ConE $ mkName s
    | otherwise = VarE $ mkName s
strToExp "" = error "strToExp on empty string"

-- | Checks for truth in the left value in each pair in the first argument. If
-- a true exists, then the corresponding right action is performed. Only the
-- first is performed. In there are no true values, then the second argument is
-- performed, if supplied.
condH :: Monad m => [(Bool, m ())] -> Maybe (m ()) -> m ()
condH bms mm = fromMaybe (return ()) $ lookup True bms `mplus` mm

-- | Runs the second argument with the value in the first, if available.
-- Otherwise, runs the third argument, if available.
maybeH :: Monad m => Maybe v -> (v -> m ()) -> Maybe (m ()) -> m ()
maybeH mv f mm = fromMaybe (return ()) $ fmap f mv `mplus` mm


type MTime = UTCTime
data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin | VTMsg | VTAttrs

type QueryParameters = [(Text, Text)]
type RenderUrl url   = (url -> QueryParameters -> Text)
type Shakespeare url = RenderUrl url -> Html
data VarExp msg url  = EPlain Html
                     | EUrl url
                     | EUrlParam (url, QueryParameters)
                     | EMixin (HtmlUrl url)
                     | EMixinI18n (HtmlUrlI18n msg url)
                     | EMsg msg

instance Show (VarExp msg url) where
  show (EPlain html) = "EPlain"
  show (EUrl url) = "EUrl"
  show (EUrlParam url) = "EUrlParam"
  show (EMixin url) = "EMixin"
  show (EMixinI18n msg_url) = "EMixinI18n"
  show (EMsg msg) = "EMsg"

getVars :: Content -> [(Deref, VarType)]
getVars ContentRaw{}     = []
getVars (ContentVar d)   = [(d, VTPlain)]
getVars (ContentUrl False d) = [(d, VTUrl)]
getVars (ContentUrl True d) = [(d, VTUrlParam)]
getVars (ContentEmbed d) = [(d, VTMixin)]
getVars (ContentMsg d)   = [(d, VTMsg)]
getVars (ContentAttrs d) = [(d, VTAttrs)]

hamletUsedIdentifiers :: HamletSettings -> String -> [(Deref, VarType)]
hamletUsedIdentifiers settings =
    concatMap getVars . contentFromString settings


data HamletRuntimeRules = HamletRuntimeRules {
                            hrrI18n :: Bool
                          }

hamletFileReloadWithSettings :: HamletRuntimeRules
                             -> HamletSettings -> FilePath -> Q Exp
hamletFileReloadWithSettings hrr settings fp = do
    s <- readFileQ fp
    let b = hamletUsedIdentifiers settings s
    c <- mapM vtToExp b
    rt <- if hrrI18n hrr
      then [|hamletRuntimeMsg settings fp|]
      else [|hamletRuntime settings fp|]
    return $ rt `AppE` ListE c
  where
    vtToExp :: (Deref, VarType) -> Q Exp
    vtToExp (d, vt) = do
        d' <- lift d
        c' <- toExp vt
        return $ TupE [d', c' `AppE` derefToExp [] d]
      where
        toExp = c
          where
            c :: VarType -> Q Exp
            c VTAttrs = [|EPlain . attrsToHtml . toAttributes|]
            c VTPlain = [|EPlain . toHtml|]
            c VTUrl = [|EUrl|]
            c VTUrlParam = [|EUrlParam|]
            c VTMixin = [|\r -> EMixin $ \c -> r c|]
            c VTMsg = [|EMsg|]

-- move to Shakespeare.Base?
readFileUtf8 :: FilePath -> IO String
readFileUtf8 fp = fmap TL.unpack $ readUtf8File fp

-- move to Shakespeare.Base?
readFileQ :: FilePath -> Q String
readFileQ fp = qRunIO $ readFileUtf8 fp

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

lookupReloadMap :: FilePath -> IO (Maybe (MTime, [Content]))
lookupReloadMap fp = do
  reloads <- readIORef reloadMapRef
  return $ M.lookup fp reloads

insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content]
insertReloadMap fp (mt, content) = atomicModifyIORef reloadMapRef
  (\reloadMap -> (M.insert fp (mt, content) reloadMap, content))

contentFromString :: HamletSettings -> String -> [Content]
contentFromString set = map justContent . docFromString set
  where
    unsupported msg = error $ "hamletFileReload does not support " ++ msg

    justContent :: Doc -> Content
    justContent (DocContent c) = c
    justContent DocForall{} = unsupported "$forall"
    justContent DocWith{} = unsupported "$with"
    justContent DocMaybe{} = unsupported "$maybe"
    justContent DocCase{} = unsupported "$case"
    justContent DocCond{} = unsupported "attribute conditionals"


hamletRuntime :: HamletSettings
              -> FilePath
              -> [(Deref, VarExp msg url)]
              -> Shakespeare url
hamletRuntime settings fp cd render = unsafePerformIO $ do
    mtime <- qRunIO $ getModificationTime fp
    mdata <- lookupReloadMap fp
    case mdata of
      Just (lastMtime, lastContents) ->
        if mtime == lastMtime then return $ go' lastContents
          else fmap go' $ newContent mtime
      Nothing -> fmap go' $ newContent mtime
  where
    newContent mtime = do
        s <- readFileUtf8 fp
        insertReloadMap fp (mtime, contentFromString settings s)

    go' = mconcat . map (runtimeContentToHtml cd render (error "I18n embed IMPOSSIBLE") handleMsgEx)
    handleMsgEx _ = error "i18n _{} encountered, but did not use ihamlet"

type RuntimeVars msg url = [(Deref, VarExp msg url)]
hamletRuntimeMsg :: HamletSettings
              -> FilePath
              -> RuntimeVars msg url
              -> HtmlUrlI18n msg url
hamletRuntimeMsg settings fp cd i18nRender render = unsafePerformIO $ do
    mtime <- qRunIO $ getModificationTime fp
    mdata <- lookupReloadMap fp
    case mdata of
      Just (lastMtime, lastContents) ->
        if mtime == lastMtime then return $ go' lastContents
          else fmap go' $ newContent mtime
      Nothing -> fmap go' $ newContent mtime
  where
    newContent mtime = do
        s <- readFileUtf8 fp
        insertReloadMap fp (mtime, contentFromString settings s)

    go' = mconcat . map (runtimeContentToHtml cd render i18nRender handleMsg)
    handleMsg d = case lookup d cd of
            Just (EMsg s) -> i18nRender s
            _ -> nothingError "EMsg for ContentMsg" d

nothingError :: Show a => String -> a -> b
nothingError expected d = error $ "expected " ++ expected ++ " but got Nothing for: " ++ show d

runtimeContentToHtml :: RuntimeVars msg url -> Render url -> Translate msg -> (Deref -> Html) -> Content -> Html
runtimeContentToHtml cd render i18nRender handleMsg = go
  where
    go :: Content -> Html
    go (ContentMsg d) = handleMsg d
    go (ContentRaw s) = preEscapedToHtml s
    go (ContentAttrs d) =
        case lookup d cd of
            Just (EPlain s) -> s
            _ -> error $ show d ++ ": expected EPlain for ContentAttrs"
    go (ContentVar d) =
        case lookup d cd of
            Just (EPlain s) -> s
            _ -> error $ show d ++ ": expected EPlain for ContentVar"
    go (ContentUrl False d) =
        case lookup d cd of
            Just (EUrl u) -> toHtml $ render u []
            Just wrong -> error $  "expected EUrl but got: " ++ show wrong ++ "\nfor: " ++ show d
            _ -> nothingError "EUrl" d
    go (ContentUrl True d) =
        case lookup d cd of
            Just (EUrlParam (u, p)) ->
                toHtml $ render u p
            _ -> error $ show d ++ ": expected EUrlParam"
    go (ContentEmbed d) = case lookup d cd of
        Just (EMixin m) -> m render
        Just (EMixinI18n m) -> m i18nRender render
        _ -> error $ show d ++ ": expected EMixin"