75 lines
2.4 KiB
Haskell
75 lines
2.4 KiB
Haskell
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Lisa
|
|
( app
|
|
, mkConfig
|
|
) where
|
|
|
|
import Control.Concurrent (MVar, newMVar, putMVar, takeMVar)
|
|
import Control.Monad.IO.Class (MonadIO, liftIO)
|
|
import Data.Maybe (fromMaybe)
|
|
import Network.HTTP.Req (https)
|
|
import Text.Blaze.Html (Html)
|
|
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
|
|
import Web.Spock (SpockAction, SpockM, ActionCtxT, get, getState, lazyBytes, param, root, setHeader, var, (<//>))
|
|
import Web.Spock.Config (PoolOrConn(PCNoDatabase), SpockCfg, defaultSpockCfg)
|
|
|
|
import Lisa.Squeak (SqueakCtx, SqueakError, Lecture)
|
|
|
|
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
|
|
|
|
instance SqueakCtx (SpockAction () () State) where
|
|
getLocationInfo = pure $ Right (https "api.squeak-test.fsmi.uni-karlsruhe.de", mempty)
|
|
getAuthToken = pure Nothing
|
|
|
|
-- State
|
|
|
|
data State = State
|
|
{ stateLectures :: MVar (Maybe [Lecture]) -- ^ Cached lectures
|
|
}
|
|
|
|
-- | Get lectures from cache if they've been retrieved before or from Squeak.
|
|
getAllLecturesCached :: SpockAction () () State (Either SqueakError [Lecture])
|
|
getAllLecturesCached = do
|
|
lecturesMVar <- stateLectures <$> getState
|
|
contents <- liftIO $ takeMVar lecturesMVar
|
|
lectures' <- case contents of
|
|
Just lectures -> pure $ Right lectures
|
|
Nothing -> do
|
|
liftIO $ putStrLn "Fetching lectures for the first time..."
|
|
Squeak.getAllLectures
|
|
liftIO $ putMVar lecturesMVar $ either (const Nothing) Just lectures'
|
|
pure lectures'
|
|
|
|
-- Exports
|
|
|
|
mkConfig :: IO (SpockCfg () () State)
|
|
mkConfig = do
|
|
lecturesMVar <- newMVar Nothing
|
|
defaultSpockCfg () PCNoDatabase (State lecturesMVar)
|
|
|
|
app :: SpockM () () State ()
|
|
app = do
|
|
get root $ do
|
|
blaze Views.viewIndex
|
|
|
|
get ("lectures" <//> var) $ \id -> do
|
|
documents <- Squeak.getDocumentsByLectureId id
|
|
blaze $ either Views.viewSqueakError (Views.viewLecture id) documents
|
|
|
|
get "lectures" $ do
|
|
query <- fromMaybe "" <$> param "query"
|
|
lectures <- getAllLecturesCached
|
|
blaze $ either Views.viewSqueakError (Views.viewLectures query) lectures
|