Advsearch: Add platform & length fields

4 files changed, 202 insertions, 138 deletions

diff --git a/elm/AdvSearch/Fields.elm b/elm/AdvSearch/Fields.elm
index d7049df7..80e31ba0 100644
--- a/elm/AdvSearch/Fields.elm
+++ b/elm/AdvSearch/Fields.elm
@@ -2,52 +2,13 @@ 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 (..)
-import Lib.Util exposing (..)
-import Gen.Types as GT
+import AdvSearch.Set as AS
 import AdvSearch.Query exposing (..)
 
 
--- TODO: Actual field implementations should be moved into a separate module
-
-langView orig model =
-  let tprefix = if orig then "O " else "L "
-      prefix = tprefix ++ if model.neg then "¬" else ""
-  in
-  ( case Set.toList model.sel of
-      []  -> b [ class "grayedout" ] [ text <| if orig then "Orig language" else "Language" ]
-      [v] -> span [ class "nowrap" ] [ text prefix, langIcon v, text <| Maybe.withDefault "" (lookup v GT.languages) ]
-      l   -> span [ class "nowrap" ] <| text prefix :: text (if model.and then "∀ " else "∃ ") :: List.intersperse (text "") (List.map langIcon l)
-  , \() ->
-    [ 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." ]
-      , div [ class "opts" ]
-        [ a [ href "#", onClickD (if orig then SetSingle (not model.single) else SetMode) ]
-          [ text <| "Mode:" ++ if model.single then "single" else if model.and then "all" else "any" ]
-        , linkRadio model.neg SetNeg [ text "invert" ]
-        ]
-      ]
-    , ul [ style "columns" "2"] <| List.map (\(l,t) -> li [] [ linkRadio (Set.member l model.sel) (SetSel l) [ langIcon l, text t ] ]) GT.languages
-    ]
-  )
-
-langFromQuery = setFromQuery (\q ->
-  case q of
-    QStr "lang" op v -> Just (op, v)
-    _ -> Nothing)
-
-olangFromQuery = setFromQuery (\q ->
-  case q of
-    QStr "olang" op v -> Just (op, v)
-    _ -> Nothing)
-
-
-
-
 -- Generic field abstraction.
 -- (this is where typeclasses would have been *awesome*)
 --
@@ -60,13 +21,17 @@ type alias Field = (Int, DD.Config FieldMsg, FieldModel) -- The Int is the index
 
 type FieldModel
   = FMCustom Query -- A read-only placeholder for Query values that failed to parse into a Field
-  | FMLang (SetModel String)
-  | FMOLang (SetModel String)
+  | FMLang     (AS.Model String)
+  | FMOLang    (AS.Model String)
+  | FMPlatform (AS.Model String)
+  | FMLength   (AS.Model Int)
 
 type FieldMsg
-  = FSCustom () -- Not actually used at the moment
-  | FSLang (SetMsg String)
-  | FSOLang (SetMsg String)
+  = FSCustom   () -- Not actually used at the moment
+  | FSLang     (AS.Msg String)
+  | FSOLang    (AS.Msg String)
+  | FSPlatform (AS.Msg String)
+  | FSLength   (AS.Msg Int)
   | FToggle Bool
 
 type FieldType = V
@@ -85,9 +50,11 @@ 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
+  --  T TITLE               QUICK     WRAP        INIT     FROM_QUERY
+  [ f V "Language"          (Just 1)  FMLang      AS.init  AS.langFromQuery
+  , 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
   -- Custom field not included, that's only ever initialized in fqueryFromQuery
   ]
 
@@ -97,8 +64,10 @@ fieldUpdate : FieldMsg -> Field -> (Field, Cmd FieldMsg)
 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)
+      (FSLang  msg,    FMLang  m)    -> map1 FMLang     (AS.update msg m)
+      (FSOLang msg,    FMOLang m)    -> map1 FMOLang    (AS.update msg m)
+      (FSPlatform msg, FMPlatform m) -> map1 FMPlatform (AS.update msg m)
+      (FSLength msg,   FMLength m)   -> map1 FMLength   (AS.update msg m)
       (FToggle b, _) -> ((num, DD.toggle dd b, model), Cmd.none)
       _ -> ((num, dd, model), Cmd.none)
 
@@ -107,17 +76,21 @@ fieldView : Field -> Html FieldMsg
 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
