Merge branch 'master' of gitlab.cip.ifi.lmu.de:jost/UniWorX

messages/uniworx/de.msg

@@ -7,6 +7,8 @@ BtnRegister: Anmelden
 BtnDeregister: Abmelden
 BtnHijack: Sitzung übernehmen
 BtnSave: Speichern
+PressSaveToSave: Änderungen werden erst durch Drücken des Knopfes "Speichern" gespeichert.
+BtnHandIn: Abgeben
 BtnCandidatesInfer: Studienfachzuordnung automatisch lernen
 BtnCandidatesDeleteConflicts: Konflikte löschen
 BtnCandidatesDeleteAll: Alle Beobachtungen löschen
@@ -16,6 +18,8 @@ BtnLecInvDecline: Ablehnen
 BtnCorrInvAccept: Annehmen
 BtnCorrInvDecline: Ablehnen
 
+
+
 Aborted: Abgebrochen
 Remarks: Hinweise
 Registered: Angemeldet
@@ -200,6 +204,7 @@ SubmissionAlreadyExists: Sie haben bereits eine Abgabe zu diesem Übungsblatt.
 SubmissionEditHead tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{csh} #{sheetName}: Abgabe editieren/anlegen
 CorrectionHead     tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName cid@CryptoFileNameSubmission: #{display tid}-#{display ssh}-#{csh} #{sheetName}: Korrektur
 SubmissionMembers: Abgebende
+SubmissionMember: Abgebende(r)
 SubmissionArchive: Zip-Archiv der Abgabedatei(en)
 SubmissionFile: Datei zur Abgabe
 SubmissionFiles: Abgegebene Dateien
@@ -954,7 +959,7 @@ TutorialCreated tutn@TutorialName: Tutorium #{tutn} erfolgreich angelegt
 
 TutorialEditHeading tutn@TutorialName: #{tutn} bearbeiten
 
-MassInputTip: Es können mehrere Werte angegeben werden. Werte müssen mit + zur Liste hinzugefügt werden und können mit - wieder entfernt werden. Die Liste wird zunächst nur lokal in Ihrem Browser gespeichert und muss noch zusammen mit dem Rest des Formulars Gesendet werden.
+MassInputTip: Es können mehrere Werte angegeben werden. Werte müssen mit + zur Liste hinzugefügt werden und können mit - wieder entfernt werden. Alle Änderungen müssen noch durch Drücken des Forumular-Knopfes bestätigt werden.
 
 HealthReport: Instanz-Zustand
 InstanceIdentification: Instanz-Identifikation

src/Handler/Corrections.hs

@@ -196,7 +196,7 @@ colPointsField = sortable (Just "rating") (i18nCell MsgColumnRatingPoints) $ for
   )
 
 colCommentField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, b, Maybe Text) CorrectionTableData)))
-colCommentField = sortable Nothing (i18nCell MsgRatingComment) $ formCell id
+colCommentField = sortable (Just "comment") (i18nCell MsgRatingComment) $ formCell id
   (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> return subId)
   (\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _) } mkUnique -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvInput <$> mopt textareaField (fsUniq mkUnique "comment") (Just $ Textarea <$> submissionRatingComment))
 
@@ -268,6 +268,9 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
               E.limit 1
               return (user E.^. UserSurname)
         )
+      , ( "comment" -- sorting by comment specifically requested by correctors to easily see submissions to be done
+        , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingComment
+        )
       ]
     , dbtFilter    = Map.fromList
       [ ( "term"
@@ -515,7 +518,7 @@ postCorrectionsR = do
         , prismAForm (singletonFilter "term"   ) mPrev $ aopt (lift `hoistField` selectField termOptions)   (fslI MsgTerm)
         , prismAForm (singletonFilter "school" ) mPrev $ aopt (lift `hoistField` selectField schoolOptions) (fslI MsgCourseSchool)
         , Map.singleton "sheet-search" . maybeToList <$> aopt (lift `hoistField` searchField False)         (fslI MsgSheet)        (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev)))
-        , prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt boolField                        (fslI MsgRatingTime)
+        , prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt boolField             (fslI MsgRatingTime)
         ]
       courseOptions = runDB $ do
         courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
@@ -531,6 +534,7 @@ postCorrectionsR = do
         & restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
         & restrictSorting (\name _ -> name /= "corrector")
         & defaultSorting [SortAscBy "israted", SortDescBy "ratingTime", SortAscBy "assignedtime" ]
+        & defaultFilter (Map.fromList [("israted",["no","Nein","No","False","Just False"]), ("sheet-search",["foo"])]) -- this does not work. "no" is the form value that we wanted
   correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
     [ downloadAction
     ]
