Advsearch: Initial experiments with a new advanced search

Doing this on the main branch to make it easier to get early testing and
feedback. Not like I have anything worth testing now, but it's not like
this code is getting in the way of anything else.

(Unless the changes broke something unrelated, in which case it's extra
good to get that early testing)

4 files changed, 259 insertions, 1 deletions

diff --git a/elm/AdvSearch/Main.elm b/elm/AdvSearch/Main.elm
new file mode 100644
index 00000000..abd8017c
--- /dev/null
+++ b/elm/AdvSearch/Main.elm
@@ -0,0 +1,125 @@
+module AdvSearch.Main exposing (main)
+
+-- TODO: This is a quick'n'dirty proof of concept, most of the functionality in
+-- here needs to be abstracted so that we can query more than just the
+-- language field.
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Browser
+import Set
+import Json.Encode as JE
+import Json.Decode as JD
+import Lib.DropDown as DD
+import Lib.Api as Api
+import Lib.Html exposing (..)
+import Lib.Util exposing (..)
+import Gen.Types as GT
+import AdvSearch.Query exposing (..)
+
+main : Program JE.Value Model Msg
+main = Browser.element
+  { init   = \e -> (init e, Cmd.none)
+  , view   = view
+  , update = update
+  , subscriptions = \m -> DD.sub m.langDd
+  }
+
+
+type alias Model =
+  { langSel  : Set.Set String
+  , langDd   : DD.Config Msg
+  , langAnd  : Bool
+  , langNeg  : Bool
+  }
+
+
+init : JE.Value -> Model
+init v = JD.decodeValue decodeQuery v |> Result.toMaybe |> Maybe.andThen query2Model |> Maybe.withDefault
+  { langSel  = Set.empty
+  , langDd   = DD.init "adv_lang" LangToggle
+  , langAnd  = False
+  , langNeg  = False
+  }
+
+
+model2Query : Model -> Maybe Query
+model2Query m =
+  case (m.langNeg, m.langAnd, Set.toList m.langSel) of
+    (_,_,[])  -> Nothing
+    (n,_,[v]) -> Just <| QStr "lang" (if n then Ne else Eq) v
+    (False, False, l) -> Just <| QOr  <| List.map (\v -> QStr "lang" Eq v) l
+    (True , False, l) -> Just <| QAnd <| List.map (\v -> QStr "lang" Ne v) l
+    (False, True , l) -> Just <| QAnd <| List.map (\v -> QStr "lang" Eq v) l
+    (True , True , l) -> Just <| QOr  <| List.map (\v -> QStr "lang" Ne v) l
+
+
+-- Only recognizes queries generated with model2Query, doesn't handle alternative query structures.
+query2Model : Query -> Maybe Model
+query2Model q =
+  let m and neg l = Just { langSel = Set.fromList l, langAnd = xor neg and, langNeg = neg, langDd = DD.init "adv_lang" LangToggle }
+      single and qs =
+        case qs of
+          QStr "lang" Eq v -> m and False [v]
+          QStr "lang" Ne v -> m and True  [v]
+          _ -> Nothing
+      lst and qs xqs =
+        case (qs, xqs) of
+          (_, []) -> single and qs
+          (QStr "lang" op _, QStr "lang" opn v :: xs) -> if op /= opn then Nothing else Maybe.map (\model -> { model | langSel = Set.insert v model.langSel }) (lst and qs xs)
+          _ -> Nothing
+  in case q of
+      QAnd (x::xs) -> lst True  x xs
+      QOr  (x::xs) -> lst False x xs
+      _ -> single False q
+
+
+type Msg
+  = LangToggle Bool
+  | LangSel String Bool
+  | LangAnd Bool
+  | LangNeg Bool
+
+update : Msg -> Model -> (Model, Cmd Msg)
+update msg model =
+  case msg of
+    LangToggle b -> ({ model | langDd = DD.toggle model.langDd b }, Cmd.none)
+    LangSel s b  -> ({ model | langSel = if b then Set.insert s model.langSel else Set.remove s model.langSel }, Cmd.none)
+    LangAnd b    -> ({ model | langAnd = b }, Cmd.none)
+    LangNeg b    -> ({ model | langNeg = b }, Cmd.none)
+
+
+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)) (model2Query model) ] []
+  , div [ class "quickselect" ]
+    [ div [ class "elm_dd_input" ]
+      [ DD.view model.langDd Api.Normal
+        (case Set.size model.langSel of
+          0 -> b [ class "grayedout" ] [ text "Language" ]
+          1 -> text <| Maybe.withDefault "" <| lookup (Set.toList model.langSel |> List.head |> Maybe.withDefault "") GT.languages
+          n -> text <| "Language (" ++ String.fromInt n ++ ")")
+         <| \() -> -- TODO: Styling & single-selection mode
+           [ div []
+             [ linkRadio model.langAnd LangAnd [ text "and" ]
+             , text " / "
+             , linkRadio (not model.langAnd) (\b -> LangAnd (not b)) [ text "or" ]
+             ]
+           , div []
+             [ linkRadio (not model.langNeg) (\b -> LangNeg (not b)) [ text "include" ]
+             , text " / "
+             , linkRadio model.langNeg LangNeg [ text "exclude" ]
+             ]
+           , ul [ style "columns" "2"] <| List.map (\(l,t) -> li [] [ linkRadio (Set.member l model.langSel) (LangSel l) [ langIcon l, text t ] ]) GT.languages
+           ]
+      ]
+    , input [ type_ "button", class "submit", value "Advanced mode" ] [] -- TODO: Advanced mode where you can construct arbitrary queries.
+    , input [ type_ "submit", class "submit", value "Search" ] []
+    ]
+  , pre []
+    [ text <| Maybe.withDefault "" <| Maybe.map (\v -> JE.encode 2 (encodeQuery v)) (model2Query model)
+    , br [] [], br [] []
+    , text <| Maybe.withDefault "" <| Maybe.map (\v -> JE.encode 2 (encodeQuery v)) <| Maybe.andThen (\nm -> model2Query nm) <| Maybe.andThen (\q -> query2Model q) (model2Query model)
+    ]
+  ]
diff --git a/elm/AdvSearch/Query.elm b/elm/AdvSearch/Query.elm
new file mode 100644
index 00000000..b2ea12ac
--- /dev/null
+++ b/elm/AdvSearch/Query.elm
@@ -0,0 +1,65 @@
+module AdvSearch.Query exposing (..)
+
+import Json.Encode as JE
+import Json.Decode as JD
+
+-- Generic dynamically typed representation of a query.
+-- Used only as an intermediate format to help with encoding/decoding.
+type Op = Eq | Ne | Ge | Le
+type Query
+  = QAnd (List Query)
+  | QOr (List Query)
+  | QInt String Op Int
+  | QStr String Op String
+  | QQuery String Op Query
+
+
+encodeOp : Op -> JE.Value
+encodeOp o = JE.string <|
+  case o of
+    Eq -> "="
+    Ne -> "!="
+    Ge -> ">="
+    Le -> "<="
+
+encodeQuery : Query -> JE.Value
+encodeQuery q =
+  case q of
+    QAnd l -> JE.list identity (JE.string "and" :: List.map encodeQuery l)
+    QOr  l -> JE.list identity (JE.string "or"  :: List.map encodeQuery l)
+    QInt   s o a -> JE.list identity [JE.string s, encodeOp o, JE.int a]
+    QStr   s o a -> JE.list identity [JE.string s, encodeOp o, JE.string a]
+    QQuery s o a -> JE.list identity [JE.string s, encodeOp o, encodeQuery a]
+
+
+
+-- Drops the first item in the list, decodes the rest
+decodeQList : JD.Decoder (List Query)
+decodeQList =
+  let dec l = List.map (JD.decodeValue decodeQuery) (List.drop 1 l) -- [Result Query]
+      f v r = Result.andThen (\a -> Result.map (\e -> (e::a)) v) r -- Result Query -> Result [Query] -> Result [Query]
+      res l = case List.foldr f (Ok []) (dec l) of  -- Decoder [Query]
+                Err e -> JD.fail (JD.errorToString e)
+                Ok v  -> JD.succeed v
+  in JD.list JD.value |> JD.andThen res -- [Value]
+
+decodeOp : JD.Decoder Op
+decodeOp = JD.string |> JD.andThen (\s ->
+  case s of
+    "="  -> JD.succeed Eq
+    "!=" -> JD.succeed Ne
+    ">=" -> JD.succeed Ge
+    "<=" -> JD.succeed Le
+    _    -> JD.fail "Invalid operator")
+
+decodeQuery : JD.Decoder Query
+decodeQuery = JD.index 0 JD.string |> JD.andThen (\s ->
+   case s of
+     "and" -> JD.map QAnd decodeQList
+     "or"  -> JD.map QOr decodeQList
+     _ -> JD.oneOf
+      [ JD.map2 (QInt s  ) (JD.index 1 decodeOp) (JD.index 2 JD.int)
+      , JD.map2 (QStr s  ) (JD.index 1 decodeOp) (JD.index 2 JD.string)
+      , JD.map2 (QQuery s) (JD.index 1 decodeOp) (JD.index 2 decodeQuery)
+      ]
+   )
diff --git a/elm/AdvSearch/Set.elm b/elm/AdvSearch/Set.elm
new file mode 100644
index 00000000..1320036d
--- /dev/null
+++ b/elm/AdvSearch/Set.elm
@@ -0,0 +1,68 @@
+-- Attempt to abstract away a single widget for set-style selections.
+
+module AdvSearch.Set exposing (..)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Set
+import Lib.DropDown as DD
+import Lib.Api as Api
+import Lib.Html exposing (..)
+import Lib.Util exposing (..)
+import Gen.Types as GT
+
+
+type alias Model a =
+  { sel    : Set.Set a
+  , dd     : DD.Config (Msg a)
+  , and    : Bool
+  , neg    : Bool
+  }
+
+type Msg a
+  = Toggle Bool
+  | Sel a Bool
+  | And Bool
+  | Neg Bool
+
+
+init : Bool -> String -> Model a
+init id =
+  { sel = Set.empty
+  , dd  = DD.init id Toggle
+  , and = False
+  , neg = False
+  }
+
+update : Msg a -> Model a -> (Model a, Cmd (Msg a))
+update msg model =
+  case msg of
+    Toggle b -> ({ model | dd = DD.toggle model.dd b }, Cmd.none)
+    Sel s b  -> ({ model | sel = if b then Set.insert s model.sel else Set.remove s model.sel }, Cmd.none)
+    And b    -> ({ model | and = b }, Cmd.none)
+    Neg b    -> ({ model | neg = b }, Cmd.none)
+
+
+view : Bool -> String -> List a -> (a -> List (Html (Msg a))) -> Model a -> Html (Msg a)
+view canAnd ddLabel items itemView model = div [ class "elm_dd_input" ]
+  [ DD.view model.dd Api.Normal
+    (case Set.size model.sel of
+      0 -> b [ class "grayedout" ] [ text ddLabel ]
+      1 -> span [] (Set.toList model.sel |> List.head |> Maybe.map itemView |> Maybe.withDefault [])
+      n -> text <| ddLabel ++ " (" ++ String.fromInt n ++ ")")
+     <| \() -> -- TODO: Styling
+       [ if not canAnd then text "" else div []
+         [ linkRadio model.and And [ text "and" ]
+         , text " / "
+         , linkRadio (not model.and) (\b -> And (not b)) [ text "or" ]
+         ]
+       , div []
+         [ linkRadio (not model.neg) (\b -> Neg (not b)) [ text "include" ]
+         , text " / "
+         , linkRadio model.neg Neg [ text "exclude" ]
+         ]
+       --, ul [ style "columns" "2"] <| List.map (\(l,t) -> li [] [ linkRadio (Set.member l model.langSel) (LangSel l) [ langIcon l, text t ] ]) GT.languages
+       , ul [ style "columns" "2"] <| List.map (\l -> li [] [ linkRadio (Set.member l model.sel) (Sel l) (itemView l) ]) items
+       ]
+  ]
diff --git a/elm/Lib/DropDown.elm b/elm/Lib/DropDown.elm
index 1e6204ac..3de02f11 100644
--- a/elm/Lib/DropDown.elm
+++ b/elm/Lib/DropDown.elm
@@ -64,5 +64,5 @@ view conf status lbl cont =
       Api.Loading -> [ lbl, span [] [ span [ class "spinner" ] [] ] ]
       Api.Error e -> [ b [ class "standout" ] [ text "error" ], span [] [ i [] [ text "▾" ] ] ]
   , div [ classList [("hidden", not conf.opened)] ]
-    <| if conf.opened then cont () else [ text "" ]
+    [ if conf.opened then div [] (cont ()) else text "" ]
   ]