AdvSearch: Add staff & seiyuu search

Ended up doing this slightly different from producer/developer search.
Instead of only allowing direct ID lookups, staff is handled as a
subquery type which also happens to have an ID filter. This allows
searching for things like "staff has an English person" or "female
characters voiced by male seiyuu".

(Some of these queries are slow...)

6 files changed, 177 insertions, 9 deletions

diff --git a/elm/AdvSearch/Fields.elm b/elm/AdvSearch/Fields.elm
index 5b1e1a02..384f4e9a 100644
--- a/elm/AdvSearch/Fields.elm
+++ b/elm/AdvSearch/Fields.elm
@@ -10,6 +10,7 @@ import Lib.Api as Api
 import Lib.Autocomplete as A
 import AdvSearch.Set as AS
 import AdvSearch.Producers as AP
+import AdvSearch.Staff as AT
 import AdvSearch.Tags as AG
 import AdvSearch.Traits as AI
 import AdvSearch.RDate as AD
@@ -100,6 +101,8 @@ nestToQuery dat model =
   in case (model.ptype, model.qtype) of
       (V,  R) -> wrap (QQuery 50 op)
       (V,  C) -> wrap (QQuery 51 op)
+      (V,  S) -> wrap (QQuery 52 op)
+      (C,  S) -> wrap (QQuery 52 op)
       _       -> wrap identity
 
 
@@ -121,6 +124,8 @@ nestFromQuery ptype qtype dat q =
   in case (ptype, qtype, q) of
        (V, R, QQuery 50 op r) -> initSub op r
        (V, C, QQuery 51 op r) -> initSub op r
+       (V, S, QQuery 52 op r) -> initSub op r
+       (C, S, QQuery 52 op r) -> initSub op r
        (_, _, QAnd l) -> if ptype == qtype then Just (init True  l) else Nothing
        (_, _, QOr  l) -> if ptype == qtype then Just (init False l) else Nothing
        _ -> Nothing
@@ -145,13 +150,15 @@ nestView dat dd model =
           [ h3 [] [ text "Add filter" ]
           , div [ class "opts" ] <|
             let opts = case model.qtype of
-                        V -> [ V, R, C ]
-                        C -> []
+                        V -> [ V, R, C, S ]
+                        C -> [ C, S ]
                         R -> []
+                        S -> []
                 f t = case t of
                        V -> "VN"
                        R -> "Release"
                        C -> "Character"
+                       S -> if model.ptype == C then "Seiyuu" else "Staff"
             in List.map (\t -> if t == model.addtype then b [] [ text (f t) ] else a [ href "#", onClickD (FSNest <| NAddType t) ] [ text (f t) ]) opts
           ]
         , let lst = Array.toIndexedList fields |> List.filter (\(_,f) -> f.qtype == model.addtype && f.title /= "")
@@ -174,16 +181,24 @@ nestView dat dd model =
 
     negcont () =
       let (a,b) =
-            case model.qtype of
-              C -> ("Has a character that matches these filters", "Does not have a character that matches these filters")
-              R -> ("Has a release that matches these filters", "Does not have a release that matches these filters")
+            case (model.ptype, model.qtype) of
+              (_, C) -> ("Has a character that matches these filters", "Does not have a character that matches these filters")
+              (_, R) -> ("Has a release that matches these filters", "Does not have a release that matches these filters")
+              (V, S) -> ("Has staff that matches these filters", "Does not have staff that matches these filters")
+              (C, S) -> ("Has a voice actor that matches these filters", "Does not have a voice actor that matches these filters")
               _ -> ("","")
       in [ ul []
         [ li [] [ linkRadio (not model.neg) (FSNest << NNeg False) [ text a ] ]
         , li [] [ linkRadio (    model.neg) (FSNest << NNeg True ) [ text b ] ]
         ] ]
 
