diff --git a/README.md b/README.md index f0b790d..3dd5cad 100644 --- a/README.md +++ b/README.md @@ -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 diff --git a/src/Lisa.hs b/src/Lisa.hs index 73c107a..fefad2a 100644 --- a/src/Lisa.hs +++ b/src/Lisa.hs @@ -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" diff --git a/src/Lisa/Types.hs b/src/Lisa/Types.hs index f02804c..f47d9bb 100644 --- a/src/Lisa/Types.hs +++ b/src/Lisa/Types.hs @@ -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 diff --git a/src/Lisa/Views.hs b/src/Lisa/Views.hs index 7f2a38f..ec44a4b 100644 --- a/src/Lisa/Views.hs +++ b/src/Lisa/Views.hs @@ -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