@@ -617,7 +621,7 @@ postCorrectionR tid ssh csh shn cid = do
         <$> areq checkBoxField (fslI MsgRatingDone) (Just $ submissionRatingDone Submission{..})
         <*> pointsForm
         <*> (((\t -> t <$ guard (not $ null t)) =<<) . fmap (Text.strip . unTextarea) <$> aopt textareaField (fslI MsgRatingComment) (Just $ Textarea <$> submissionRatingComment))
-      let corrForm = wrapForm corrForm' def
+      let corrForm = wrapForm' BtnSave corrForm' def
             { formAction = Just . SomeRoute $ CSubmissionR tid ssh csh shn cid CorrectionR
             , formEncoding = corrEncoding
             }
@@ -879,8 +883,8 @@ postCorrectionsGradeR = do
   uid <- requireAuthId
   let whereClause = ratedBy uid
       displayColumns = mconcat -- should match getSSubsR for consistent UX
-        [ dbRow
+        [ -- dbRow,
-        , colSchool
+          colSchool
         , colTerm
         , colCourse
         , colSheet
@@ -948,9 +952,10 @@ postSAssignR tid ssh csh shn cID = do
                   ]
       addMessageI Success MsgCorrectorUpdated
     redirect actionUrl
-  let corrForm = wrapForm corrForm' def
+  let corrForm = wrapForm' BtnSave corrForm' def
         { formAction = Just $ SomeRoute actionUrl
         , formEncoding = corrEncoding
+        , formSubmit = FormDualSubmit
         }
   defaultLayout $ do
       setTitleI MsgCorrectorAssignTitle

src/Handler/Submission.hs

@@ -162,14 +162,23 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
     addField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Bool -> Field m (Set (Either UserEmail UserId))
     addField isAdmin = multiUserField True $ courseUsers <$ guard isAdmin
 
-    addFieldSettings, submittorSettings :: FieldSettings UniWorX
+    addFieldSettings, submittorSettings, singleSubSettings :: FieldSettings UniWorX
-    addFieldSettings = fslI MsgSubmissionMembers
+    addFieldSettings  = fslI MsgSubmissionMembers
     submittorSettings = fslI MsgSubmissionMembers & setTooltip MsgMassInputTip
+    singleSubSettings = fslI MsgSubmissionMember
+
+    maxSize | Arbitrary{..} <- grouping = Just maxParticipants
+            | otherwise = Nothing
+    mayEdit = is _Arbitrary grouping
+
+    submittorSettings'
+      | maxSize > Just 1 = submittorSettings
+      | otherwise        = singleSubSettings
 
     miButtonAction' :: forall p. PathPiece p => Maybe (Route UniWorX) -> p -> Maybe (SomeRoute UniWorX)
     miButtonAction' mCurrent frag = mCurrent <&> \current -> SomeRoute (current :#: frag)
 
-    submittorsForm 
+    submittorsForm
       | isLecturer = do-- Form is being used by lecturer; allow Everything™
         let
           miAdd :: (Text -> Text) -> FieldView UniWorX -> Form ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId])
