chore(profile): add massinput stub for label management

src/Handler/Profile.hs

@@ -31,6 +31,20 @@ import Jobs
 import Foundation.Yesod.Auth (updateUserLanguage)
 
 
+data ExamOfficeSettings
+  = ExamOfficeSettings
+    { eosettingsGetSynced :: Bool
+    , eosettingsGetLabels :: Bool
+    , eosettingsLabels    :: EOLabels
+    }
+
+type EOLabelData
+  = ( ExamOfficeLabelName
+    , MessageStatus        -- status
+    , Int                  -- priority; also used for label ordering
+    )
+type EOLabels = Map (Either ExamOfficeLabelName ExamOfficeLabelId) EOLabelData
+
 data SettingsForm = SettingsForm
       { stgDisplayName          :: UserDisplayName
       , stgDisplayEmail         :: UserEmail
@@ -315,18 +329,50 @@ allocationNotificationForm = maybe (pure mempty) allocationNotificationForm' . (
 examOfficeForm :: Maybe ExamOfficeSettings -> AForm Handler ExamOfficeSettings
 examOfficeForm template = wFormToAForm $ do
   (_uid, User{userExamOfficeGetSynced,userExamOfficeGetLabels}) <- requireAuthPair
-  userIsExamOffice <- liftHandler . hasReadAccessTo $ ExamOfficeR EOExamsR
-  userExamOfficeLabels <- return $ maybe Set.empty eosettingsLabels template
   let
-    eoLabelForm :: AForm Handler (Set ExamOfficeLabel)
-    eoLabelForm = pure userExamOfficeLabels  -- TODO
+    userExamOfficeLabels = fromMaybe mempty $ eosettingsLabels <$> template
+    eoLabelForm :: AForm Handler EOLabels
+    eoLabelForm = wFormToAForm $ do
+      let
+        miAdd :: ListPosition -> Natural -> ListLength -> (Text -> Text) -> FieldView UniWorX -> Maybe (Form (Map ListPosition (Either ExamOfficeLabelName ExamOfficeLabelId) -> FormResult (Map ListPosition (Either ExamOfficeLabelName ExamOfficeLabelId))))
+        miAdd = error "WIP"
+        
+        miCell :: ListPosition -> Either ExamOfficeLabelName ExamOfficeLabelId -> Maybe EOLabelData -> (Text -> Text) -> Form EOLabelData
+        miCell = error "WIP"
+
+        miDelete :: Map ListPosition (Either ExamOfficeLabelName ExamOfficeLabelId) -> ListPosition -> MaybeT (MForm Handler) (Map ListPosition ListPosition)
+        miDelete = error "WIP"
+
+        miAddEmpty :: ListPosition -> Natural -> ListLength -> Set ListPosition
+        miAddEmpty = error "WIP"
+
+        miButtonAction :: forall p. p -> Maybe (SomeRoute UniWorX)
+        -- miButtonAction :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)
+        miButtonAction = error "WIP"
+
+        miLayout :: ListLength -> Map ListPosition (Either ExamOfficeLabelName ExamOfficeLabelId, FormResult EOLabelData) -> Map ListPosition Widget -> Map ListPosition (FieldView UniWorX) -> Map (Natural, ListPosition) Widget -> Widget
+        miLayout = error "WIP"
+
+        miIdent :: Text
+        miIdent = "exam-office-labels"
+
+        postProcess :: Map ListPosition (Either ExamOfficeLabelName ExamOfficeLabelId, EOLabelData) -> EOLabels
+        postProcess = error "WIP"
+
+        filledData :: Maybe (Map ListPosition (Either ExamOfficeLabelName ExamOfficeLabelId, EOLabelData))
+        filledData = Just . Map.fromList . zip [0..] $ Map.toList userExamOfficeLabels
+
+      fmap postProcess <$> massInputW MassInput{..} (fslI MsgExamOfficeLabels & setTooltip MsgExamOfficeLabelsTip) False filledData
+  userIsExamOffice <- liftHandler . hasReadAccessTo $ ExamOfficeR EOExamsR
   if userIsExamOffice
