diff --git a/src/Handler/Exam/AutoOccurrence.hs b/src/Handler/Exam/AutoOccurrence.hs index 1d4fe0b26..dd17c328a 100644 --- a/src/Handler/Exam/AutoOccurrence.hs +++ b/src/Handler/Exam/AutoOccurrence.hs @@ -23,7 +23,7 @@ newtype ExamAutoOccurrenceCalculateForm = ExamAutoOccurrenceCalculateForm makeLenses_ ''ExamAutoOccurrenceCalculateForm data ExamAutoOccurrenceAcceptForm = ExamAutoOccurrenceAcceptForm - { eaofMapping :: Maybe (ExamOccurrenceMapping ExamOccurrenceId) + { eaofMapping :: ExamOccurrenceMapping ExamOccurrenceId , eaofAssignment :: Map UserId (Maybe ExamOccurrenceId) } deriving (Eq, Ord, Read, Show, Generic, Typeable) @@ -114,7 +114,15 @@ postEAutoOccurrenceR tid ssh csh examn = do (Entity uid userRec, Entity _ ExamRegistration{..}) <- participants return (uid, (userRec, examRegistrationOccurrence)) occurrences' = Map.fromList $ map (\(Entity eoId ExamOccurrence{..}) -> (eoId, fromIntegral examOccurrenceCapacity)) occurrences - (eaofMapping, eaofAssignment) = examAutoOccurrence eId examOccurrenceRule eaofConfig occurrences' participants' + autoOccurrenceResult = examAutoOccurrence eId examOccurrenceRule eaofConfig occurrences' participants' + -- TODO catch error here + -- lookup from ExamOccurrenceId -> Name can happen here + -- examOccurrenceName :: CI Text is probably the right one + (eaofMapping, eaofAssignment) <- case autoOccurrenceResult of + (Left e) -> do + addMessageI Error e + redirect $ CExamR tid ssh csh examn EUsersR + (Right r) -> pure r return $ Just ExamAutoOccurrenceAcceptForm{..} ((confirmRes, confirmView), confirmEncoding) <- runFormPost $ examAutoOccurrenceAcceptForm calcResult @@ -126,18 +134,18 @@ postEAutoOccurrenceR tid ssh csh examn = do formResult confirmRes $ \ExamAutoOccurrenceAcceptForm{..} -> do Sum assignedCount <- runDB $ do - let eaofMapping'' :: Maybe (Maybe (ExamOccurrenceMapping ExamOccurrenceName)) - eaofMapping'' = (<$> eaofMapping) . traverseExamOccurrenceMapping $ \eoId -> case filter ((== eoId) . entityKey) occurrences of + let eaofMapping'' :: Maybe (ExamOccurrenceMapping ExamOccurrenceName) + eaofMapping'' = ($ eaofMapping) . traverseExamOccurrenceMapping $ \eoId -> case filter ((== eoId) . entityKey) occurrences of [Entity _ ExamOccurrence{..}] -> Just examOccurrenceName _other -> Nothing eaofMapping' <- case eaofMapping'' of - Nothing -> return Nothing - Just Nothing -> invalidArgsI [MsgExamAutoOccurrenceOccurrencesChangedInFlight] - Just (Just x ) -> return $ Just x + Nothing -> invalidArgsI [MsgExamAutoOccurrenceOccurrencesChangedInFlight] + Just x -> return $ Just x update eId [ ExamExamOccurrenceMapping =. eaofMapping' ] fmap fold . iforM eaofAssignment $ \pid occ -> case occ of Just _ -> Sum <$> updateWhereCount [ ExamRegistrationExam ==. eId, ExamRegistrationUser ==. pid, ExamRegistrationOccurrence ==. Nothing ] [ ExamRegistrationOccurrence =. occ ] Nothing -> return mempty + -- TODO here we produce the html redirect addMessageI Success $ MsgExamAutoOccurrenceParticipantsAssigned assignedCount redirect $ CExamR tid ssh csh examn EUsersR @@ -158,13 +166,13 @@ postEAutoOccurrenceR tid ssh csh examn = do occLoad = fromMaybe 0 . flip Map.lookup occLoads - occMappingRule = examOccurrenceMappingRule <$> eaofMapping + occMappingRule = examOccurrenceMappingRule eaofMapping loadProp curr max' | max' /= 0 = MsgProportion (toMessage curr) (toMessage max') (toRational curr / toRational max') | otherwise = MsgProportionNoRatio (toMessage curr) (toMessage max') - occMapping occId = examOccurrenceMappingDescriptionWidget <$> occMappingRule <*> (Map.lookup occId . examOccurrenceMappingMapping =<< eaofMapping) + occMapping occId = examOccurrenceMappingDescriptionWidget occMappingRule <$> (Map.lookup occId $ examOccurrenceMappingMapping $ eaofMapping) in $(widgetFile "widgets/exam-occurrence-mapping") siteLayoutMsg heading $ do diff --git a/templates/widgets/exam-occurrence-mapping.hamlet b/templates/widgets/exam-occurrence-mapping.hamlet index 69f7af6f8..4383169af 100644 --- a/templates/widgets/exam-occurrence-mapping.hamlet +++ b/templates/widgets/exam-occurrence-mapping.hamlet @@ -6,19 +6,18 @@ $newline never _{MsgExamRoomName} _{MsgExamRoomLoad} - $maybe rule <- occMappingRule - $case rule - $of ExamRoomSurname - - _{MsgExamRoomMappingSurname} - $of ExamRoomMatriculation - - _{MsgExamRoomMappingMatriculation} - $of ExamRoomRandom - - _{MsgExamRoomMappingRandom} - $of _ - + $case occMappingRule + $of ExamRoomSurname + + _{MsgExamRoomMappingSurname} + $of ExamRoomMatriculation + + _{MsgExamRoomMappingMatriculation} + $of ExamRoomRandom + + _{MsgExamRoomMappingRandom} + $of _ + _{MsgExamRoom}