@@ -183,7 +192,7 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
                   | otherwise
                     -> FormSuccess $ Set.toList newData
             return (addRes', $(widgetFile "widgets/massinput/submissionUsers/add"))
-        
+
         mRoute <- getCurrentRoute
         submittors <- massInputAccumW miAdd (miCell' mempty) (miButtonAction' mRoute) miLayout miIdent submittorSettings True (Just $ Set.toList prefillUsers)
         MsgRenderer mr <- getMsgRenderer
@@ -193,13 +202,8 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
       | otherwise = do
         uid <- liftHandlerT requireAuthId
         mRoute <- getCurrentRoute
-        
-        let
-          maxSize
-            | Arbitrary{..} <- grouping = Just maxParticipants
-            | otherwise = Nothing
-          mayEdit = is _Arbitrary grouping
 
+        let
           miAdd :: ListPosition
                 -> Natural
                 -> (Text -> Text)
@@ -231,7 +235,7 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
             guard $ Map.size dat > 1
 
             -- User may drop from submission only if it already exists; no directly creating submissions for other people
-            guard $ maybe True (/= Right uid) (dat !? delPos) || isJust msmid 
+            guard $ maybe True (/= Right uid) (dat !? delPos) || isJust msmid
 
             miDeleteList dat delPos
 
@@ -248,8 +252,8 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
 
           postProcess :: Map ListPosition (Either UserEmail UserId, ()) -> Set (Either UserEmail UserId)
           postProcess = setOf $ folded . _1
-        fmap postProcess <$> massInputW MassInput{..} submittorSettings True (Just . Map.fromList . zip [0..] . map (, ()) $ Set.toList prefillUsers)
+        fmap postProcess <$> massInputW MassInput{..} submittorSettings' True (Just . Map.fromList . zip [0..] . map (, ()) $ Set.toList prefillUsers)
-        
+
 
 getSubmissionNewR, postSubmissionNewR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
 getSubmissionNewR = postSubmissionNewR
@@ -335,7 +339,7 @@ submissionHelper tid ssh csh shn mcid = do
                 | otherwise      =  (mempty   , Set.singleton $ Right userID)
 
           invites <- sourceInvitationsList smid <&> Set.fromList . map (\(email, InvDBDataSubmissionUser) -> Left email)
-          
+
           return . over _2 (Set.union invites) $ foldMap breakUserFromBuddies submittors
 
         lastEdits <- do
@@ -351,7 +355,7 @@ submissionHelper tid ssh csh shn mcid = do
             forM raw $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time
         return (csheet,buddies,lastEdits,maySubmit,isLecturer,isOwner)
   ((res,formWidget'), formEnctype) <- runFormPost . makeSubmissionForm sheetCourse msmid (fromMaybe (Upload True) . submissionModeUser $ sheetSubmissionMode) sheetGrouping isLecturer $ bool id (Set.insert $ Right uid) isOwner buddies
-  let formWidget = wrapForm formWidget' def
+  let formWidget = wrapForm' BtnHandIn formWidget' def
         { formAction = Just $ SomeRoute actionUrl
         , formEncoding = formEnctype
         }

src/Handler/Utils/Form.hs

@@ -75,14 +75,27 @@ instance Finite ButtonSave
 saveButton :: (Button (HandlerSite m) ButtonSave, MonadHandler m) => AForm m ()
 saveButton = combinedButtonFieldF_ (Proxy @ButtonSave) ""
 
-
-
 nullaryPathPiece ''ButtonSave $ camelToPathPiece' 1
 
 embedRenderMessage ''UniWorX ''ButtonSave id
 instance Button UniWorX ButtonSave where
   btnClasses BtnSave = [BCIsButton, BCPrimary]
 
+
+
+data ButtonHandIn = BtnHandIn
+  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
+instance Universe ButtonHandIn
+instance Finite ButtonHandIn
+
+nullaryPathPiece ''ButtonHandIn $ camelToPathPiece' 1
+
+embedRenderMessage ''UniWorX ''ButtonHandIn id
+instance Button UniWorX ButtonHandIn where
+  btnClasses BtnHandIn = [BCIsButton, BCPrimary]
+
+
+
 data ButtonRegister = BtnRegister | BtnDeregister
   deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
 instance Universe ButtonRegister
@@ -190,7 +203,7 @@ multiActionM :: (RenderMessage UniWorX action, PathPiece action, Ord action, Eq
              -> (Html -> MForm Handler (FormResult a, Widget))
 multiActionM acts fSettings defAction = renderAForm FormStandard $ multiActionA acts fSettings defAction
 
-  
+
 ------------
 -- Fields --
 ------------
@@ -549,7 +562,7 @@ utcTimeField = checkMMap (return . localTimeToUTC') utcToLocalTime localTimeFiel
       LTUUnique{_ltuResult} -> Right _ltuResult
       LTUNone{}             -> Left MsgIllDefinedUTCTime
       LTUAmbiguous{}        -> Left MsgAmbiguousUTCTime
-      
+
 
 langField :: Bool -- ^ Only allow values from `appLanguages`
           -> Field (HandlerT UniWorX IO) Lang
@@ -703,7 +716,7 @@ multiUserField onlySuggested suggestions = Field{..}
     lookupExpr
       | onlySuggested = suggestions
       | otherwise     = Just $ E.from return
-    
+
     fieldEnctype = UrlEncoded
     fieldView theId name attrs val isReq = do
       val' <- case val of
@@ -723,7 +736,7 @@ multiUserField onlySuggested suggestions = Field{..}
           return $ emails ++ rEmails
 
       datalistId <- maybe (return $ error "Not to be used") (const newIdent) suggestions
-      
+
       [whamlet|
         $newline never
         <input id="#{theId}" name="#{name}" *{attrs} type="email" multiple :isReq:required="" value="#{val'}" :isJust suggestions:list=#{datalistId}>
@@ -739,7 +752,7 @@ multiUserField onlySuggested suggestions = Field{..}
             $forall email <- suggestedEmails
               <option value=#{email}>
         |]
-    fieldParse (all Text.null -> True) _ = return $ Right Nothing 
+    fieldParse (all Text.null -> True) _ = return $ Right Nothing
     fieldParse ts _ = runExceptT . fmap Just $ do
       let ts' = concatMap (Text.splitOn ",") ts
       emails <- forM ts' $ \t -> either (\errStr -> throwE . SomeMessage $ MsgInvalidEmail [st|#{t} (#{errStr})|]) (return . decodeUtf8 . Email.toByteString) $ Email.validate (encodeUtf8 t)

templates/submission-assign.hamlet

@@ -1 +1,3 @@
+<p>
+  _{MsgPressSaveToSave}
 ^{corrForm}