fix(Help Widget, Corrector Assignment): Modal Form closes in place; assign alerts

Closes #195

.directory

@@ -1,5 +1,5 @@
 [Dolphin]
-Timestamp=2018,3,14,10,57,55
+Timestamp=2019,6,26,19,32,25
 Version=4
 
 [Settings]

messages/uniworx/de.msg

@@ -203,6 +203,7 @@ SheetErrHintEarly: Hinweise dürfen erst nach Beginn des Abgabezeitraums herausg
 SheetErrSolutionEarly: Lösungen dürfen erst nach Ende der Abgabezeitraums herausgegeben werden
 SheetNoCurrent: Es gibt momentan kein aktives Übungsblatt.
 SheetNoOldUnassigned: Alle Abgaben inaktiver Blätter sind bereits einen Korrektor zugeteilt.
+SheetsUnassignable name@Text: Momentan keine Abgaben zuteilbar für #{name}
 
 Deadline: Abgabe
 Done: Eingereicht
@@ -403,6 +404,7 @@ UpdatedSheetCorrectorsAutoFailed n@Int: #{display n} #{pluralDE n "Abgabe konnte
 CouldNotAssignCorrectorsAuto num@Int64: #{display num} Abgaben konnten nicht automatisch zugewiesen werden:
 SelfCorrectors num@Int64: #{display num} Abgaben wurden Abgebenden als eigenem Korrektor zugeteilt!
 
+
 CorrectionSheets: Übersicht Korrekturen nach Blättern
 CorrectionCorrectors: Übersicht Korrekturen nach Korrektoren
 AssignSubmissionExceptionNoCorrectors: Es sind keine Korrektoren eingestellt

src/Foundation.hs

@@ -1436,7 +1436,7 @@ instance YesodBreadcrumbs UniWorX where
   breadcrumb (CourseR tid ssh csh CInviteR)   = return ("Einladung", Just $ CourseR tid ssh csh CShowR)
   breadcrumb (CourseR tid ssh csh (CUserR _)) = return ("Teilnehmer" , Just $ CourseR tid ssh csh CUsersR)
   breadcrumb (CourseR tid ssh csh CCorrectionsR) = return ("Abgaben" , Just $ CourseR tid ssh csh CShowR)
-  breadcrumb (CourseR tid ssh csh CAssignR)   = return ("Zuteilung"  , Just $ CourseR tid ssh csh CCorrectionsR)
+  breadcrumb (CourseR tid ssh csh CAssignR)   = return ("Zuteilung Korrekturen"  , Just $ CourseR tid ssh csh CCorrectionsR)
   breadcrumb (CourseR tid ssh csh SheetListR) = return ("Übungen"    , Just $ CourseR tid ssh csh CShowR)
   breadcrumb (CourseR tid ssh csh SheetNewR ) = return ("Neu",         Just $ CourseR tid ssh csh SheetListR)
   breadcrumb (CourseR tid ssh csh SheetCurrentR) = return ("Aktuelles Blatt", Just $ CourseR tid ssh csh SheetListR)
@@ -1454,7 +1454,7 @@ instance YesodBreadcrumbs UniWorX where
   breadcrumb (CSheetR tid ssh csh shn SEditR)   = return ("Bearbeiten"   , Just $ CSheetR tid ssh csh shn SShowR)
   breadcrumb (CSheetR tid ssh csh shn SDelR )   = return ("Löschen"      , Just $ CSheetR tid ssh csh shn SShowR)
   breadcrumb (CSheetR tid ssh csh shn SSubsR)   = return ("Abgaben"      , Just $ CSheetR tid ssh csh shn SShowR)
-  breadcrumb (CSheetR tid ssh csh shn SAssignR) = return ("Zuteilen"     , Just $ CSheetR tid ssh csh shn SSubsR)
+  breadcrumb (CSheetR tid ssh csh shn SAssignR) = return ("Zuteilung Korrekturen"     , Just $ CSheetR tid ssh csh shn SSubsR)
   breadcrumb (CSheetR tid ssh csh shn SubmissionNewR)  = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR)
   breadcrumb (CSheetR tid ssh csh shn SubmissionOwnR)  = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR)
   breadcrumb (CSubmissionR tid ssh csh shn _ SubShowR) = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR)

src/Handler/Corrections.hs

