Add basic dynamic routes
This commit is contained in:
parent
dde97a0658
commit
96bafd4dca
11
src/Lisa.hs
11
src/Lisa.hs
@ -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>"
|
||||||
|
@ -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 } } } }"
|
||||||
|
Loading…
x
Reference in New Issue
Block a user