From 547de9d70601c69f5c57b03230bdac4565e0f206 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Thu, 23 Nov 2023 17:18:45 +1300 Subject: [PATCH] Add support for variations upon the date input! --- src/Text/HTML/Form/WebApp.hs | 34 +++++++++++-------- src/Text/HTML/Form/WebApp/Ginger/Hourglass.hs | 3 +- tpl/gregorian.html | 18 ++++++++++ 3 files changed, 39 insertions(+), 16 deletions(-) diff --git a/src/Text/HTML/Form/WebApp.hs b/src/Text/HTML/Form/WebApp.hs index b98fb5b..0e80b91 100644 --- a/src/Text/HTML/Form/WebApp.hs +++ b/src/Text/HTML/Form/WebApp.hs @@ -32,24 +32,28 @@ renderPage form [] _ = return $ Just $ Right $ Txt.concat [ "Start!"] renderPage _ _ _ = return Nothing +isCalType :: Text -> Bool +isCalType = flip L.elem ["date", "datetime-local", "datetime", "month", "time"] 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 +renderInput form ix input@Input { inputType = ty, inputName = name } ["year", p] qs + | isCalType ty, + 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 { inputType = "date", inputName = name } ["zone", p] qs = do - t <- timeParseOrNow $ get name qs - let Elapsed (Seconds t') = timeGetElapsed $ localTimeToGlobal t - template' "cal/timezone.html" form ix input qs $ \prop -> case prop of - "T" -> timeData t - "zones" -> tzdata t' $ unEscapeString $ Txt.unpack p - "continents" -> continents - _ -> toGVal () +renderInput form ix input@Input { inputType = ty, inputName = name } ["zone", p] qs + | isCalType ty = do + t <- timeParseOrNow $ get name qs + let Elapsed (Seconds t') = timeGetElapsed $ localTimeToGlobal t + template' "cal/timezone.html" form ix input qs $ \prop -> case prop of + "T" -> timeData t + "zones" -> tzdata t' $ unEscapeString $ Txt.unpack p + "continents" -> continents + _ -> toGVal () renderInput form ix input@Input { multiple = True } [p] qs | '=':v' <- Txt.unpack p, (utf8 $ inputName input, Just $ utf8' v') `Prelude.elem` qs = @@ -141,8 +145,8 @@ 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 +renderInput form ix input@Input { inputType = ty, inputName = n } [op] qs + | isCalType ty, 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) $ @@ -151,10 +155,10 @@ renderInput form ix input@Input { inputType = "date", inputName = n } [op] qs "seqTo" -> fromFunction $ return . gSeqTo "pad2" -> fromFunction $ return . gPad2 _ -> toGVal () - | otherwise = return Nothing -renderInput form ix input@Input { inputType = "date", inputName = n } [] qs = do + | isCalType ty = return Nothing +renderInput f ix input@Input { inputType = ty, inputName = n } [] qs | isCalType ty = do v' <- timeParseOrNow $ get n qs - template' "gregorian.html" form ix input qs $ \x -> case x of -- TODO: Ditto + template' "gregorian.html" f ix input qs $ \x -> case x of -- TODO: Ditto "T" -> timeData v' "seqTo" -> fromFunction $ return . gSeqTo "pad2" -> fromFunction $ return . gPad2 diff --git a/src/Text/HTML/Form/WebApp/Ginger/Hourglass.hs b/src/Text/HTML/Form/WebApp/Ginger/Hourglass.hs index d071569..89d6860 100644 --- a/src/Text/HTML/Form/WebApp/Ginger/Hourglass.hs +++ b/src/Text/HTML/Form/WebApp/Ginger/Hourglass.hs @@ -21,7 +21,8 @@ timeData datetime = orderedDict [ _ -> "PM", ("hour", enumG $ case todHour $ dtTime $ localTimeUnwrap datetime of x | x <= 12 -> x - x -> x - 12), + 24 -> 12 + x -> x - 11), ("minute", enumG $ todMin $ dtTime $ localTimeUnwrap datetime), ("second", enumG $ todSec $ dtTime $ localTimeUnwrap datetime), ("nano", showG unwrapNanos $ todNSec $ dtTime $ localTimeUnwrap datetime), diff --git a/tpl/gregorian.html b/tpl/gregorian.html index b86f1d2..2178dff 100644 --- a/tpl/gregorian.html +++ b/tpl/gregorian.html @@ -12,17 +12,23 @@

↓ + {% if input.inputType != "time" %} {{ T.year }} ↑ ↓ {{ T.month }} ↑ + {% endif %} + {% if input.inputType != "month" %} + {% if input.inputType != "time" %} ↓ {{ T.date }} ↑ + {% endif %} + {% if input.inputType != "date" %} ↓ {{ T.hour|pad2 }} ↑ @@ -32,12 +38,17 @@ ↑ {{ T.meridiem }} + {% if input.inputType != "datetime-local" && input.inputType != "time" %} ↓ {{ T.zone }} ↑

+ {% endif %} + {% endif %} + {% endif %}

Now

+ {% if input.inputType != "time" %} + {% endif %} + {% if input.inputType != "month" %} + {% if input.inputType != "time" %} + {% endif %} + {% if input.inputType != "date" %} + {% endif %} + {% endif %}
{%- endblock -%} -- 2.30.2