lisa/src/Lisa/Squeak.hs

91 lines
2.5 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module Lisa.Squeak where
import Data.Aeson (FromJSON(parseJSON), ToJSON(toJSON), Value, (.:), (.:?), (.=), object, withObject)
import Data.Text (Text)
import Data.Time.Calendar (Day)
import Network.HTTP.Req (POST(..), ReqBodyJson(..), Req, https, jsonResponse, responseBody, req)
data GQLQuery = GQLQuery
{ gqlQueryQuery :: Text
}
deriving (Show)
instance ToJSON GQLQuery where
toJSON (GQLQuery q) = object ["query" .= q]
data GQLReply a = GQLReply
{ gqlReplyData :: Maybe a
, gqlReplyErrors :: Maybe [GQLError]
}
deriving (Show)
instance FromJSON a => FromJSON (GQLReply a) where
parseJSON = withObject "GQLReply" $ \v -> GQLReply
<$> v .: "data"
<*> v .:? "errors"
data GQLError = GQLError
{ gqlErrorMessage :: Text
}
deriving (Show)
instance FromJSON GQLError where
parseJSON = withObject "GQLError" $ \v -> GQLError
<$> v .: "message"
data Documents = Documents { getDocuments :: [Document] }
deriving (Show)
instance FromJSON Documents where
parseJSON = withObject "Documents" $ \v -> Documents
<$> ((v .: "documents") >>= (.: "results"))
data Document = Document
{ documentId :: Text
, documentDate :: Day
, documentSemester :: Text
, documentPublicComment :: Maybe Text
, documentFaculty :: Faculty
, documentLectures :: [Lecture]
}
deriving (Show)
instance FromJSON Document where
parseJSON = withObject "Document" $ \v -> Document
<$> v .: "id"
<*> v .: "date"
<*> v .: "semester"
<*> v .: "publicComment"
<*> v .: "faculty"
<*> v .: "lectures"
data Faculty = Faculty
{ facultyId :: Text
, facultyDisplayName :: Text
}
deriving (Show)
instance FromJSON Faculty where
parseJSON = withObject "Faculty" $ \v -> Faculty
<$> v .: "id"
<*> v .: "displayName"
data Lecture = Lecture
{ lectureId :: Text
, lectureDisplayName :: Text
}
deriving (Show)
instance FromJSON Lecture where
parseJSON = withObject "Lecture" $ \v -> Lecture
<$> v .: "id"
<*> v .: "displayName"
serverUrl = https "api.squeak-test.fsmi.uni-karlsruhe.de"
getLectures :: Req (GQLReply Documents)
getLectures = responseBody <$> req POST serverUrl (ReqBodyJson $ GQLQuery q) jsonResponse mempty
where q = "{ documents(filters: []) { results { id date semester publicComment faculty { id displayName } lectures { id displayName } } } }"