Add getAllLecturesCached

lisa.cabal

@@ -27,6 +27,7 @@ library
   exposed-modules:
       Lisa
       Lisa.Squeak
+      Lisa.Views
   other-modules:
       Paths_lisa
   hs-source-dirs:
@@ -36,6 +37,7 @@ library
       Spock >=0.14
     , aeson >=2.0
     , base >=4.7 && <5
+    , blaze-html >=0.9
     , req >=3.10
     , text >=1.0
     , time
@@ -52,6 +54,7 @@ executable lisa-exe
       Spock >=0.14
     , aeson >=2.0
     , base >=4.7 && <5
+    , blaze-html >=0.9
     , lisa
     , req >=3.10
     , text >=1.0
@@ -70,6 +73,7 @@ test-suite lisa-test
       Spock >=0.14
     , aeson >=2.0
     , base >=4.7 && <5
+    , blaze-html >=0.9
     , lisa
     , req >=3.10
     , text >=1.0

package.yaml

@@ -22,6 +22,7 @@ description:         Please see the README on GitHub at <https://github.com/pbri
 dependencies:
 - base >= 4.7 && < 5
 - aeson >= 2.0
+- blaze-html >= 0.9
 - req >= 3.10
 - Spock >= 0.14
 - text >= 1.0

src/Lisa.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Lisa
@@ -5,19 +7,68 @@ module Lisa
     , mkConfig
     ) where
 
+import Control.Concurrent (MVar, newMVar, putMVar, takeMVar)
+import Control.Monad.IO.Class (MonadIO, liftIO)
 import Data.Maybe (fromMaybe)
-import Web.Spock (SpockM, get, html, param, root)
+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)
 
-data Session = Session
+import Lisa.Squeak (SqueakCtx, SqueakError, Lecture)
 
-mkConfig :: IO (SpockCfg () Session ())
+import qualified Lisa.Squeak as Squeak
-mkConfig = defaultSpockCfg Session PCNoDatabase ()
+import qualified Lisa.Views as Views
 
-app :: SpockM () Session () ()
+-- 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
-        html "<h1>It works!</h1><ul><li><a href='/lectures/search'>Vorlesungen</a></li></ul>"
+        blaze Views.viewIndex
-    get "/lectures/search" $ do
+    
+    get ("lectures" <//> var) $ \id -> do
+        documents <- Squeak.getDocumentsByLectureId id
+        blaze $ either Views.viewSqueakError (Views.viewLecture id) documents
+
+    get "lectures" $ do
         query <- fromMaybe "" <$> param "query"
-        html $ "<h1>" <> query <> "</h1><form action='/lectures/search' method='GET'><input name='query' value='"  <> query <> "'><button type='submit'>Suchen</button></form>"
+        lectures <- getAllLecturesCached
+        blaze $ either Views.viewSqueakError (Views.viewLectures query) lectures

src/Lisa/Squeak.hs

@@ -130,6 +130,8 @@ data Document = Document
     , documentFaculty       :: Faculty
     , documentLectures      :: [Lecture]
     , documentDownloadable  :: Bool
+    , documentType          :: Text
+    , documentNumPages      :: Int
     }
     deriving (Show, Generic)
 
@@ -171,7 +173,17 @@ getAllDocuments :: (SqueakCtx m, MonadIO m) => m (Either SqueakError [Document])
 getAllDocuments = fmap unDocuments <$> joinErrors <$> mkQuery
     "{ documents(filters: []) \
     \  { results \
-    \    { id date semester publicComment downloadable faculty { id displayName } lectures { id displayName aliases } } \
+    \    { id date semester publicComment downloadable faculty { id displayName } lectures { id displayName aliases } type numPages } \
+    \  } \
+    \}"
+
+getDocumentsByLectureId :: (SqueakCtx m, MonadIO m) => Text -> m (Either SqueakError [Document])
+getDocumentsByLectureId lecture = fmap unDocuments <$> joinErrors <$> mkQueryWithVars
+    (object ["lecture" .= lecture])
+    "query DocumentsByLectureId($lecture: LectureId!) \
+    \ { documents(filters: [{ lectures: [$lecture] }]) \
+    \  { results \
+    \    { id date semester publicComment downloadable faculty { id displayName } lectures { id displayName aliases } type numPages } \
     \  } \
     \}"
 

src/Lisa/Views.hs

@@ -0,0 +1,54 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Lisa.Views
+    ( viewIndex
+    , viewLecture
+    , viewLectures
+    , viewSqueakError
+    ) where
+
+import Prelude hiding (div)
+
+import Control.Monad (forM_)
+import Data.List (intersperse)
+import Data.Text (Text, isInfixOf)
+import Text.Blaze.Html5 hiding (map)
+import Text.Blaze.Html5.Attributes hiding (form)
+
+import Lisa.Squeak (Document(..), Lecture(..), SqueakError(..))
+
+viewIndex :: Html
+viewIndex = do
+    h1 "Lisa"
+    ul $ do
+        li $ a "Vorlesungen" ! href "/lectures"
+
+viewLectures :: Text -> [Lecture] -> Html
+viewLectures query lectures = do
+    h1 $ text "Vorlesungen"
+    form ! action "/lectures" ! method "GET" $ do
+        input ! name "query" ! value (textValue query)
+        button ! type_ "submit" $ text "Filtern"
+    ul $ forM_ (filter matchQuery lectures) $ \(Lecture id displayName aliases) -> do
+        li $ do
+            div $ a ! href (textValue $ "/lectures/" <> id) $ text displayName
+            div $ text $ mconcat $ intersperse ", " aliases
+    where
+        matchQuery (Lecture _id displayName aliases) =
+            any (query `isInfixOf`) (displayName : aliases)
+
+viewLecture :: Text -> [Document] -> Html
+viewLecture id documents = do
+    h1 $ text ("Vorlesung " <> id)
+    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
+
+viewSqueakError :: SqueakError -> Html
+viewSqueakError error = string $ show error