diff --git a/messages/uniworx/utils/utils/de-de-formal.msg b/messages/uniworx/utils/utils/de-de-formal.msg index 067b7ba11..5ff122fb1 100644 --- a/messages/uniworx/utils/utils/de-de-formal.msg +++ b/messages/uniworx/utils/utils/de-de-formal.msg @@ -98,6 +98,7 @@ RoomReferenceLinkInstructions: Anweisungen RoomReferenceLinkInstructionsPlaceholder: Anweisungen UtilEmptyChoice: Auswahl war leer UtilEmptyNoChangeTip: Eine leere Eingabe belässt den vorherigen Wert unverändert. +MultiNoSelection: Keine Auswahl #invitation.hs InvitationAction: Aktion diff --git a/messages/uniworx/utils/utils/en-eu.msg b/messages/uniworx/utils/utils/en-eu.msg index cafb5fac8..f65004cd1 100644 --- a/messages/uniworx/utils/utils/en-eu.msg +++ b/messages/uniworx/utils/utils/en-eu.msg @@ -98,6 +98,7 @@ RoomReferenceLinkInstructions: Instructions RoomReferenceLinkInstructionsPlaceholder: Instructions UtilEmptyChoice: Empty selection UtilEmptyNoChangeTip: Existing values remain unchanged if this field is left empty. +MultiNoSelection: No selection #invitation.hs InvitationAction: Action diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index fabb20538..53914269e 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -94,7 +94,7 @@ firmActionMap mr isAdmin acts = mconcat (mkAct isAdmin <$> acts) <*> aopt checkBoxField (fslI MsgFirmActResetMutualSupervision) (Just $ Just True ) mkAct _ FirmActAddSupersvisors = singletonMap FirmActAddSupersvisors $ FirmActAddSupersvisorsData <$> areq (textField & cfAnySeparatedSet) (fslI MsgTableIsDefaultSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing - <*> areq checkBoxField (fslI MsgTableIsDefaultReroute ) (Just True) + <*> areq checkBoxField (fslI MsgTableIsDefaultReroute) (Just True) <*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing mkAct _ FirmActChangeContactFirm = singletonMap FirmActChangeContactFirm $ FirmActChangeContactFirmData <$> aopt htmlField (fslI MsgPostAddress & setTooltip (SomeMessages [SomeMessage MsgPostAddressTip, SomeMessage MsgUtilEmptyNoChangeTip])) Nothing @@ -704,10 +704,9 @@ mkFirmUserTable isAdmin cid = do return (usr E.^. UserId, usr E.^. UserDisplayName, usrCmp E.?. UserCompanySupervisor) let -- supervisorField :: Field Handler UserId - supervisorField = selectField $ procOptions rawSupers - -- TODO: Markieren Alien/Standard/Irregulär - -- supervisorsField = multiSelectField $ procOptions rawSupers - -- supervisorsField = convertField pure head supervisorField + -- supervisorField = selectField' (Just $ SomeMessage MsgMultiNoSelection) $ procOptions rawSupers + supervisorsField = multiSelectField' (Just $ SomeMessage MsgMultiNoSelection) $ procOptions rawSupers + fsh = unCompanyKey cid resultDBTable = DBTable{..} @@ -796,8 +795,8 @@ mkFirmUserTable isAdmin cid = do -- superField = selectField $ ???? dbtFilterUI mPrev = mconcat [ fltrUserNameEmailHdrUI MsgTableCompanyUser mPrev - , prismAForm (singletonFilter "supervisor-is" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift supervisorField) (fslI MsgFilterSupervisor) - -- , prismAForm (multiFilter "supervisors-are" . maybePrism monoPathPieces) mPrev $ aopt (hoistField lift supervisorsField) (fslI MsgFilterSupervisor & setTooltip MsgMultiSelectTip ) + -- , prismAForm (singletonFilter "supervisor-is" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift supervisorField) (fslI MsgFilterSupervisor) + , prismAForm (multiFilter "supervisors-are" . maybePrism monoPathPieces) mPrev $ aopt (hoistField lift supervisorsField) (fslI MsgFilterSupervisor & setTooltip MsgMultiSelectTip) , prismAForm (singletonFilter "has-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterSupervisor) , prismAForm (singletonFilter "has-company-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorCompany fsh) , prismAForm (singletonFilter "has-foreign-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorForeign fsh) @@ -810,10 +809,10 @@ mkFirmUserTable isAdmin cid = do <$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep) (Just $ Just False) -- <*> aopt checkBoxField (fslI MsgFirmActResetMutualSupervision) (Just $ Just True ) , singletonMap FirmUserActSetSupervisor $ FirmUserActSetSupervisorData - <$> aopt (textField & cfAnySeparatedSet) (fslI MsgFirmNewSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing - <*> fmap (fmap pure) (aopt supervisorField (fslI MsgFirmSetSupervisor) Nothing) - <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just False) - <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep) (Just False) + <$> aopt (textField & cfAnySeparatedSet) (fslI MsgFirmNewSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing + <*> aopt supervisorsField (fslI MsgFirmSetSupervisor & setTooltip MsgMultiSelectTip) Nothing + <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just False) + <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep) (Just False) , singletonMap FirmUserActMkSuper $ FirmUserActMkSuperData <$> aopt checkBoxField (fslI MsgTableIsDefaultReroute) (Just $ Just True) , singletonMap FirmUserActChangeContact $ FirmUserActChangeContactData diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index 39107331e..1a4bc3aa9 100644 --- a/src/Utils/Form.hs +++ b/src/Utils/Form.hs @@ -950,6 +950,54 @@ selectField' optMsg mkOpts = Field{..} #{optionDisplay opt} |] +multiSelectField' :: ( Eq a + , RenderMessage (HandlerSite m) FormMessage + , MonadHandler m + ) + => Maybe (SomeMessage (HandlerSite m)) -- ^ Caption used for @Nothing@-Option, if Field is optional and whether to show such an option + -> HandlerT (HandlerSite m) IO (OptionList a) + -> Field m [a] +-- ^ Like @multiSelectField@, but it can handle OptionListGrouped and also offers more control over the @Nothing@-Option, if Field is optional +multiSelectField' optMsg mkOpts = Field{..} + where + fieldEnctype = UrlEncoded + + fieldParse [] _ = return $ Right Nothing + fieldParse optlist _ = do + let optlist' = filter notNull optlist + readExternal <- view _olReadExternal <$> liftHandler mkOpts + return . maybe (Left . SomeMessage $ MsgInvalidEntry $ T.intercalate ", " optlist') (Right . Just) $ mapM readExternal optlist' + -- case mapM readExternal optlist' of + -- Nothing -> return $ Left $ SomeMessage $ MsgInvalidEntry $ T.intercalate ", " optlist' + -- res -> return $ Right res + + fieldView theId name attrs val isReq = do + opts <- liftHandler mkOpts + let + rendered = case val of + Left _ -> [] + Right xs -> [optionExternalValue o | o <- opts ^.. _olOptions, x <- xs, x == optionInternalValue o] + isSel Nothing = ClassyPrelude.Yesod.null rendered + isSel (Just opt) = optionExternalValue opt `elem` rendered + [whamlet| + $newline never +