feat(eeusers): fix form & finish implementation

src/Handler/ExamOffice/ExternalExam.hs

@@ -4,8 +4,6 @@ module Handler.ExamOffice.ExternalExam
 
 import Import
 
-import Database.Persist.Sql (deleteWhereCount, updateWhereCount)
-
 import Handler.Utils
 
 import Handler.Utils.ExternalExam.Users
@@ -17,52 +15,13 @@ postEEGradesR tid ssh coursen examn = do
     eExam <- getBy404 $ UniqueExternalExam tid ssh coursen examn
     (usersResult, examUsersTable) <- makeExternalExamUsersTable EEUMGrades eExam
 
-    let
-      editResults results changeList = fmap getSum . flip foldMapM results $ \result -> do
-        now <- liftIO getCurrentTime
-        mExtExamRes <- get result
-        nrEdit <- updateWhereCount
-          [ ExternalExamResultId ==. result ]
-          (changeList <> [ ExternalExamResultLastChanged =. now ])
-        if
-          | Just ExternalExamResult{..} <- mExtExamRes -> do
-            forM_ [1..nrEdit] $ const $ audit $ TransactionExternalExamResultEdit externalExamResultExam externalExamResultUser
-            return $ Sum nrEdit
-          | otherwise -> return mempty
-
     usersResult' <- formResultMaybe usersResult $ \case
       (ExternalExamUserMarkSynchronisedData, selectedResults) -> do
         forM_ selectedResults externalExamResultMarkSynchronised
         return . Just $ do
           addMessageI Success $ MsgExamUserMarkedSynchronised $ length selectedResults
           redirect $ EExamR tid ssh coursen examn EEGradesR
