diff options
author | Yorhel <git@yorhel.nl> | 2020-11-04 13:26:16 +0100 |
---|---|---|
committer | Yorhel <git@yorhel.nl> | 2020-11-04 13:26:53 +0100 |
commit | 71d166057701305e1b7def38c4c6d0926494f9ec (patch) | |
tree | b4990cd198bb34f19439ade84574c1ddfd276450 | |
parent | a795b3ee3dc57c27f59ce9f5c3ac8eccfddedcdb (diff) |
AdvSearch: Add buttons to delete & move fields into or out of a parent
Still feels kind of awkward, but it'll have to do for now.
-rw-r--r-- | data/style.css | 5 | ||||
-rw-r--r-- | elm/AdvSearch/Fields.elm | 81 | ||||
-rw-r--r-- | elm/AdvSearch/Main.elm | 2 |
3 files changed, 62 insertions, 26 deletions
diff --git a/data/style.css b/data/style.css index 85ab464e..6d5b3bb8 100644 --- a/data/style.css +++ b/data/style.css @@ -1116,11 +1116,14 @@ p.filselect i { font-style: normal } .advsearch { max-width: 800px; margin: 0 auto; display: flex; flex-direction: column; align-items: center; justify-content: center } .advsearch .advnest { display: flex } -.advsearch .advnest > div:nth-child(1) { flex: 0 0 35px; } +.advsearch .advnest > div:nth-child(1) { flex: 0 0 45px; } .advsearch .advnest > div:nth-child(2) { flex: 1; border-left: 1px dashed $border$ } .advsearch .elm_dd_input { margin: 5px; width: 150px } .advsearch .elm_dd_input.elm_dd_noarrow { width: 13px } .advsearch .advrow { display: flex; flex-wrap: wrap } +.advsearch .advbut { width: 100%; background-color: $_blendbg$; text-align: right; white-space: nowrap } +.advsearch .advbut > * { display: inline-block; box-sizing: border-box; height: 20px; padding: 3px 5px 0 2px; cursor: pointer; border-bottom: none; font-size: 16px } +.advsearch .advbut > b { color: $grayedout$; font-style: normal } .advsearch .advheader { box-sizing: border-box; background-color: $_blendbg$; padding: 3px; width: 100%; margin-bottom: 2px } .advsearch .advheader > h3 { text-align: center; font-weight: bold; font-size: inherit; margin-bottom: 3px } .advsearch .advheader .opts { display: flex; justify-content: space-between } diff --git a/elm/AdvSearch/Fields.elm b/elm/AdvSearch/Fields.elm index 79015359..1be82854 100644 --- a/elm/AdvSearch/Fields.elm +++ b/elm/AdvSearch/Fields.elm @@ -12,6 +12,7 @@ import AdvSearch.Query exposing (..) -- "Nested" fields are a container for other fields. +-- The code for nested fields is tightly coupled with the generic 'Field' abstraction below. type NestType = NAnd | NOr @@ -46,6 +47,12 @@ nestUpdate dat msg model = NAdd n -> let (ndat,f) = fieldInit n dat in (ndat, { model | add = DD.toggle model.add False, fields = model.fields ++ [f] }, Cmd.none) + NField n FDel -> (dat, { model | fields = delidx n model.fields }, Cmd.none) + NField n FMoveSub -> + let (ndat,subm) = nestInit (if model.ntype == NAnd then NOr else NAnd) model.ftype dat + subfields = List.drop n model.fields |> List.take 1 |> List.map (\(fid,fdd,fm) -> (fid, DD.toggle fdd False, fm)) + (ndat2,subf) = fieldCreate -1 (ndat, FMNest { subm | fields = subfields }) + in (ndat2, { model | fields = modidx n (always subf) model.fields }, Cmd.none) NField n m -> case List.head (List.drop n model.fields) of Nothing -> (dat, model, Cmd.none) @@ -76,17 +83,14 @@ nestFromQuery ntype ftype dat q = _ -> Nothing -nestFieldView : Field -> Html FieldMsg -nestFieldView (fid, fdd, fm) = - let (flbl, fcont, fbody) = fieldView (fid,fdd,fm) - in div [ class "advnest" ] - [ div [ class "elm_dd_input", style "width" "40px" ] [ DD.view fdd Api.Normal flbl fcont ] - , fbody ] +nestFieldView : Int -> Field -> Html FieldMsg +nestFieldView level f = + let (fddv, fbody) = fieldView level f + in div [ class "advnest" ] [ fddv, fbody ] --- TODO: Buttons to move and remove fields -nestView : NestModel -> (Html NestMsg, () -> List (Html NestMsg), Html NestMsg) -nestView model = +nestView : Int -> NestModel -> (Html NestMsg, () -> List (Html NestMsg), Html NestMsg) +nestView level model = let isNest (_,(_,_,f)) = case f of @@ -96,11 +100,8 @@ nestView model = nests = List.filter isNest list plains = List.filter (not << isNest) list - pView (fid, fdd, fm) = - let (flbl, fcont, fbody) = fieldView (fid,fdd,fm) - in div [ class "elm_dd_input" ] [ DD.view fdd Api.Normal flbl fcont ] - pViews = List.map (\(i,f) -> Html.map (NField i) (pView f)) plains - nViews = List.map (\(i,f) -> Html.map (NField i) (nestFieldView f)) nests + pViews = List.map (\(i,f) -> Html.map (NField i) (Tuple.first (fieldView (level+2) f))) plains + nViews = List.map (\(i,f) -> Html.map (NField i) (nestFieldView (level+1) f)) nests add = div [ class "elm_dd_input elm_dd_noarrow" ] @@ -158,6 +159,9 @@ type FieldMsg | FSPlatform (AS.Msg String) | FSLength (AS.Msg Int) | FToggle Bool + | FDel -- intercepted in nestUpdate + | FMoveSub -- intercepted in nestUpdate + | FMovePar type FieldType = V @@ -198,10 +202,27 @@ fields = fieldUpdate : Data -> FieldMsg -> Field -> (Data, Field, Cmd FieldMsg) fieldUpdate dat msg_ (num, dd, model) = - let maps f m = (dat, (num, dd, (f m)), Cmd.none) -- Simple version: update function returns a Model - mapf fm fc (d,m,c) = (d, (num, dd, (fm m)), Cmd.map fc c) -- Full version: update function returns (Data, Model, Cmd) - mapc fm fc (d,m,c) = (d, (num, DD.toggle dd False, (fm m)), Cmd.map fc c) -- Full version that also closes the DD (Ugly hack...) + let maps f m = (dat, (num, dd, f m), Cmd.none) -- Simple version: update function returns a Model + mapf fm fc (d,m,c) = (d, (num, dd, fm m), Cmd.map fc c) -- Full version: update function returns (Data, Model, Cmd) + mapc fm fc (d,m,c) = (d, (num, DD.toggle dd False, fm m), Cmd.map fc c) -- Full version that also closes the DD (Ugly hack...) + noop = (dat, (num, dd, model), Cmd.none) in case (msg_, model) of + -- Move to parent node is tricky, needs to be intercepted at this point so that we can access the parent NestModel. + (FSNest (NField parentNum (FSNest (NField fieldNum FMovePar))), FMNest grandModel) -> + case List.head <| List.drop parentNum grandModel.fields of + Just (_,_,FMNest parentModel) -> + let fieldField = List.drop fieldNum parentModel.fields |> List.take 1 + newFields = List.map (\(fid,fdd,fm) -> (fid, DD.toggle fdd False, fm)) fieldField + newParentModel = { parentModel | fields = delidx fieldNum parentModel.fields } + newGrandFields = + (if List.isEmpty newParentModel.fields + then delidx parentNum grandModel.fields + else modidx parentNum (\(pid,pdd,_) -> (pid,pdd,FMNest newParentModel)) grandModel.fields + ) ++ newFields + newGrandModel = { grandModel | fields = newGrandFields } + in (dat, (num,dd,FMNest newGrandModel), Cmd.none) + _ -> noop + (FSNest (NType a b), FMNest m) -> mapc FMNest FSNest (nestUpdate dat (NType a b) m) (FSNest msg, FMNest m) -> mapf FMNest FSNest (nestUpdate dat msg m) (FSLang msg, FMLang m) -> maps FMLang (AS.update msg m) @@ -209,16 +230,28 @@ fieldUpdate dat msg_ (num, dd, model) = (FSPlatform msg, FMPlatform m) -> maps FMPlatform (AS.update msg m) (FSLength msg, FMLength m) -> maps FMLength (AS.update msg m) (FToggle b, _) -> (dat, (num, DD.toggle dd b, model), Cmd.none) - _ -> (dat, (num, dd, model), Cmd.none) - - -fieldView : Field -> (Html FieldMsg, () -> List (Html FieldMsg), Html FieldMsg) -fieldView (_, dd, model) = - let vf f (lbl,cont,body) = (Html.map f lbl, \() -> List.map (Html.map f) (cont ()), Html.map f body) + _ -> noop + + +fieldView : Int -> Field -> (Html FieldMsg, Html FieldMsg) +fieldView level (_, dd, model) = + let ddv lbl cont = div [ class "elm_dd_input" ] + [ DD.view dd Api.Normal lbl <| \() -> + div [ class "advbut" ] + [ if level == 0 + then b [ title "Can't delete the top-level filter" ] [ text "⊗" ] + else a [ href "#", onClickD FDel, title "Delete this filter" ] [ text "⊗" ] + , if level <= 1 + then b [ title "Can't move this filter to parent branch" ] [ text "↰" ] + else a [ href "#", onClickD FMovePar, title "Move this filter to parent branch" ] [ text "↰" ] + , a [ href "#", onClickD FMoveSub, title "Create new branch for this filter" ] [ text "↳" ] + ] :: cont () + ] + vf f (lbl,cont,body) = (ddv (Html.map f lbl) (\() -> List.map (Html.map f) (cont ())), Html.map f body) vs f (lbl,cont) = vf f (lbl,cont,text "") in case model of FMCustom m -> vs FSCustom (text "Unrecognized query", \() -> [text ""]) -- TODO: Display the Query - FMNest m -> vf FSNest (nestView m) + FMNest m -> vf FSNest (nestView level m) FMLang m -> vs FSLang (AS.langView False m) FMOLang m -> vs FSOLang (AS.langView True m) FMPlatform m -> vs FSPlatform (AS.platformView m) diff --git a/elm/AdvSearch/Main.elm b/elm/AdvSearch/Main.elm index c536ef83..f983b088 100644 --- a/elm/AdvSearch/Main.elm +++ b/elm/AdvSearch/Main.elm @@ -95,6 +95,6 @@ update msg model = view : Model -> Html Msg view model = div [ class "advsearch" ] [ input [ type_ "hidden", id "f", name "f", value <| Maybe.withDefault "" <| Maybe.map (\v -> JE.encode 0 (encodeQuery v)) (fieldToQuery model.query) ] [] - , Html.map Field (nestFieldView model.query) + , Html.map Field (nestFieldView 0 model.query) , input [ type_ "submit", class "submit", value "Search" ] [] ] |