diff options
author | Yorhel <git@yorhel.nl> | 2020-11-07 10:47:04 +0100 |
---|---|---|
committer | Yorhel <git@yorhel.nl> | 2020-11-07 11:01:31 +0100 |
commit | dc34ce6828878962e016417c4bd337ddccac5d6a (patch) | |
tree | e4c25e478157cc5bc5a87021abde6962552b0adc /elm | |
parent | 8ec2900f12be852ef9ec0e4d3152c6b73ee28592 (diff) |
AdvSearch: Add developer filter
First attempt to add filters that reference database entries. Will need
to be refined.
Diffstat (limited to 'elm')
-rw-r--r-- | elm/AdvSearch/Fields.elm | 38 | ||||
-rw-r--r-- | elm/AdvSearch/Main.elm | 23 | ||||
-rw-r--r-- | elm/AdvSearch/Producers.elm | 94 | ||||
-rw-r--r-- | elm/AdvSearch/Query.elm | 6 | ||||
-rw-r--r-- | elm/AdvSearch/Set.elm | 17 |
5 files changed, 149 insertions, 29 deletions
diff --git a/elm/AdvSearch/Fields.elm b/elm/AdvSearch/Fields.elm index 1e446aaa..426b35ea 100644 --- a/elm/AdvSearch/Fields.elm +++ b/elm/AdvSearch/Fields.elm @@ -8,6 +8,7 @@ import Lib.Html exposing (..) import Lib.DropDown as DD import Lib.Api as Api import AdvSearch.Set as AS +import AdvSearch.Producers as AP import AdvSearch.Query exposing (..) @@ -106,14 +107,14 @@ nestFromQuery ntype ftype dat q = _ -> Nothing -nestFieldView : Int -> Field -> Html FieldMsg -nestFieldView level f = - let (fddv, fbody) = fieldView level f +nestFieldView : Data -> Field -> Html FieldMsg +nestFieldView dat f = + let (fddv, fbody) = fieldView dat f in div [ class "advnest" ] [ fddv, fbody ] -nestView : Int -> NestModel -> (Html NestMsg, () -> List (Html NestMsg), Html NestMsg) -nestView level model = +nestView : Data -> NestModel -> (Html NestMsg, () -> List (Html NestMsg), Html NestMsg) +nestView dat model = let isNest (_,(_,_,f)) = case f of @@ -124,8 +125,8 @@ nestView level model = plains = List.filter (not << isNest) list subtype = model.ntype /= NAnd && model.ntype /= NOr - pViews = List.map (\(i,f) -> Html.map (NField i) (Tuple.first (fieldView (if subtype then 0 else level+1) f))) plains - nViews = List.map (\(i,f) -> Html.map (NField i) (nestFieldView (if subtype then 0 else level+1) f)) nests + pViews = List.map (\(i,f) -> Html.map (NField i) (Tuple.first (fieldView { dat | level = if subtype then 0 else dat.level+1 } f))) plains + nViews = List.map (\(i,f) -> Html.map (NField i) (nestFieldView { dat | level = if subtype then 0 else dat.level+1 } f)) nests add = if model.ntype /= NAnd && model.ntype /= NOr then text "" else @@ -150,8 +151,8 @@ nestView level model = cont () = [ ul [] <| if model.ntype == NAnd || model.ntype == NOr - then [ li [] [ linkRadio (model.ntype == NAnd) (NType NAnd) [ text "And" ] ] - , li [] [ linkRadio (model.ntype == NOr ) (NType NOr ) [ text "Or" ] ] + then [ li [] [ linkRadio (model.ntype == NAnd) (NType NAnd) [ text "And: All filters must match" ] ] + , li [] [ linkRadio (model.ntype == NOr ) (NType NOr ) [ text "Or: At least one filter must match" ] ] ] else [ li [] [ linkRadio (model.ntype == NRel) (NType NRel) [ text "Has a release that matches these filters" ] ] , li [] [ linkRadio (model.ntype == NRelNeg) (NType NRelNeg) [ text "Does not have a release that matches these filters" ] ] @@ -185,6 +186,7 @@ type FieldModel | FMOLang (AS.Model String) | FMPlatform (AS.Model String) | FMLength (AS.Model Int) + | FMDeveloper AP.Model type FieldMsg = FSCustom () -- Not actually used at the moment @@ -193,6 +195,7 @@ type FieldMsg | FSOLang (AS.Msg String) | FSPlatform (AS.Msg String) | FSLength (AS.Msg Int) + | FSDeveloper AP.Msg | FToggle Bool | FDel -- intercepted in nestUpdate | FMoveSub -- intercepted in nestUpdate @@ -232,9 +235,11 @@ fields = , f V "Original language" (Just 2) FMOLang AS.init AS.olangFromQuery , f V "Platform" (Just 3) FMPlatform AS.init AS.platformFromQuery , f V "Length" (Just 4) FMLength AS.init AS.lengthFromQuery + , f V "Developer" Nothing FMDeveloper AP.init AP.devFromQuery , f V "Release" Nothing FMNest (nestInit NRel R []) (nestFromQuery NRel V) , f R "Language" (Just 1) FMLang AS.init AS.langFromQuery + , f R "Developer" Nothing FMDeveloper AP.init AP.devFromQuery ] @@ -267,22 +272,23 @@ fieldUpdate dat msg_ (num, dd, model) = (FSOLang msg, FMOLang m) -> maps FMOLang (AS.update msg m) (FSPlatform msg, FMPlatform m) -> maps FMPlatform (AS.update msg m) (FSLength msg, FMLength m) -> maps FMLength (AS.update msg m) + (FSDeveloper msg,FMDeveloper m)-> mapf FMDeveloper FSDeveloper (AP.update dat msg m) (FToggle b, _) -> (dat, (num, DD.toggle dd b, model), Cmd.none) _ -> noop -fieldView : Int -> Field -> (Html FieldMsg, Html FieldMsg) -fieldView level (_, dd, model) = +fieldView : Data -> Field -> (Html FieldMsg, Html FieldMsg) +fieldView dat (_, dd, model) = let ddv lbl cont = div [ class "elm_dd_input" ] [ DD.view dd Api.Normal lbl <| \() -> div [ class "advbut" ] - [ if level == 0 + [ if dat.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 + , if dat.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 "↰" ] - , if level == 0 + , if dat.level == 0 then b [ title "Can't move this filter into a subbranch" ] [ text "↳" ] else a [ href "#", onClickD FMoveSub, title "Create new branch for this filter" ] [ text "↳" ] ] :: cont () @@ -291,11 +297,12 @@ fieldView level (_, dd, model) = 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 level m) + FMNest m -> vf FSNest (nestView dat m) FMLang m -> vs FSLang (AS.langView False m) FMOLang m -> vs FSOLang (AS.langView True m) FMPlatform m -> vs FSPlatform (AS.platformView m) FMLength m -> vs FSLength (AS.lengthView m) + FMDeveloper m-> vs FSDeveloper(AP.devView dat m) fieldToQuery : Field -> Maybe Query @@ -307,6 +314,7 @@ fieldToQuery (_, _, model) = FMOLang m -> AS.toQuery (QStr "olang") m FMPlatform m -> AS.toQuery (QStr "platform") m FMLength m -> AS.toQuery (QInt "length") m + FMDeveloper m-> AP.toQuery (QInt "developer") m fieldCreate : Int -> (Data,FieldModel) -> (Data,Field) diff --git a/elm/AdvSearch/Main.elm b/elm/AdvSearch/Main.elm index 5d49f116..af049a9a 100644 --- a/elm/AdvSearch/Main.elm +++ b/elm/AdvSearch/Main.elm @@ -5,14 +5,16 @@ import Html.Attributes exposing (..) import Html.Events exposing (..) import Browser import Set +import Dict import Array as A import Json.Encode as JE import Json.Decode as JD +import Gen.Api as GApi import AdvSearch.Query exposing (..) import AdvSearch.Fields exposing (..) -main : Program JE.Value Model Msg +main : Program Recv Model Msg main = Browser.element { init = \e -> (init e, Cmd.none) , view = view @@ -20,6 +22,11 @@ main = Browser.element , subscriptions = \m -> Sub.map Field (fieldSub m.query) } +type alias Recv = + { query : JE.Value + , ftype : String + , producers : List GApi.ApiProducerResult + } type alias Model = { query : Field @@ -60,10 +67,14 @@ normalize model = _ -> model -init : JE.Value -> Model +init : Recv -> Model init arg = - let dat = { objid = 0 } - (ndat, query) = JD.decodeValue decodeQuery arg |> Result.toMaybe |> Maybe.withDefault (QAnd []) |> fieldFromQuery V dat + let dat = { objid = 0 + , level = 0 + , producers = Dict.fromList <| List.map (\p -> (p.id,p)) <| arg.producers + } + + (ndat, query) = JD.decodeValue decodeQuery arg.query |> Result.toMaybe |> Maybe.withDefault (QAnd []) |> fieldFromQuery V dat -- We always want the top-level query to be a Nest type. addtoplvl = let (_,m) = fieldCreate -1 (Tuple.mapSecond FMNest (nestInit NAnd V [query] ndat)) in m @@ -79,7 +90,7 @@ init arg = _ -> True model = { query = nquery - , ftype = V + , ftype = if arg.ftype == "v" then V else R , data = { ndat | objid = ndat.objid + 5 } -- +5 for the creation of nQuery } in if isSimple then normalize model else model @@ -96,6 +107,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 0 model.query) + , Html.map Field (nestFieldView model.data model.query) , input [ type_ "submit", class "submit", value "Search" ] [] ] diff --git a/elm/AdvSearch/Producers.elm b/elm/AdvSearch/Producers.elm new file mode 100644 index 00000000..e0071a0c --- /dev/null +++ b/elm/AdvSearch/Producers.elm @@ -0,0 +1,94 @@ +module AdvSearch.Producers exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Set +import Dict +import Lib.Autocomplete as A +import Lib.Html exposing (..) +import Lib.Util exposing (..) +import Gen.Api as GApi +import AdvSearch.Query exposing (..) +import AdvSearch.Set as S + + + +type alias Model = + { sel : S.Model Int + , conf : A.Config Msg GApi.ApiProducerResult + , search : A.Model GApi.ApiProducerResult + } + +type Msg + = Sel (S.Msg Int) + | Search (A.Msg GApi.ApiProducerResult) + + +init : Data -> (Data, Model) +init dat = + let (ndat, sel) = S.init dat + in ( { ndat | objid = ndat.objid + 1 } + , { sel = { sel | single = False } + , conf = { wrap = Search, id = "advsearch_prod" ++ String.fromInt ndat.objid, source = A.producerSource } + , search = A.init "" + } + ) + + +update : Data -> Msg -> Model -> (Data, Model, Cmd Msg) +update dat msg model = + case msg of + Sel m -> (dat, { model | sel = S.update m model.sel }, Cmd.none) + Search m -> + let (nm, c, res) = A.update model.conf m model.search + in case res of + Nothing -> (dat, { model | search = nm }, c) + Just p -> + if Set.member p.id model.sel.sel then (dat, { model | search = nm }, c) + else ( { dat | producers = Dict.insert p.id p dat.producers } + , { model | search = A.clear nm "", sel = S.update (S.Sel p.id True) model.sel } + , c ) + + +toQuery f m = S.toQuery f m.sel + +fromQuery f dat q = + S.fromQuery f dat q |> Maybe.map (\(ndat,sel) -> + ( { ndat | objid = ndat.objid+1 } + , { sel = { sel | single = False } + , conf = { wrap = Search, id = "advsearch_prod" ++ String.fromInt ndat.objid, source = A.producerSource } + , search = A.init "" + } + )) + + +devFromQuery = fromQuery (\q -> + case q of + QInt "developer" op v -> Just (op, v) + _ -> Nothing) + + +devView : Data -> Model -> (Html Msg, () -> List (Html Msg)) +devView dat model = + ( case Set.toList model.sel.sel of + [] -> b [ class "grayedout" ] [ text "Developer" ] + [s] -> span [ class "nowrap" ] + [ b [ class "grayedout" ] [ text <| "p" ++ String.fromInt s ++ ":" ] + , Dict.get s dat.producers |> Maybe.map (\p -> p.name) |> Maybe.withDefault "" |> text + ] + l -> span [] [ S.lblPrefix model.sel, text <| "Developers (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "Developer" ] + , Html.map Sel (S.opts model.sel True False) + ] + , ul [] <| List.map (\s -> + li [] + [ inputButton "X" (Sel (S.Sel s False)) [] + , b [ class "grayedout" ] [ text <| " p" ++ String.fromInt s ++ ": " ] + , Dict.get s dat.producers |> Maybe.map (\p -> p.name) |> Maybe.withDefault "" |> text + ] + ) (Set.toList model.sel.sel) + , A.view model.conf model.search [ placeholder "Search..." ] + ] + ) diff --git a/elm/AdvSearch/Query.elm b/elm/AdvSearch/Query.elm index e504a3de..dffb50be 100644 --- a/elm/AdvSearch/Query.elm +++ b/elm/AdvSearch/Query.elm @@ -2,6 +2,8 @@ module AdvSearch.Query exposing (..) import Json.Encode as JE import Json.Decode as JD +import Dict +import Gen.Api as GApi -- Generic dynamically typed representation of a query. -- Used only as an intermediate format to help with encoding/decoding. @@ -69,5 +71,7 @@ decodeQuery = JD.index 0 JD.string |> JD.andThen (\s -> -- Global data that's passed around for Fields -- (defined here because everything imports this module) type alias Data = - { objid : Int -- Incremental integer for global identifiers + { objid : Int -- Incremental integer for global identifiers + , level : Int -- Nesting level of the field being processed + , producers : Dict.Dict Int GApi.ApiProducerResult } diff --git a/elm/AdvSearch/Set.elm b/elm/AdvSearch/Set.elm index e4f7281e..94312d13 100644 --- a/elm/AdvSearch/Set.elm +++ b/elm/AdvSearch/Set.elm @@ -84,9 +84,12 @@ fromQuery f dat q = lblPrefix m = text <| (if m.neg then "¬" else "") ++ (if m.single || Set.size m.sel == 1 then "" else if m.and then "∀ " else "∃ ") -opts m canAnd = div [ class "opts" ] - [ a [ href "#", onClickD (if canAnd then Mode else Single (not m.single)) ] - [ text <| "Mode:" ++ if m.single then "single" else if m.and then "all" else "any" ] +opts m canAnd canSingle = div [ class "opts" ] + [ a + [ href "#" + , onClickD (if canAnd && canSingle then Mode else if canSingle then Single (not m.single) else And (not m.and)) + , title <| if m.single then "Single-selection mode" else if m.and then "Entry must match all selected items" else "Entry must match at least one item" + ] [ text <| "Mode:" ++ if m.single then "single" else if m.and then "all" else "any" ] , linkRadio m.neg Neg [ text "invert" ] ] @@ -105,7 +108,7 @@ langView orig model = , \() -> [ div [ class "advheader" ] [ h3 [] [ text <| if orig then "Language the visual novel has been originally written in." else "Language(s) in which the visual novel is available." ] - , opts model (not orig) + , opts model (not orig) True ] , ul [ style "columns" "2"] <| List.map (\(l,t) -> li [] [ linkRadio (Set.member l model.sel) (Sel l) [ langIcon l, text t ] ]) GT.languages ] @@ -134,7 +137,7 @@ platformView model = , \() -> [ div [ class "advheader" ] [ h3 [] [ text "Platforms for which the visual novel is available." ] - , opts model True + , opts model True True ] , ul [ style "columns" "2"] <| List.map (\(p,t) -> li [classList [("separator", p == "web")]] [ linkRadio (Set.member p model.sel) (Sel p) [ platformIcon p, text t ] ] @@ -159,8 +162,8 @@ lengthView model = l -> span [] [ lblPrefix model, text <| "Length (" ++ String.fromInt (List.length l) ++ ")" ] , \() -> [ div [ class "advheader" ] - [ h3 [] [ text "Estimated play time" ] - , opts model False ] + [ h3 [] [ text "Length (estimated play time)" ] + , opts model False True ] , ul [] <| List.map (\(l,t) -> li [] [ linkRadio (Set.member l model.sel) (Sel l) [ text t ] ]) GT.vnLengths ] ) |