Advsearch: Add quick select field list normalization

There we go, we have a useful search system again.

3 files changed, 110 insertions, 42 deletions

diff --git a/elm/AdvSearch/Fields.elm b/elm/AdvSearch/Fields.elm
index dfaa125a..00cb9cdd 100644
--- a/elm/AdvSearch/Fields.elm
+++ b/elm/AdvSearch/Fields.elm
@@ -3,6 +3,7 @@ module AdvSearch.Fields exposing (..)
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Set
+import Array as A
 import Lib.DropDown as DD
 import Lib.Api as Api
 import Lib.Html exposing (..)
@@ -44,14 +45,14 @@ olangFromQuery = setFromQuery (\q ->
 
 
 -- Generic field abstraction.
--- (this is where typeclasses would been *awesome*)
+-- (this is where typeclasses would have been *awesome*)
 --
 -- The following functions and definitions are only intended to provide field
 -- listings and function dispatchers, if the implementation of anything in here
 -- is longer than a single line, it should get its own definition near where
 -- the rest of that field is defined.
 
-type alias Field = (DD.Config FieldMsg, FieldModel)
+type alias Field = (Int, DD.Config FieldMsg, FieldModel) -- The Int is the index into 'fields'
 
 type FieldModel
   = FMCustom Query -- A read-only placeholder for Query values that failed to parse into a Field
@@ -64,20 +65,42 @@ type FieldMsg
   | FSOLang (SetMsg String)
   | FToggle Bool
 
+type FieldType = V
+
+type alias FieldDesc =
+  { ftype     : FieldType
+  , title     : String                     -- How it's listed in the advanced search field selection menu (must be unique for the given ftype).
+  , quick     : Maybe Int                  -- Whether it should be included in the quick search mode and in which order.
+  , init      : FieldModel                 -- How to initialize an empty field
+  , fromQuery : Query -> Maybe FieldModel  -- How to initialize the field from a query
+  }
+
+
+-- XXX: Should this be lazily initialized instead? May impact JS load time like this.
+fields : A.Array FieldDesc
+fields =
+  let f ftype title quick wrap init fromq = { ftype = ftype, title = title, quick = quick, init = wrap init, fromQuery = Maybe.map wrap << fromq }
+  in A.fromList
+  --  T TITLE               QUICK     WRAP      INIT     FROM_QUERY
+  [ f V "Language"          (Just 1)  FMLang    setInit  langFromQuery
+  , f V "Original language" (Just 2)  FMOLang   setInit  olangFromQuery
+  -- Custom field not included, that's only ever initialized in fqueryFromQuery
+  ]
+
 
 -- XXX: This needs a 'data' argument for global data such as a tag info cache
 fieldUpdate : FieldMsg -> Field -> (Field, Cmd FieldMsg)
-fieldUpdate msg_ (dd, model) =
-  let map1 f m = ((dd, (f m)), Cmd.none)
+fieldUpdate msg_ (num, dd, model) =
+  let map1 f m = ((num, dd, (f m)), Cmd.none)
   in case (msg_, model) of
       (FSLang  msg, FMLang  m) -> map1 FMLang  (setUpdate msg m)
       (FSOLang msg, FMOLang m) -> map1 FMOLang (setUpdate msg m)
-      (FToggle b, _) -> ((DD.toggle dd b, model), Cmd.none)
-      _ -> ((dd, model), Cmd.none)
+      (FToggle b, _) -> ((num, DD.toggle dd b, model), Cmd.none)
+      _ -> ((num, dd, model), Cmd.none)
 
 
 fieldView : Field -> Html FieldMsg
-fieldView (dd, model) =
+fieldView (_, dd, model) =
   let v f (lbl,cont) = div [ class "elm_dd_input" ] [ DD.view dd Api.Normal (Html.map f lbl) <| \() -> List.map (Html.map f) (cont ()) ]
   in case model of
       FMCustom m -> v FSCustom (text "Unrecognized query", \() -> [text ""]) -- TODO: Display the Query
@@ -86,28 +109,29 @@ fieldView (dd, model) =
 
 
 fieldToQuery : Field -> Maybe Query
-fieldToQuery (_, model) =
+fieldToQuery (_, _, model) =
   case model of
     FMCustom m -> Just m
     FMLang  m -> setToQuery (QStr "lang" ) m
     FMOLang m -> setToQuery (QStr "olang") m
 
 
-fieldFromQueryList =
-  let f wrap conv = \q -> Maybe.map wrap (conv q)
-  in [ f FMLang  langFromQuery
-     , f FMOLang olangFromQuery
-     ]
+fieldInit : Int -> Int -> Field
+fieldInit n ddid =
+  case A.get n fields of
+    Just f -> (n, DD.init ("advsearch_field" ++ String.fromInt ddid) FToggle, f.init)
+    Nothing -> (-1, DD.init "" FToggle, FMCustom (QAnd [])) -- Shouldn't happen.
+
 
-fieldFromQuery : Int -> Query -> Maybe Field
-fieldFromQuery ddid q =
-  let match lst =
-        case lst of
-          [] -> Nothing
-          (x::xs) -> case x q of
-                      Just m -> Just (DD.init ("advsearch_field" ++ String.fromInt ddid) FToggle, m)
-                      Nothing -> match xs
-  in match fieldFromQueryList
+fieldFromQuery : FieldType -> Int -> Query -> Maybe Field
+fieldFromQuery ftype ddid q =
+  Tuple.first <| A.foldl (\f a ->
+    let inc = Tuple.mapSecond (\n -> n+1) a
+    in if Tuple.first a /= Nothing || f.ftype /= ftype then inc
+       else case f.fromQuery q of
+             Nothing -> inc
+             Just m -> (Just (Tuple.second a, DD.init ("advsearch_field" ++ String.fromInt ddid) FToggle, m), 0)
+  ) (Nothing,0) fields
 
 
 
@@ -151,16 +175,16 @@ fqueryToQuery fq =
 
 
 -- This algorithm is kind of slow. It walks the Query tree and tries every possible Field for each Query found.
-fqueryFromQuery : Int -> Query -> (Int, FQuery)
-fqueryFromQuery ddid q =
-  let lst wrap l = Tuple.mapSecond wrap <| List.foldr (\oq (did,nl) -> let (ndid, fq) = fqueryFromQuery did oq in (ndid, fq::nl)) (ddid,[]) l
-  in case fieldFromQuery ddid q of
+fqueryFromQuery : FieldType -> Int -> Query -> (Int, FQuery)
+fqueryFromQuery ftype ddid q =
+  let lst wrap l = Tuple.mapSecond wrap <| List.foldr (\oq (did,nl) -> let (ndid, fq) = fqueryFromQuery ftype did oq in (ndid, fq::nl)) (ddid,[]) l
+  in case fieldFromQuery ftype ddid q of
       Just fq -> (ddid+1, FField fq)
       Nothing ->
         case q of
           QAnd l -> lst FAnd l
           QOr  l -> lst FOr  l
-          _      -> (ddid+1, FField (DD.init ("advsearch_field" ++ String.fromInt ddid) FToggle, FMCustom q))
+          _      -> (ddid+1, FField (-1, DD.init ("advsearch_field" ++ String.fromInt ddid) FToggle, FMCustom q))
 
 
 -- Update a node at the given path (unused)
@@ -194,8 +218,8 @@ fqueryGet path q =
     [] -> Just q
     x::xs ->
       case q of
-        FAnd l -> List.drop x l |> List.head |> Maybe.andThen (fqueryGet path)
-        FOr  l -> List.drop x l |> List.head |> Maybe.andThen (fqueryGet path)
+        FAnd l -> List.drop x l |> List.head |> Maybe.andThen (fqueryGet xs)
+        FOr  l -> List.drop x l |> List.head |> Maybe.andThen (fqueryGet xs)
         _ -> Nothing
 
 
@@ -204,4 +228,4 @@ fquerySub path wrap q =
   case q of
     FAnd l -> Sub.batch <| List.indexedMap (\i -> fquerySub (i::path) wrap) l
     FOr  l -> Sub.batch <| List.indexedMap (\i -> fquerySub (i::path) wrap) l
-    FField f -> Sub.map (wrap (List.reverse path)) <| DD.sub <| Tuple.first f
+    FField (_,dd,_) -> Sub.map (wrap (List.reverse path)) (DD.sub dd)
diff --git a/elm/AdvSearch/Main.elm b/elm/AdvSearch/Main.elm
index 91977ff2..56352b6d 100644
--- a/elm/AdvSearch/Main.elm
+++ b/elm/AdvSearch/Main.elm
@@ -4,6 +4,8 @@ import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
 import Browser
+import Set
+import Array as A
 import Json.Encode as JE
 import Json.Decode as JD
 import AdvSearch.Query exposing (..)
@@ -21,18 +23,59 @@ main = Browser.element
 
 type alias Model =
   { query : FQuery
+  , ftype : FieldType
+  , ddid  : Int
   }
 
+type Msg
+  = Field (List Int) FieldMsg
+
+
+-- Add "default" set of filters if they aren't present yet and sort the list
+normalizeForQuick : Model -> Model
+normalizeForQuick model =
+  let present = List.foldr (\f a ->
+          case f of
+            FField (n,_,_) -> Set.insert n a
+            _ -> a
+        ) Set.empty
+      defaults pres = A.foldl (\f (al,did,an) ->
+          if f.ftype == model.ftype && f.quick /= Nothing && not (Set.member an pres)
+          then (FField (fieldInit an did) :: al, did+1, an+1)
+          else (al,did,an+1)
+        ) ([],model.ddid,0) fields
+      cmp a b =
+        case (a,b) of -- Sort active filters before empty ones, then order by 'quick', fallback to title
+          (FField (an,add,am), FField (bn,bdd,bm)) ->
+            let aq = fieldToQuery (an,add,am) /= Nothing
+                bq = fieldToQuery (bn,bdd,bm) /= Nothing
+                af = A.get an fields
+                bf = A.get bn fields
+                ao = Maybe.andThen (\d -> d.quick) af |> Maybe.withDefault 9999
+                bo = Maybe.andThen (\d -> d.quick) bf |> Maybe.withDefault 9999
+                at = Maybe.map (\d -> d.title) af |> Maybe.withDefault ""
+                bt = Maybe.map (\d -> d.title) bf |> Maybe.withDefault ""
+            in if aq && not bq then LT else if not aq && bq then GT
+               else if ao /= bo then compare ao bo else compare at bt
+          _ -> EQ
+      norm l =
+        let (nl,did,_) = defaults (present l)
+        in { model | query = FAnd (List.sortWith cmp (nl++l)), ddid = did }
+  in case model.query of
+      FAnd   l -> norm l
+      FField f -> norm [FField f]
+      _ -> model
+
 
 init : JE.Value -> Model
 init arg =
-  -- TODO: Sort and add (empty) fields for quick select mode, it's kind of useless like this
-  { query = JD.decodeValue decodeQuery arg |> Result.toMaybe |> Maybe.map (Tuple.second << fqueryFromQuery 1) |> Maybe.withDefault (FAnd [])
+  let (ddid, query) = JD.decodeValue decodeQuery arg |> Result.toMaybe |> Maybe.map (fqueryFromQuery V 1) |> Maybe.withDefault (0, FAnd [])
+  in normalizeForQuick
+  { query = query
+  , ftype = V
+  , ddid  = ddid
   }
 
-type Msg
-  = Field (List Int) FieldMsg
-
 
 update : Msg -> Model -> (Model, Cmd Msg)
 update msg model =
diff --git a/elm/AdvSearch/Query.elm b/elm/AdvSearch/Query.elm
index c4bbe0bf..60a20d1b 100644
--- a/elm/AdvSearch/Query.elm
+++ b/elm/AdvSearch/Query.elm
@@ -92,17 +92,18 @@ setInit = { sel = Set.empty, single = True, and = False, neg = False, last = Set
 
 setUpdate : SetMsg comparable -> SetModel comparable -> SetModel comparable
 setUpdate msg model =
+  let singleMode m =
+        { m | sel = if m.single then Set.fromList <| List.take 1 <| Set.toList m.sel
+                    else if model.single && not m.single && not (Set.isEmpty model.last) then m.last
+                    else m.sel
+            , last = if m.single && not model.single && Set.size m.sel > 1 then m.sel else Set.empty }
+  in
   case msg of
     SetSel v b  -> { model | last = Set.empty, sel = if not b then Set.remove v model.sel else if model.single then Set.fromList [v] else Set.insert v model.sel }
     SetNeg b    -> { model | neg = b }
     SetAnd b    -> { model | and = b }
-    SetSingle b -> { model | single = b }
-    SetMode     ->
-      let m = { model | single = not model.single && model.and, and = not model.single && not model.and }
-      in  { m | sel = if m.single then Set.fromList <| List.take 1 <| Set.toList m.sel
-                      else if model.single && not m.single && not (Set.isEmpty model.last) then m.last
-                      else m.sel
-              , last = if m.single && not model.single && Set.size m.sel > 1 then m.sel else Set.empty }
+    SetSingle b -> singleMode { model | single = b }
+    SetMode     -> singleMode { model | single = not model.single && model.and, and = not model.single && not model.and }
 
 
 -- Usage: setToQuery (QStr "lang") model