-    neglbl = text <| (if model.neg then "¬" else "") ++ if model.qtype == C then "Char" else "Rel"
+    neglbl = text <| (if model.neg then "¬" else "") ++
+      case (model.ptype, model.qtype) of
+        (_, C) -> "Char"
+        (_, R) -> "Rel"
+        (V, S) -> "Staff"
+        (C, S) -> "Seiyuu"
+        _ -> ""
 
     ourdd =
       if model.qtype == model.ptype
@@ -240,6 +255,7 @@ type FieldModel
   | FMRole       (AS.Model String)
   | FMBlood      (AS.Model String)
   | FMSex        (AS.SexModel)
+  | FMGender     (AS.Model String)
   | FMMedium     (AS.Model String)
   | FMVoiced     (AS.Model Int)
   | FMAniEro     (AS.Model Int)
@@ -259,6 +275,7 @@ type FieldModel
   | FMMinAge     (AR.Model Int)
   | FMDeveloper  AP.Model
   | FMProducer   AP.Model
+  | FMStaff      AT.Model
   | FMRDate      AD.Model
   | FMResolution AE.Model
   | FMEngine     AEng.Model
@@ -277,6 +294,7 @@ type FieldMsg
   | FSRole       (AS.Msg String)
   | FSBlood      (AS.Msg String)
   | FSSex        AS.SexMsg
+  | FSGender     (AS.Msg String)
   | FSMedium     (AS.Msg String)
   | FSVoiced     (AS.Msg Int)
   | FSAniEro     (AS.Msg Int)
@@ -296,6 +314,7 @@ type FieldMsg
   | FSMinAge     AR.Msg
   | FSDeveloper  AP.Msg
   | FSProducer   AP.Msg
+  | FSStaff      AT.Msg
   | FSRDate      AD.Msg
   | FSResolution AE.Msg
   | FSEngine     AEng.Msg
@@ -329,6 +348,8 @@ fields =
       l qtype title quick lst =
         f qtype title quick FMList (\d -> (d, { val = 0, lst = lst }))
           (\d q -> List.indexedMap (\n (k,v) -> (n,k,v)) lst |> List.filter (\(n,k,_) -> k == q) |> List.head |> Maybe.map (\(n,_,_) -> (d, { val = n, lst = lst })))
+
+      staffInit t dat = let (ndat, n) = fieldCreate -1 (Tuple.mapSecond FMStaff (AT.init dat)) in nestInit True t S [n] ndat
   in Array.fromList
   -- IMPORTANT: This list is processed in reverse order when reading a Query
   -- into Fields, so "catch all" fields must be listed first. In particular,
@@ -338,6 +359,7 @@ fields =
   [ f V ""                   0  FMNest        (nestInit True V V [])  (nestFromQuery V V) -- and/or's
   , f R ""                   0  FMNest        (nestInit True V R [])  (nestFromQuery R R)
   , f C ""                   0  FMNest        (nestInit True C C [])  (nestFromQuery C C)
+  , f S ""                   0  FMNest        (nestInit True S S [])  (nestFromQuery S S)
 
   , f V "Language"           1  FMLang        AS.init                 AS.langFromQuery
   , f V "Original language"  2  FMOLang       AS.init                 AS.olangFromQuery
@@ -349,6 +371,7 @@ fields =
   , f V "My Labels"          0  FMLabel       AS.init                 AS.labelFromQuery
   , f V "Length"             0  FMLength      AS.init                 AS.lengthFromQuery
   , f V "Developer"          0  FMDeveloper   AP.init                 (AP.fromQuery False)
+  , f V "Staff"              0  FMNest        (staffInit V)           (nestFromQuery V S)
   , f V "Release date"       0  FMRDate       AD.init                 AD.fromQuery
   , f V "Popularity"         0  FMPopularity  AR.popularityInit       AR.popularityFromQuery
   , f V "Rating"             0  FMRating      AR.ratingInit           AR.ratingFromQuery
@@ -394,6 +417,11 @@ fields =
   , f C "Waist"              0  FMWaist       AR.waistInit            AR.waistFromQuery
   , f C "Hips"               0  FMHips        AR.hipsInit             AR.hipsFromQuery
   , f C "Cup size"           0  FMCup         AR.cupInit              AR.cupFromQuery
+  , f C "Seiyuu"             0  FMNest        (staffInit C)           (nestFromQuery C S) -- seiyuu subtype
+
+  , f S "ID"                 0  FMStaff       AT.init                 AT.fromQuery
+  , f S "Language"           1  FMLang        AS.init                 AS.langFromQuery
+  , f S "Gender"             2  FMGender      AS.init                 AS.genderFromQuery
   ]
 
 
