fix(submissions): improve submission process

Fixes #675

.hlint.yaml

@@ -183,6 +183,9 @@
   - fixity: "infix 4 <<<.>="
 
   - suggest: { lhs: maybeT (return ()), rhs: maybeT_ }
+  - suggest: { lhs: fromMaybe (return ()), rhs: maybeVoid }
+  - suggest: { lhs: maybe (return ()) void, rhs: maybeVoid }
+
   - warn: { lhs: length xs >= n, rhs: minLength n xs, note: IncreasesLaziness }
   - warn: { lhs: n <= length xs, rhs: minLength n xs, note: IncreasesLaziness }
   - warn: { lhs: length xs > n, rhs: minLength (n + 1) xs, note: IncreasesLaziness }

messages/uniworx/misc/de-de-formal.msg

@@ -402,6 +402,8 @@ SubmissionUserAlreadyAdded: Dieser Nutzer ist bereits als Mitabgebende(r) einget
 NoOpenSubmissions: Keine unkorrigierten Abgaben vorhanden
 SubmissionFilesCorrected: Abgegebene & Korrigierte Dateien
 RatingUpdatedFiles: Bei der Korrektur wurden Dateien angepasst oder hinzugefügt
+SubmissionFilesUnchanged: Abgabedateien beibehalten
+SubmissionFilesUnchangedTip: Sollen die bestehenden Abgabedateien beim Ersetzen der Abgabe unverändert übernommen werden?
 
 SubmissionsDeleteQuestion n@Int: Wollen Sie #{pluralDE n "die unten aufgeführte Abgabe" "die unten aufgeführten Abgaben"} wirklich löschen?
 SubmissionsDeleted n@Int: #{pluralDE n "Abgabe gelöscht" "Abgaben gelöscht"}

messages/uniworx/misc/en-eu.msg

@@ -400,6 +400,8 @@ SubmissionUserAlreadyAdded: This user is already configured as a submittor
 NoOpenSubmissions: No open submissions exist
 SubmissionFilesCorrected: Submitted & Corrected files
 RatingUpdatedFiles: During correction files were added or changed
+SubmissionFilesUnchanged: Keep submission files
+SubmissionFilesUnchangedTip: Should the existing submission files be retained unchanged while replacing the submission?
 
 SubmissionsDeleteQuestion n: Do you really want to delete the #{pluralEN n "submission" "submissions"} mentioned below?
 SubmissionsDeleted n: #{pluralEN n "Submission" "Submissions"} deleted

src/Handler/Allocation/Application.hs

@@ -174,11 +174,12 @@ applicationForm maId@(is _Just -> isAlloc) cid muid ApplicationFormMode{..} mcsr
 
   (filesRes, filesView) <-
     let mkFs = bool MsgCourseApplicationFile MsgCourseApplicationArchive
+        prevAppFiles (Entity aId _) = runDBSource $ selectSource [CourseApplicationFileApplication ==. aId] [Asc CourseApplicationFileTitle] .| C.map (view $ _FileReference . _1)
      in if
       | not afmApplicantEdit || is _NoUpload courseApplicationsFiles
         -> return (FormSuccess Nothing, Nothing)
       | otherwise
-        -> fmap (over _2 $ Just . ($ [])) . aFormToForm $ fileUploadForm False (fslI . mkFs) courseApplicationsFiles
+        -> fmap (over _2 $ Just . ($ [])) . aFormToForm $ fileUploadForm False (fslI . mkFs) courseApplicationsFiles (prevAppFiles <$> mApp)
 
   (vetoRes, vetoView) <- if
     | afmLecturer

src/Handler/Course/Edit.hs

@@ -303,7 +303,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
       <*> allocationForm
       <*> apopt checkBoxField (fslI MsgCourseApplicationRequired & setTooltip MsgCourseApplicationRequiredTip) (cfAppRequired <$> template)
       <*> aopt htmlField (fslI MsgCourseApplicationInstructions & setTooltip MsgCourseApplicationInstructionsTip) (cfAppInstructions <$> template)
