Add getLectureByIdCached function

This commit is contained in:
Paul Brinkmeier 2022-09-10 15:52:51 +02:00
parent bedd094669
commit d389e78ddc
4 changed files with 20 additions and 5 deletions

View File

@ -3,3 +3,8 @@
> lightweight squeak access
Webserver that offers an HTML-only interface to Squeak.
## TODO
- Improve error handling: Write functions that turn `Maybe` and `Either` `SpockAction`s that return `4xx` or `5xx`.
- Document JSON stuff

View File

@ -16,7 +16,7 @@ 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, emtpySession, mkState, setSessionAuthToken)
import Lisa.Types (Session, State, getAllLecturesCached, getLectureByIdCached, emtpySession, mkState, setSessionAuthToken)
import qualified Lisa.Squeak as Squeak
import qualified Lisa.Views as Views
@ -51,8 +51,9 @@ app = do
blaze Views.viewIndex
get ("lectures" <//> var) $ \lid -> do
lecture <- getLectureByIdCached lid
documents <- Squeak.getDocumentsByLectureId lid
blaze $ either Views.viewSqueakError (Views.viewLecture lid) documents
blaze $ either Views.viewSqueakError id $ Views.viewLecture <$> lecture <*> documents
get "lectures" $ do
query <- fromMaybe "" <$> param "query"

View File

@ -6,13 +6,14 @@ module Lisa.Types where
import Control.Concurrent (MVar, newMVar, putMVar, takeMVar)
import Control.Monad.IO.Class (liftIO)
import Data.List (find)
import Data.Text (Text)
import Data.Time.Clock (UTCTime, addUTCTime, getCurrentTime)
import Network.HTTP.Req (https)
import Text.Printf (printf)
import Web.Spock (SpockAction, getState, readSession)
import Lisa.Squeak (Lecture, SqueakCtx, SqueakError)
import Lisa.Squeak (Lecture(..), SqueakCtx, SqueakError(..))
import qualified Lisa.Squeak as Squeak
@ -61,6 +62,14 @@ getAllLecturesCached = do
liftIO $ putMVar lecturesMVar newContents
pure result
getLectureByIdCached :: Text -> SpockAction conn Session State (Either SqueakError Lecture)
getLectureByIdCached lid = do
lectures <- getAllLecturesCached
pure $ lectures >>= findLecture
where
findLecture =
maybe (Left $ SqueakError "LISA" "Lecture does not exist") Right . find ((lid ==) . lectureId)
instance SqueakCtx (SpockAction conn Session State) where
getLocationInfo = pure $ Right (https "api.squeak-test.fsmi.uni-karlsruhe.de", mempty)
getAuthToken = fmap sessionAuthToken readSession

View File

@ -36,9 +36,9 @@ viewLectures query lectures = do
matchQuery (Lecture _id displayName aliases) =
any (query `isInfixOf`) (displayName : aliases)
viewLecture :: Text -> [Document] -> Html
viewLecture :: Lecture -> [Document] -> Html
viewLecture lecture documents = do
h1 $ text ("Vorlesung " <> lecture)
h1 $ text ("Vorlesung " <> lectureDisplayName lecture)
table $ do
thead $ tr $ mapM_ th ["Art", "Vorlesungen", "Prüfer", "Datum", "Semester", "Seiten"]
tbody $ forM_ documents $ \document -> tr $ do