{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Lisa
    ( app
    , mkConfig
    ) where

import Control.Monad.IO.Class (MonadIO)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Network.HTTP.Types.Status (Status, badRequest400, internalServerError500)
import Text.Blaze.Html (Html)
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import Web.Internal.HttpApiData (FromHttpApiData)
import Web.Spock (ActionCtxT, SpockM, get, lazyBytes, modifySession, param, post, readSession, redirect, request, root, setHeader, setStatus, text, var, (<//>))
import Web.Spock.Config (PoolOrConn(PCNoDatabase), SpockCfg, defaultSpockCfg)

import Lisa.Types (Session, State, getAllLecturesCached, getLectureByIdCached, emtpySession, mkState, setSessionAuthToken)

import qualified Lisa.Squeak as Squeak
import qualified Lisa.Views as Views

-- Utilities

-- From https://github.com/Rockfordal/spockmini/blob/51af99760bbf68c956e906c9633182700a18be9c/src/Web/Utils.hs#L17
blaze :: MonadIO m => Html -> ActionCtxT ctx m a
blaze html = do
    setHeader "Content-Type" "text/html; charset=utf-8"
    lazyBytes $ renderHtml html

-- | Like 'Web.Spock.param'', but uses status 400 instead of 500.
requiredParam :: (FromHttpApiData a, MonadIO m) => Text -> ActionCtxT ctx m a
requiredParam k = param k >>= \case
    Nothing -> do
        setStatus badRequest400
        text $ "Parameter " <> k <> " is required"
    Just val ->
        pure val

-- TODO: Generalize, introduce some sort of Lisa.Types.Error type
-- TODO: Make more readable
onLeft :: MonadIO m => (ActionCtxT ctx m (Either e a)) -> (Status, Text) -> ActionCtxT ctx m a
onLeft f (status, message) = f >>= (flip either pure $ \_ -> do
    setStatus status
    text message)

-- Exports

mkConfig :: IO (SpockCfg () Session State)
mkConfig = do
    state <- mkState
    defaultSpockCfg emtpySession PCNoDatabase state

app :: SpockM () Session State ()
app = do
    get root $ do
        blaze Views.viewIndex
    
    get ("lectures" <//> var) $ \lid -> do
        lecture <- getLectureByIdCached lid `onLeft` (internalServerError500, "Failed to retrieve lectures")
        documents <- Squeak.getDocumentsByLectureId lid `onLeft` (internalServerError500, "Failed to retrieve documents")
        blaze $ Views.viewLecture lecture documents

    get "lectures" $ do
        query <- fromMaybe "" <$> param "query"
        lectures <- getAllLecturesCached
        blaze $ either Views.viewSqueakError (Views.viewLectures query) lectures

    get "login" $ blaze Views.viewLogin

    post "login" $ do
        username <- requiredParam "username"
        password <- requiredParam "password"

        Squeak.login username password >>= \case
            Left err -> blaze $ Views.viewSqueakError err
            Right (Squeak.Credentials authToken _user) -> do
                modifySession $ setSessionAuthToken authToken
                redirect "/"

    get "debug" $ do
        req <- request
        sess <- readSession
        blaze $ Views.viewDebug req sess