-    then aFormToWForm $ ExamOfficeSettings
-           <$  aformSection MsgFormExamOffice
-           <*> apopt checkBoxField (fslI MsgExamOfficeGetSynced & setTooltip MsgExamOfficeGetSyncedTip) (eosettingsGetSynced <$> template)
-           <*> apopt checkBoxField (fslI MsgExamOfficeGetLabels & setTooltip MsgExamOfficeGetLabelsTip) (eosettingsGetLabels <$> template)
-           <*> eoLabelForm
-    else return . pure . fromMaybe (ExamOfficeSettings userExamOfficeGetSynced userExamOfficeGetLabels userExamOfficeLabels) $ template
+    then
+      aFormToWForm $ ExamOfficeSettings
+        <$  aformSection MsgFormExamOffice
+        <*> apopt checkBoxField (fslI MsgExamOfficeGetSynced & setTooltip MsgExamOfficeGetSyncedTip) (eosettingsGetSynced <$> template)
+        <*> apopt checkBoxField (fslI MsgExamOfficeGetLabels & setTooltip MsgExamOfficeGetLabelsTip) (eosettingsGetLabels <$> template)
+        <*> eoLabelForm
+    else
+      return . pure . fromMaybe (ExamOfficeSettings userExamOfficeGetSynced userExamOfficeGetLabels userExamOfficeLabels) $ template
 
 
 validateSettings :: User -> FormValidator SettingsForm Handler ()
@@ -360,13 +406,21 @@ getProfileR, postProfileR :: Handler Html
 getProfileR = postProfileR
 postProfileR = do
   (uid, user@User{..}) <- requireAuthPair
-  userSchools <- fmap (setOf $ folded . _Value) . runDB . E.select . E.from $ \school -> do
-    E.where_ . E.exists . E.from $ \userSchool ->
-      E.where_ $ E.not_ (userSchool E.^. UserSchoolIsOptOut)
-           E.&&. userSchool E.^. UserSchoolUser E.==. E.val uid
-           E.&&. userSchool E.^. UserSchoolSchool E.==. school E.^. SchoolId
-    return $ school E.^. SchoolId
-  userExamOfficeLabels <- return Set.empty  -- TODO
+  (userSchools, userExamOfficeLabels) <- runDB $ do
+    userSchools <- fmap (setOf $ folded . _Value) . E.select . E.from $ \school -> do
+      E.where_ . E.exists . E.from $ \userSchool ->
+        E.where_ $ E.not_ (userSchool E.^. UserSchoolIsOptOut)
+             E.&&. userSchool E.^. UserSchoolUser E.==. E.val uid
+             E.&&. userSchool E.^. UserSchoolSchool E.==. school E.^. SchoolId
+      return $ school E.^. SchoolId
+    userExamOfficeLabels <- fmap (foldMap $ \(Entity eolid ExamOfficeLabel{..}) -> Map.singleton (Right eolid) (examOfficeLabelName,examOfficeLabelStatus,examOfficeLabelPriority)) (selectList [ ExamOfficeLabelUser ==. uid ] [])
+    --Map.union
+      -- <$> fmap foldMap $ \(Entity eolid ExamOfficeLabel{..}) -> Map.singleton (Right eolid) (examOfficeLabelName,examOfficeLabelStatus,examOfficeLabelPriority)) (selectList [ ExamOfficeLabelUser ==. uid ] [])
+      -- E.select . E.from $ \examOfficeLabel -> do
+      -- E.where_ $ examOfficeLabel E.^. ExamOfficeLabelUser E.==. E.val uid
+      -- E.orderBy [ E.desc $ examOfficeLabel E.^. ExamOfficeLabelPriority ]
+      -- return examOfficeLabel
+    return (userSchools, userExamOfficeLabels)
   allocs <- runDB $ getAllocationNotifications uid
   let settingsTemplate = Just SettingsForm
         { stgDisplayName          = userDisplayName

src/Handler/Utils/Profile.hs

@@ -1,6 +1,5 @@
 module Handler.Utils.Profile
   ( validDisplayName
-  , ExamOfficeSettings(..)
   ) where
 
 import Import.NoFoundation
@@ -34,11 +33,3 @@ validDisplayName (fmap Text.strip -> mTitle) (Text.strip -> fName) (Text.strip -
     sNameLetters = Set.fromList $ unpack sName
     dNameLetters = Set.fromList $ unpack dName
     addLetters = Set.fromList [' ']
-
-
-data ExamOfficeSettings
-  = ExamOfficeSettings
-    { eosettingsGetSynced :: Bool
-    , eosettingsGetLabels :: Bool
-    , eosettingsLabels    :: Set ExamOfficeLabel
-    }