Commit 9d6b0ba11ff953304bc378206d6d69a6049b843e

  • avatar
  • Ville Tirronen <ville.tirronen @j…u.fi> (Committer)
  • Thu Oct 04 22:52:45 EEST 2018
  • avatar
  • Ville Tirronen <ville.tirronen @j…u.fi> (Author)
  • Thu Oct 04 22:52:45 EEST 2018
Moved pollservant from FileStore to SQLite-smple
CheckPEs/CheckPEs.cabal
(5 / 0)
  
1919 , uniplate , haskell-src-exts, PluginConstructionKit, containers >= 0.5.6, lucid >= 2.9, text >= 1.2, aeson >= 0.8, mtl >= 2.2
2020 default-language: Haskell2010
2121
22executable CheckPEServer
23 hs-source-dirs: service
24 main-is: CheckPEService.hs
25 build-depends: base >= 4.7 && < 5, CheckPEs, scotty, aeson, haskell-src-exts, text
26
2227--test-suite simple-test
2328-- type: exitcode-stdio-1.0
2429-- hs-source-dirs: test
DerivationChecker/tasks/type_polytypes1
(1 / 1)
  
5151''
5252, t_expression = ''length "a hypnomino"''
5353, knownInstances = [] : List Text
54, needsContext = True
54, needsContext = False
5555, accepts = [{acceptsType="Int",msg="Good. You can proceed to [next exercise](../type_constraints/page)"}]
5656}
ExerciseReturns/elm-review/page/custom.css
(2 / 0)
  
77
88.card{margin:0.5em}
99
10h1{font-size:2em;margin-bottom:0.7em;}
11
1012object.inlinePdf {min-width:100%; min-height:50em;}
ExerciseReturns/elm-review/page/review.js
(4 / 1)
  