@@ -1052,11 +1052,8 @@ data SubAssignInfo = SubAssignInfo { saiName :: SheetName, saiSubmissionNr, saiC
 getCAssignR, postCAssignR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCAssignR = postCAssignR
 postCAssignR tid ssh csh = do
-  (shids,cid) <- runDB $ do
+  cid <- runDB $ getKeyBy404 $ TermSchoolCourseShort tid ssh csh
-    cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
+  assignHandler tid ssh csh cid []
-    shids <- selectKeysList [SheetCourse ==. cid] [Asc SheetActiveTo]
-    return (shids,cid)
-  assignHandler tid ssh csh cid shids
 
 getSAssignR, postSAssignR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
 getSAssignR = postSAssignR
@@ -1064,51 +1061,13 @@ postSAssignR tid ssh csh shn = do
   (shid,cid) <- runDB $ fetchSheetIdCourseId tid ssh csh shn
   assignHandler tid ssh csh cid [shid]
 
--- DEPRECATED assignHandler', delete me soonish
+{- TODO: Feature:
-assignHandler' :: TermId -> SchoolId -> CourseShorthand -> CourseId -> [SheetId] -> Handler Html
+  make distivt buttons for each sheet, so that users see which sheet will be assigned.
-assignHandler' tid ssh csh _cid rawSids = do
+  Currently this information is available within the page heading!
-  -- gather data
-  openSubs <- runDB $ (\f -> foldM f Map.empty rawSids) $
-      \acc sid -> maybeT (return acc) $ do
-        Just Sheet{sheetName=saiName} <- lift $ get sid
-        guardM $ lift $ hasWriteAccessTo $ CSheetR tid ssh csh saiName SAssignR  -- we must check, whether the submission is already closed and thus assignable
-        saiUnassignedNr <- lift $ count [SubmissionSheet ==. sid, SubmissionRatingBy ==. Nothing]
-        guard $ 0 < saiUnassignedNr -- only consider sheets with unassigned submissions
-        saiSubmissionNr <- lift $ count [SubmissionSheet ==. sid]
-        saiCorrectorNr  <- lift $ count [SheetCorrectorSheet ==. sid, SheetCorrectorState ==. CorrectorNormal]
-        -- guard $ saiCorrectorNr > 0 -- COMMENTED OUT BECAUSE we should show sheets without possible correctors to inform the user about these problematic sheets
-        return $ Map.insert sid SubAssignInfo{..} acc
-  let sids = Map.keys openSubs
-  linkBack <- simpleLinkI (SomeMessage MsgGenericBack) <$> case sids of
-        [sid] -> do Sheet{sheetName} <- runDB $ getJust sid
-                    return $ CSheetR tid ssh csh sheetName SSubsR
-        _     ->    return $ CourseR tid ssh csh CCorrectionsR
-  -- process form
-  currentRoute <- getCurrentRoute
-  ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm FIDAssignSubmissions buttonForm
-  assignmentStatus <- fmap (fromMaybe Map.empty) . formResultMaybe btnResult $ \BtnSubmissionsAssign ->
-      -- Assign submissions
-      fmap Just . runDB $ (\f -> foldM f Map.empty sids) $
-        \acc sid -> flip (Map.insert sid) acc <$> assignSubmissions sid Nothing
-      -- Too much important information for an alert message. Display proper info page instead
-  let btnForm = wrapForm btnWdgt def
-                { formAction = SomeRoute <$> currentRoute
-                , formEncoding = btnEnctype
-                , formSubmit = FormNoSubmit
-                }
-      headingShort = MsgMenuCorrectionsAssign
-      headingLong = prependCourseTitle tid ssh csh MsgMenuCorrectionsAssign
-  siteLayoutMsg headingShort $ do
-    setTitleI headingLong
-    $(widgetFile "corrections-assign")
-    if null sids || not (null assignmentStatus)
-      then linkBack  -- TODO: convenience link might be unnecessary: either via breadcrumb or closing model. Remove, if modal works fine. Otherwise change to PrimaryAction?
-      else btnForm
 
-
+  Stub:
-{- TODO: make buttons for each sheet, so that users see which sheet is assigned
 data ButtonCorrectionsAssign = BtnCorrectionsAssignAll | BtnCorrectionsAssignSheet SheetName
-  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
+    deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
 instance Button UniWorX ButtonCorrectionsAssign
 -- Are those needed any more?
 instance Universe ButtonCorrectionsAssign
@@ -1126,7 +1085,7 @@ assignHandler tid ssh csh cid assignSids = do
   (btnWdgt, btnResult) <- runButtonForm FIDAssignSubmissions
 
   -- gather data
-  (nrParticipants, groupsPossible, infoMap, correctorMap, assignment) <- runDB $ do
+  (assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment) <- runDB $ do
       -- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
       nrParticipants <- count [CourseParticipantCourse ==. cid]
 
@@ -1137,6 +1096,7 @@ assignHandler tid ssh csh cid assignSids = do
           groupsPossible =
             let foldFun (Entity _ Sheet{sheetGrouping=sgr}) acc = acc || sgr /= NoGroups
             in  List.foldr foldFun False sheetList
+          assignSheetNames = fmap sheetName $ mapMaybe (\sid -> Map.lookup sid sheets) assignSids
 
       -- plan or assign unassigned submissions for given sheets
       let buildA :: (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int, Map UserId Rational)) -> SheetId -> DB (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int, Map UserId Rational))
@@ -1166,7 +1126,10 @@ assignHandler tid ssh csh cid assignSids = do
                   addMessageI msg_status $ UniWorXMessages $ msg_header : catMaybes [alert_ok, alert_fail]
                 return status
             return $ Map.insert shn (status, countMapElems plan, deficit) acc
-      assignment <- foldM buildA Map.empty assignSids
+      assignSids' <- if null assignSids -- assignAll; we distinguish assignSids' here avoid useless Alerts
+                      then selectKeysList [SheetCourse ==. cid] [Asc SheetActiveTo]
+                      else return assignSids
+      assignment <- foldM buildA Map.empty assignSids'
 
       correctors <- E.select . E.from $ \(corrector `E.InnerJoin` user) -> do
           E.on $ corrector E.^. SheetCorrectorUser E.==. user E.^. UserId
@@ -1210,7 +1173,7 @@ assignHandler tid ssh csh cid assignSids = do
                             }
               in Map.insertWith (Map.unionWith (<>)) shnm cinf m
 
