commit 3afe4b5ff9fefb54c1b463ca0be5199260371f77 Author: Paul Brinkmeier Date: Tue Aug 2 23:56:13 2022 +0200 Setup commit, play around with Req, Aeson and Scotty diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c368d45 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +.stack-work/ +*~ \ No newline at end of file diff --git a/README.md b/README.md new file mode 100644 index 0000000..f0b790d --- /dev/null +++ b/README.md @@ -0,0 +1,5 @@ +# lisa + +> lightweight squeak access + +Webserver that offers an HTML-only interface to Squeak. diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..072207d --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,8 @@ +module Main where + +import Web.Scotty (scotty) + +import Lisa (app) + +main :: IO () +main = scotty 8080 app diff --git a/lisa.cabal b/lisa.cabal new file mode 100644 index 0000000..2f2b4ce --- /dev/null +++ b/lisa.cabal @@ -0,0 +1,76 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.4. +-- +-- see: https://github.com/sol/hpack + +name: lisa +version: 0.1.0.0 +description: Please see the README on GitHub at +homepage: https://github.com/pbrinkmeier/lisa#readme +bug-reports: https://github.com/pbrinkmeier/lisa/issues +author: Paul Brinkmeier +maintainer: hallo@pbrinkmeier.de +copyright: Paul Brinkmeier (c) 2021 +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + ChangeLog.md + +source-repository head + type: git + location: https://github.com/pbrinkmeier/lisa + +library + exposed-modules: + Lisa + Lisa.Squeak + other-modules: + Paths_lisa + hs-source-dirs: + src + build-depends: + aeson >=2.0 + , base >=4.7 && <5 + , req >=3.10 + , scotty >=0.12 + , text >=1.0 + , time + default-language: Haskell2010 + +executable lisa-exe + main-is: Main.hs + other-modules: + Paths_lisa + hs-source-dirs: + app + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + aeson >=2.0 + , base >=4.7 && <5 + , lisa + , req >=3.10 + , scotty >=0.12 + , text >=1.0 + , time + default-language: Haskell2010 + +test-suite lisa-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_lisa + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + aeson >=2.0 + , base >=4.7 && <5 + , lisa + , req >=3.10 + , scotty >=0.12 + , text >=1.0 + , time + default-language: Haskell2010 diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000..0d79d35 --- /dev/null +++ b/package.yaml @@ -0,0 +1,54 @@ +name: lisa +version: 0.1.0.0 +github: "pbrinkmeier/lisa" +license: BSD3 +author: "Paul Brinkmeier" +maintainer: "hallo@pbrinkmeier.de" +copyright: "Paul Brinkmeier (c) 2021" + +extra-source-files: +- README.md +- ChangeLog.md + +# Metadata used when publishing your package +# synopsis: Short description of your package +# category: Web + +# To avoid duplicated efforts in documentation and dealing with the +# complications of embedding Haddock markup inside cabal files, it is +# common to point users to the README.md file. +description: Please see the README on GitHub at + +dependencies: +- base >= 4.7 && < 5 +- aeson >= 2.0 +- req >= 3.10 +- scotty >= 0.12 +- text >= 1.0 +- time + +library: + source-dirs: src + +executables: + lisa-exe: + main: Main.hs + source-dirs: app + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - lisa + - scotty >= 0.12 + +tests: + lisa-test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - lisa diff --git a/src/Lisa.hs b/src/Lisa.hs new file mode 100644 index 0000000..de3194d --- /dev/null +++ b/src/Lisa.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Lisa + ( app + ) where + +import Web.Scotty (ScottyM, get, html) + +app :: ScottyM () +app = get "/" $ do + html "

It works!

" diff --git a/src/Lisa/Squeak.hs b/src/Lisa/Squeak.hs new file mode 100644 index 0000000..f2595c0 --- /dev/null +++ b/src/Lisa/Squeak.hs @@ -0,0 +1,90 @@ +{-# 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 } } } }" diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..56d2355 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,67 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/17.yaml + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# subdirs: +# - auto-update +# - wai +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver. +# These entries can reference officially published versions as well as +# forks / in-progress versions pinned to a git hash. For example: +# +# extra-deps: +# - acme-missiles-0.3 +# - git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=2.7" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..84bf18d --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,13 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + size: 619161 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/17.yaml + sha256: 7f47507fd037228a8d23cf830f5844e1f006221acebdd7cb49f2f5fb561e0546 + original: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/17.yaml diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 index 0000000..cd4753f --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"