fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Rework recipient UI

Browse Source
This commit is contained in:
Gregor Kleen 2019-04-20 12:20:35 +02:00
parent 45ea84e663
commit feee06e80a
7 changed files with 37 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Handler/Admin.hs
View File

@ -205,7 +205,7 @@ postAdminTestR = do
-- The actual call to @massInput@ is comparatively simple:
((miResult, fvInput -> miForm), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell allowAdd buttonAction defaultMiLayout) "" True Nothing
((miResult, fvInput -> miForm), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell allowAdd (\_ _ _ -> Set.empty) buttonAction defaultMiLayout) "" True Nothing
let locallyDefinedPageHeading = [whamlet|Admin TestPage for Uni2work|]

3
src/Handler/Course.hs
View File

@ -661,6 +661,9 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse $ \html -> do
miAllowAdd :: ListPosition -> Natural -> ListLength -> Bool
miAllowAdd _ _ _ = True
miAddEmpty :: ListPosition -> Natural -> ListLength -> Set ListPosition
miAddEmpty _ _ _ = Set.empty
miLayout :: ListLength
-> Map ListPosition (Either UserEmail UserId, FormResult (Maybe LecturerType)) -- ^ massInput state
-> Map ListPosition Widget -- ^ Cell widgets

8
src/Handler/Utils/Communication.hs
View File

