{-# 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!

import Hearth.TopSites
import Network.URI (uriToString)

renderPage :: ByteString -> [(ByteString, Maybe ByteString)] -> [Txt.Text] -> [Link]
        -> Maybe Txt.Text
renderPage path query langs hist = 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 "tops" = list' [hist2gval entry | entry <- take 20 $ topsites hist]
    ctxt "hist" = list' $ map hist2gval $ siteHistory hist
    ctxt _ = toGVal ()
    hist2gval entry@(label, href, time) = orderedDict [
            "label"~>label,
            "href"~>uriToString id href "",
            "time"~>time,
            "count"~>countVisits entry hist]

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
    | "-" `Txt.isInfixOf` lang = let (lang', _) = Txt.breakOn "-" lang
        in translations (lang':langs)
    | otherwise = translations langs
  where files = $(makeRelativeToProject "i18n" >>= embedDir)
translations [] = JS.Null

-- | Type-constrained conversion of a list to Ginger's datamodel,
-- serves to avoid type-inference issues.
list' :: [GVal m] -> GVal m
list' = toGVal

------
--- 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