AdvSearch: Add character birthday filter

Only exact matches for now, and the UI's a bit ugly.
w/e it works, ship it.

4 files changed, 91 insertions, 29 deletions

diff --git a/elm/AdvSearch/Birthday.elm b/elm/AdvSearch/Birthday.elm
new file mode 100644
index 00000000..6d8ae86f
--- /dev/null
+++ b/elm/AdvSearch/Birthday.elm
@@ -0,0 +1,68 @@
+module AdvSearch.Birthday exposing (..)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Lib.Html exposing (..)
+import Lib.RDate as RDate
+import AdvSearch.Lib exposing (..)
+
+
+type alias Model =
+  { op    : Op
+  , month : Int
+  , day   : Int
+  }
+
+
+type Msg
+  = MOp Op
+  | Month Int
+  | Day Int
+
+
+update : Msg -> Model -> Model
+update msg model =
+  case msg of
+    MOp o   -> { model | op = o }
+    Month m -> { model | month = m, day = if m == 0 then 0 else model.day }
+    Day d   -> { model | day = d }
+
+
+init : Data -> (Data, Model)
+init dat = (dat,
+  { op    = Eq
+  , month = 0
+  , day   = 0
+  })
+
+
+
+toQuery : Model -> Maybe Query
+toQuery model = Just <| QTuple 14 model.op model.month model.day
+
+
+fromQuery : Data -> Query -> Maybe (Data, Model)
+fromQuery dat q =
+  case q of
+    QTuple 14 o m d -> Just (dat, { op = o, month = m, day = d })
+    _ -> Nothing
+
+
+view : Model -> (Html Msg, () -> List (Html Msg))
+view model =
+  ( text <| showOp model.op ++ " "
+      ++ (if model.month == 0 then "Unknown"
+          else List.drop (model.month-1) RDate.monthList |> List.head |> Maybe.withDefault "")
+      ++ (if model.day == 0 then "" else " - " ++ String.fromInt model.day)
+  , \() ->
+    [ div [ class "advheader", style "width" "290px" ]
+      [ h3 [] [ text "Birthday" ]
+      , div [ class "opts" ] [ inputOp True model.op MOp ]
+      ]
+    , inputSelect "" model.month Month [style "width" "128px"]
+        <| (0, "Unknown") :: List.indexedMap (\m s -> (m+1, s)) RDate.monthList
+    , if model.month == 0 then text ""
+      else inputSelect "" model.day Day [style "width" "70px"]
+        <| (0, "- day -") :: List.map (\i -> (i, String.fromInt i)) (List.range 1 31)
+    ]
+  )
diff --git a/elm/AdvSearch/Fields.elm b/elm/AdvSearch/Fields.elm
index 6c90a4f4..723634fb 100644
--- a/elm/AdvSearch/Fields.elm
+++ b/elm/AdvSearch/Fields.elm
@@ -19,6 +19,7 @@ import AdvSearch.RDate as AD
 import AdvSearch.Range as AR
 import AdvSearch.Resolution as AE
 import AdvSearch.Engine as AEng
+import AdvSearch.Birthday as AB
 import AdvSearch.Lib exposing (..)
 
 
@@ -312,6 +313,7 @@ type FieldModel
   | FMEngine     AEng.Model
   | FMTag        AG.Model
   | FMTrait      AI.Model
+  | FMBirthday   AB.Model
 
 type FieldMsg
   = FSCustom     () -- Not actually used at the moment
@@ -354,6 +356,7 @@ type FieldMsg
   | FSEngine     AEng.Msg
   | FSTag        AG.Msg
   | FSTrait      AI.Msg
+  | FSBirthday   AB.Msg
   | FToggle Bool
   | FDel       -- intercepted in nestUpdate
   | FMoveSub   -- intercepted in nestUpdate
@@ -450,6 +453,7 @@ fields =
   , n C V "Visual Novel »"
   , f C "Role"               1  FMRole        AS.init                 AS.roleFromQuery
   , f C "Age"                0  FMAge         AR.ageInit              AR.ageFromQuery
+  , f C "Birthday"           0  FMBirthday    AB.init                 AB.fromQuery
   , f C "Sex"                2  FMSex         (AS.sexInit False)      (AS.sexFromQuery False)
   , f C ""                   0  FMSex         (AS.sexInit True)       (AS.sexFromQuery True)
   , f C "Traits"             3  FMTrait       AI.init                 (AI.fromQuery -1)