-      <*> aopt (multiFileField' . fromMaybe (return ()) $ cfAppInstructionFiles =<< template) (fslI MsgCourseApplicationTemplate & setTooltip MsgCourseApplicationTemplateTip) (cfAppInstructionFiles <$> template)
+      <*> aopt (multiFileField' . maybeVoid $ cfAppInstructionFiles =<< template) (fslI MsgCourseApplicationTemplate & setTooltip MsgCourseApplicationTemplateTip) (cfAppInstructionFiles <$> template)
       <*> apopt checkBoxField (fslI MsgCourseApplicationsText & setTooltip MsgCourseApplicationsTextTip) (cfAppText <$> template)
       <*> uploadModeForm (fslI MsgCourseApplicationsFiles & setTooltip MsgCourseApplicationsFilesTip) (fmap cfAppFiles template <|> pure NoUpload)
       <*> apopt checkBoxField (fslI MsgCourseApplicationRatingsVisible & setTooltip MsgCourseApplicationRatingsVisibleTip) (cfAppRatingsVisible <$> template)

src/Handler/Course/News/Form.hs

@@ -23,7 +23,7 @@ courseNewsForm :: Maybe CourseNewsForm -> Form CourseNewsForm
 courseNewsForm template = identifyForm FIDCourseNews . renderWForm FormStandard $ do
   now <- liftIO getCurrentTime
 
-  let oldFileIds = fromMaybe (return ()) $ template >>= cnfFiles
+  let oldFileIds = maybeVoid $ template >>= cnfFiles
       cTime = ceilingQuarterHour now
       visibleFromTip
         | Just vFrom <- template >>= cnfVisibleFrom

src/Handler/Course/Register.hs

@@ -132,11 +132,12 @@ courseRegisterForm (Entity cid Course{..}) = liftHandler $ do
 
     appFilesRes <- let mkFs | courseApplicationsRequired = bool MsgCourseApplicationFile MsgCourseApplicationArchive
                             | otherwise                  = bool MsgCourseRegistrationFile MsgCourseRegistrationArchive
+                       prevAppFiles (Entity aId _) = runDBSource $ selectSource [CourseApplicationFileApplication ==. aId] [Asc CourseApplicationFileTitle] .| C.map (view $ _FileReference . _1)
                     in if
       | isRegistered
         -> return $ FormSuccess Nothing
       | otherwise
-        -> aFormToWForm $ fileUploadForm False (fslI . mkFs) courseApplicationsFiles
+        -> aFormToWForm $ fileUploadForm False (fslI . mkFs) courseApplicationsFiles (prevAppFiles <$> application)
 
     mayViewCourseAfterDeregistration <- liftHandler . runDB $ E.selectExists . E.from $ \course -> E.where_ $
       course E.^. CourseId E.==. E.val cid

src/Handler/Course/User.hs

@@ -87,7 +87,7 @@ postCUserR tid ssh csh uCId = do
   siteLayout headingLong $ do
     setTitleI headingShort
 
-    forM_ sections . fromMaybe $ return ()
+    mapM_ maybeVoid sections
 
 courseUserProfileSection :: Entity Course -> Entity User -> MaybeT Handler Widget
 courseUserProfileSection course@(Entity cid Course{..}) (Entity uid User{ userShowSex = _, ..}) = do

src/Handler/Material.hs

@@ -63,7 +63,7 @@ makeMaterialForm cid template = identifyForm FIDmaterial $ \html -> do
                                                              (mfDescription <$> template)
       <*> aopt utcTimeField   (fslI MsgMaterialVisibleFrom & setTooltip visibleToolTip)
                                                             ((mfVisibleFrom <$> template) <|> pure (Just ctime))
-      <*> aopt (multiFileField' . fromMaybe (return ()) $ mfFiles =<< template)
+      <*> aopt (multiFileField' . maybeVoid $ mfFiles =<< template)
                               (fslI MsgMaterialFiles)        (mfFiles <$> template)
 
 fetchMaterial :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> DB (Entity Material)
@@ -326,7 +326,7 @@ handleMaterialEdit tid ssh csh cid template dbMaterial = do
         case mbmid of
           Nothing -> False <$ addMessageI Error (MsgMaterialNameDup tid ssh csh mfName)
           (Just mid) -> do -- save files in DB
-            insertMaterialFile' mid $ fromMaybe (return ()) mfFiles
+            insertMaterialFile' mid $ maybeVoid mfFiles
             addMessageI Success $ MsgMaterialSaveOk tid ssh csh mfName
             -- more info/warnings could go here
             return True

src/Handler/Sheet/Edit.hs

@@ -92,10 +92,10 @@ handleSheetEdit tid ssh csh msId template dbAction = do
         case mbsid of
           Nothing    -> False <$ addMessageI Error (MsgSheetNameDup tid ssh csh sfName)
           (Just sid) ->  do -- save files in DB:
-            insertSheetFile' sid SheetExercise $ fromMaybe (return ()) sfSheetF
-            insertSheetFile' sid SheetHint     $ fromMaybe (return ()) sfHintF
-            insertSheetFile' sid SheetSolution $ fromMaybe (return ()) sfSolutionF
-            insertSheetFile' sid SheetMarking  $ fromMaybe (return ()) sfMarkingF
+            insertSheetFile' sid SheetExercise $ maybeVoid sfSheetF
+            insertSheetFile' sid SheetHint     $ maybeVoid sfHintF
+            insertSheetFile' sid SheetSolution $ maybeVoid sfSolutionF
+            insertSheetFile' sid SheetMarking  $ maybeVoid sfMarkingF
             runConduit $
                  maybe (return ()) (transPipe liftHandler) (spffFiles =<< sfPersonalF)
               .| sinkPersonalisedSheetFiles cid sid (maybe False spffFilesKeepExisting sfPersonalF)

src/Handler/Submission/Correction.hs

@@ -149,7 +149,7 @@ postCorrectionR tid ssh csh shn cid = do
         setTitleI heading
         urlArchive <- toTextUrl . CSubmissionR tid ssh csh shn cid $ SubArchiveR SubmissionCorrected
         let userCorrection = $(widgetFile "correction-user")
-        fromMaybe (return ()) invisibleWidget
+        maybeVoid invisibleWidget
         $(widgetFile "correction")
     _ -> notFound
 getCorrectionUserR tid ssh csh shn cid = do

src/Handler/Submission/Helper.hs

@@ -29,12 +29,21 @@ import Data.Aeson.Lens
 
 import Handler.Submission.SubmissionUserInvite
 
+import qualified Data.Conduit.Combinators as C
 
-makeSubmissionForm :: CourseId -> Maybe SubmissionId -> UploadMode -> SheetGroup -> Bool -> Set (Either UserEmail UserId) -> Form (Maybe FileUploads, Set (Either UserEmail UserId))
-makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = identifyForm FIDsubmission . renderAForm FormStandard $ (,)
-  <$> fileUploadForm (not isLecturer && is _Nothing msmid) (fslI . bool MsgSubmissionFile MsgSubmissionArchive) uploadMode
+
+makeSubmissionForm :: CourseId -> Maybe SubmissionId -> UploadMode -> SheetGroup -> Maybe FileUploads -> Bool -> Set (Either UserEmail UserId) -> Form (Maybe FileUploads, Set (Either UserEmail UserId))
+makeSubmissionForm cid msmid uploadMode grouping mPrev isLecturer prefillUsers = identifyForm FIDsubmission . renderAForm FormStandard $ (,)
+  <$> uploadForm
   <*> wFormToAForm submittorsForm'
   where
+    uploadForm
+      | is _NoUpload uploadMode = pure Nothing
+      | is _Nothing msmid = uploadForm'
+      | otherwise = join <$> optionalActionNegatedA uploadForm' (fslI MsgSubmissionFilesUnchanged & setTooltip MsgSubmissionFilesUnchangedTip) (Just False)
+
+    uploadForm' = fileUploadForm (not isLecturer) (fslI . bool MsgSubmissionFile MsgSubmissionArchive) uploadMode mPrev
+    
     miCell' :: Markup -> Either UserEmail UserId -> Widget
     miCell' csrf (Left email) = do
       invWarnMsg <- messageIconI Info IconEmail $ if
@@ -311,7 +320,8 @@ submissionHelper tid ssh csh shn mcid = do
   -- Therefore we do not restrict upload behaviour in any way in that case
   ((res,formWidget'), formEnctype) <- do
     (Entity _ Sheet{..}, buddies, _, _, isLecturer, isOwner, _, _) <- runDB getSheetInfo
-    runFormPost . makeSubmissionForm sheetCourse msmid (fromMaybe (UploadAny True Nothing True) . submissionModeUser $ sheetSubmissionMode) sheetGrouping isLecturer $ bool id (maybe id (Set.insert . Right) muid) isOwner buddies
+    let mPrevUploads = msmid <&> \smid -> runDBSource $ selectSource [SubmissionFileSubmission ==. smid, SubmissionFileIsUpdate ==. False] [Asc SubmissionFileTitle] .| C.map (view $ _FileReference . _1)
+    runFormPost . makeSubmissionForm sheetCourse msmid (fromMaybe (UploadAny True Nothing True) . submissionModeUser $ sheetSubmissionMode) sheetGrouping mPrevUploads isLecturer $ bool id (maybe id (Set.insert . Right) muid) isOwner buddies
   let formWidget = wrapForm' BtnHandIn formWidget' def
         { formAction = Just $ SomeRoute actionUrl
         , formEncoding = formEnctype

src/Handler/Utils/Form.hs

@@ -181,6 +181,20 @@ linkButton defWdgt lbl cls url = do
 -- Interactive fieldset --
 --------------------------
 
+optionalAction'' :: Bool -- ^ negated?
+                 -> (Field Handler Bool -> FieldSettings UniWorX -> Maybe Bool -> MForm Handler (FormResult Bool, FieldView UniWorX))
+                 -> AForm Handler a
+                 -> FieldSettings UniWorX
+                 -> Maybe Bool
+                 -> (Html -> MForm Handler (FormResult (Maybe a), [FieldView UniWorX]))
+optionalAction'' negated minp justAct fs@FieldSettings{..} defActive csrf = do
+  (doRes, doView) <- minp (bool id (isoField _not) negated checkBoxField) fs defActive
+  (actionRes, actionViews') <- over _2 ($ []) <$> aFormToForm justAct
+
+  let actionViews = over (mapped . _fvInput) (\w -> $(widgetFile "widgets/multi-action/optional-action")) actionViews'
+
+  return (doRes >>= bool (pure Nothing) (Just <$> actionRes), over _fvInput (mappend $ toWidget csrf) doView : actionViews)
+           
 optionalAction :: AForm Handler a
                -> FieldSettings UniWorX
                -> Maybe Bool
@@ -192,19 +206,19 @@ optionalAction' :: (Field Handler Bool -> FieldSettings UniWorX -> Maybe Bool ->
                 -> FieldSettings UniWorX
                 -> Maybe Bool
                 -> (Html -> MForm Handler (FormResult (Maybe a), [FieldView UniWorX]))
-optionalAction' minp justAct fs@FieldSettings{..} defActive csrf = do
-  (doRes, doView) <- minp checkBoxField fs defActive
-  (actionRes, actionViews') <- over _2 ($ []) <$> aFormToForm justAct
-
-  let actionViews = over (mapped . _fvInput) (\w -> $(widgetFile "widgets/multi-action/optional-action")) actionViews'
-
-  return (doRes >>= bool (pure Nothing) (Just <$> actionRes), over _fvInput (mappend $ toWidget csrf) doView : actionViews)
+optionalAction' = optionalAction'' False
 
 optionalActionA :: AForm Handler a
                 -> FieldSettings UniWorX
                 -> Maybe Bool
                 -> AForm Handler (Maybe a)
 optionalActionA = optionalActionA' mpopt
+  
+optionalActionNegatedA :: AForm Handler a
+                       -> FieldSettings UniWorX
+                       -> Maybe Bool
+                       -> AForm Handler (Maybe a)
+optionalActionNegatedA = optionalActionA'' True mpopt
 
 optionalActionA' :: (Field Handler Bool -> FieldSettings UniWorX -> Maybe Bool -> MForm Handler (FormResult Bool, FieldView UniWorX))
                  -> AForm Handler a
@@ -213,6 +227,14 @@ optionalActionA' :: (Field Handler Bool -> FieldSettings UniWorX -> Maybe Bool -
                  -> AForm Handler (Maybe a)
 optionalActionA' minp justAct fs defActive = formToAForm $ optionalAction' minp justAct fs defActive mempty
 
+optionalActionA'' :: Bool
+                  -> (Field Handler Bool -> FieldSettings UniWorX -> Maybe Bool -> MForm Handler (FormResult Bool, FieldView UniWorX))
+                  -> AForm Handler a
+                  -> FieldSettings UniWorX
+                  -> Maybe Bool
+                  -> AForm Handler (Maybe a)
+optionalActionA'' negated minp justAct fs defActive = formToAForm $ optionalAction'' negated minp justAct fs defActive mempty
+
 optionalActionW :: AForm Handler a
                 -> FieldSettings UniWorX
                 -> Maybe Bool
@@ -921,13 +943,15 @@ genericFileField mkOpts = Field{..}
 
     fieldEnctype = Multipart
     fieldParse :: [Text] -> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe FileUploads))
-    fieldParse vals files = runExceptT $ do
+    fieldParse vals files' = runExceptT $ do
+      let files = filter (not . null . fileName) files'
+      
       opts@FileField{..} <- liftHandler mkOpts
 
       mIdent <- fmap getFirst . flip foldMapM vals $ \v ->
         fmap First . runMaybeT . exceptTMaybe $ encodedSecretBoxOpen v
 
-      let uploadedFilenames = fileName <$> bool (take 1) id fieldMultiple files
+      let uploadedFilenames = fileName <$> files
 
       let
         doUnpack
@@ -974,7 +998,7 @@ genericFileField mkOpts = Field{..}
                      .| C.mapMaybe (\fTitle -> fmap (fTitle, ) . assertM (views _3 $ not . fieldOptionForce) $ Map.lookup fTitle permittedFiles)
                      .| C.filter (\(fTitle, _) ->
                                      fieldMultiple
-                                  || (    bool (\n h -> h == pure n) elem fieldMultiple fTitle (mapMaybe (preview _FileTitle) vals)
+                                  || (    fTitle `elem` mapMaybe (preview _FileTitle) vals
                                        && null files
                                      )
                                  )
@@ -1092,47 +1116,67 @@ singleFileField prev = genericFileField $ do
     , fieldAllEmptyOk = True
     }
 
-specificFileField :: UploadSpecificFile -> Field Handler FileUploads
-specificFileField UploadSpecificFile{..} = convertField (.| fixupFileTitles) id . genericFileField $ return FileField
-  { fieldIdent = Nothing
-  , fieldUnpackZips = FileFieldUserOption True False
-  , fieldMultiple = False
-  , fieldRestrictExtensions = fromNullable . maybe Set.empty (Set.singleton . view _2) . Map.lookupMin . Map.fromList . map (length &&& id) $ fileNameExtensions specificFileName
-  , fieldAdditionalFiles = _FileReferenceFileReferenceTitleMap # Map.empty
-  , fieldMaxFileSize = specificFileMaxSize
-  , fieldAllEmptyOk = specificFileEmptyOk
-  }
+specificFileField :: UploadSpecificFile -> Maybe FileUploads -> Field Handler FileUploads
+specificFileField UploadSpecificFile{..} mPrev = convertField (.| fixupFileTitles) id . genericFileField $ do
+  previous <- runConduit $ maybeVoid mPrev .| C.foldMap Set.singleton
+  return FileField
+    { fieldIdent = Nothing
+    , fieldUnpackZips = FileFieldUserOption True False
+    , fieldMultiple = False
+    , fieldRestrictExtensions = fromNullable . maybe Set.empty (Set.singleton . view _2) . Map.lookupMin . Map.fromList . map (length &&& id) $ fileNameExtensions specificFileName
+    , fieldAdditionalFiles = _FileReferenceFileReferenceTitleMap # Map.fromList
+      [ (fileReferenceTitle, (fileReferenceContent, fileReferenceModified, FileFieldUserOption False True))
+      | FileReference{..} <- Set.toList previous
+      ]
+    , fieldMaxFileSize = specificFileMaxSize
+    , fieldAllEmptyOk = specificFileEmptyOk
+    }
   where
     fixupFileTitles = C.map $ set _fileReferenceTitle (unpack specificFileName)
 
 zipFileField :: Bool -- ^ Unpack zips?
-             -> Maybe (NonNull (Set Extension)) -- ^ Restrictions on file extensions
-             -> Bool -- ^ Empty files ok?
-             -> Field Handler FileUploads
-zipFileField doUnpack permittedExtensions emptyOk = genericFileField $ return FileField
-  { fieldIdent = Nothing
-  , fieldUnpackZips = FileFieldUserOption True doUnpack
-  , fieldMultiple = doUnpack
-  , fieldRestrictExtensions = permittedExtensions
-  , fieldAdditionalFiles = _FileReferenceFileReferenceTitleMap # Map.empty
-  , fieldMaxFileSize = Nothing
-  , fieldAllEmptyOk = emptyOk
-  }
+              -> Maybe (NonNull (Set Extension)) -- ^ Restrictions on file extensions
+              -> Bool -- ^ Empty files ok?
+              -> Field Handler FileUploads
+zipFileField doUnpack permittedExtensions emptyOk = zipFileField' doUnpack permittedExtensions emptyOk Nothing
+  
+zipFileField' :: Bool -- ^ Unpack zips?
+              -> Maybe (NonNull (Set Extension)) -- ^ Restrictions on file extensions
+              -> Bool -- ^ Empty files ok?
+              -> Maybe FileUploads
+              -> Field Handler FileUploads
+zipFileField' doUnpack permittedExtensions emptyOk mPrev = genericFileField $ do
+  previous <- runConduit $ maybeVoid mPrev .| C.foldMap Set.singleton
+  return FileField
+    { fieldIdent = Nothing
+    , fieldUnpackZips = FileFieldUserOption True doUnpack
+    , fieldMultiple = doUnpack
+    , fieldRestrictExtensions = permittedExtensions
+    , fieldAdditionalFiles = _FileReferenceFileReferenceTitleMap # Map.fromList
+      [ (fileReferenceTitle, (fileReferenceContent, fileReferenceModified, FileFieldUserOption False True))
+      | FileReference{..} <- Set.toList previous
+      ]
+    , fieldMaxFileSize = Nothing
+    , fieldAllEmptyOk = emptyOk
+    }
 
 fileUploadForm :: Bool -- ^ Required?
                -> (Bool -> FieldSettings UniWorX) -- ^ given @unpackZips@ generate `FieldSettings` in the case of `UploadAny`
-               -> UploadMode -> AForm Handler (Maybe FileUploads)
-fileUploadForm isReq mkFs = \case
+               -> UploadMode
+               -> Maybe FileUploads
+               -> AForm Handler (Maybe FileUploads)
+fileUploadForm isReq mkFs uMode mPrev = case uMode of
   NoUpload
     -> pure Nothing
   UploadAny{..}
-    -> bool aopt (\f fs _ -> Just <$> areq f fs Nothing) isReq (zipFileField uploadUnpackZips uploadExtensionRestriction uploadEmptyOk) (mkFs uploadUnpackZips) Nothing
+    -> bool (\f fs d -> aopt f fs $ Just <$> d) (\f fs d -> Just <$> apreq f fs d) isReq (zipFileField' uploadUnpackZips uploadExtensionRestriction uploadEmptyOk mPrev) (mkFs uploadUnpackZips) mPrev
   UploadSpecific{..}
     -> mergeFileSources <$> traverse specificFileForm (Set.toList $ toNullable uploadSpecificFiles)
   where
     specificFileForm :: UploadSpecificFile -> AForm Handler (Maybe FileUploads)
     specificFileForm spec@UploadSpecificFile{..}
-      = bool (\f fs d -> aopt f fs $ fmap Just d) (\f fs d -> Just <$> areq f fs d) (specificFileRequired && isReq) (specificFileField spec) (fsl specificFileLabel) Nothing
+      = bool (\f fs d -> aopt f fs $ Just <$> d) (\f fs d -> Just <$> apreq f fs d) (specificFileRequired && isReq) (specificFileField spec mPrev') (fsl specificFileLabel) mPrev'
+      where mPrev' = flip (.|) (C.filter . has $ _fileReferenceTitle . only (unpack specificFileName)) <$> mPrev
 
     mergeFileSources :: [Maybe FileUploads] -> Maybe FileUploads
     mergeFileSources (catMaybes -> sources) = case sources of

src/Utils.hs

@@ -700,6 +700,9 @@ hoistMaybe = maybe mzero return
 hoistMaybeM :: MonadPlus m => m (Maybe a) -> m a
 hoistMaybeM = (=<<) hoistMaybe
 
+maybeVoid :: Monad m => Maybe (m a) -> m ()
+maybeVoid = maybe (return ()) void
+
 catchIfMaybeT :: (MonadCatch m, Exception e) => (e -> Bool) -> m a -> MaybeT m a
 catchIfMaybeT p act = catchIf p (lift act) (const mzero)
 

src/Utils/Lens.hs

@@ -82,6 +82,8 @@ _SqlKey = _SqlKey' . _Unwrapped
 _Integral :: (Integral a, Integral b) => Iso' a b
 _Integral = iso fromIntegral fromIntegral
 
+_not :: Iso' Bool Bool
+_not = iso not not
 
 -----------------------------------
 -- Lens Definitions for our Types

templates/widgets/multi-action/optional-action.hamlet

@@ -1,4 +1,4 @@
-<fieldset uw-interactive-fieldset data-conditional-input=#{fvId doView}>
+<fieldset uw-interactive-fieldset data-conditional-input=#{fvId doView} :negated:data-conditional-negated>
   <legend>
     _{fsLabel}
   ^{w}