4 files changed, 101 insertions(+), 56 deletions(-)

M form.html
M src/Text/HTML/Form/WebApp.hs
M src/Text/HTML/Form/WebApp/Ginger/Hourglass.hs
M tpl/gregorian.html

@@ 17,6 17,7 @@
     <label><input type="url" name="site" />Homepage</label>
     <label><input type="number" name="numerator" />Numerator</label>
     <label><input type="range" min="1" max="42" name="denominator" />Denominator</label>
+    <label><input type="date" name="published" />Published at</label>
   </form>
 </body>
 </html>

@@ 15,8 15,10 @@ import System.Directory (XdgDirectory(..), getXdgDirectory, doesFileExist,
 import Text.HTML.Form (Form(..), Input(..))
 import Text.HTML.Form.WebApp.Ginger (template, template', resolveSource, list')
 import Text.HTML.Form.Query (renderQueryString, renderQuery')
+import Text.HTML.Form.WebApp.Ginger.Hourglass (timeData, modifyTime', timeParseOrNow,
+        gSeqTo, gPad2)
 
-import Text.Ginger.GVal as V (GVal(..), toGVal, orderedDict, (~>))
+import Text.Ginger.GVal as V (GVal(..), toGVal, orderedDict, (~>), fromFunction)
 import Text.Ginger.Html (html)
 
 type Query = [(ByteString, Maybe ByteString)]


@@ 122,6 124,24 @@ renderInput form ix input@Input { inputType = "number" } [] qs =
     template "number.html" form ix input qs
 renderInput form ix input@Input { inputType = "range" } [] qs =
     template "number.html" form ix input qs
+renderInput form ix input@Input { inputType = "date", inputName = n } [op] qs
+    | Just v <- modifyTime' op $ get n qs = do
+        -- TODO: Support other calendars
+        v' <- timeParseOrNow v
+        template' "gregorian.html" form ix input (set n (Txt.pack v) qs) $
+            \x -> case x of
+                "T" -> timeData v'
+                "seqTo" -> fromFunction $ return . gSeqTo
+                "pad2" -> fromFunction $ return . gPad2
+                _ -> toGVal ()
+    | otherwise = return Nothing
+renderInput form ix input@Input { inputType = "date", inputName = n } [] qs = do
+    v' <- timeParseOrNow $ get n qs
+    template' "gregorian.html" form ix input qs $ \x -> case x of -- TODO: Ditto
+        "T" -> timeData v'
+        "seqTo" -> fromFunction $ return . gSeqTo
+        "pad2" -> fromFunction $ return . gPad2
+        _ -> toGVal ()
 renderInput form ix input [keyboard] qs =
     renderInput form ix input [keyboard, ""] qs
 renderInput form ix input [keyboard, ""] qs | Just (Just _) <- resolveSource path =

@@ 1,7 1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Text.HTML.Form.WebApp.Ginger.Hourglass(timeData, modifyTime) where
+module Text.HTML.Form.WebApp.Ginger.Hourglass(
+    timeData, modifyTime, modifyTime', timeParseOrNow, gSeqTo, gPad2) where
 
-import Text.Ginger.GVal as V (GVal(..), toGVal, ToGVal, orderedDict, (~>))
+import Text.Ginger.GVal as V (GVal(..), toGVal, ToGVal, orderedDict, (~>), toInt)
 import Text.Ginger.Html (unsafeRawHtml)
 import Data.Hourglass
 import Time.System (localDateCurrent)


@@ 11,7 12,6 @@ import System.IO.Unsafe (unsafePerformIO) -- For use with localDateCurrent
 
 timeData :: LocalTime DateTime -> GVal a
 timeData datetime = orderedDict [
-    "epoch" ~> if dateYear date < 0 then "BCE" :: String else "CE",
     "year" ~> abs (dateYear date),
     ("month", enumG $ dateMonth date),
     "date" ~> dateDay date,


@@ 25,7 25,7 @@ timeData datetime = orderedDict [
     ("minute", enumG $ todMin $ dtTime $ localTimeUnwrap datetime),
     ("second", enumG $ todSec $ dtTime $ localTimeUnwrap datetime),
     ("nano", showG unwrapNanos $ todNSec $ dtTime $ localTimeUnwrap datetime),
-    ("timezone", showG timezoneOffsetToMinutes $ localTimeGetTimezone datetime),
+    ("zone", showG timezoneOffsetToMinutes $ localTimeGetTimezone datetime),
     "daysInMonth" ~> (dateYear date `daysInMonth` dateMonth date),
     ("monthStart", toGVal $ fromEnum $ getWeekDay date { dateDay = 1 })
    ]


@@ 65,32 65,34 @@ modifyTime "-zone" time = offsetTZ time (-30) -- TODO Include a timezone databas
 modifyTime "+zone" time = offsetTZ time 30
 modifyTime "now" _ = Just $ unsafePerformIO $ localDateCurrent
 modifyTime op time
-    | Just x' <- Txt.stripPrefix "year:" op, Just x <- readMaybe $ Txt.unpack x' =
+    | Just x' <- Txt.stripPrefix "year=" op, Just x <- readMaybe $ Txt.unpack x' =
         modLTime time $ \time' -> time' { dtDate = date { dateYear = toEnum x } }
-    | Just x' <- Txt.stripPrefix "month:" op, Just x <- readMaybe $ Txt.unpack x' =
+    | Just x' <- Txt.stripPrefix "month=" op, Just x <- readMaybe $ Txt.unpack x' =
         modLTime time $ \time' -> time' { dtDate = date { dateMonth = toEnum x } }
-    | Just x' <- Txt.stripPrefix "date:" op, Just x <- readMaybe $ Txt.unpack x' =
+    | Just x' <- Txt.stripPrefix "date=" op, Just x <- readMaybe $ Txt.unpack x' =
         modLTime time $ \time' -> time' { dtDate = date { dateDay = toEnum x } }
-    | Just x' <- Txt.stripPrefix "hour:" op, Just x <- readMaybe $ Txt.unpack x' =
-        modLTime time $ \time' -> time' { dtTime = time_ { todHour = toEnum x } }
-    | Just x' <- Txt.stripPrefix "minute:" op, Just x <- readMaybe $ Txt.unpack x' =
+    | Just x' <- Txt.stripPrefix "hour=" op, Just x <- readMaybe $ Txt.unpack x' =
+        modLTime time $ \time' -> time' { dtTime = time_ {
+            todHour = toEnum x + (if isAM then 0 else 12)
+        } }
+    | Just x' <- Txt.stripPrefix "minute=" op, Just x <- readMaybe $ Txt.unpack x' =
         modLTime time $ \time' -> time' { dtTime = time_ { todMin = toEnum x } }
-    | Just x' <- Txt.stripPrefix "second:" op, Just x <- readMaybe $ Txt.unpack x' =
+    | Just x' <- Txt.stripPrefix "second=" op, Just x <- readMaybe $ Txt.unpack x' =
         modLTime time $ \time' -> time' { dtTime = time_ { todSec = toEnum x } }
-    | Just x' <- Txt.stripPrefix "nano:" op, Just x <- readMaybe $ Txt.unpack x' =
+    | Just x' <- Txt.stripPrefix "nano=" op, Just x <- readMaybe $ Txt.unpack x' =
         modLTime time $ \time' -> time' { dtTime = time_ { todNSec = NanoSeconds x } }
-    | Just x' <- Txt.stripPrefix "zone:" op, Just x <- readMaybe $ Txt.unpack x' =
+    | Just x' <- Txt.stripPrefix "zone=" op, Just x <- readMaybe $ Txt.unpack x' =
         Just $ localTimeSetTimezone (TimezoneOffset x) time
   where
     date = dtDate $ localTimeUnwrap time
     time_ = dtTime $ localTimeUnwrap time
+    isAM | todHour time_ == 24 = True
+        | todHour time_ < 12 = True
+        | otherwise = False
 -- Written this way to avoid GHC complaining about us pattern-matching too much! Blasphemy!
 modifyTime op time = case op of
     "-year" -> addPeriod' time mempty { periodYears = -1 }
     "+year" -> addPeriod' time mempty { periodYears = 1 }
-    "epoch" -> modLTime time $ \time' -> time' {
-        dtDate = (dtDate time') { dateYear = -dateYear (dtDate time') }
-      }
     "-month" -> addPeriod' time mempty { periodMonths = -1 }
     "+month" -> addPeriod' time mempty { periodMonths = 1 }
     "-date" -> addPeriod' time mempty { periodDays = -1 }


@@ 106,3 108,25 @@ offsetTZ :: Time t => LocalTime t -> Int -> Maybe (LocalTime t)
 offsetTZ time mins = Just $ localTimeSetTimezone
     (TimezoneOffset $ timezoneOffsetToMinutes (localTimeGetTimezone time) + mins)
     time
+
+modifyTime' :: Txt.Text -> String -> Maybe String
+modifyTime' op time
+    | Just ret <- modifyTime op $ unsafePerformIO $ timeParseOrNow time =
+        Just $ localTimePrint ISO8601_DateAndTime ret
+    | otherwise = Nothing
+timeParseOrNow :: String -> IO (LocalTime DateTime)
+timeParseOrNow txt = case localTimeParse ISO8601_DateAndTime txt of
+    Just ret -> return ret
+    Nothing -> localDateCurrent
+
+gSeqTo :: [(a, GVal m)] -> GVal m
+gSeqTo [(_, from), (_, to)]
+    | Just x <- toInt from, Just y <- toInt to = toGVal [x..y]
+gSeqTo [(_, from), (_, than), (_, to)]
+    | Just x <- toInt from, Just y <- toInt than, Just z <- toInt to = toGVal [x,y..z]
+gSeqTo _ = toGVal ()
+
+gPad2 :: [(a, GVal m)] -> GVal m
+gPad2 [(_, x)] | Just y <- toInt x, y < 10 = toGVal $ '0':show x
+    | Just y <- toInt x = toGVal $ show y
+gPad2 _ = toGVal ()

@@ 5,67 5,67 @@
       .multi { display: flex }
       ul.control, .multi > ul {
         display: grid;
+        gap: 5px;
         grid-template-columns: repeat(3, min-content);
         list-style-type: none;
       }
     </style>
 
-    <p><a href="-year" title="Past year">↓</a>
-        <a href="year/" title="Edit year">{{ year }}</a>
-        <a href="+year" title="Next year">↑</a>
-        <a href="epoch" title="Toggle BCE/CE">{{ epoch }}</a>
+    <p><a href="-year{{Q}}" title="Past year">↓</a>
+        <a href="year/{{Q}}" title="Edit year">{{ T.year }}</a>
+        <a href="+year{{Q}}" title="Next year">↑</a>
 
-        <a href="-month" title="Past month">↓</a>
-        {{ month }}
-        <a href="+month" title="Next month">↑</a>
+        <a href="-month{{Q}}" title="Past month">↓</a>
+        {{ T.month }}
+        <a href="+month{{Q}}" title="Next month">↑</a>
 
-        <a href="-date" title="Past day">↓</a>
-        {{ date }}
-        <a href="+date" title="Next day">↑</a>
+        <a href="-date{{Q}}" title="Past day">↓</a>
+        {{ T.date }}
+        <a href="+date{{Q}}" title="Next day">↑</a>
 
-        <a href="-hour" title="Past hour">↓</a>
-        {{ hour }}
-        <a href="+hour" title="Next hour">↑</a>
+        <a href="-hour{{Q}}" title="Past hour">↓</a>
+        {{ T.hour|pad2 }}
+        <a href="+hour{{Q}}" title="Next hour">↑</a>
         :
-        <a href="-minute" title="Past minute">↓</a>
-        {{ minute }}
-        <a href="+minute" title="Next minute">↑</a>
-        <a href="meridiem" title="Toggle AM/PM">{{ meridiem }}</a>
+        <a href="-minute{{Q}}" title="Past minute">↓</a>
+        {{ T.minute|pad2 }}
+        <a href="+minute{{Q}}" title="Next minute">↑</a>
+        <a href="meridiem{{Q}}" title="Toggle AM/PM">{{ T.meridiem }}</a>
 
-        <a href="-zone" title="Previous timezone">↓</a>
-        {{ zone }}
-        <a href="+zone" title="Next zone">↑</a></p>
-    <p><a href="now" title="Select current date & time">Now</a></a>
+        <a href="-zone{{Q}}" title="Previous timezone">↓</a>
+        {{ T.zone }}
+        <a href="+zone{{Q}}" title="Next zone">↑</a></p>
+    <p><a href="now{{Q}}" title="Select current date & time">Now</a></a>
 
     <div class="multi">
       <ul>
-        <li><a href="month:0">January</a></li>
-        <li><a href="month:1">Febuary</a></li>
-        <li><a href="month:2">March</a></li>
-        <li><a href="month:3">April</a></li>
-        <li><a href="month:4">May</a></li>
-        <li><a href="month:5">June</a></li>
-        <li><a href="month:6">July</a></li>
-        <li><a href="month:7">August</a></li>
-        <li><a href="month:8">September</a></li>
-        <li><a href="month:9">October</a></li>
-        <li><a href="month:10">November</a></li>
-        <li><a href="month:11">December</a></li>
+        <li><a href="month=0{{Q}}">January</a></li>
+        <li><a href="month=1{{Q}}">Febuary</a></li>
+        <li><a href="month=2{{Q}}">March</a></li>
+        <li><a href="month=3{{Q}}">April</a></li>
+        <li><a href="month=4{{Q}}">May</a></li>
+        <li><a href="month=5{{Q}}">June</a></li>
+        <li><a href="month=6{{Q}}">July</a></li>
+        <li><a href="month=7{{Q}}">August</a></li>
+        <li><a href="month=8{{Q}}">September</a></li>
+        <li><a href="month=9{{Q}}">October</a></li>
+        <li><a href="month=10{{Q}}">November</a></li>
+        <li><a href="month=11{{Q}}">December</a></li>
       </ul>
 
       <ul style="grid-template-columns: repeat(7, min-content)">
-        {% for i in 1|seqTo(daysInMonth) %}
-          <li {% if i == 1 %}style="grid-column: {{ monthStart }}"{% endif %}>
-            <a href="date:{{ i }}">{{ i }}</a>
+        {% for i in 1|seqTo(T.daysInMonth) %}
+          <li {% if i == 1 %}style="grid-column: {{ T.monthStart }}"{% endif %}>
+            <a href="date={{ i }}{{Q}}">{{ i }}</a>
           </li>
         {% endfor %}
       </ul>
 
       <ul>{% for i in 1|seqTo(12) %}
-        <li><a href="hour:{{ i }}">{{ i }}:{{ minute }}</a></li>
+        <li><a href="hour={{ i }}{{Q}}">{{ i|pad2 }}:{{ T.minute|pad2 }}</a></li>
       {% endfor %}</ul>
-      <ul>{% for i in 0|seqTo(60, 5) %}
-        <li><a href="minute:{{ i }}">{{ hour }}:{{ i|pad(2) }}</a></li>
+      <ul>{% for i in 0|seqTo(5, 55) %}
+        <li><a href="minute={{ i }}{{Q}}">{{ T.hour|pad2 }}:{{ i|pad2 }}</a></li>
       {% endfor %}</ul>
     </div>
 </section>{%- endblock -%}