@ -139,13 +139,15 @@ commR CommunicationRoute{..} = do
return (addRes', $(widgetFile "widgets/communication/recipientAdd"))
miAdd _ _ _ _ = Nothing
miCell _ (Left (CI.original -> email)) initRes nudge csrf = do
(tickRes, tickView) <- mpreq checkBoxField ("" & addName (nudge "tick")) initRes
(tickRes, tickView) <- mpreq checkBoxField ("" & addName (nudge "tick")) $ initRes <|> Just True
return (tickRes, $(widgetFile "widgets/communication/recipientEmail"))
miCell _ (Right (lookupUser -> User{..})) initRes nudge csrf = do
(tickRes, tickView) <- mpreq checkBoxField ("" & addName (nudge "tick")) initRes
(tickRes, tickView) <- mpreq checkBoxField ("" & addName (nudge "tick")) $ initRes <|> Just True
return (tickRes, $(widgetFile "widgets/communication/recipientName"))
miAllowAdd (EnumPosition RecipientCustom, 0) 1 _ = True
miAllowAdd _ _ _ = False
miAddEmpty _ 0 _ = Set.singleton (EnumPosition RecipientCustom, 0)
miAddEmpty _ _ _ = Set.empty
miButtonAction :: forall p . PathPiece p => p -> Maybe (SomeRoute UniWorX)
miButtonAction anchor = SomeRoute . (:#: anchor) <$> mbCurrentRoute
miLayout :: MapLiveliness (EnumLiveliness RecipientCategory) ListLength
@ -156,7 +158,7 @@ commR CommunicationRoute{..} = do
-> Widget
miLayout liveliness state cellWdgts _delButtons addWdgts = do
checkedIdentBase <- newIdent
let checkedCategories = Set.mapMonotonic (unEnumPosition . fst) . Set.filter (\k' -> Map.foldrWithKey (\k (_, checkState) -> (||) $ k == k' && checkState /= FormSuccess False && checkState /= FormMissing) False state) $ Map.keysSet state
let checkedCategories = Set.mapMonotonic (unEnumPosition . fst) . Set.filter (\k' -> Map.foldrWithKey (\k (_, checkState) -> (||) $ k == k' && checkState /= FormSuccess False && (checkState /= FormMissing || fromMaybe True (fmap snd $ chosenRecipients' !? k))) False state) $ Map.keysSet state
checkedIdent c = checkedIdentBase <> "-" <> toPathPiece c
categoryIndices c = Set.filter ((== c) . unEnumPosition . fst) $ review liveCoords liveliness
$(widgetFile "widgets/communication/recipientLayout")

23
src/Handler/Utils/Form/MassInput.hs
View File

@ -249,6 +249,10 @@ data MassInput handler liveliness cellData cellResult = MassInput
-> Natural
-> liveliness
-> Bool -- ^ Decide whether an addition-operation should be permitted
, miAddEmpty :: BoxCoord liveliness
-> Natural
-> liveliness
-> Set (BoxCoord liveliness) -- ^ Usually addition widgets are only provided for dimension 0 and all _lines_ that have at least one live coordinate. `miAddEmpty` allows specifying when to provide additional widgets
, miButtonAction :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX) -- ^ Override form-tag route for `massInput`-Buttons to keep the user closer to the Widget, the `PathPiece` Argument is to be used for constructiong a `Fragment`
, miLayout :: liveliness
-> Map (BoxCoord liveliness) (cellData, FormResult cellResult)
@ -293,10 +297,10 @@ massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do
sentLiveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet sentShape' ^? liveCoords :: MForm handler liveliness
let addForm :: [BoxDimension (BoxCoord liveliness)] -> MForm handler (Map (Natural, BoxCoord liveliness) (FormResult (Maybe (Map (BoxCoord liveliness) cellData -> FormResult (Map (BoxCoord liveliness) cellData))), Maybe Widget))
addForm = addForm' boxOrigin . zip [0..]
addForm = addForm' boxOrigin [] . zip [0..]
where
addForm' _ [] = return Map.empty
addForm' miCoord ((dimIx, _) : remDims) = do
addForm' _ _ [] = return Map.empty
addForm' miCoord pDims (dim''@(dimIx, _) : remDims) = do
let nudgeAddWidgetName :: Text -> Text
nudgeAddWidgetName miAddWidgetField = toPathPiece MassInputAddWidget{..}
(btnRes', btnView) <- mopt (buttonField $ MassInputAddDimension dimIx miCoord) ("" & addName MassInputAddButton{..} & addFormAction) Nothing
@ -312,12 +316,12 @@ massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do
case remDims of
[] -> return dimRes'
((_, BoxDimension dim) : _) -> do
let
miCoords
= Set.fromList
. takeWhile (\c -> review (liveCoord c) sentLiveliness)
$ set dim <$> enumFrom (miCoord ^. dim) <*> pure miCoord
dimRess <- sequence $ Map.fromSet (\c -> addForm' c remDims) miCoords
let miCoords
= Set.union (miAddEmpty miCoord dimIx sentLiveliness)
. Set.map (\c -> miCoord & dim .~ (c ^. dim))
. Set.filter (\c -> and [ ((==) `on` view pDim) miCoord c | (_, BoxDimension pDim) <- pDims `snoc` dim'' ])
$ review liveCoords sentLiveliness
dimRess <- sequence $ Map.fromSet (\c -> addForm' c (pDims `snoc` dim'') remDims) miCoords
return $ dimRes' `Map.union` fold dimRess
addResults <- addForm boxDimensions
@ -458,6 +462,7 @@ massInputList field fieldSettings miButtonAction miSettings miRequired miPrevRes
over _2 (\FieldView{..} -> $(widgetFile "widgets/massinput/list/cell")) <$> mreq field (fieldSettings pos & addName (nudge "field")) iRes
, miDelete = miDeleteList
, miAllowAdd = \_ _ _ -> True
, miAddEmpty = \_ _ _ -> Set.empty
, miButtonAction
, miLayout = \lLength _ cellWdgts delButtons addWdgts
-> $(widgetFile "widgets/massinput/list/layout")

16
static/js/utils/form.js
View File

@ -150,13 +150,14 @@
var INTERACTIVE_FIELDSET_UTIL_NAME = 'interactiveFieldset';
var INTERACTIVE_FIELDSET_UTIL_SELECTOR = '[uw-interactive-fieldset]';
var INTERACTIVE_FIELDSET_UTIL_TARGET_SELECTOR = '.interactive-fieldset--target';
var INTERACTIVE_FIELDSET_INITIALIZED_CLASS = 'interactive-fieldset--initialized';
var interactiveFieldsetUtil = function(element) {
var conditionalInput;
var conditionalValue;
var formGroup;
var target;
function init() {
if (!element) {
@ -183,9 +184,14 @@
}
conditionalValue = element.dataset.conditionalValue;
formGroup = element.closest(FORM_GROUP_SELECTOR);
if (!formGroup) {
throw new Error('Interactive Fieldset needs a .form-group ancestor!');
if (element.matches(INTERACTIVE_FIELDSET_UTIL_TARGET_SELECTOR)) {
target = element;
}
if (!target) {
target = element.closest(INTERACTIVE_FIELDSET_UTIL_TARGET_SELECTOR);
}
if (!target) {
throw new Error('Interactive Fieldset needs to be a target or have a target-ancestor!');
}
// add event listener
@ -205,7 +211,7 @@
}
function updateVisibility() {
element.classList.toggle('hidden', !matchesConditionalValue());
target.classList.toggle('hidden', !matchesConditionalValue());
}
function matchesConditionalValue() {

2
templates/widgets/aform/aform.hamlet
View File

@ -11,7 +11,7 @@ $case formLayout
<h3 .form-section-title>
^{fvLabel view}
$else
<div .form-group :fvRequired view:.form-group--required :not $ fvRequired view:.form-group--optional :isJust $ fvErrors view:.form-group--has-error>
<div .form-group .interactive-fieldset--target :fvRequired view:.form-group--required :not $ fvRequired view:.form-group--optional :isJust $ fvErrors view:.form-group--has-error>
$if not (Blaze.null $ fvLabel view)
<label .form-group-label for=#{fvId view}>
<span .form-group-label__caption>

4
templates/widgets/communication/recipientLayout.hamlet
View File

@ -5,9 +5,9 @@ $forall category <- activeCategories
<label for=#{checkedIdent category}>
_{category}
<fieldset uw-interactive-fieldset data-conditional-input=#{checkedIdent category}>
<fieldset uw-interactive-fieldset data-conditional-input=#{checkedIdent category} .interactive-fieldset--target>
$forall optIx <- categoryIndices category
^{cellWdgts ! optIx}
$maybe addWdgt <- addWdgts !? (0, (EnumPosition category, 0))
$maybe addWdgt <- addWdgts !? (1, (EnumPosition category, 0))
^{addWdgt}