Add basic dynamic routes

This commit is contained in:
Paul Brinkmeier 2022-08-24 04:42:06 +02:00
parent dde97a0658
commit 96bafd4dca
2 changed files with 21 additions and 3 deletions

View File

@ -4,8 +4,13 @@ module Lisa
( app ( app
) where ) where
import Web.Scotty (ScottyM, get, html) import Data.Maybe (fromMaybe)
import Web.Scotty (ScottyM, get, html, param, rescue)
app :: ScottyM () app :: ScottyM ()
app = get "/" $ do app = do
html "<h1>It works!</h1>" get "/" $ do
html "<h1>It works!</h1><ul><li><a href='/lectures/search?query='>Vorlesungen</a></li></ul>"
get "/lectures/search" $ do
query <- param "query"
html $ "<form action='/lectures/search' method='GET'><input name='query' value='" <> query <> "'><button type='submit'>Suchen</button></form>"

View File

@ -74,9 +74,17 @@ instance FromJSON Faculty where
<$> v .: "id" <$> v .: "id"
<*> v .: "displayName" <*> v .: "displayName"
data Lectures = Lectures { unLectures :: [Lecture] }
deriving (Show)
instance FromJSON Lectures where
parseJSON = withObject "Lectures" $ \v -> Lectures
<$> v .: "lectures"
data Lecture = Lecture data Lecture = Lecture
{ lectureId :: Text { lectureId :: Text
, lectureDisplayName :: Text , lectureDisplayName :: Text
, lectureAliases :: [Text]
} }
deriving (Show) deriving (Show)
@ -84,9 +92,14 @@ instance FromJSON Lecture where
parseJSON = withObject "Lecture" $ \v -> Lecture parseJSON = withObject "Lecture" $ \v -> Lecture
<$> v .: "id" <$> v .: "id"
<*> v .: "displayName" <*> v .: "displayName"
<*> v .: "aliases"
serverUrl = https "api.squeak-test.fsmi.uni-karlsruhe.de" serverUrl = https "api.squeak-test.fsmi.uni-karlsruhe.de"
getLectures :: Req (GQLReply Lectures)
getLectures = responseBody <$> req POST serverUrl (ReqBodyJson $ GQLQuery q) jsonResponse mempty
where q = "{ lectures { id displayName aliases } }"
getDocuments :: Req (GQLReply Documents) getDocuments :: Req (GQLReply Documents)
getDocuments = responseBody <$> req POST serverUrl (ReqBodyJson $ GQLQuery q) jsonResponse mempty getDocuments = responseBody <$> req POST serverUrl (ReqBodyJson $ GQLQuery q) jsonResponse mempty
where q = "{ documents(filters: []) { results { id date semester publicComment downloadable faculty { id displayName } lectures { id displayName } } } }" where q = "{ documents(filters: []) { results { id date semester publicComment downloadable faculty { id displayName } lectures { id displayName } } } }"