{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}

module Inf.Templates
  ( main
  , page
  , list
  , login
  , edit
  , post
  , delete
  , Main(..)

  , dbException
  , someException

  , markdown

  , InternalError(..)
  ) where

import qualified Control.Exception as Exn
import           Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
import           Data.Monoid ((<>))
import qualified Data.Text as TS
import qualified Data.Text.Lazy as T
import qualified Text.Mustache as Stache
import qualified Text.Pandoc.Class as Pandoc
import qualified Text.Pandoc.Extensions as Pandoc
import qualified Text.Pandoc.Highlighting as Pandoc
import qualified Text.Pandoc.Options as Pandoc
import qualified Text.Pandoc.Readers.Markdown as Pandoc
import qualified Text.Pandoc.Writers.HTML as Pandoc

import           Inf.Types

class InternalError t where
  renderedError :: t -> IO T.Text
  loggedError   :: t -> String

instance InternalError DBException where
  renderedError = dbException
  loggedError = show

instance InternalError Exn.SomeException where
  renderedError = someException
  loggedError = show

instance InternalError Unimplemented where
  renderedError (Unimplemented _) = main Main
    { mainUser     = Nothing
    , mainTitle    = "Unimplemented"
    , mainContents = "IMPLEMENT ME"
    , mainUrl      = "/"
    }

  loggedError (Unimplemented msg) = "Unimplemented: " ++ msg

markdownOpts :: Pandoc.ReaderOptions
markdownOpts = Pandoc.def
  { Pandoc.readerExtensions = Pandoc.pandocExtensions
  }

htmlOpts :: Pandoc.WriterOptions
htmlOpts = Pandoc.def
  { Pandoc.writerHighlightStyle = Just Pandoc.tango
  }

markdown :: TS.Text -> IO TS.Text
markdown raw = Pandoc.runIOorExplode $ do
  pandoc <- Pandoc.readMarkdown markdownOpts raw
  Pandoc.writeHtml5String htmlOpts pandoc

data Main = Main
  { mainUser     :: !(Maybe TS.Text)
  , mainTitle    :: !T.Text
  , mainContents :: !T.Text
  , mainUrl      :: !TS.Text
  }

main :: Main -> IO T.Text
main Main { mainUser, mainTitle, mainContents, mainUrl } = do
  template <- Stache.compileMustacheFile "templates/main.mustache"
  let vals = Aeson.object
        [ "title" .= mainTitle
        , "contents" .= mainContents
        , "user" .= case mainUser of
            Nothing -> Aeson.toJSON ()
            Just u  -> Aeson.object [ "name" .= u ]
        , "url" .= mainUrl
        ]
  pure (Stache.renderMustache template vals)

login :: IO T.Text
login = do
  template <- Stache.compileMustacheFile "templates/login.mustache"
  pure (Stache.renderMustache template (Aeson.object []))

page :: TS.Text -> IO T.Text
page contents = do
  template <- Stache.compileMustacheFile "templates/page.mustache"
  mk <- markdown contents
  let vals = Aeson.object
        [ "contents" .= mk ]
  pure (Stache.renderMustache template vals)

nullable :: Maybe a -> (a -> [(TS.Text, Aeson.Value)]) -> Aeson.Value
nullable Nothing  _ = Aeson.toJSON ()
nullable (Just x) k = Aeson.object (k x)

post :: Maybe TS.Text -> Post -> IO T.Text
post user ps = do
  template <- Stache.compileMustacheFile "templates/post.mustache"
  mk <- markdown (postContents ps)
  let vals = Aeson.object
        [ "contents" .= mk
        , "user"     .= nullable user (\_ ->
              [ "editurl" .= (postURL ps <> "/edit")
              , "delurl"  .= (postURL ps <> "/delete")
              ])
        , "next" .= nullable (postNext ps) (\nxt ->
            [ "link" .= postRefURL nxt ])
        , "prev" .= nullable (postPrev ps) (\nxt ->
            [ "link" .= postRefURL nxt ])
        ]
  pure (Stache.renderMustache template vals)

edit :: TS.Text -> RawPost -> IO T.Text
edit url ps = do
  template <- Stache.compileMustacheFile "templates/edit.mustache"
  let vals = Aeson.object
        [ "id"       .= maybe "" (show . fromPostId) (rpId ps)
        , "title"    .= rpTitle ps
        , "author"   .= userName (rpAuthor ps)
        , "contents" .= rpContents ps
        , "url"      .= url
        ]
  pure (Stache.renderMustache template vals)

delete :: Post -> IO T.Text
delete ps = do
  template <- Stache.compileMustacheFile "templates/delete.mustache"
  let vals = Aeson.object
        [ "post_url" .= postURL ps
        ]
  pure (Stache.renderMustache template vals)

list :: [PostRef] -> IO T.Text
list posts = do
  template <- Stache.compileMustacheFile "templates/list.mustache"
  let vals = Aeson.object
        [ "posts" .=
            [ Aeson.object [ "url"   .= postRefURL ref
                           , "title" .= prName ref
                           , "date"  .= postRefDateT ref
                           ]
            | ref <- posts
            ]
        ]
  pure (Stache.renderMustache template vals)


dbException :: DBException -> IO T.Text
dbException exn = do
  contents <- page $ TS.unlines
    ( "## Internal server error"
      : case exn of
        NoSuchPost -> [ "database misconfiguration" ]
        BadUserError -> [ "bad user session" ]
        NonUniqueResult -> [ "database misconfiguration" ]
        MissingPost pId -> [ "missing post: `" <> TS.pack (show pId) <> "`"]
        MissingPage name -> [ "missing page: `" <> name <> "`"]
        NoPostFound year month slug ->
          [ "no such post: `" <> year <> "/" <> month <> "/" <> slug <> "`" ]
    )
  main Main
    { mainUser     = Nothing
    , mainTitle    = "Error"
    , mainContents = contents
    , mainUrl      = "/"
    }

someException :: Exn.SomeException -> IO T.Text
someException exn = do
  contents <- page $ TS.unlines
    [ "The following unexpected error occurred:"
    , "```"
    , TS.pack (show exn)
    , "```"
    ]
  main Main
    { mainUser     = Nothing
    , mainTitle    = "Internal Server Error"
    , mainContents = contents
    , mainUrl      = "/"
    }