diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 4e3fcf82e..98e081d96 100644 --- a/src/Handler/Profile.hs +++ b/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 diff --git a/src/Handler/Utils/Profile.hs b/src/Handler/Utils/Profile.hs index 647e9a7c5..ca272d6b8 100644 --- a/src/Handler/Utils/Profile.hs +++ b/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 - }