fix(form): multiSelectField working with grouped options
This commit is contained in:
parent
fc0ca7b854
commit
3aa89019a8
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
<select ##{theId} name=#{name} multiple *{attrs} :isReq:required>
|
||||
$maybe optMsg' <- assertM (const $ not isReq) optMsg
|
||||
<option value="" :isSel Nothing:selected>
|
||||
_{optMsg'}
|
||||
$case opts
|
||||
$of OptionList{olOptions}
|
||||
$forall opt <- olOptions
|
||||
<option value=#{optionExternalValue opt} :isSel (Just opt):selected>
|
||||
#{optionDisplay opt}
|
||||
$of OptionListGrouped{olOptionsGrouped}
|
||||
$forall (groupLbl, iOpts) <- olOptionsGrouped
|
||||
<optgroup label=#{groupLbl}>
|
||||
$forall opt <- iOpts
|
||||
<option value=#{optionExternalValue opt} :isSel (Just opt):selected>
|
||||
#{optionDisplay opt}
|
||||
|]
|
||||
|
||||
radioField' :: ( Eq a
|
||||
, RenderMessage (HandlerSite m) FormMessage
|
||||
, MonadHandler m
|
||||
|
||||
Loading…
Reference in New Issue
Block a user