fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

refactor(profile): more readable eo-label-form

Browse Source
This commit is contained in:
Sarah Vaupel 2021-12-06 23:13:51 +01:00
parent 614b8a18a9
commit 5d7b87e75a
1 changed files with 44 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
src/Handler/Profile.hs
View File

@ -326,17 +326,29 @@ allocationNotificationForm = maybe (pure mempty) allocationNotificationForm' . (
fmap (review _AllocNotify) <$> wpopt (radioGroupField Nothing optionsFinite) (fsl allocDesc & addName [st|alloc-notify__#{toPathPiece cID}|]) (Just $ mPrev ^. _AllocNotify)
where funcForm' forms = funcForm forms (fslI MsgFormAllocationNotifications & setTooltip MsgFormAllocationNotificationsTip) False
examOfficeForm :: Maybe ExamOfficeSettings -> AForm Handler ExamOfficeSettings
examOfficeForm template = wFormToAForm $ do
(_uid, User{userExamOfficeGetSynced,userExamOfficeGetLabels}) <- requireAuthPair
currentRoute <- fromMaybe (error "examOfficeForm called from 404-handler") <$> liftHandler getCurrentRoute
mr <- getMessageRender
let
userExamOfficeLabels :: EOLabels
userExamOfficeLabels = fromMaybe mempty $ eosettingsLabels <$> template
eoLabelsForm :: AForm Handler EOLabels
eoLabelsForm = 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 :: ListPosition
-> Natural
-> ListLength
-> (Text -> Text)
-> FieldView UniWorX
-> Maybe
(Form (Map ListPosition (Either ExamOfficeLabelName ExamOfficeLabelId)
-> FormResult (Map ListPosition (Either ExamOfficeLabelName ExamOfficeLabelId)))
)
miAdd _ _ _ nudge submitView = Just $ \csrf -> do
(addRes, addView) <- mpreq textField (fslI MsgExamOfficeLabelName & addName (nudge "name")) Nothing
let
@ -344,10 +356,14 @@ examOfficeForm template = wFormToAForm $ do
| Set.member (Left nLabel) . Set.fromList $ Map.elems oldData
-> FormFailure [mr MsgExamOfficeLabelAlreadyExists]
| otherwise
-> FormSuccess . Map.fromList $ [(kStart, Left nLabel)]
-> FormSuccess $ Map.singleton kStart (Left nLabel)
return (addRes', $(widgetFile "profile/exam-office-labels/add"))
miCell :: ListPosition -> Either ExamOfficeLabelName ExamOfficeLabelId -> Maybe EOLabelData -> (Text -> Text) -> Form EOLabelData
miCell :: ListPosition
-> Either ExamOfficeLabelName ExamOfficeLabelId
-> Maybe EOLabelData
-> (Text -> Text)
-> Form EOLabelData
miCell _ eoLabel initRes nudge csrf = do
labelIdent <- case eoLabel of
Left lblName -> return lblName
@ -361,28 +377,47 @@ examOfficeForm template = wFormToAForm $ do
res = (,,) <$> (FormSuccess labelIdent) <*> statusRes <*> priorityRes
return (res, $(widgetFile "profile/exam-office-labels/cell"))
miDelete :: Map ListPosition (Either ExamOfficeLabelName ExamOfficeLabelId) -> ListPosition -> MaybeT (MForm Handler) (Map ListPosition ListPosition)
miDelete :: Map ListPosition (Either ExamOfficeLabelName ExamOfficeLabelId)
-> ListPosition
-> MaybeT (MForm Handler) (Map ListPosition ListPosition)
miDelete = miDeleteList
miAddEmpty :: ListPosition -> Natural -> ListLength -> Set ListPosition
miAddEmpty :: ListPosition
-> Natural
-> ListLength
-> Set ListPosition
miAddEmpty _ _ _ = Set.empty
miButtonAction :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)
miButtonAction :: forall p.
PathPiece p
=> p
-> Maybe (SomeRoute UniWorX)
miButtonAction frag = Just . SomeRoute $ currentRoute :#: frag
miLayout :: ListLength -> Map ListPosition (Either ExamOfficeLabelName ExamOfficeLabelId, FormResult EOLabelData) -> Map ListPosition Widget -> Map ListPosition (FieldView UniWorX) -> Map (Natural, ListPosition) Widget -> Widget
miLayout :: ListLength
-> Map ListPosition (Either ExamOfficeLabelName ExamOfficeLabelId, FormResult EOLabelData)
-> Map ListPosition Widget
-> Map ListPosition (FieldView UniWorX)
-> Map (Natural, ListPosition) Widget
-> Widget
miLayout lLength _ cellWdgts delButtons addWdgets = $(widgetFile "profile/exam-office-labels/layout")
miIdent :: Text
miIdent = "exam-office-labels"
postProcess :: Map ListPosition (Either ExamOfficeLabelName ExamOfficeLabelId, EOLabelData) -> EOLabels
postProcess = error "WIP"
postProcess :: Map ListPosition (Either ExamOfficeLabelName ExamOfficeLabelId, EOLabelData)
-> EOLabels
postProcess = Map.fromList . map postProcess' . Map.elems
where
postProcess' :: (Either ExamOfficeLabelName ExamOfficeLabelId, EOLabelData)
-> (Either ExamOfficeLabelName ExamOfficeLabelId, EOLabelData)
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