-      FMLang  m -> v FSLang  (langView False m)
-      FMOLang m -> v FSOLang (langView True  m)
+      FMCustom m   -> v FSCustom   (text "Unrecognized query", \() -> [text ""]) -- TODO: Display the Query
+      FMLang  m    -> v FSLang     (AS.langView False m)
+      FMOLang m    -> v FSOLang    (AS.langView True  m)
+      FMPlatform m -> v FSPlatform (AS.platformView m)
+      FMLength m   -> v FSLength   (AS.lengthView m)
 
 
 fieldToQuery : Field -> Maybe Query
 fieldToQuery (_, _, model) =
   case model of
-    FMCustom m -> Just m
-    FMLang  m -> setToQuery (QStr "lang" ) m
-    FMOLang m -> setToQuery (QStr "olang") m
+    FMCustom m   -> Just m
+    FMLang  m    -> AS.toQuery (QStr "lang" ) m
+    FMOLang m    -> AS.toQuery (QStr "olang") m
+    FMPlatform m -> AS.toQuery (QStr "platform") m
+    FMLength m   -> AS.toQuery (QInt "length") m
 
 
 fieldInit : Int -> Int -> Field
diff --git a/elm/AdvSearch/Query.elm b/elm/AdvSearch/Query.elm
index 60a20d1b..b2ea12ac 100644
--- a/elm/AdvSearch/Query.elm
+++ b/elm/AdvSearch/Query.elm
@@ -1,6 +1,5 @@
 module AdvSearch.Query exposing (..)
 
-import Set
 import Json.Encode as JE
 import Json.Decode as JD
 
@@ -64,80 +63,3 @@ decodeQuery = JD.index 0 JD.string |> JD.andThen (\s ->
       , JD.map2 (QQuery s) (JD.index 1 decodeOp) (JD.index 2 decodeQuery)
       ]
    )
