{-# LANGUAGE OverloadedStrings #-}

module Lisa.Views where

import Prelude hiding (div, id)

import Control.Monad (forM_)
import Data.List (intersperse)
import Data.Text (Text, isInfixOf)
import Network.Wai (Request)
import Text.Blaze.Html5 hiding (map, style)
import Text.Blaze.Html5.Attributes hiding (form, label)

import Lisa.Types (Session)
import Lisa.Squeak (Document(..), Lecture(..), SqueakError(..))

viewIndex :: Html
viewIndex = do
    h1 "Lisa"
    ul $ do
        li $ a "Login" ! href "/login"
        li $ a "Vorlesungen" ! href "/lectures"
        li $ a "Debuginformation" ! href "/debug"

viewLectures :: Text -> [Lecture] -> Html
viewLectures query lectures = do
    h1 $ text "Vorlesungen"
    form ! method "GET" ! action "/lectures" $ do
        input ! name "query" ! value (textValue query)
        button ! type_ "submit" $ text "Filtern"
    ul $ forM_ (filter matchQuery lectures) $ \(Lecture lid displayName aliases) -> do
        li $ do
            div $ a ! href (textValue $ "/lectures/" <> lid) $ text displayName
            div $ text $ mconcat $ intersperse ", " aliases
    where
        matchQuery (Lecture _id displayName aliases) =
            any (query `isInfixOf`) (displayName : aliases)

viewLecture :: Lecture -> [Document] -> Html
viewLecture lecture documents = do
    h1 $ text ("Vorlesung " <> lectureDisplayName lecture)
    table $ do
        thead $ tr $ mapM_ th ["Art", "Vorlesungen", "Prüfer", "Datum", "Semester", "Seiten"]
        tbody $ forM_ documents $ \document -> tr $ do
            td $ text $ documentType document
            td $ text $ mconcat $ intersperse ", " $ map lectureDisplayName $ documentLectures document
            td $ text "TBD"
            td $ string $ show $ documentDate document
            td $ text $ documentSemester document
            td $ string $ show $ documentNumPages document

viewLogin :: Html
viewLogin = do
    h1 $ text "FSMI-Login"
    form ! method "POST" ! action "/login" $ do
        div $ do
            label ! for (textValue "username") $ text "Benutzername"
            input ! name "username" ! id "username"
        div $ do
            label ! for (textValue "password") $ text "Passwort"
            input ! type_ "password" ! name "password" ! id "password"
        button ! type_ "submit" $ text "Einloggen"

viewDebug :: Request -> Session -> Html
viewDebug request session = do
    h1 $ text "Debuginformation"
    snippetCodebox "Request" request
    snippetCodebox "Session" session

viewSqueakError :: SqueakError -> Html
viewSqueakError err = do
    h1 $ text "Ein Fehler ist aufgetreten"
    snippetCodebox "Fehler" err

-- snippets
snippetCodebox :: Show a => Text -> a -> Html
snippetCodebox codeboxLabel x = 
    fieldset $ do
        legend $ text codeboxLabel
        pre ! style (textValue "white-space: pre-wrap; word-wrap: anywhere") $ string $ show x