chore: chasing type-errors

messages are still temporary

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

templates/widgets/exam-occurrence-mapping.hamlet

@@ -6,19 +6,18 @@ $newline never
         _{MsgExamRoomName}
       <th .table__th colspan=2>
         _{MsgExamRoomLoad}
-      $maybe rule <- occMappingRule
-        $case rule
-          $of ExamRoomSurname
-            <th .table__th>
-              _{MsgExamRoomMappingSurname}
-          $of ExamRoomMatriculation
-            <th .table__th>
-              _{MsgExamRoomMappingMatriculation}
-          $of ExamRoomRandom
-            <th .table__th>
-              _{MsgExamRoomMappingRandom}
-          $of _
-            <th .table__td>
+      $case occMappingRule
+        $of ExamRoomSurname
+          <th .table__th>
+            _{MsgExamRoomMappingSurname}
+        $of ExamRoomMatriculation
+          <th .table__th>
+            _{MsgExamRoomMappingMatriculation}
+        $of ExamRoomRandom
+          <th .table__th>
+            _{MsgExamRoomMappingRandom}
+        $of _
+          <th .table__td>
       <th .table__th>
         _{MsgExamRoom}
       <th .table__th>