-
+      _other -> return Nothing
-      (ExternalExamUserEditOccurrenceData occ, selectedResults) -> do
-        nrEdited <- editResults selectedResults
-          [ ExternalExamResultTime =. occ ]
-        return . Just $ do
-          addMessageI Success $ MsgExternalExamOccurrenceEdited nrEdited
-          redirect $ EExamR tid ssh coursen examn EEGradesR
-
-      (ExternalExamUserEditResultData examResult, selectedResults) -> do
-        nrEdited <- editResults selectedResults
-          [ ExternalExamResultResult =. examResult ]
-        return . Just $ do
-          addMessageI Success $ MsgExternalExamResultEdited nrEdited
-          redirect $ EExamR tid ssh coursen examn EEGradesR
-
-      (ExternalExamUserDeleteData, selectedResults) -> do
-        nrDeleted <- fmap getSum . flip foldMapM selectedResults $ \selectedResult -> do
-          mExtExamRes <- get selectedResult
-          nrDel <- deleteWhereCount [ ExternalExamResultId ==. selectedResult ]
-          if
-            | Just ExternalExamResult{..} <- mExtExamRes -> do
-              forM_ [1..nrDel] $ const $ audit $ TransactionExternalExamResultDelete externalExamResultExam externalExamResultUser
-              return $ Sum nrDel
-            | otherwise -> return mempty
-        return . Just $ do
-          addMessageI Success $ MsgExternalExamUserDeleted nrDeleted
-          redirect $ EExamR tid ssh coursen examn EEGradesR
 
     return (usersResult', examUsersTable)
 

src/Handler/ExternalExam/Users.hs

@@ -4,14 +4,64 @@ module Handler.ExternalExam.Users
 
 import Import
 
+import Database.Persist.Sql (deleteWhereCount, updateWhereCount)
+
+import Handler.Utils
+
 import Handler.Utils.ExternalExam.Users
 
 getEEUsersR, postEEUsersR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html
 getEEUsersR = postEEUsersR
 postEEUsersR tid ssh coursen examn = do
-  (_, table) <- runDB $ do
+  (usersResult, table) <- runDB $ do
     eExam <- getBy404 $ UniqueExternalExam tid ssh coursen examn
-    makeExternalExamUsersTable EEUMUsers eExam
+    (usersResult, examUsersTable) <- makeExternalExamUsersTable EEUMUsers eExam
+
+    let
+      editResults results changeList = fmap getSum . flip foldMapM results $ \result -> do
+        now <- liftIO getCurrentTime
+        mExtExamRes <- get result
+        nrEdit <- updateWhereCount
+          [ ExternalExamResultId ==. result ]
+          (changeList <> [ ExternalExamResultLastChanged =. now ])
+        if
+          | Just ExternalExamResult{..} <- mExtExamRes -> do
+            forM_ [1..nrEdit] $ const $ audit $ TransactionExternalExamResultEdit externalExamResultExam externalExamResultUser
+            return $ Sum nrEdit
+          | otherwise -> return mempty
+
+    usersResult' <- formResultMaybe usersResult $ \case
+      (ExternalExamUserEditOccurrenceData occ, selectedResults) -> do
+        nrEdited <- editResults selectedResults
+          [ ExternalExamResultTime =. occ ]
+        return . Just $ do
+          addMessageI Success $ MsgExternalExamOccurrenceEdited nrEdited
+          redirect $ EExamR tid ssh coursen examn EEGradesR
+
+      (ExternalExamUserEditResultData examResult, selectedResults) -> do
+        nrEdited <- editResults selectedResults
+          [ ExternalExamResultResult =. examResult ]
+        return . Just $ do
+          addMessageI Success $ MsgExternalExamResultEdited nrEdited
+          redirect $ EExamR tid ssh coursen examn EEGradesR
+
+      (ExternalExamUserDeleteData, selectedResults) -> do
+        nrDeleted <- fmap getSum . flip foldMapM selectedResults $ \selectedResult -> do
+          mExtExamRes <- get selectedResult
+          nrDel <- deleteWhereCount [ ExternalExamResultId ==. selectedResult ]
+          if
+            | Just ExternalExamResult{..} <- mExtExamRes -> do
+              forM_ [1..nrDel] $ const $ audit $ TransactionExternalExamResultDelete externalExamResultExam externalExamResultUser
+              return $ Sum nrDel
+            | otherwise -> return mempty
+        return . Just $ do
+          addMessageI Success $ MsgExternalExamUserDeleted nrDeleted
+          redirect $ EExamR tid ssh coursen examn EEGradesR
+      _other -> return Nothing
+
+    return (usersResult', examUsersTable)
+
+  whenIsJust usersResult join
 
   siteLayoutMsg (MsgExternalExamUsers coursen examn) $ do
     setTitleI MsgBreadcrumbExternalExamUsers

src/Handler/Utils/ExternalExam/Users.hs

@@ -34,6 +34,7 @@ data ExternalExamUserMode = EEUMUsers | EEUMGrades
 instance Universe ExternalExamUserMode
 instance Finite ExternalExamUserMode
 nullaryPathPiece ''ExternalExamUserMode $ camelToPathPiece' 1
+makePrisms ''ExternalExamUserMode
 
 
 type ExternalExamUserTableExpr = E.SqlExpr (Entity ExternalExamResult)
@@ -259,12 +260,8 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do
 
     dbtColonnade :: Colonnade Sortable _ _
     dbtColonnade = mconcat
-      [ case mode of
+      [ dbSelect (applying _2) id $ return . view (resultResult . _entityKey)
-          EEUMGrades -> mconcat
+      , fromMaybe mempty . guardOn (is _EEUMGrades mode) $ colSynced
-            [ dbSelect (applying _2) id $ return . view (resultResult . _entityKey)
-            , colSynced
-            ]
-          _other -> mempty
       , colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname)
       , colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer)
       , Colonnade.singleton (fromSortable . Sortable (Just "occurrence-start") $ i18nCell MsgExamTime) $ \x -> cell . flip runReaderT x $ do
@@ -299,9 +296,7 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do
       { dbParamsFormMethod = POST
       , dbParamsFormAction = Just $ SomeRoute currentRoute
       , dbParamsFormAttrs  = []
-      , dbParamsFormSubmit = case mode of
+      , dbParamsFormSubmit = FormSubmit
-          EEUMGrades -> FormSubmit
-          _other -> FormNoSubmit
       , dbParamsFormAdditional = case mode of
           EEUMGrades -> \csrf -> do
             let
@@ -316,18 +311,14 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do
             return (formRes, formWgt)
           EEUMUsers -> \csrf -> do
             let
-              -- TODO work in progress
               actionMap :: Map ExternalExamUserAction (AForm Handler ExternalExamUserActionData)
               actionMap = mconcat
-                [ singletonMap ExternalExamUserMarkSynchronised $
+                [ singletonMap ExternalExamUserEditOccurrence $
-                    pure ExternalExamUserMarkSynchronisedData
+                    ExternalExamUserEditOccurrenceData
-                --, singletonMap ExternalExamUserEditOccurrence $
+                      <$> apopt utcTimeField (fslI MsgExamTime) externalExamDefaultTime
-                --    ExternalExamUserEditOccurrenceData
+                , singletonMap ExternalExamUserEditResult $
-                --      <$> mempty
+                    ExternalExamUserEditResultData
-                    --  <$> aopt () (fslI MsgExamOccurrence) (Just Nothing)
+                      <$> apopt (examResultPassedGradeField Nothing) (fslI MsgExamResult) Nothing
-                --, singletonMap ExternalExamUserEditResult $
-                --    ExternalExamUserEditResultData
-                --      <$> mempty
                 , singletonMap ExternalExamUserDelete $
                     pure ExternalExamUserDeleteData
                 ]