@@ -411,6 +439,7 @@ fieldUpdate dat msg_ (num, dd, model) =
           FMTrait      m -> Cmd.map FSTrait      (A.refocus m.conf)
           FMDeveloper  m -> Cmd.map FSDeveloper  (A.refocus m.conf)
           FMProducer   m -> Cmd.map FSProducer   (A.refocus m.conf)
+          FMStaff      m -> Cmd.map FSStaff      (A.refocus m.conf)
           FMResolution m -> Cmd.map FSResolution (A.refocus m.conf)
           FMEngine     m -> Cmd.map FSEngine     (A.refocus m.conf)
           _ -> Cmd.none
@@ -443,6 +472,7 @@ fieldUpdate dat msg_ (num, dd, model) =
       (FSRole msg,     FMRole m)     -> maps FMRole     (AS.update msg m)
       (FSBlood msg,    FMBlood m)    -> maps FMBlood    (AS.update msg m)
       (FSSex msg,      FMSex m)      -> maps FMSex      (AS.sexUpdate msg m)
+      (FSGender msg,   FMGender m)   -> maps FMGender   (AS.update msg m)
       (FSMedium msg,   FMMedium m)   -> maps FMMedium   (AS.update msg m)
       (FSVoiced msg,   FMVoiced m)   -> maps FMVoiced   (AS.update msg m)
       (FSAniEro msg,   FMAniEro m)   -> maps FMAniEro   (AS.update msg m)
@@ -461,7 +491,8 @@ fieldUpdate dat msg_ (num, dd, model) =
       (FSVotecount msg,FMVotecount m)-> maps FMVotecount (AR.update msg m)
       (FSMinAge msg   ,FMMinAge m)   -> maps FMMinAge   (AR.update msg m)
       (FSDeveloper msg,FMDeveloper m)-> mapf FMDeveloper FSDeveloper (AP.update dat msg m)
-      (FSProducer msg, FMProducer m) -> mapf FMProducer  FSProducer (AP.update dat msg m)
+      (FSProducer msg, FMProducer m) -> mapf FMProducer  FSProducer  (AP.update dat msg m)
+      (FSStaff msg,    FMStaff m)    -> mapf FMStaff     FSStaff     (AT.update dat msg m)
       (FSRDate msg,    FMRDate m)    -> maps FMRDate    (AD.update msg m)
       (FSResolution msg,FMResolution m)->mapf FMResolution FSResolution (AE.update dat msg m)
       (FSEngine msg,   FMEngine m)   -> mapf FMEngine FSEngine (AEng.update dat msg m)
@@ -505,6 +536,7 @@ fieldView dat (_, dd, model) =
       FMRole m       -> f FSRole       (AS.roleView m)
       FMBlood m      -> f FSBlood      (AS.bloodView m)
       FMSex m        -> f FSSex        (AS.sexView m)
+      FMGender m     -> f FSGender     (AS.genderView m)
       FMMedium m     -> f FSMedium     (AS.mediumView m)
       FMVoiced m     -> f FSVoiced     (AS.voicedView m)
       FMAniEro m     -> f FSAniEro     (AS.animatedView False m)
@@ -524,6 +556,7 @@ fieldView dat (_, dd, model) =
       FMMinAge m     -> f FSMinAge     (AR.minageView m)
       FMDeveloper m  -> f FSDeveloper  (AP.view False dat m)
       FMProducer m   -> f FSProducer   (AP.view True dat m)
