{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
module Hearth (renderPage, handleForm) where

import Text.Ginger.Parse (parseGingerFile, SourcePos)
import Text.Ginger.Run (runGinger, makeContextHtml, Run)
import Text.Ginger.Html (htmlSource, Html)
import Text.Ginger.GVal as V (toGVal, orderedDict, (~>), GVal)
import Control.Monad.Writer.Lazy (Writer)

import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text as Txt
import qualified Data.Text.Encoding as Txt
import Data.FileEmbed
import System.FilePath (normalise, (</>))

import qualified Data.Aeson as JS
import Data.Maybe (fromMaybe)

import Debug.Trace (traceShow) -- For error reporting!

renderPage :: ByteString -> [(ByteString, Maybe ByteString)] -> [Txt.Text] -> Maybe Txt.Text
renderPage path query langs = case parseGingerFile resolveSource $ utf8 path of
    Just (Right tpl) -> do
      Just $ htmlSource $ flip runGinger tpl $ makeContextHtml ctxt
    Just (Left err) -> traceShow err Nothing
    Nothing -> Nothing
  where
    ctxt :: Txt.Text -> GVal (Run SourcePos (Writer Html) Html)
    ctxt "Q" = orderedDict [utf8' k~>v | (k, v) <- query]
    ctxt "_" = toGVal $ translations langs
    ctxt _ = toGVal ()

resolveSource :: FilePath -> Maybe (Maybe [Char])
resolveSource path
    | ret@(Just _) <- resolveSource' path = Just ret
    | ret@(Just _) <- resolveSource' (path </> "index.html") = Just ret
    | otherwise = Nothing
resolveSource' :: FilePath -> Maybe [Char]
resolveSource' = fmap utf8 .
    flip lookup $(makeRelativeToProject "tpl" >>= embedDir) . tail . normalise

-- | Convert from UTF-8 bytestring to a string.
utf8 :: ByteString -> String
utf8 = Txt.unpack . Txt.decodeUtf8
utf8' :: ByteString -> Txt.Text
utf8' = Txt.decodeUtf8

translations :: [Txt.Text] -> JS.Value
translations (lang:langs)
    | Just file <- lookup (Txt.unpack lang ++ ".json") files,
        Just ret <- JS.decode $ LBS.fromStrict file = ret
    | otherwise = translations langs
  where files = $(makeRelativeToProject "i18n" >>= embedDir)
translations [] = JS.Null

------
--- Interactive features
------

handleForm :: ByteString -> [(ByteString, ByteString)] -> IO ByteString
handleForm "/" query = return $ fromMaybe "/" $ lookup "url" query
handleForm "/index.html" query = return $ fromMaybe "/" $ lookup "url" query
handleForm path _ = return path