Add template haskell function to embed the templates in the haskell c…

…ode.

src/Kucipong/Handler/Admin.hs

@@ -70,21 +70,8 @@ storeCreate
     => ActionCtxT (HVect xs) m ()
 storeCreate = do
     (AdminSession email) <- getAdminEmail
-    -- TODO: Actually return the correct html from here.
-    let rawTemplate = "{% if var %}\nHello, {{ var }}!\n{% else %}\nnegative!\n{% endif %}\n"
-        env = fromPairs [ "var1" .= ("World" :: Text) ]
-        eitherParsedTemplate = eitherParse rawTemplate
-    template <- fromEitherM
-        (html . ("err occured when parsing template: " <>) . pack)
-        eitherParsedTemplate
-    let eitherRenderedTemplate = eitherRender template env
-    renderedTemplate <- fromEitherM
-        (html . ("err occured when trying to render template: " <>) . pack)
-        eitherRenderedTemplate
-    let lala = $(renderTemplateFromEnv "adminUser_admin_store_create.html")
-    $(logDebug) $ lala
-    html . toStrict $ "rendered template: " <> renderedTemplate
-    -- $(renderTemplateFromEnv "adminUser_admin_store_create.html")
+    $(renderTemplateFromEnv "adminUser_admin_store_create.html") $ fromPairs
+        [ "adminEmail" .= email ]
 
 adminAuthHook
     :: ( MonadIO m

src/Kucipong/RenderTemplate.hs

@@ -1,37 +1,57 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module Kucipong.RenderTemplate where
 
 import Kucipong.Prelude hiding ( try )
 
 import Control.Exception ( try )
-import Language.Haskell.TH ( Exp, Q, litE, stringL )
-import Text.EDE ( eitherParse, eitherRender, fromPairs )
+import Language.Haskell.TH
+    ( Exp, Q, appE, litE, lookupValueName, mkName, stringL, varE )
+import Language.Haskell.TH.Syntax ( addDependentFile )
+import Network.HTTP.Types ( internalServerError500 )
+import Text.EDE ( Template, eitherParse, eitherRender, fromPairs )
+import Web.Spock ( html, setStatus )
 
 import Kucipong.Util ( fromEitherM )
 
 templateDirectory :: FilePath
 templateDirectory = "frontend" </> "dist"
 
+unsafeFromRight :: Show e => Either e a -> a
+unsafeFromRight (Right a) = a
+unsafeFromRight (Left err) = error $
+    "Called unsafeFromRight, but we got a left with this value: " <> show err
+
 renderTemplateFromEnv :: String -> Q Exp
 renderTemplateFromEnv filename = do
+    addDependentFile fullFilePath
     eitherRawTemplate <- liftIO . try $ readFile fullFilePath
     rawTemplate <- fromEitherM handleTemplateFileRead eitherRawTemplate
     let eitherParsedTemplate = eitherParse rawTemplate
     -- Check to make sure the template can be parsed correctly.  Return an
-    -- error to the user if it cannot.
+    -- error during compile time to the user if it cannot.
     void $ fromEitherM handleIncorrectTemplate eitherParsedTemplate
-    litE $ stringL "hello"
+    templateExp <- [e| unsafeFromRight $ eitherParse rawTemplate |]
+    eitherRenderLambdaExp <- [e| eitherRender $(pure templateExp) |]
+    [e| \environmentObject -> case $(pure eitherRenderLambdaExp) environmentObject of
+            Left err -> do
+                setStatus internalServerError500
+                html $ "<h3>Error with rendering template:</h3>" <> pack err
+            Right bytestring -> html $ toStrict bytestring |]
   where
     -- This is the full path of the template file.
     fullFilePath :: FilePath
     fullFilePath = templateDirectory </> filename
 
     handleTemplateFileRead :: SomeException -> Q a
     handleTemplateFileRead exception = fail $
-        "exception occured when trying to read file \"" <>
+        "exception occured when trying to read the template file \"" <>
         fullFilePath <>
-        ": " <>
+        ":\n" <>
         show exception
 
     handleIncorrectTemplate :: String -> Q a
-    handleIncorrectTemplate errorMsg = undefined
+    handleIncorrectTemplate errorMsg = fail $
+        "exception occured when trying to parse the template file \"" <>
+        fullFilePath <> ":\n" <> errorMsg