+      FMStaff m      -> f FSStaff      (AT.view dat m)
       FMRDate m      -> f FSRDate      (AD.view m)
       FMResolution m -> f FSResolution (AE.view m)
       FMEngine m     -> f FSEngine     (AEng.view m)
@@ -546,6 +579,7 @@ fieldToQuery dat (_, _, model) =
     FMRole m     -> AS.toQuery (QStr 2) m
     FMBlood m    -> AS.toQuery (QStr 3) m
     FMSex (s,m)  -> AS.toQuery (QStr (if s then 5 else 4)) m
+    FMGender m   -> AS.toQuery (QStr 4) m
     FMMedium m   -> AS.toQuery (QStr 11) m
     FMVoiced m   -> AS.toQuery (QInt 12) m
     FMAniEro m   -> AS.toQuery (QInt 13) m
@@ -565,6 +599,7 @@ fieldToQuery dat (_, _, model) =
     FMMinAge m   -> AR.toQuery (QInt 10) (QStr 10) m
     FMDeveloper m-> AP.toQuery False m
     FMProducer m -> AP.toQuery True m
+    FMStaff m    -> AT.toQuery m
     FMRDate m    -> AD.toQuery m
     FMResolution m-> AE.toQuery m
     FMEngine m   -> AEng.toQuery m
diff --git a/elm/AdvSearch/Lib.elm b/elm/AdvSearch/Lib.elm
index e65af61c..c1d252d8 100644
--- a/elm/AdvSearch/Lib.elm
+++ b/elm/AdvSearch/Lib.elm
@@ -11,7 +11,7 @@ import Gen.Api as GApi
 -- Generic dynamically typed representation of a query.
 -- Used only as an intermediate format to help with encoding/decoding.
 -- Corresponds to the compact JSON form.
-type QType = V | R | C
+type QType = V | R | C | S
 type Op = Eq | Ne | Ge | Gt | Le | Lt
 type Query
   = QAnd (List Query)
@@ -167,6 +167,7 @@ type alias Data =
   , labels       : List (Int, String)
   , defaultSpoil : Int
   , producers    : Dict.Dict Int GApi.ApiProducerResult
+  , staff        : Dict.Dict Int GApi.ApiStaffResult
   , tags         : Dict.Dict Int GApi.ApiTagResult
   , traits       : Dict.Dict Int GApi.ApiTraitResult
   }
diff --git a/elm/AdvSearch/Main.elm b/elm/AdvSearch/Main.elm
index 28303a2d..e707a2a8 100644
--- a/elm/AdvSearch/Main.elm
+++ b/elm/AdvSearch/Main.elm
@@ -29,6 +29,7 @@ type alias Recv =
   , labels       : List { id: Int, label: String }
   , defaultSpoil : Int
   , producers    : List GApi.ApiProducerResult
+  , staff        : List GApi.ApiStaffResult
   , tags         : List GApi.ApiTagResult
   , traits       : List GApi.ApiTraitResult
   }
@@ -80,6 +81,7 @@ init arg =
             , labels       = (0, "Unlabeled") :: List.map (\e -> (e.id, e.label)) arg.labels
             , defaultSpoil = arg.defaultSpoil
             , producers    = Dict.fromList <| List.map (\p -> (p.id,p)) <| arg.producers
+            , staff        = Dict.fromList <| List.map (\s -> (s.id,s)) <| arg.staff
             , tags         = Dict.fromList <| List.map (\t -> (t.id,t)) <| arg.tags
             , traits       = Dict.fromList <| List.map (\t -> (t.id,t)) <| arg.traits
             }
