2 files changed, 15 insertions(+), 0 deletions(-)

M src/Text/HTML/Form/WebApp.hs
M src/Text/HTML/Form/WebApp/Ginger/Hourglass.hs

@@ 33,6 33,13 @@ renderPage _ _ _ = return Nothing
 renderInput :: Form -> Int -> Input -> [Text] -> [(ByteString, Maybe ByteString)] ->
     IO (Maybe (Either Query Text))
 renderInput form ix input [""] qs = renderInput form ix input [] qs
+renderInput form ix input@Input { inputType = "date", inputName = name } ["year", p] qs
+    | Just t <- modifyTime' (Txt.pack $ "year/" ++ Txt.unpack p) $ get name qs = do
+        t' <- timeParseOrNow t
+        template' "cal/year-numpad.html" form ix input (set name (Txt.pack t) qs) $
+            \prop -> case prop of
+                "T" -> timeData t'
+                _ -> toGVal ()
 renderInput form ix input@Input { multiple = True } [p] qs
     | '=':v' <- Txt.unpack p,
             (utf8 $ inputName input, Just $ utf8' v') `Prelude.elem` qs =

@@ 83,6 83,14 @@ modifyTime op time
         modLTime time $ \time' -> time' { dtTime = time_ { todNSec = NanoSeconds x } }
     | Just x' <- Txt.stripPrefix "zone=" op, Just x <- readMaybe $ Txt.unpack x' =
         Just $ localTimeSetTimezone (TimezoneOffset x) time
+    | Just x' <- Txt.stripPrefix "year/:" op, Just x <- readMaybe $ Txt.unpack x' =
+        modLTime time $ \time' -> time' {
+            dtDate = date { dateYear = dateYear date * 10 + x }
+          }
+    | "year/-" <- op = modLTime time $ \time' -> time' {
+            dtDate = date { dateYear = dateYear date `div` 10 }
+          }
+    | "year/" <- op = Just time -- Noop, allow viewer.
   where
     date = dtDate $ localTimeUnwrap time
     time_ = dtTime $ localTimeUnwrap time