summaryrefslogtreecommitdiff
path: root/elm
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2020-11-07 10:47:04 +0100
committerYorhel <git@yorhel.nl>2020-11-07 11:01:31 +0100
commitdc34ce6828878962e016417c4bd337ddccac5d6a (patch)
treee4c25e478157cc5bc5a87021abde6962552b0adc /elm
parent8ec2900f12be852ef9ec0e4d3152c6b73ee28592 (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.elm38
-rw-r--r--elm/AdvSearch/Main.elm23
-rw-r--r--elm/AdvSearch/Producers.elm94
-rw-r--r--elm/AdvSearch/Query.elm6
-rw-r--r--elm/AdvSearch/Set.elm17
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
]
)