diff --git a/elm/AdvSearch/Set.elm b/elm/AdvSearch/Set.elm
index a3000a3b..e44574f4 100644
--- a/elm/AdvSearch/Set.elm
+++ b/elm/AdvSearch/Set.elm
@@ -228,7 +228,7 @@ bloodFromQuery = fromQuery (\q ->
 
 
 
--- Sex / gender
+-- Character sex
 
 type alias SexModel = (Bool, Model String)
 
@@ -268,6 +268,29 @@ sexView (spoil,model) =
 
 
 
+-- Staff gender
+
+genderView model =
+  ( case Set.toList model.sel of
+      []  -> b [ class "grayedout" ] [ text "Gender" ]
+      [v] -> span [ class "nowrap" ] [ lblPrefix model, text <| Maybe.withDefault "" (lookup v GT.genders) ]
+      l   -> span [] [ lblPrefix model, text <| "Gender (" ++ String.fromInt (List.length l) ++ ")" ]
+  , \() ->
+    [ div [ class "advheader" ]
+      [ h3 [] [ text "Gender" ]
+      , opts model False True ]
+    , ul [] <| List.map (\(k,l) -> li [] [ if k == "b" then text "" else linkRadio (Set.member k model.sel) (Sel k) [ text l ] ]) GT.genders
+    ]
+  )
+
+genderFromQuery = fromQuery (\q ->
+  case q of
+    QStr 4 op v -> Just (op, v)
+    _ -> Nothing)
+
+
+
+
 -- Release medium
 
 mediumView model =
diff --git a/elm/AdvSearch/Staff.elm b/elm/AdvSearch/Staff.elm
new file mode 100644
index 00000000..eec3c86c
--- /dev/null
+++ b/elm/AdvSearch/Staff.elm
@@ -0,0 +1,93 @@
+module AdvSearch.Staff 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.Lib exposing (..)
+import AdvSearch.Set as S
+
+
+
+type alias Model =
+  { sel    : S.Model Int
+  , conf   : A.Config Msg GApi.ApiStaffResult
+  , search : A.Model GApi.ApiStaffResult
+  }
+
+type Msg
+  = Sel (S.Msg Int)
+  | Search (A.Msg GApi.ApiStaffResult)
+
+
+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_staff" ++ String.fromInt ndat.objid, source = A.staffSource }
+        , 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 s ->
+            if Set.member s.id model.sel.sel then (dat, { model | search = nm }, c)
+            else ( { dat | staff = Dict.insert s.id s dat.staff }
+                 , { model | search = A.clear nm "", sel = S.update (S.Sel s.id True) model.sel }
+                 , c )
+
+
+toQuery m = S.toQuery (QInt 3) m.sel
+
+fromQuery dat qf = S.fromQuery (\q ->
+  case q of
+    QInt 3 op v -> Just (op, v)
+    _ -> Nothing) dat qf
+  |> Maybe.map (\(ndat,sel) ->
+    ( { ndat | objid = ndat.objid+1 }
+    , { sel    = { sel | single = False }
+      , conf   = { wrap = Search, id = "advsearch_staff" ++ String.fromInt ndat.objid, source = A.staffSource }
+      , search = A.init ""
+      }
+    ))
+
+
+
+view : Data -> Model -> (Html Msg, () -> List (Html Msg))
+view dat model =
+  ( case Set.toList model.sel.sel of
+      []  -> b [ class "grayedout" ] [ text "ID" ]
+      [s] -> span [ class "nowrap" ]
+             [ S.lblPrefix model.sel
+             , b [ class "grayedout" ] [ text <| "s" ++ String.fromInt s ++ ":" ]
+             , Dict.get s dat.staff |> Maybe.map (\e -> e.name) |> Maybe.withDefault "" |> text
+             ]
+      l   -> span [] [ S.lblPrefix model.sel, text <| "IDs (" ++ String.fromInt (List.length l) ++ ")" ]
+  , \() ->
+    [ div [ class "advheader" ]
+      [ h3 [] [ text "Staff identifier" ]
+      , Html.map Sel (S.opts model.sel True False)
+      ]
+    , ul [] <| List.map (\s ->
+        li [ style "overflow" "hidden", style "text-overflow" "ellipsis" ]
+        [ inputButton "X" (Sel (S.Sel s False)) []
+        , b [ class "grayedout" ] [ text <| " s" ++ String.fromInt s ++ ": " ]
+        , Dict.get s dat.staff |> Maybe.map (\e -> e.name) |> Maybe.withDefault "" |> text
+        ]
+      ) (Set.toList model.sel.sel)
+    , A.view model.conf model.search [ placeholder "Search..." ]
+    ]
+  )
diff --git a/lib/VNWeb/AdvSearch.pm b/lib/VNWeb/AdvSearch.pm
index ff0bc0fc..e1adfdfa 100644
--- a/lib/VNWeb/AdvSearch.pm
+++ b/lib/VNWeb/AdvSearch.pm
@@ -328,6 +328,7 @@ f v => 12 => 'label',    { type => 'any', func => \&_validate_label },
 
 f v => 50 => 'release',  'r', '=' => sub { sql 'v.id IN(SELECT rv.vid FROM releases r JOIN releases_vn rv ON rv.id = r.id WHERE NOT r.hidden AND', $_, ')' };
 f v => 51 => 'character','c', '=' => sub { sql 'v.id IN(SELECT cv.vid FROM chars c JOIN chars_vns cv ON cv.id = c.id WHERE NOT c.hidden AND', $_, ')' }; # TODO: Spoiler setting?
+f v => 52 => 'staff',    's', '=' => sub { sql 'v.id IN(SELECT vs.id FROM vn_staff vs JOIN staff_alias sa ON sa.aid = vs.aid JOIN staff s ON s.id = sa.id WHERE NOT s.hidden AND', $_, ')' };
 
 
 
@@ -391,6 +392,15 @@ f c => 13 => 'trait',      { type => 'any', func => \&_validate_trait },
     compact => sub { my $id = ($_->[0] =~ s/^i//r)*1; $_->[1] == 0 ? $id : [ $id, int $_->[1] ] },
     sql_list => \&_sql_where_trait;
 
+# TODO: SQL is different when not used as a subquery in VN search (no vs.id comparison)
+f c => 52 => 'seiyuu',    's', '=' => sub { sql 'c.id IN(SELECT vs.cid FROM vn_seiyuu vs JOIN staff_alias sa ON sa.aid = vs.aid JOIN staff s ON s.id = sa.id WHERE NOT s.hidden AND vs.id = v.id AND', $_, ')' };
+
+
+
+f s =>  2 => 'lang',      { enum => \%LANGUAGE }, '=' => sub { sql 's.lang =', \$_ };
+f s =>  3 => 'id',        { vndbid => 's' }, '=' => sub { sql 's.id = vndbid_num(', \$_, ')' };
+f s =>  4 => 'gender',    { enum => \%GENDER }, '=' => sub { sql 's.gender =', \$_ };
+
 
 
 
@@ -647,6 +657,9 @@ sub elm_ {
     $o{producers} = [ map +{id => $_=~s/^p//rg}, grep /^p/, keys %ids ];
     enrich_merge id => 'SELECT id, name, original, hidden FROM producers WHERE id IN', $o{producers};
 
+    $o{staff} = [ map +{id => $_=~s/^s//rg}, grep /^s/, keys %ids ];
+    enrich_merge id => 'SELECT s.id, sa.aid, sa.name, sa.original FROM staff s JOIN staff_alias sa ON sa.aid = s.aid WHERE s.id IN', $o{staff};
+
     $o{tags} = [ map +{id => $_=~s/^g//rg}, grep /^g/, keys %ids ];
     enrich_merge id => 'SELECT id, name, searchable, applicable, state FROM tags WHERE id IN', $o{tags};
 
@@ -667,6 +680,7 @@ sub elm_ {
         labels       => { aoh => { id => { uint => 1 }, label => {} } },
         defaultSpoil => { uint => 1 },
         producers    => $VNWeb::Elm::apis{ProducerResult}[0],
+        staff        => $VNWeb::Elm::apis{StaffResult}[0],
         tags         => $VNWeb::Elm::apis{TagResult}[0],
         traits       => $VNWeb::Elm::apis{TraitResult}[0],
     }});