-
-
-
-
--- Helper functions for Set-like filters
-
-type alias SetModel a =
-  { sel    : Set.Set a
-  , single : Bool
-  , and    : Bool
-  , neg    : Bool
-  , last   : Set.Set a -- Last selection before switching to single mode, if there were multiple items selected
-  }
-
-type SetMsg a
-  = SetSel a Bool
-  | SetNeg Bool
-  | SetAnd Bool
-  | SetSingle Bool
-  | SetMode -- Toggle between single / multi (or) / multi (and)
-
-
-setInit : SetModel a
-setInit = { sel = Set.empty, single = True, and = False, neg = False, last = Set.empty }
-
-
-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 -> 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
-setToQuery : (Op -> a -> Query) -> SetModel a -> Maybe Query
-setToQuery f m =
-  case (m.neg, m.and, Set.toList m.sel) of
-    (_,_,[])  -> Nothing
-    (n,_,[v]) -> Just (f (if n then Ne else Eq) v)
-    (False, False, l) -> Just <| QOr  <| List.map (\v -> f Eq v) l
-    (True , False, l) -> Just <| QAnd <| List.map (\v -> f Ne v) l
-    (False, True , l) -> Just <| QAnd <| List.map (\v -> f Eq v) l
-    (True , True , l) -> Just <| QOr  <| List.map (\v -> f Ne v) l
-
-
--- Only recognizes queries generated by setToQuery, doesn't handle alternative query structures.
--- Usage:
---   setFromQuery (\q -> case q of
---                         QStr "lang" op v -> Just (op, v)
---                         _ -> Nothing) model
-setFromQuery : (Query -> Maybe (Op,comparable)) -> Query -> Maybe (SetModel comparable)
-setFromQuery f q =
-  let single and qs = f qs |> Maybe.andThen (\(op,v) ->
-        if op /= Ne && op /= Eq
-        then Nothing
-        else Just { sel = Set.fromList [v], and = xor and (op == Ne), neg = (op == Ne), single = True, last = Set.empty })
-      lst mm xqs =
-        case (mm, xqs) of
-          (Nothing, _) -> Nothing
-          (_, [])      -> mm
-          (Just m, x :: xs) -> f x |> Maybe.andThen (\(op,v) ->
-            if (op /= Ne && op /= Eq) || (op == Ne) /= m.neg
-            then Nothing
-            else lst (Just {m | single = False, sel = Set.insert v m.sel}) xs)
-  in case q of
-      QAnd (x::xs) -> lst (single True  x) xs
-      QOr  (x::xs) -> lst (single False x) xs
-      _ -> single False q
diff --git a/elm/AdvSearch/Set.elm b/elm/AdvSearch/Set.elm
new file mode 100644
index 00000000..48f5f6a0
--- /dev/null
+++ b/elm/AdvSearch/Set.elm
@@ -0,0 +1,168 @@
+module AdvSearch.Set exposing (..)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Set
+import Lib.Html exposing (..)
+import Lib.Util exposing (..)
+import Gen.Types as GT
+import AdvSearch.Query exposing (..)
+
+
+type alias Model a =
+  { sel    : Set.Set a
+  , single : Bool
+  , and    : Bool
+  , neg    : Bool
+  , last   : Set.Set a -- Last selection before switching to single mode, if there were multiple items selected
+  }
+
+type Msg a
+  = Sel a Bool
+  | Neg Bool
+  | And Bool
+  | Single Bool
+  | Mode -- Toggle between single / multi (or) / multi (and)
+
+
+init : Model a
+init = { sel = Set.empty, single = True, and = False, neg = False, last = Set.empty }
+
+
+update : Msg comparable -> Model comparable -> Model comparable
+update 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
+    Sel 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 }
+    Neg b    -> { model | neg = b }
+    And b    -> { model | and = b }
+    Single b -> singleMode { model | single = b }
+    Mode     -> singleMode { model | single = not model.single && model.and, and = not model.single && not model.and }
+
+
+toQuery : (Op -> a -> Query) -> Model a -> Maybe Query
+toQuery f m =
+  case (m.neg, m.and, Set.toList m.sel) of
+    (_,_,[])  -> Nothing
+    (n,_,[v]) -> Just (f (if n then Ne else Eq) v)
+    (False, False, l) -> Just <| QOr  <| List.map (\v -> f Eq v) l
+    (True , False, l) -> Just <| QAnd <| List.map (\v -> f Ne v) l
+    (False, True , l) -> Just <| QAnd <| List.map (\v -> f Eq v) l
+    (True , True , l) -> Just <| QOr  <| List.map (\v -> f Ne v) l
+
+
+-- Only recognizes queries generated by setToQuery, doesn't handle alternative query structures.
+-- Usage:
+--   setFromQuery (\q -> case q of
+--                         QStr "lang" op v -> Just (op, v)
+--                         _ -> Nothing) model
+fromQuery : (Query -> Maybe (Op,comparable)) -> Query -> Maybe (Model comparable)
+fromQuery f q =
+  let single and qs = f qs |> Maybe.andThen (\(op,v) ->
+        if op /= Ne && op /= Eq
+        then Nothing
+        else Just { sel = Set.fromList [v], and = xor and (op == Ne), neg = (op == Ne), single = True, last = Set.empty })
+      lst mm xqs =
+        case (mm, xqs) of
+          (Nothing, _) -> Nothing
+          (_, [])      -> mm
+          (Just m, x :: xs) -> f x |> Maybe.andThen (\(op,v) ->
+            if (op /= Ne && op /= Eq) || (op == Ne) /= m.neg
+            then Nothing
+            else lst (Just {m | single = False, sel = Set.insert v m.sel}) xs)
+  in case q of
+      QAnd (x::xs) -> lst (single True  x) xs
+      QOr  (x::xs) -> lst (single False x) xs
+      _ -> single False 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" ]
+  , linkRadio m.neg Neg [ text "invert" ]
+  ]
+
+
+
+
+-- Language
+
+langView orig model =
+  let tprefix = if orig then "O " else "L "
+  in
+  ( case Set.toList model.sel of
+      []  -> b [ class "grayedout" ] [ text <| if orig then "Orig language" else "Language" ]
+      [v] -> span [ class "nowrap" ] [ lblPrefix model, langIcon v, text <| Maybe.withDefault "" (lookup v GT.languages) ]
+      l   -> span [ class "nowrap" ] <| lblPrefix model :: List.intersperse (text "") (List.map langIcon l)
+  , \() ->
+    [ 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)
+      ]
+    , ul [ style "columns" "2"] <| List.map (\(l,t) -> li [] [ linkRadio (Set.member l model.sel) (Sel l) [ langIcon l, text t ] ]) GT.languages
+    ]
+  )
+
+langFromQuery = fromQuery (\q ->
+  case q of
+    QStr "lang" op v -> Just (op, v)
+    _ -> Nothing)
+
+olangFromQuery = fromQuery (\q ->
+  case q of
+    QStr "olang" op v -> Just (op, v)
+    _ -> Nothing)
+
+
+
+
+-- Platform
+
+platformView model =
+  ( case Set.toList model.sel of
+      []  -> b [ class "grayedout" ] [ text "Platform" ]
+      [v] -> span [ class "nowrap" ] [ lblPrefix model, platformIcon v, text <| Maybe.withDefault "" (lookup v GT.platforms) ]
+      l   -> span [ class "nowrap" ] <| lblPrefix model :: List.intersperse (text "") (List.map langIcon l)
+  , \() ->
+    [ div [ class "advheader" ]
+      [ h3 [] [ text "Platforms for which the visual novel is available." ]
+      , opts model True
+      ]
+    , ul [ style "columns" "2"] <| List.map (\(p,t) -> li [] [ linkRadio (Set.member p model.sel) (Sel p) [ platformIcon p, text t ] ]) GT.platforms
+    ]
+  )
+
+platformFromQuery = fromQuery (\q ->
+  case q of
+    QStr "platform" op v -> Just (op, v)
+    _ -> Nothing)
+
+
+
+
+-- Length
+
+lengthView model =
+  ( case Set.toList model.sel of
+      []  -> b [ class "grayedout" ] [ text "Length" ]
+      [v] -> span [ class "nowrap" ] [ lblPrefix model, text <| Maybe.withDefault "" (lookup v GT.vnLengths) ]
+      l   -> span [] [ lblPrefix model, text <| "Length (" ++ String.fromInt (List.length l) ++ ")" ]
+  , \() ->
+    [ div [ class "advheader" ]
+      [ opts model False ]
+    , ul [] <| List.map (\(l,t) -> li [] [ linkRadio (Set.member l model.sel) (Sel l) [ text t ] ]) GT.vnLengths
+    ]
+  )
+
+lengthFromQuery = fromQuery (\q ->
+  case q of
+    QInt "length" op v -> Just (op, v)
+    _ -> Nothing)
diff --git a/lib/VNWeb/AdvSearch.pm b/lib/VNWeb/AdvSearch.pm
index b6b1354a..7496a221 100644
--- a/lib/VNWeb/AdvSearch.pm
+++ b/lib/VNWeb/AdvSearch.pm
@@ -65,9 +65,10 @@ sub f {
     $fields{$t}{$n} = \%f;
 }
 