-      return (nrParticipants, groupsPossible, infoMap, correctorMap, assignment)
+      return (assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment)
 
   let -- infoMap  :: Map SheetName (Map (Maybe UserId) CorrectionInfo) -- repeated here for easier reference
       -- create aggregate maps
@@ -1277,6 +1240,10 @@ assignHandler tid ssh csh cid assignSids = do
         | 0 < Map.size assignment = MsgMenuCorrectionsAssignSheet $ Text.intercalate ", " $ fmap CI.original $ Map.keys assignment
         | otherwise               = MsgMenuCorrectionsAssign
       headingLong = prependCourseTitle tid ssh csh MsgMenuCorrectionsAssign
+
+      unassignableSheets = filter (\shn -> Map.notMember shn assignment) assignSheetNames
+  unless (null unassignableSheets) $ addMessageI Warning $ MsgSheetsUnassignable $ Text.intercalate ", " $ fmap CI.original unassignableSheets
+
   siteLayoutMsg headingShort $ do
     setTitleI headingLong
     $(widgetFile "corrections-overview")

src/Handler/Help.hs

@@ -66,6 +66,6 @@ postHelpR = do
     let formWidget = wrapForm formWidget' def
           { formAction = Just $ SomeRoute HelpR
           , formEncoding = formEnctype
-          , formAttrs = [ ("data-ajax-submit", "") | isModal ]
+          , formAttrs = [ asyncSubmitAttr | isModal ]
           }
     $(widgetFile "help")

src/Handler/Profile.hs

@@ -593,7 +593,7 @@ postUserNotificationR cID = do
   let formWidget = wrapForm nsInnerWdgt def
         { formAction = Just . SomeRoute $ UserNotificationR cID
         , formEncoding = nsEnc
-        , formAttrs = [ ("data-ajax-submit", "") | isModal ]
+        , formAttrs = [ asyncSubmitAttr | isModal ]
         }
 
   formResultModal nsRes (UserNotificationR cID, [ (toPathPiece GetBearer, toPathPiece jwt) | Just jwt <- pure mJwt ]) $ \ns -> do

src/Utils/Form.hs

@@ -156,6 +156,11 @@ inputReadonly = addAttr "readonly" ""
 addAutosubmit :: FieldSettings site -> FieldSettings site
 addAutosubmit = addAttr "uw-auto-submit-input" ""
 
+-- | Asynchronous Submit, e.g. use with forms in modals
+asyncSubmitAttr :: (Text,Text)
+asyncSubmitAttr = ("uw-async-form", "")
+
+
 ------------------------------------------------
 -- Unique Form Identifiers to avoid accidents --
 ------------------------------------------------