@@ -549,6 +553,7 @@ fieldUpdate dat msg_ (num, dd, model) =
       (FSEngine msg,   FMEngine m)   -> mapf FMEngine FSEngine (AEng.update dat msg m)
       (FSTag msg,      FMTag m)      -> mapf FMTag FSTag     (AG.update dat msg m)
       (FSTrait msg,    FMTrait m)    -> mapf FMTrait FSTrait (AI.update dat msg m)
+      (FSBirthday msg, FMBirthday m) -> maps FMBirthday (AB.update msg m)
       (FToggle b, _) -> (dat, (num, DD.toggle dd b, model), if b then focus else Cmd.none)
       _ -> noop
 
@@ -616,6 +621,7 @@ fieldView dat (_, dd, model) =
       FMEngine m     -> f FSEngine     (AEng.view m)
       FMTag m        -> f FSTag        (AG.view dat m)
       FMTrait m      -> f FSTrait      (AI.view dat m)
+      FMBirthday m   -> f FSBirthday   (AB.view m)
       FMNest m       -> nestView dat dd m
 
 
@@ -662,6 +668,7 @@ fieldToQuery dat (_, _, model) =
     FMEngine m   -> AEng.toQuery m
     FMTag m      -> AG.toQuery m
     FMTrait m    -> AI.toQuery m
+    FMBirthday m -> AB.toQuery m
 
 
 fieldCreate : Int -> (Data,FieldModel) -> (Data,Field)
diff --git a/elm/CharEdit.elm b/elm/CharEdit.elm
index 57a870a1..8d360146 100644
--- a/elm/CharEdit.elm
+++ b/elm/CharEdit.elm
@@ -316,20 +316,7 @@ view model =
         [ b [ class "standout" ] [ text "English please!" ] ] ]
       , formField "bmonth::Birthday"
         [ inputSelect "bmonth" model.bMonth BMonth [style "width" "128px"]
-          [ ( 0, "Unknown")
-          , ( 1, "January")
-          , ( 2, "February")
-          , ( 3, "March")
-          , ( 4, "April")
-          , ( 5, "May")
-          , ( 6, "June")
-          , ( 7, "July")
-          , ( 8, "August")
-          , ( 9, "September")
-          , (10, "October")
-          , (11, "November")
-          , (12, "December")
-          ]
+          <| (0, "Unknown") :: List.indexedMap (\m s -> (m+1, s)) RDate.monthList
         , if model.bMonth == 0 then text ""
           else inputSelect "" model.bDay BDay [style "width" "70px"] <| List.map (\i -> (i, String.fromInt i)) <| List.range 1 31
         ]
diff --git a/elm/Lib/RDate.elm b/elm/Lib/RDate.elm
index f86ecea4..0c616ef5 100644
--- a/elm/Lib/RDate.elm
+++ b/elm/Lib/RDate.elm
@@ -76,20 +76,20 @@ display today d =
   in if future then b [ class "future" ] [ text fmt ] else text fmt
 
 
-monthList : List (Int, String)
+monthList : List String
 monthList =
-  [ ( 1, "Jan")
-  , ( 2, "Feb")
-  , ( 3, "Mar")
-  , ( 4, "Apr")
-  , ( 5, "May")
-  , ( 6, "Jun")
-  , ( 7, "Jul")
-  , ( 8, "Aug")
-  , ( 9, "Sep")
-  , (10, "Oct")
-  , (11, "Nov")
-  , (12, "Dec")
+  [ "1 (Jan)"
+  , "2 (Feb)"
+  , "3 (Mar)"
+  , "4 (Apr)"
+  , "5 (May)"
+  , "6 (Jun)"
+  , "7 (Jul)"
+  , "8 (Aug)"
+  , "9 (Sep)"
+  , "10 (Oct)"
+  , "11 (Nov)"
+  , "12 (Dec)"
   ]
 
 -- Input widget.
@@ -101,8 +101,8 @@ view ro permitUnknown permitToday msg =
         ++ (if permitUnknown then [(0, "Unknown")] else [])
         ++ [(99999999, "TBA")]
         ++ List.reverse (range 1980 (GT.curYear + 5) (\n -> {r|y=n}))
-      mf (m,s) = (compact (normalize {r|m=m}), String.fromInt m ++ " (" ++ s ++ ")")
-      ml = ({r|m=99} |> normalize |> compact, "- month -") :: List.map mf monthList
+      mf m s = (compact (normalize {r|m=m+1}), s)
+      ml = ({r|m=99} |> normalize |> compact, "- month -") :: List.indexedMap mf monthList
       dl = ({r|d=99} |> normalize |> compact, "- day -") :: range 1 (maxDayInMonth r.y r.m) (\n -> {r|d=n})
   in div []
     [ inputSelect "" ro msg [ style "width" "100px" ] yl