1178411784 {ctor: '[]'},
1178511785 {
1178611786 ctor: '::',
11787 _0: _elm_lang$html$Html$text(item.reviewItem.rev_question),
11787 _0: A2(
11788 _evancz$elm_markdown$Markdown$toHtml,
11789 {ctor: '[]'},
11790 item.reviewItem.rev_question),
1178811791 _1: {
1178911792 ctor: '::',
1179011793 _0: _elm_lang$html$Html$text(
ExerciseReturns/elm-review/src/ListTasks.elm
(10 / 1)
  
3939
4040view : Model -> Html Msg
4141view model = Bulma.columns []
42 [Bulma.column [] [Table.view config model.table model.submissions] ]
42 [Bulma.column [] [stats model.submissions
43 ,Table.view config model.table model.submissions] ]
44stats submissions
45 = let
46 size = List.length submissions
47 category = if size < 50 then "is-primary" else "is-danger"
48 in div [class "tags",class "has-addons"]
49 [span [class "tag"] [text "Unreviewed"]
50 ,span [class category,class "tag"] [text (toString size)]
51 ]
4352
4453init : MyFlags -> (Model,Cmd Msg)
4554init flags = {table = Table.initialSort "Submission",submissions=[], modal=Bulma.emptyModal}![loadSubmissions flags]
ExerciseReturns/elm-review/src/Review.elm
(1 / 1)
  
180180 _ -> "System failure"
181181
182182reviewItem flags identity item = Bulma.card {defaultCard
183 | header = [Bulma.cardtitle [] [text item.reviewItem.rev_question
183 | header = [Bulma.cardtitle [] [Markdown.toHtml [] item.reviewItem.rev_question
184184 , text (" ("++toString item.reviewItem.rev_minWords++"-"
185185 ++toString item.reviewItem.rev_maxWords++" words, ")
186186 , if revItemOk flags item
FileStore/FileStore.hs
(51 / 33)
  
11{-#LANGUAGE FlexibleInstances#-}
22{-#LANGUAGE TypeOperators #-}
3{-#LANGUAGE OverloadedStrings #-}
34{-#LANGUAGE DeriveGeneric #-}
45{-#LANGUAGE DeriveDataTypeable #-}
56module FileStore where
3535import Data.Time.Clock
3636import Data.Time.Format
3737
38import Database.SQLite.Simple
39
40
41
3842class Key a where
3943 toPath :: a -> FilePath
4044
200200makeBlackboard :: (MonadIO m, Monad m) => FilePath -> m BBStore
201201makeBlackboard storePath = liftIO (createDirectoryIfMissing True storePath) >> liftIO (BB<$>newTVarIO mempty<*>pure storePath)
202202--
203
204bbTableSpec ="CREATE TABLE IF NOT EXISTS blackboard (id INTEGER PRIMARY KEY, user TEXT, tag TEXT, UNIQUE(user,tag))"
205
203206bbfetch :: ST.Text -> BBStore -> IO (Set.HashSet ST.Text)
204bbfetch user (BB locks path)
205 | ST.null user = return mempty
206 | otherwise = do
207 let file = path</>sanitizeToFilename (ST.unpack user)
208 e <- doesFileExist file
209 if e
210 then withLock locks file $ do
211 r <- LBS.readFile file
212 case A.decode r of
213 Nothing -> evaluate (r`deepseq`mempty)
214 Just set -> evaluate (r`deepseq`set)
215 else return mempty
207bbfetch user (BB _ path) = do
208 conn <- open (path</>"blackboard.db") -- This allows collisions!
209 execute_ conn bbTableSpec
210 r <- query conn "SELECT tag FROM blackboard where user = ?" (Only user)
211 close conn
212 pure (Set.fromList [val | Only val <-r])
213
214-- | ST.null user = return mempty
215-- | otherwise = do
216-- let file = path</>sanitizeToFilename (ST.unpack user)
217-- e <- doesFileExist file
218-- if e
219-- then withLock locks file $ do
220-- r <- LBS.readFile file
221-- case A.decode r of
222-- Nothing -> evaluate (r`deepseq`mempty)
223-- Just set -> evaluate (r`deepseq`set)
224-- else return mempty
216225
217226---- Ad tag for user
218227bbAdd :: ST.Text -> ST.Text -> BBStore -> IO ()
219bbAdd user tag store = withbbstore user store (Set.insert tag)
228bbAdd user tag (BB _ path) = do
229 conn <- open (path</>"blackboard.db") -- This allows collisions!
230 execute_ conn bbTableSpec
231 execute conn "INSERT OR IGNORE INTO blackboard (user,tag) VALUES (?,?)" (user, tag)
232 close conn
220233--
221234---- 'Atomic'
222withbbstore :: ST.Text -> BBStore -> (HashSet ST.Text -> HashSet ST.Text) -> IO ()
223withbbstore user (BB locks path) op
224 | ST.null user = return ()
225 | otherwise = do
226 let file = path</>sanitizeToFilename (ST.unpack user)
227 e <- doesFileExist file
228 if e
229 then withLock locks file $ do
230 r <- LBS.readFile file
231 let logPath = (path</>ST.unpack user<.>"log")
232 createDirectoryIfMissing True logPath
233 now <- getCurrentTime
234 LBS.writeFile (logPath</>formatTime defaultTimeLocale "%Y-%m-%d-%H-%M-%S" now)
235 (A.encode (op mempty))
236 mod <- case A.decode r of
237 Nothing -> evaluate (r`deepseq`op mempty)
238 Just set -> evaluate (r`deepseq`op set)
239 LBS.writeFile file $ A.encode mod
240 else
241 LBS.writeFile file $ A.encode (op mempty)
235-- withbbstore :: ST.Text -> BBStore -> (HashSet ST.Text -> HashSet ST.Text) -> IO ()
236-- withbbstore user (BB locks path) op
237-- | ST.null user = return ()
238-- | otherwise = do
239-- let file = path</>sanitizeToFilename (ST.unpack user)
240-- e <- doesFileExist file
241-- if e
242-- then withLock locks file $ do
243-- r <- LBS.readFile file
244-- let logPath = (path</>ST.unpack user<.>"log")
245-- createDirectoryIfMissing True logPath
246-- now <- getCurrentTime
247-- LBS.writeFile (logPath</>formatTime defaultTimeLocale "%Y-%m-%d-%H-%M-%S" now)
248-- (A.encode (op mempty))
249-- mod <- case A.decode r of
250-- Nothing -> evaluate (r`deepseq`op mempty)
251-- Just set -> evaluate (r`deepseq`op set)
252-- LBS.writeFile file $ A.encode mod
253-- else
254-- LBS.writeFile file $ A.encode (op mempty)
242255
243256bbstore :: ST.Text -> HashSet ST.Text -> BBStore -> IO ()
244257bbstore user val (BB locks path)
FileStore/stack.yaml
(0 / 49)
  
1 resolver: nightly-2016-09-01
2
3# User packages to be built.
4# Various formats can be used as shown in the example below.
5#
6# packages:
7# - some-directory
8# - https://example.com/foo/bar/baz-0.0.2.tar.gz
9# - location:
10# git: https://github.com/commercialhaskell/stack.git
11# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
12# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
13# extra-dep: true
14# subdirs:
15# - auto-update
16# - wai
17#
18# A package marked 'extra-dep: true' will only be built if demanded by a
19# non-dependency (i.e. a user package), and its test suites and benchmarks
20# will not be run. This is useful for tweaking upstream packages.
21packages:
22- '.'
23# Dependency packages to be pulled from upstream that are not in the resolver
24# (e.g., acme-missiles-0.3)
25extra-deps: []
26
27# Override default flag values for local packages and extra-deps
28flags: {}
29
30# Extra package databases containing global packages
31extra-package-dbs: []
32
33# Control whether we use the GHC we find on the path
34# system-ghc: true
35#
36# Require a specific version of stack, using version ranges
37# require-stack-version: -any # Default
38# require-stack-version: ">=1.1"
39#
40# Override the architecture used by stack, especially useful on Windows
41# arch: i386
42# arch: x86_64
43#
44# Extra directories used by stack for building
45# extra-include-dirs: [/path/to/dir]
46# extra-lib-dirs: [/path/to/dir]
47#
48# Allow a newer minor version of GHC than the snapshot specifies
49# compiler-check: newer-minor
New_Hec/NewHec.hs
(4 / 3)
  
244244instance Reply HecOutputCtx BlackboardOut where
245245 putIt a@(HOC ctx plgName taskID _) (BlackboardOut v) = case user ctx of
246246 Just userName -> do
247 withbbstore (userName) (blackboards ctx) $ \bb ->
248 execBBCs bb v
247 let toAddToBB = execBBCs mempty v
248 -- withbbstore (userName) (blackboards ctx) $ \bb ->
249 mapM_ (\tag -> bbAdd userName tag (blackboards ctx)) toAddToBB
249250 return a
250251 Nothing -> return a
251252
284284 where
285285 css = mempty
286286 tsk = let TID t=task in T.fromStrict t
287 script = "https://functional-programming.it.jyu.fi/new-resources/ExerciseReturns/elm-upload/embed_gui.js"
287 script = "<script>https://functional-programming.it.jyu.fi/new-resources/ExerciseReturns/elm-upload/embed_gui.js</script>"
288288 text = T.unlines [
289289 "<div id='"<>tsk<>"'></div>"
290290 ," <script>"
PollServant/MarkPolls/Main.hs
(3 / 4)
  
99import qualified Data.Map as M
1010import Data.Monoid
1111import Text.Pretty.Simple
12import qualified Database.SQLite.Simple as SQLite (Connection,withConnection)
1213
1314import Cortex.Polls
1415
5858main = do
5959 cmd <- execParser commands
6060 case cmd of
61 Mark (MarkOpts storename bblackboard lecture) -> do
62 store <- fmakeStore storename
61 Mark (MarkOpts storename bblackboard lecture) -> SQLite.withConnection storename $ \store -> do
6362 bb <- makeBlackboard bblackboard
6463 lecSpec <- getLectureSpec lecture
6564 voters <- lectureVoters store lecSpec
7272 else putStrLn $ "Failing" ++ show voter
7373
7474
75 Check (CheckOpts store student lecname) -> do
76 s <- fmakeStore store
75 Check (CheckOpts storename student lecname) -> SQLite.withConnection storename $ \s -> do
7776 res <- join $ gradeLecture s <$> getLectureSpec lecname<*>pure (student)
7877 pPrint res
PollServant/PollServant.cabal
(5 / 3)
  
1515
1616library
1717 hs-source-dirs: src
18 exposed-modules: PollServant.API, PollServant.Server, PollServant.Policy
18 exposed-modules: PollServant.API, PollServant.Server, PollServant.Policy, PollServant.Database
1919 build-depends: base >= 4.7 && < 5
2020 , aeson
2121 , mtl
2828 , http-client-tls
2929 , containers
3030 , text
31 , FileStore
31 , sqlite-simple
3232 , LoginManager
3333 , yaml
3434 , Cortex
4343 , PollServant
4444 , pretty-simple
4545 , optparse-applicative
46 , text
4746 , FileStore
47 , text
48 , sqlite-simple
4849 , containers
4950 , Cortex
5051 default-language: Haskell2010
5757 build-depends: base
5858 , PollServant
5959 , optparse-applicative
60 , sqlite-simple
6061 default-language: Haskell2010
6162
6263source-repository head
PollServant/src/PollServant/API.hs
(42 / 18)
  
33{-# LANGUAGE TypeOperators #-}
44{-# LANGUAGE DeriveGeneric #-}
55{-# LANGUAGE DeriveAnyClass #-}
6{-# LANGUAGE OverloadedStrings #-}
67module PollServant.API where
78
89import Data.Aeson
1818import qualified Data.Map as Map
1919import Data.Map (Map)
2020import Data.Time.Clock
21import qualified FileStore
21-- import qualified FileStore
2222import Cortex.Polls
2323
2424data User = User T.Text deriving (Eq,Ord,Show,Generic,FromJSON,ToJSON,ToJSONKey,FromJSONKey)
2525
2626newtype PollName = PollName T.Text deriving (Eq,Ord,Show,FromJSON,ToJSON,Generic)
2727
28instance FileStore.Key PollName where
29 toPath (PollName a) = FileStore.sanitizeToFilename (T.unpack a)
28--instance FileStore.Key PollName where
29-- toPath (PollName a) = FileStore.sanitizeToFilename (T.unpack a)
3030
3131type API =
3232 ("submit" :> JYSes :> Capture "PollName" T.Text :> ReqBody '[JSON] [Int] :> Post '[JSON] ())
5757api :: Proxy API
5858api = Proxy
5959
60
61selectionFromInt :: Int -> Maybe Answer
62selectionFromInt i = case i of
63 1 -> Just IsTrue
64 0 -> Just Dunno
65 -1 -> Just IsFalse
66 _ -> Nothing
67
68selectionToString :: Answer -> T.Text
69selectionToString i = case i of
70 IsTrue -> "YES"
71 Dunno -> "DUNNO"
72 IsFalse -> "NO"
73
74selectionFromString i = case i of
75 "YES" -> Just IsTrue
76 "DUNNO" -> Just Dunno
77 "NO" -> Just IsFalse
78 _ -> Nothing
79
6080type PollData = Map User Vote
61data Vote = Vote (IntMap Int) UTCTime deriving (Show,Generic,ToJSON,FromJSON)
81data Vote = Vote (IntMap Answer) UTCTime deriving (Show,Generic)
6282
6383usersThatVoted :: PollData -> [User]
6484usersThatVoted = Map.keys
8686voteTime :: Vote -> UTCTime
8787voteTime (Vote _ t) = t
8888
89getVote :: Vote -> IntMap Int
89getVote :: Vote -> IntMap Answer
9090getVote (Vote v _) = v
9191
9292voteOption :: Int -> Vote -> Answer
9393voteOption i (Vote v _) = case IM.lookup i v of
94 Just 1 -> IsTrue
95 Just (-1) -> IsFalse
96 Just 0 -> IsNeutral
94 Just s -> s
9795 _ -> Dunno
9896
9997toTriple :: Tally -> (Int,Int,Int)
10098toTriple (Sum a,Sum b,Sum c) =(a,b,c)
10199
102vote :: User -> [Int] -> PollData -> IO PollData
103vote usr vt pd = do
104 time <- getCurrentTime
105 return $ Map.insert usr (Vote (IM.fromList (zip [1..] vt)) time) pd
100-- vote :: User -> [Int] -> PollData -> IO PollData
101-- vote usr vt pd = do
102-- time <- getCurrentTime
103-- return $ Map.insert usr (Vote (IM.fromList (zip [1..] vt)) time) pd
106104
107105tallyVotes :: PollData -> IntMap Tally
108106tallyVotes = IM.unionsWith mappend . fmap (fmap toTally1) . map getVote . Map.elems
109107
110108type Tally = (Sum Int,Sum Int,Sum Int)
111109
112toTally1 :: Int -> Tally
113toTally1 n
114 | n==0 = (mempty,Sum 1,mempty)
115 | n==1 = (Sum 1,mempty,mempty)
116 | n== -1 = (mempty,mempty,Sum 1)
117 | otherwise = mempty
110toTally :: Int -> Answer -> Tally
111toTally i n | n == Dunno = (mempty, Sum i, mempty)
112 | n == IsTrue = (Sum i, mempty, mempty)
113 | n == IsFalse = (mempty, mempty, Sum i)
114 | otherwise = mempty
115
116toTally1 :: Answer -> Tally
117toTally1 n | n == Dunno = (mempty, Sum 1, mempty)
118 | n == IsTrue = (Sum 1, mempty, mempty)
119 | n == IsFalse = (mempty, mempty, Sum 1)
120 | otherwise = mempty
PollServant/src/PollServant/Database.hs
(75 / 0)
  
1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3
4module PollServant.Database where
5
6import Control.Applicative
7import qualified Data.Text as T
8import Database.SQLite.Simple
9import Database.SQLite.Simple.FromRow
10import Data.Time.Clock
11import qualified Data.IntMap as IntMap
12import Data.IntMap (IntMap)
13import PollServant.API
14import Data.Maybe
15import Data.Monoid
16import Data.Ord
17import Data.Coerce
18import Data.List
19import qualified Data.IntMap.Strict as IM
20
21createDB conn = do
22 execute_ conn "CREATE TABLE IF NOT EXISTS LectureVotes\
23 \(user TEXT, poll TEXT, option INT,selection TEXT,time TEXT,\
24 \CONSTRAINT pk PRIMARY KEY (user,poll,option))"
25
26
27
28addVote conn user poll votes = do
29 now <- getCurrentTime
30 withTransaction conn $
31 sequence_ [execute conn "INSERT OR REPLACE INTO LectureVotes values (?,?,?,?,?)" (user,poll,n,v,now)
32 | (n,v') <- zip [1::Int ..] votes
33 , let v = (maybe ("ERROR("<>T.pack (show v')<>")")
34 selectionToString
35 (selectionFromInt v')) :: T.Text
36 ]
37
38
39getUserVote :: Connection -> User -> PollName -> IO (Maybe Vote) -- (Maybe (IntMap Selection))
40getUserVote conn (User user) (PollName poll) = do
41 vs :: [(Int,T.Text,UTCTime)] <- query conn "SELECT option,selection FROM LectureVotes WHERE user=? AND poll=?" (user,poll)
42 case vs of
43 [] -> return Nothing
44 _ -> let
45 (votes,dates) = unzip (map (\(a,b,c) -> ((a,b),c)) vs)
46 voteMap = sequenceA (selectionFromString <$> IntMap.fromList votes)
47 date = maximum dates
48 in return (Vote <$> voteMap <*> pure date)
49
50userCount :: Connection -> PollName -> IO Int
51userCount conn (PollName p) = do
52 r <- query conn "SELECT COUNT(DISTINCT user) from LectureVotes where poll=?" (Only p)
53 case r of
54 [] -> pure $ 0
55 _ -> pure $ maximum (map fromOnly r)
56
57totals :: Connection -> PollName -> IO [(Int, Int, Int)]
58totals conn (PollName p) = do
59 items <- query
60 conn
61 "SELECT option,selection,COUNT(Selection) from LectureVotes WHERE Poll=? GROUP BY option,selection\
62 \ ORDER BY option"
63 (Only p)
64 pure
65 $ map (\(_, (Sum a, Sum b, Sum c)) -> (a, b, c))
66 $ IM.toList
67 $ IM.fromListWith mappend
68 [ (opt, t)
69 | (opt, ans, count) <- items
70 , let t = fromMaybe mempty (toTally count <$> (selectionFromInt ans))
71 ]
72
73pollVoters :: Connection -> PollName -> IO [User]
74pollVoters conn (PollName p) = do
75 map (User . fromOnly) <$> query conn "SELECT DISTINCT user FROM LectureVotes WHERE poll=?" (Only p)
PollServant/src/PollServant/Policy.hs
(42 / 39)
  
1010import Data.Monoid
1111import Control.Monad.Trans
1212import Control.Monad
13import FileStore
13-- import FileStore
1414import PollServant.API
15import PollServant.Database
1516import Cortex.Polls
1617import Dhall
18import Database.SQLite.Simple (Connection)
1719
18getUserVote :: User -> PollName -> FIOStore -> IO (Maybe Vote)
19getUserVote user p store = do
20 (polldata :: Maybe PollData) <- liftIO
21 $ ffetch ("PollStore" :: T.Text, p) store
22 return $ do
23 poll <- polldata
24 Map.lookup user poll
20--getUserVote :: User -> PollName -> FIOStore -> IO (Maybe Vote)
21--getUserVote user p store = do
22-- (polldata :: Maybe PollData) <- liftIO
23-- $ ffetch ("PollStore" :: T.Text, p) store
24-- return $ do
25-- poll <- polldata
26-- Map.lookup user poll
2527
2628getPollSpec :: MonadIO io => PollName -> io PollDescription
2729getPollSpec (PollName pn) = liftIO $ 
4747 let corrects = length [ () | True <- map prd gs ]
4848 in fromIntegral corrects / fromIntegral (length gs) > p
4949
50gradeLecture :: FIOStore -> LectureDescription -> User -> IO LectureReport
50gradeLecture :: Connection -> LectureDescription -> User -> IO LectureReport
5151gradeLecture st ld u = do
5252 pollReps <- mapM report (lecturePolls ld)
5353 return $
5454 LectureReport (lectureName ld) pollReps (atleast 0.3 isAcceptable pollReps)
5555 where
5656 report poll = do
57 uv <- getUserVote u (PollName $ identifier poll) st
57 uv <- getUserVote st u (PollName $ identifier poll)
5858 case uv of
5959 Nothing -> return $ PollReport [] (identifier poll)
6060 Just uservote -> return $ doGrade uservote poll
6161
62lectureVoters :: FIOStore -> LectureDescription -> IO [User]
62lectureVoters :: Connection -> LectureDescription -> IO [User]
6363lectureVoters store lec = nub . concat <$> mapM (pollVoters store . PollName . identifier) (lecturePolls lec)
6464
65pollVoters :: FIOStore -> PollName -> IO [User]
66pollVoters store p = do
67 (pollData :: Maybe PollData) <- ffetch ("PollStore" :: T.Text, p) store
68 return $ Data.Maybe.maybe [] (Map.keys) pollData
65--pollVoters :: FIOStore -> PollName -> IO [User]
66--pollVoters store p = do
67-- (pollData :: Maybe PollData) <- ffetch ("PollStore" :: T.Text, p) store
68-- return $ Data.Maybe.maybe [] (Map.keys) pollData
6969
7070doGrade :: Vote -> PollDescription -> PollReport
71doGrade uservote pollspec =
72 PollReport chks (identifier pollspec)
73 where
74 duringLecture = fromMaybe True $ do
75 duetime <- parseTimeM True defaultTimeLocale "%d.%m.%Y %H:%M%z" (T.unpack (due pollspec))
76 let votetime = voteTime uservote
77 return ( diffUTCTime votetime duetime < 2*60*60
78 && diffUTCTime votetime duetime >= 0)
79 chk g
80 | duringLecture = g
81 | otherwise = Grade OutsideLecture False
82 chks = [ chk $ case (studentanswer,correct opt) of
83 (IsTrue,Just True) -> Grade IsTrue True
84 (IsFalse,Just False) -> Grade IsFalse True
85 (Dunno, _) -> Grade Dunno False
86 (a, Nothing) -> Grade a True
87 (a, _) -> Grade a False
88 | (i,opt) <- zip [1..] (options pollspec)
89 , let studentanswer = voteOption i uservote
90 ]
91
71doGrade uservote pollspec = PollReport chks (identifier pollspec)
72 where
73 duringLecture = fromMaybe True $ do
74 duetime <- parseTimeM True
75 defaultTimeLocale
76 "%d.%m.%Y %H:%M%z"
77 (T.unpack (due pollspec))
78 let me = voteTime uservote
79 return (diffUTCTime me duetime < 2 * 60 * 60 && diffUTCTime me duetime >= 0)
80 chk g | duringLecture = g
81 | otherwise = Grade OutsideLecture False
82 chks =
83 [ chk $ case (studentanswer, correct opt) of
84 (IsTrue , Just True ) -> Grade IsTrue True
85 (IsFalse, Just False) -> Grade IsFalse True
86 (a , Nothing ) -> Grade a True
87 (Dunno , _ ) -> Grade Dunno False
88 (a , _ ) -> Grade a False
89 | (i, opt) <- zip [1 ..] (options pollspec)
90 , let studentanswer = voteOption i uservote
91 ]
9292
93gradesFor :: User -> PollName -> FIOStore -> IO (Maybe PollReport)
94gradesFor (User user) p store = do
95 uservote <- getUserVote (User user) p store
93
94gradesFor :: Connection -> User -> PollName -> IO (Maybe PollReport)
95gradesFor conn (User user) p = do
96 uservote <- getUserVote conn (User user) p
9697 pollspec <- getPollSpec p
9798 return $ doGrade <$> uservote <*> pure pollspec
9899
PollServant/src/PollServant/Server.hs
(18 / 14)
  
2020import Network.HTTP.Client hiding (Proxy)
2121import Network.HTTP.Client.TLS
2222
23import FileStore
23-- import FileStore
2424
2525import LoginManager.Types
2626import LoginManager.Remote
2727import LoginManager.Backends
2828
2929import PollServant.API
30import PollServant.Database
3031import Cortex.Polls
3132
3233import PollServant.Policy
34import qualified Database.SQLite.Simple as SQLite (Connection,withConnection)
3335
3436
3537startApp :: Int -> String -> String -> IO ()
3638startApp portNum loginManagerUrl lecturer = do
3739 httpManager <- newManager tlsManagerSettings
38 store <- fmakeStore "PollData"
40 let store = "PollData.db"
3941 let baseURL = fromMaybe (error "Bad login manager url")
4042 (parseBaseUrl loginManagerUrl)
4143 jlb <- mkRemoteManager (mkClientEnv httpManager baseURL)
4244 run portNum (app jlb store (T.pack lecturer))
4345
4446app :: HasContextEntry '[x] LoginManager.Backends.JyLimitedBackend =>
45 x -> FIOStore -> T.Text -> Application
47 x -> FilePath -> T.Text -> Application
4648app jlb store lecturer =
4749 serveWithContext api (jlb :. EmptyContext) (server store lecturer)
4850
4951
50
51
52server :: FIOStore -> T.Text -> Server API
53server store lecturer = submit :<|> totals :<|> answerCount :<|> status :<|> myGrade :<|> myLecture
52server :: FilePath -> T.Text -> Server API
53server store lecturer = submit :<|> gettotals :<|> answerCount :<|> status :<|> myGrade :<|> myLecture
5454 :<|> pollInfo :<|> lectureInfo
5555 where
5656 pollInfo :: T.Text -> Handler PollDescription
5757 pollInfo = liftIO . getPollSpec . PollName
5858 lectureInfo = liftIO . getLectureSpec
5959
60 myLecture (Ok user) lecname =
61 liftIO $ join $
62 gradeLecture store<$>getLectureSpec lecname<*>pure (User user)
60 myLecture (Ok user) lecName =
61 liftIO $ SQLite.withConnection store $ \conn -> do
62 lecSpec <- getLectureSpec lecName
63 gradeLecture conn lecSpec (User user)
6364 myLecture Failure _ = throwError $ err401 {errBody = "LOGIN needed"}
6465
6566 myGrade (Ok user) pollname = do
66 r <- liftIO $ gradesFor (User user) (PollName pollname) store
67 r <- liftIO $ SQLite.withConnection store $ \conn -> gradesFor conn (User user) (PollName pollname)
6768 case r of
6869 Nothing -> return $ PollReport [] pollname
6970 Just v -> return v
7474 submit Failure _ _ = throwError $ err401 {errBody = "LOGIN needed"}
7575
7676 submit (Ok user) poll uservote =
77 liftIO $ fmodifyM ("PollStore"::T.Text,poll) (vote (User user) uservote) store
77 liftIO $ SQLite.withConnection store $ \conn ->
78 addVote conn user poll uservote
79--fmodifyM ("PollStore"::T.Text,poll) (vote (User user) uservote) store
7880
79 totals poll = liftIO $ map toTriple . toList . tallyVotes . fromMaybe mempty <$> ffetch ("PollStore"::T.Text,poll) store
81 gettotals poll = liftIO $ SQLite.withConnection store
82 $ \conn -> totals conn (PollName poll) -- ffetch ("PollStore"::T.Text,poll) store
8083
81 answerCount poll = liftIO $ length . fromMaybe mempty <$> ((ffetch @_ @PollData) ("PollStore"::T.Text,poll) store )
84 answerCount poll = liftIO $ SQLite.withConnection store $ \conn -> userCount conn (PollName poll)
8285
8386 status (Ok user)
8487 | user == lecturer = return $ T.pack "Lecturer"
itkst53.it.jyu.fi/foo
(156 / 0)
  
1Aarrelampi Iita-Maria,31874,iihebloi,iita-maria.h.aarrelampi@student.jyu.fi
2Ali-Kovero Jouni,279968,joaaolal,jouni.a.o.ali-kovero@student.jyu.fi
3Alila Juuso,284629,jusaalil,juuso.s.alila@student.jyu.fi
4Asp Jali,279512,japeanas,jali.p.a.asp@student.jyu.fi
5Attolou Herve-Madelein,316008,heattolo,herve-madelein.h-m.attolou@student.jyu.fi
6Bachelot Loic,316016,lopibach,loic.bachelot@gmail.com
7Bhandari Biplob,309651,bibhanda,bibhanda@student.jyu.fi
8Buure Otto,280955,otvieebu,otto.v.e.buure@student.jyu.fi
9de Castilla David,316057,dabedeca,david.b.decastilla@student.jyu.fi
10Eskelinen Eeva,279970,eesaeske,eeva.r.eskelinen@student.jyu.fi
11Flyktman Marko,284598,mataflyk,marko.t.flyktman@student.jyu.fi
12Geier Anton,284642,anlugeie,anton.l.geier@student.jyu.fi
13Goman Amanda,275892,amalgoma,amanda.a.goman@student.jyu.fi
14Hallikainen Amanda,312206,niamhall,amanda.n.hallikainen@student.jyu.fi
15Harju Niko,194252,niveharj,niko.v.harju@student.jyu.fi
16Heinonen Eveliina,22930,evtolone,t.eveliina.heinonen@student.jyu.fi
17Helen Satu,275982,sathanhe,satu.h.helen@student.jyu.fi
18Hellsten Joonas,256893,jopehell,tiltti_94@hotmail.com
19Hillilä Petra,292583,pesuhill,petra.s.hillila@student.jyu.fi
20Hiltunen Satu,84649,samahilt,satu.m.hiltunen@student.jyu.fi
21Himmanen Joonas,300036,joeehimm,joonas.e.himmanen@student.jyu.fi
22Hirvonen-Lankisch Riitta,640,riihirvo,riitta.j.hirvonen-lankisch@student.jyu.fi
23Honka Niina,10981,nituomi,niinath31@gmail.com
24Honkala Jukka,264452,jutahonk,jukka.t.honkala@student.jyu.fi
25Huhta Anna,297252,anilhuht,anna.i.huhta@student.jyu.fi
26Huotari Sonja,284626,soonhuot,sonja.o.huotari@student.jyu.fi
27Huusko Kirsi,5101,kituhuus,kirsi.huusko@gmail.com
28Hyytiäinen Teemu,288058,teehyyti,teemu.o.hyytiainen@student.jyu.fi
29Häkkinen Satu,278119,satmarkr,satu.m.k.hakkinen@student.jyu.fi
30Häkkänen Jussi,292543,jusehakk,jussi.s.hakkanen@student.jyu.fi
31Hämäläinen Antti,280968,anoshama,antti.o.hamalainen@student.jyu.fi
32Hänninen Jesse,284555,jejohann,jesse.j.hanninen@student.jyu.fi
33Hänninen Konsta,280358,kokuhann,konsta.k.hanninen@student.jyu.fi
34Ikäkoivu Mirva,310844,mikaikak,mirva.k.ikakoivu@student.jyu.fi
35Ikävalko Juuso,295923,jujuosik,juuso.j.o.ikavalko@student.jyu.fi
36Ivanov Anton,315913,anolivan,anton.o.ivanov@student.jyu.fi
37Jalkanen Jaakko,279543,jasajalk,jaakko.s.jalkanen@student.jyu.fi
38Jantunen Marianna,288395,masipaja,marianna.jantunen@gmail.com
39Jokisuu Annika,255962,aninjoki,annika.i.jokisuu@student.jyu.fi
40Jokitalo Jussi,250780,jukajoki,jussi.k.jokitalo@student.jyu.fi
41Juntunen Otto,265661,otjojunt,otto.j.juntunen@student.jyu.fi
42Jussila Aapo,263116,aasajuss,jussila.aapo@hotmail.com
43Juutilainen Jesse,287953,jeosjuut,juutilainenjesse@gmail.com
44Juvonen Taneli,279875,tajojuvo,taneli.j.juvonen@student.jyu.fi
45Jääskeläinen Susanna,287963,sunijoja,susanna.jaaskelainen@hotmail.com
46Kalasniemi Salla-Mari,312235,sakalasn,salla-mari.s-m.kalasniemi@student.jyu.fi
47Kanerva Teija,311941,tejekane,teija.j.kanerva@student.jyu.fi
48Kansanaho Anniina,289123,ankansan,anniina.a.kansanaho@student.jyu.fi
49Kasanen Mari,287691,remasoka,r.mari.s.kasanen@student.jyu.fi
50Katajarinne Ida-Sofia,310701,idkataja,ida-sofia.i-s.katajarinne@student.jyu.fi
51Kela Jenna,287729,jejukela,jenna.j.kela@student.jyu.fi
52Kiianmaa Nelli,190413,nejokiia,nelli.j.kiianmaa@student.jyu.fi
53Kiimalainen Henna,252506,hesakiim,henna.s.kiimalainen@jyu.fi
54Kingelin Janita,310003,jajoking,janita.j.kingelin@student.jyu.fi
55Kivistö Reetta,287537,rekaterv,reetta.kivistoe@gmail.com
56Kohvakka Heikki,278081,heolkohv,heikki.o.kohvakka@student.jyu.fi
57Koistinen Juho,279326,juvakois,juho.v.koistinen@student.jyu.fi
58Korko Henri,312112,henantko,henri.a.korko@student.jyu.fi
59Korpelainen Noora,216613,nokakorp,noorakorpelainen@gmail.com
60Korpivaara Ida,307425,idelkorp,ida.e.korpivaara@student.jyu.fi
61Kortemaa Antti,303175,anhekuko,antti.h.k.kortemaa@student.jyu.fi
62Koskinen Anna,310112,koskanka,anna.k.koskinen@student.jyu.fi
63Koskinen Elias,258419,eledkosk,eledkosk@gmail.com
64Koskinen Ida,287895,idmikosk,zin_pepper@hotmail.com
65Koskinen Laura,279192,lakakosk,laura.ka.koskinen@student.jyu.fi
66Kronholm Kristiina,297778,krevamkr,kristiina.e.a.kronholm@student.jyu.fi
67Kuhalampi Mikko,288432,mivikuha,kuhalampimikko@hotmail.com
68Kultanen Joni,264323,jomikult,joni.m.kultanen@student.jyu.fi
69Kurvinen Kaarlo,280196,kajokurv,kaarlo.j.kurvinen@student.jyu.fi
70Kylämies Jaakko,284632,jasakyla,jaskakylis@gmail.com
71Käyhty Mervi,284572,meelkayh,mervi.e.kayhty@student.jyu.fi
72Lahti Aleksi,251840,aljulaht,aleksi.j.lahti@student.jyu.fi
73Lahti Sonja,279717,sohilaht,sonja.h.lahti@student.jyu.fi
74Lahtinen Anssi,284571,anjolaht,anssi.j.lahtinen@student.jyu.fi
75Laine Henri,275759,henmaran,henri.m.a.laine@student.jyu.fi
76Lehto Mila,311816,mimoleht,mila.m.lehto@student.jyu.fi
77Leppälä Leevi,281022,leallepp,leevi.a.leppala@student.jyu.fi
78Lokka Aleksi,272376,alolvalo,aleksi.o.v.lokka@student.jyu.fi
79Mahlberg Alvar,280123,aljomahl,aljomahl@student.jyu.fi
80Matilainen Juhani,284640,jualmati,jualmat@gmail.com
81Maunu Miikka,282892,mimaunu,miikka.o.maunu@student.jyu.fi
82Mikkola Ella-Maria,292593,ellmaami,ellamaria.mikkola@gmail.com
83Mikkonen Sari,271519,sasumikk,sasumikk@jyu.fi
84Moisa Teuvo,222300,tepamois,teuvo.moisa@gmail.com
85Müller Lauri,287529,lawimull,lauri.muller@gmail.com
86Mäkinen Annika,252803,annkarma,annikakaroliina.makinen@gmail.com
87Mäkinen Petri,271213,petjuhma,petri.j.makinen@student.jyu.fi
88Naveed Nasir,310313,nanaveed,nasir.n.naveed@student.jyu.fi
89Nevalainen Ville,311996,vipeneva,ville.p.nevalainen@student.jyu.fi
90Nevanlinna Kimmo,267816,kiarolne,kimmo.a.nevanlinna@student.jyu.fi
91Niesniemi Sami,299958,sakanies,niesniemisami@gmail.com
92Niskakangas Teemu,279266,teeenisk,teemu.e.niskakangas@student.jyu.fi
93Niutanen Otto,25074,otilniut,otto.i.niutanen@student.jyu.fi
94Nupponen Marjo-Kaisa,312178,marnuppo,marjo.n.nupponen@student.jyu.fi
95Olavuo Sami,284510,sapeolav,sami.p.olavuo@student.jyu.fi
96Ollila Markus,289791,mapaheol,markus.p.h.ollila@student.jyu.fi
97Pakarinen Timo,267071,letitapa,timo.l.t.pakarinen@student.jyu.fi
98Pakola Henri,290590,hemipako,henri.pakola@gmail.com
99Palsa Mikko,312193,miolpepa,mikko.o.p.palsa@student.jyu.fi
100Palvaila Jaakko,284463,jajupalv,jaakko.j.palvaila@student.jyu.fi
101Pertola Anna,311603,annkarpe,anna.k.pertola@student.jyu.fi
102Pesari Joonas,287434,joakpesa,joonas.pesari@welho.com
103Pietilä Mikko,303826,miotalpi,pietila.mikko@hotmail.fi
104Piirto Sanna,311922,smpiirto,sanna.m.piirto@student.jyu.fi
105Pohjanlahti Eveliina,308000,tuevpohj,evepohjanlahti@gmail.com
106Pohjola Tommi,250720,tojopohj,tommi.j.pohjola@student.jyu.fi
107Poutala Tero,268639,tepeolpo,tero.p.o.poutala@student.jyu.fi
108Puikkonen Marjo,312329,mahapuik,marjo.h.puikkonen@student.jyu.fi
109Pylkkönen Taneli,259825,tapylkko,taneli.x.pylkkonen@student.jyu.fi
110Raitanen Tuure,271618,tutorait,tuure.t.raitanen@student.jyu.fi
111Ranta Kristian,46321,hekrrant,kristian.h.ranta@student.jyu.fi
112Rautala Elias,286985,elosraut,elias.o.rautala@student.jyu.fi
113Riihijärvi Veronica,308858,vevekari,veronica.riihijarvi@gmail.com
114Ristimäki Jaso,284465,jatarist,jaso.t.ristimaki@student.jyu.fi
115Ropponen Johanna,265670,juelropp,johanna_ropponen@hotmail.com
116Rönkä Aleksanteri,284434,alpamaro,aleksanteri.p.m.ronka@student.jyu.fi
117Saarelainen Patrik,288045,pahesaar,patriksaarelainen@gmail.com
118Salakka Matti,270939,masalakk,matti.t.e.salakka@student.jyu.fi
119Salmela Henri,288020,henaarju,henrisalmelaa@gmail.com
120Salminen Jonna,305876,salmjonn,jonnasalminen@outlook.com
121Schuitemaker Jonas,316081,jojaalsc,j.j.a.schuitemaker@gmail.com
122Shrestha Govinda,313105,goshrest,govinda.g.shrestha@student.jyu.fi
123Sippo Markus,287242,makrsipp,make.sippo@hotmail.com
124Sjöholm Katja,275907,kalihesj,katja.l.h.sjoholm@student.jyu.fi
125Solanterä Terhi,310962,temaaiso,terhi.m.a.solantera@student.jyu.fi
126Sollo Julia,266952,jucasoll,julia.carita@hotmail.com
127Sorvali Aleksi,275802,aljosorv,aleksi.j.sorvali@student.jyu.fi
128Suni Ella,292577,elfaansu,ella.f.a.suni@student.jyu.fi
129Taipale Meri,279194,mekataip,meri.k.taipale@student.jyu.fi
130Tarvainen Timo,47326,titujuta,timo.t.j.tarvainen@student.jyu.fi
131Teukku Sanni,280745,sasukrte,sanni.s.k.teukku@student.jyu.fi
132Tiainen Tatu,275875,taaltiai,tatu.tiainen@gmail.com
133Tiikkainen Sara,271470,samatiik,sara.m.tiikkainen@student.jyu.fi
134Toitturi Mikko,279338,mipetoit,mikko.p.toitturi@student.jyu.fi
135Tolonen Ville,265566,vimaheto,ville.m.h.tolonen@student.jyu.fi
136Torkkeli Tuomas,275963,tujualto,tuomas.j.a.torkkeli@student.jyu.fi
137Tornberg Antti,284493,anpejuto,antti.p.tornberg@student.jyu.fi
138Tran Kimngan,316084,kitran,kimngan.k.tran@student.jyu.fi
139Tulisalo Anne,28786,antulisa,anne.tulisalo@gmail.com
140Tulla Riku,287503,ritatull,riku.t.tulla@student.jyu.fi
141Tähtinen Jenny,284432,jemainta,jenny.m.i.tahtinen@student.jyu.fi
142Uusitalo Eliisa,288311,elmauusi,eliisa.m.uusitalo@gmail.com
143Vainio Pyry,310890,pysavain,pyry.s.vainio@student.jyu.fi
144Varcok Tomas,312984,tovarcok,tomas.t.varcok@student.jyu.fi
145Vartiainen Emil,288445,emaajuva,emil.a.j.vartiainen@student.jyu.fi
146Veijalainen Elena,287835,elhemave,elena.h.m.veijalainen@student.jyu.fi
147Venäläinen Henri,258654,hemavena,henri.m.venalainen@student.jyu.fi
148Vesterinen Jammi,280176,jamaosve,jammi.m.o.vesterinen@student.jyu.fi
149Viljanen Simo,292545,sieevilj,pohjaventtiili@gmail.com
150Virtala Jani,264627,jamivirt,jani.m.virtala@student.jyu.fi
151Virtanen Janina,311204,janmarvi,janina.m.virtanen@student.jyu.fi
152Virtanen Joni,300120,jopevirt,jomppavirtanen@gmail.com
153Vitikainen Teemu,284657,tematavi,teemu.m.t.vitikainen@student.jyu.fi
154Vuorela Teemu,287927,terivuor,teemu.r.vuorela@student.jyu.fi
155Ylinampa Vili,262193,vihejayl,vihejayl@student.jyu.fi
156Yrjänä Laura,284565,laanyrja,laura.a.yrjana@student.jyu.fi