-f 'v', 'lang',  { enum => \%LANGUAGE }, '=' => sub { sql 'v.c_languages && ARRAY', \$_, '::language[]' };
-f 'v', 'olang', { enum => \%LANGUAGE }, '=' => sub { sql 'v.c_olang     && ARRAY', \$_, '::language[]' };
-f 'v', 'plat',  { enum => \%PLATFORM }, '=' => sub { sql 'v.c_platforms && ARRAY', \$_, '::platform[]' };
+f 'v', 'lang',     { enum => \%LANGUAGE }, '=' => sub { sql 'v.c_languages && ARRAY', \$_, '::language[]' };
+f 'v', 'olang',    { enum => \%LANGUAGE }, '=' => sub { sql 'v.c_olang     && ARRAY', \$_, '::language[]' };
+f 'v', 'platform', { enum => \%PLATFORM }, '=' => sub { sql 'v.c_platforms && ARRAY', \$_, '::platform[]' };
+f 'v', 'length',   { uint => 1, enum => \%VN_LENGTH }, '=' => sub { sql 'v.length =', \$_ };
 
 
 
@@ -121,7 +122,7 @@ sub coerce_for_json {
         coerce_for_json($t, $_) for @$q[1..$#$q];
     } else {
         my $f = $fields{$t}{$q->[0]};
-        ()= $f->{int} ? $q->[2]*1 : ref $f->{value} ? "$q->[2]" : coerce_for_json($t, $q->[2]);
+        $q->[2] = $f->{int} ? int $q->[2] : ref $f->{value} ? "$q->[2]" : coerce_for_json($t, $q->[2]);
     }
     $q
 }