summaryrefslogtreecommitdiff
path: root/elm/AdvSearch/Main.elm
diff options
context:
space:
mode:
Diffstat (limited to 'elm/AdvSearch/Main.elm')
-rw-r--r--elm/AdvSearch/Main.elm267
1 files changed, 267 insertions, 0 deletions
diff --git a/elm/AdvSearch/Main.elm b/elm/AdvSearch/Main.elm
new file mode 100644
index 00000000..31331692
--- /dev/null
+++ b/elm/AdvSearch/Main.elm
@@ -0,0 +1,267 @@
+module AdvSearch.Main exposing (main)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Browser
+import Set
+import Dict
+import Task
+import Browser.Dom as Dom
+import Array as Array
+import Json.Encode as JE
+import Json.Decode as JD
+import Gen.Api as GApi
+import Gen.AdvSearchSave as GASS
+import Gen.AdvSearchDel as GASD
+import Lib.Html exposing (..)
+import Lib.Api as Api
+import Lib.Ffi as Ffi
+import Lib.DropDown as DD
+import Lib.Autocomplete as A
+import AdvSearch.Lib exposing (..)
+import AdvSearch.Fields exposing (..)
+
+
+main : Program Recv Model Msg
+main = Browser.element
+ { init = \e -> (init e, Cmd.none)
+ , view = view
+ , update = update
+ , subscriptions = \m -> Sub.batch [ DD.sub m.saveDd, Sub.map Field (fieldSub m.query) ]
+ }
+
+type alias SQuery = { name: String, query: String }
+type alias Recv =
+ { uid : Maybe String
+ , labels : List { id: Int, label: String }
+ , defaultSpoil : Int
+ , saved : List SQuery
+ , error : Bool
+ , query : GApi.ApiAdvSearchQuery
+ }
+
+type SaveAct = Save | Load | Delete | Default
+
+type alias Model =
+ { query : Field
+ , qtype : QType
+ , data : Data
+ , error : Bool
+ , saved : List SQuery
+ , saveState : Api.State
+ , saveDd : DD.Config Msg
+ , saveAct : SaveAct
+ , saveName : String
+ , saveDel : Set.Set String
+ , loadQuery : Maybe String
+ }
+
+type Msg
+ = Noop
+ | Field FieldMsg
+ | SaveToggle Bool
+ | SaveAct SaveAct
+ | SaveName String
+ | SaveSave String
+ | SaveSaved SQuery GApi.Response
+ | SaveLoad String
+ | SaveDelSel String
+ | SaveDel (Set.Set String)
+ | SaveDeleted (Set.Set String) GApi.Response
+
+
+-- If the query only contains "quick" selection fields, add the remaining quick fields and sort them.
+normalize : QType -> Field -> Data -> (Field, Data)
+normalize qtype query odat =
+ let quickFromId (n,_,_) = Array.get n fields |> Maybe.map (\f -> abs f.quick) |> Maybe.withDefault 0
+ present = List.foldl (\f a -> Set.insert (quickFromId f) a) Set.empty
+ defaults pres = Array.foldl (\f (al,dat,an) ->
+ if f.qtype == qtype && f.quick > 0 && not (Set.member (abs f.quick) pres)
+ then let (ndat, nf) = fieldInit an dat
+ in (nf::al, ndat, an+1)
+ else (al,dat,an+1)
+ ) ([],odat,0) fields
+ cmp a b = compare (quickFromId a) (quickFromId b)
+ in case query of
+ (qid, qdd, FMNest qm) ->
+ let pres = present qm.fields
+ (nl, ndat, _) = defaults pres
+ nqm = { qm | fields = List.sortWith cmp (nl++qm.fields) }
+ in if Set.member 0 pres || List.length nqm.fields > 4 then (query, odat) else ((qid, qdd, FMNest nqm), ndat)
+ _ -> (query, odat)
+
+
+loadQuery : Data -> GApi.ApiAdvSearchQuery -> (QType, Field, Data)
+loadQuery odat arg =
+ let dat = { objid = 0
+ , level = 0
+ , parentTypes = Set.empty
+ , uid = odat.uid
+ , labels = odat.labels
+ , defaultSpoil = odat.defaultSpoil
+ , producers = Dict.union (Dict.fromList <| List.map (\p -> (p.id,p)) <| arg.producers) odat.producers
+ , staff = Dict.union (Dict.fromList <| List.map (\s -> (s.id,s)) <| arg.staff ) odat.staff
+ , tags = Dict.union (Dict.fromList <| List.map (\t -> (t.id,t)) <| arg.tags ) odat.tags
+ , traits = Dict.union (Dict.fromList <| List.map (\t -> (t.id,t)) <| arg.traits ) odat.traits
+ , anime = Dict.union (Dict.fromList <| List.map (\a -> (a.id,a)) <| arg.anime ) odat.anime
+ }
+ qtype =
+ case arg.qtype of
+ "v" -> V
+ "c" -> C
+ "s" -> S
+ "p" -> P
+ _ -> R
+
+ (dat2, query) = JD.decodeValue decodeQuery arg.query |> Result.toMaybe |> Maybe.withDefault (QAnd []) |> fieldFromQuery qtype dat
+
+ -- We always want the top-level query to be a Nest type.
+ addtoplvl = let (_,m) = fieldCreate -1 (Tuple.mapSecond FMNest (nestInit True qtype qtype [query] dat2)) in m
+ query2 = case query of
+ (_,_,FMNest m) -> if m.qtype == qtype then query else addtoplvl
+ _ -> addtoplvl
+ dat3 = { dat2 | objid = dat2.objid + 5 } -- +5 for the creation of query2
+
+ (query3, dat4) = normalize qtype query2 dat3
+ in (qtype, query3, dat4)
+
+
+init : Recv -> Model
+init arg =
+ let dat = { objid = 0
+ , level = 0
+ , parentTypes = Set.empty
+ , uid = arg.uid
+ , labels = (0, "Unlabeled") :: List.map (\e -> (e.id, e.label)) arg.labels
+ , defaultSpoil = arg.defaultSpoil
+ , producers = Dict.empty
+ , staff = Dict.empty
+ , tags = Dict.empty
+ , traits = Dict.empty
+ , anime = Dict.empty
+ }
+ (qtype, query, ndat) = loadQuery dat arg.query
+ in { query = query
+ , qtype = qtype
+ , data = ndat
+ , error = arg.error
+ , saved = arg.saved
+ , saveState = Api.Normal
+ , saveDd = DD.init "xsearch_save" SaveToggle
+ , saveAct = Save
+ , saveName = ""
+ , saveDel = Set.empty
+ , loadQuery = Nothing
+ }
+
+
+update : Msg -> Model -> (Model, Cmd Msg)
+update msg model =
+ case msg of
+ Noop -> (model, Cmd.none)
+ Field m ->
+ let (ndat, nm, nc) = fieldUpdate model.data m model.query
+ in ({ model | data = ndat, query = nm, error = False }, Cmd.map Field nc)
+ SaveToggle b ->
+ let act = if model.saveAct == Save && not (List.isEmpty model.saved) && fieldToQuery model.data model.query == Nothing then Load else model.saveAct
+ in ( { model | saveDd = DD.toggle model.saveDd b, saveAct = act, saveDel = Set.empty }
+ , if b && act == Save then Task.attempt (always Noop) (Dom.focus "xsearch_saveinput") else Cmd.none)
+ SaveAct n -> ({ model | saveAct = n, saveDel = Set.empty }, Cmd.none)
+ SaveName n -> ({ model | saveName = n }, Cmd.none)
+ SaveSave s ->
+ case Maybe.map encQuery (fieldToQuery model.data model.query) of
+ Just q -> ({ model | saveState = Api.Loading }, GASS.send { name = s, qtype = showQType model.qtype, query = q } (SaveSaved { name = s, query = q }) )
+ Nothing -> (model, Cmd.none)
+ SaveSaved q GApi.Success ->
+ let f rep lst = case lst of
+ (x::xs) ->
+ if x.name == q.name then q :: f True xs
+ else if not rep && x.name > q.name then q :: x :: f True xs
+ else x :: f rep xs
+ [] -> if rep then [] else [q]
+ in ({ model | saveState = Api.Normal, saveDd = DD.toggle model.saveDd False, saved = f False model.saved }, Cmd.none)
+ SaveSaved _ e -> ({ model | saveState = Api.Error e }, Cmd.none)
+ SaveLoad q -> ({ model | saveState = Api.Loading, saveDd = DD.toggle model.saveDd False, loadQuery = Just q }, Task.attempt (always Noop) (Ffi.elemCall "click" "advsubmit"))
+ SaveDelSel s -> ({ model | saveDel = (if Set.member s model.saveDel then Set.remove else Set.insert) s model.saveDel }, Cmd.none)
+ SaveDel d -> ({ model | saveState = Api.Loading }, GASD.send { qtype = showQType model.qtype, name = Set.toList d } (SaveDeleted d))
+ SaveDeleted d GApi.Success -> ({ model | saveState = Api.Normal, saveDel = Set.empty, saved = List.filter (\e -> not (Set.member e.name d)) model.saved }, Cmd.none)
+ SaveDeleted _ e -> ({ model | saveState = Api.Error e }, Cmd.none)
+
+
+saveIcon = "<svg xmlns=\"http://www.w3.org/2000/svg\" viewBox=\"0 0 24 24\"><g fill=\"none\" stroke=\"currentColor\" stroke-width=\"2\" stroke-linecap=\"round\" stroke-linejoin=\"round\"><path d=\"M19 21H5a2 2 0 0 1-2-2V5a2 2 0 0 1 2-2h11l5 5v11a2 2 0 0 1-2 2z\"></path><polyline points=\"17 21 17 13 7 13 7 21\"></polyline><polyline points=\"7 3 7 8 15 8\"></polyline></g></svg>"
+
+view : Model -> Html Msg
+view model = div [ class "xsearch" ] <|
+ let encQ = Maybe.withDefault "" <| Maybe.map encQuery (fieldToQuery model.data model.query)
+ in
+ [ input [ type_ "hidden", id "f", name "f", value (Maybe.withDefault encQ model.loadQuery) ] []
+ , input [ type_ "submit", id "advsubmit", class "hidden" ] []
+ , if model.data.uid == Nothing then text "" else div [ class "elm_dd_input elm_dd_noarrow elm_dd_rightish short" ]
+ [ DD.view model.saveDd model.saveState (span [ Ffi.innerHtml saveIcon ] []) <| \() ->
+ [ div [ class "advheader", style "min-width" "300px" ]
+ [ div [ class "opts", style "margin-bottom" "5px" ]
+ [ if model.saveAct == Save then strong [] [ text "Save" ] else a [ href "#", onClickD (SaveAct Save ) ] [ text "Save" ]
+ , if model.saveAct == Load then strong [] [ text "Load" ] else a [ href "#", onClickD (SaveAct Load ) ] [ text "Load" ]
+ , if model.saveAct == Delete then strong [] [ text "Delete" ] else a [ href "#", onClickD (SaveAct Delete ) ] [ text "Delete" ]
+ , if model.saveAct == Default then strong [] [ text "Default"] else a [ href "#", onClickD (SaveAct Default) ] [ text "Default" ]
+ ]
+ , h3 [] [ text <| case model.saveAct of
+ Save -> "Save current filter"
+ Load -> "Load filter"
+ Delete -> "Delete saved filter"
+ Default -> "Default filter" ]
+ ]
+ , case (List.filter (\e -> e.name /= "") model.saved, model.saveAct) of
+ (_, Save) ->
+ if encQ == "" then text "Nothing to save." else
+ form_ "" (SaveSave model.saveName) False
+ [ inputText "xsearch_saveinput" model.saveName SaveName [ required True, maxlength 50, placeholder "Name...", style "width" "290px" ]
+ , if model.saveName /= "" && List.any (\e -> e.name == model.saveName) model.saved
+ then text "You already have a filter by that name, click save to overwrite it."
+ else text ""
+ , submitButton "Save" model.saveState True
+ ]
+ (_, Default) ->
+ div []
+ [ p [ class "center", style "padding" "0px 5px" ] <|
+ case model.qtype of
+ V -> [ text "You can set a default filter that will be applied automatically to most listings on the site,"
+ , text " this includes the \"Random visual novel\" button, lists on the homepage, tag pages, etc."
+ , text " This feature is mainly useful to filter out tags, languages or platforms that you are not interested in seeing."
+ ]
+ R -> [ text "You can set a default filter that will be applied automatically to this release browser and the listings on the homepage."
+ , text " This feature is mainly useful to filter out tags, languages or platforms that you are not interested in seeing."
+ ]
+ _ -> [ text "You can set a default filter that will be applied automatically when you open this listing." ]
+ , br [] []
+ , case List.filter (\e -> e.name == "") model.saved of
+ [d] -> span []
+ [ inputButton "Load my default filters" (SaveLoad d.query) [style "width" "100%"]
+ , br [] []
+ , br [] []
+ , inputButton "Delete my default filters" (SaveDel (Set.fromList [""])) [style "width" "100%"]
+ ]
+ _ -> text "You don't have a default filter set."
+ , if encQ /= "" then inputButton "Save current filters as default" (SaveSave "") [ style "width" "100%" ] else text ""
+ ]
+ ([], _) -> text "You don't have any saved queries."
+ (l, Load) ->
+ div []
+ [ if encQ == "" || List.any (\e -> encQ == e.query) l
+ then text "" else text "Unsaved changes will be lost when loading a saved filter."
+ , ul [] <| List.map (\e -> li [ style "overflow" "hidden", style "text-overflow" "ellipsis" ] [ a [ href "#", onClickD (SaveLoad e.query) ] [ text e.name ] ]) l
+ ]
+ (l, Delete) ->
+ div []
+ [ ul [] <| List.map (\e -> li [ style "overflow" "hidden", style "text-overflow" "ellipsis" ] [ linkRadio (Set.member e.name model.saveDel) (always (SaveDelSel e.name)) [ text e.name ] ]) l
+ , inputButton "Delete selected" (SaveDel model.saveDel) [ disabled (Set.isEmpty model.saveDel) ]
+ ]
+ ]
+ ]
+ , Html.map Field (fieldView model.data model.query)
+ , if model.error
+ then b [] [ text "Error parsing search query. The URL was probably corrupted in some way. "
+ , text "Please report a bug if you opened this page from VNDB (as opposed to getting here from an external site)." ]
+ else text ""
+ ]
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-19 09:15:38 +0000