81 lines
2.8 KiB
Haskell
81 lines
2.8 KiB
Haskell
{-# 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
|