From 680706daf93b5e0ac346df89fe691735bf12b18e Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Tue, 28 Nov 2023 13:34:00 +1300 Subject: [PATCH] Add week & color input support! --- bureaucromancy.cabal | 4 +- form.html | 3 +- src/Text/HTML/Form/Colours.hs | 77 +++++++++++++++++++ src/Text/HTML/Form/WebApp.hs | 26 ++++++- src/Text/HTML/Form/WebApp/Ginger/Hourglass.hs | 2 + tpl/base.html | 5 +- tpl/color.html | 21 +++++ tpl/gregorian.html | 6 +- 8 files changed, 137 insertions(+), 7 deletions(-) create mode 100644 src/Text/HTML/Form/Colours.hs create mode 100644 tpl/color.html diff --git a/bureaucromancy.cabal b/bureaucromancy.cabal index 2f5e550..c54817e 100644 --- a/bureaucromancy.cabal +++ b/bureaucromancy.cabal @@ -63,7 +63,9 @@ library -- Modules exported by the library. exposed-modules: Text.HTML.Form, Text.HTML.Form.Query, - Text.HTML.Form.WebApp, Text.HTML.Form.WebApp.Ginger, Text.HTML.Form.WebApp.Ginger.Hourglass, Text.HTML.Form.WebApp.Ginger.TZ + Text.HTML.Form.WebApp, Text.HTML.Form.WebApp.Ginger, + Text.HTML.Form.WebApp.Ginger.Hourglass, Text.HTML.Form.WebApp.Ginger.TZ, + Text.HTML.Form.Colours -- Modules included in this library but not exported. -- other-modules: diff --git a/form.html b/form.html index f5ddd39..25e8cdf 100644 --- a/form.html +++ b/form.html @@ -17,7 +17,8 @@ - + + diff --git a/src/Text/HTML/Form/Colours.hs b/src/Text/HTML/Form/Colours.hs new file mode 100644 index 0000000..23a4090 --- /dev/null +++ b/src/Text/HTML/Form/Colours.hs @@ -0,0 +1,77 @@ +module Text.HTML.Form.Colours(tailwindColours, Colour) where + +-- Finally a good use for Tailwind! + +type Colour = String -- Stores a hexcode, with preceding "#" +tailwindColours :: [(String, [(Int, Colour)])] +tailwindColours = [ + "Slate"~>[50~>"#f8fafc", 100~>"#f1f5f9", 200~>"#e2e8f0", 300~>"#cbd5e1", + 400~>"#94a3b8", 500~>"#64748b", 600~>"#475569", 700~>"#334155", + 800~>"#1e293b", 900~>"#0f172a", 950~>"#020617"], + "Gray"~>[50~>"#f9fafb", 100~>"#f3f4f6", 200~>"#e5e7eb", 300~>"#d1d5db", + 400~>"#9ca3af", 500~>"#6b7280", 600~>"#4b5563", 700~>"#374151", + 800~>"#1f2937", 900~>"#111827", 950~>"#030712"], + "Zinc"~>[50~>"#fafafa", 100~>"#f4f4f5", 200~>"#e4e4e7", 300~>"#d4d4d8", + 400~>"#a1a1aa", 500~>"#71717a", 600~>"#52525b", 700~>"#3f3f46", + 800~>"#27272a", 900~>"#18181b", 950~>"#09090b"], + "Neutral"~>[50~>"#fafafa", 100~>"#f5f5f5", 200~>"#e5e5e5", 300~>"#d4d4d4", + 400~>"#a3a3a3", 500~>"#737373", 600~>"#404040", 700~>"#404040", + 800~>"#262626", 900~>"#171717", 950~>"#0a0a0a"], + "Stone"~>[50~>"#fafaf9", 100~>"#f5f5f4", 200~>"#e7e5e4", 300~>"#d6d3d1", + 400~>"#a8a29e", 500~>"#78716c", 600~>"#57534e", 700~>"#44403c", + 800~>"#292524", 900~>"#1c1917", 950~>"#0c0a09"], + "Red"~>[50~>"#fef2f2", 100~>"#fee2e2", 200~>"#fecaca", 300~>"#fca5a5", + 400~>"#f87171", 500~>"#ef4444", 600~>"#dc2626", 700~>"#b91c1c", + 800~>"#991b1b", 900~>"#7f1d1d", 950~>"#450a0a"], + "Orange"~>[50~>"#fff7ed", 100~>"#ffedd5", 200~>"#fed7aa", 300~>"#fdba74", + 400~>"#fb923c", 500~>"#f97316", 600~>"#ea580c", 700~>"#c2410c", + 800~>"#9a3412", 900~>"#7c2d12", 950~>"#431407"], + "Amber"~>[50~>"#fffbeb", 100~>"#fef3c7", 200~>"#fde68a", 300~>"#fcd34d", + 400~>"#fbbf24", 500~>"#f59e0b", 600~>"#d97706", 700~>"#b45309", + 800~>"#92400e", 900~>"#78350f", 950~>"#451a03"], + "Yellow"~>[50~>"#fefce8", 100~>"#fef9c3", 200~>"#fef08a", 300~>"#fde047", + 400~>"#facc15", 500~>"#eab308", 600~>"#ca8a04", 700~>"#a16207", + 800~>"#854d0e", 900~>"#713f12", 950~>"#422006"], + "Lime"~>[50~>"#f7fee7", 100~>"#ecfccb", 200~>"#d9f99d", 300~>"#bef264", + 400~>"#a3e635", 500~>"#84cc16", 600~>"#65a30d", 700~>"#4d7c0f", + 800~>"#3f6212", 900~>"#365314", 950~>"#1a2e05"], + "Green"~>[50~>"#f0fdf4", 100~>"#dcfce7", 200~>"#bbf7d0", 300~>"#86efac", + 400~>"#4ade80", 500~>"#22c55e", 600~>"#16a34a", 700~>"#15803d", + 800~>"#166534", 900~>"#14532d", 950~>"#052e16"], + "Emerald"~>[50~>"#ecfdf5", 100~>"#d1fae5", 200~>"#a7f3d0", 300~>"#6ee7b7", + 400~>"#34d399", 500~>"#10b981", 600~>"#059669", 700~>"#047857", + 800~>"#065f46", 900~>"#064e3b", 950~>"#022c22"], + "Teal"~>[50~>"#f0fdfa", 100~>"#ccfbf1", 200~>"#99f6e4", 300~>"#5eead4", + 400~>"#2dd4bf", 500~>"#14b8a6", 600~>"#0f766e", 700~>"#0f766e", + 800~>"#115e59", 900~>"#134e4a", 950~>"#042f2e"], + "Cyan"~>[50~>"#ecfeff", 100~>"#cffafe", 200~>"#a5f3fc", 300~>"#67e8f9", + 400~>"#22d3ee", 500~>"#06b6d4", 600~>"#0891b2", 700~>"#0e7490", + 800~>"#155e75", 900~>"#164e63", 950~>"#083344"], + "Sky"~>[50~>"#f0f9ff", 100~>"#e0f2fe", 200~>"#bae6fd", 300~>"#7dd3fc", + 400~>"#38bdf8", 500~>"#0ea5e9", 600~>"#0284c7", 700~>"#0369a1", + 800~>"#075985", 900~>"#0c4a6e", 950~>"#082f49"], + "Blue"~>[50~>"#eff6ff", 100~>"#dbeafe", 200~>"#bfdbfe", 300~>"#93c5fd", + 400~>"#60a5fa", 500~>"#3b82f6", 600~>"#2563eb", 700~>"#1d4ed8", + 800~>"#1e40af", 900~>"#1e3a8a", 950~>"#172554"], + "Indigo"~>[50~>"#eef2ff", 100~>"#e0e7ff", 200~>"#c7d2fe", 300~>"#a5b4fc", + 400~>"#818cf8", 500~>"#6366f1", 600~>"#4f46e5", 700~>"#4338ca", + 800~>"#3730a3", 900~>"#312e81", 950~>"#1e1b4b"], + "Violet"~>[50~>"#f5f3ff", 100~>"#ede9fe", 200~>"#ddd6fe", 300~>"#c4b5fd", + 400~>"#a78bfa", 500~>"#8b5cf6", 600~>"#7c3aed", 700~>"#6d28d9", + 800~>"#5b21b6", 900~>"#4c1d95", 950~>"#2e1065"], + "Purple"~>[50~>"#faf5ff", 100~>"#f3e8ff", 200~>"#e9d5ff", 300~>"#d8b4fe", + 400~>"#c084fc", 500~>"#a855f7", 600~>"#9333ea", 700~>"#7e22ce", + 800~>"#6b21a8", 900~>"#581c87", 950~>"#3b0764"], + "Fuchsia"~>[50~>"#fdf4ff", 100~>"#fae8ff", 200~>"#f5d0fe", 300~>"#f0abfc", + 400~>"#e879f9", 500~>"#d946ef", 600~>"#c026d3", 700~>"#a21caf", + 800~>"#86198f", 900~>"#701a75", 950~>"#4a044e"], + "Pink"~>[50~>"#fdf2f8", 100~>"#fce7f3", 200~>"#fbcfe8", 300~>"#f9a8d4", + 400~>"#f472b6", 500~>"#ec4899", 600~>"#db2777", 700~>"#be185d", + 800~>"#9d174d", 900~>"#831843", 950~>"#500724"], + "Rose"~>[50~>"#fff1f2", 100~>"#ffe4e6", 200~>"#fecdd3", 300~>"#fda4af", + 400~>"#fb7185", 500~>"#f43f5e", 600~>"#e11d48", 700~>"#be123c", + 800~>"#9f1239", 900~>"#881337", 950~>"#4c0519"] + ] + +(~>) :: a -> b -> (a, b) +a ~> b = (a, b) diff --git a/src/Text/HTML/Form/WebApp.hs b/src/Text/HTML/Form/WebApp.hs index 0e80b91..41f2413 100644 --- a/src/Text/HTML/Form/WebApp.hs +++ b/src/Text/HTML/Form/WebApp.hs @@ -19,9 +19,10 @@ import Text.HTML.Form.WebApp.Ginger.Hourglass (timeData, modifyTime', timeParseO gSeqTo, gPad2) import Text.HTML.Form.WebApp.Ginger.TZ (tzdata, continents) -import Text.Ginger.GVal as V (GVal(..), toGVal, orderedDict, (~>), fromFunction) +import Text.Ginger.GVal as V (GVal(..), ToGVal(..), orderedDict, (~>), fromFunction, list) import Text.Ginger.Html (html) import Data.Hourglass (Elapsed(..), Seconds(..), timeGetElapsed, localTimeToGlobal) +import Text.HTML.Form.Colours (tailwindColours) type Query = [(ByteString, Maybe ByteString)] renderPage :: Form -> [Text] -> Query -> IO (Maybe (Either Query Text)) @@ -33,7 +34,7 @@ renderPage form [] _ = return $ Just $ Right $ Txt.concat [ renderPage _ _ _ = return Nothing isCalType :: Text -> Bool -isCalType = flip L.elem ["date", "datetime-local", "datetime", "month", "time"] +isCalType = flip L.elem ["date", "datetime-local", "datetime", "month", "time", "week"] renderInput :: Form -> Int -> Input -> [Text] -> [(ByteString, Maybe ByteString)] -> IO (Maybe (Either Query Text)) renderInput form ix input [""] qs = renderInput form ix input [] qs @@ -146,6 +147,8 @@ renderInput form ix input@Input { inputType = "number" } [] qs = renderInput form ix input@Input { inputType = "range" } [] qs = template "number.html" form ix input qs renderInput form ix input@Input { inputType = ty, inputName = n } [op] qs + | "week" <- ty, "+date" <- op = renderInput form ix input ["+date7"] qs + | "week" <- ty, "-date" <- op = renderInput form ix input ["-date7"] qs | isCalType ty, Just v <- modifyTime' op $ get n qs = do -- TODO: Support other calendars v' <- timeParseOrNow v @@ -163,6 +166,20 @@ renderInput f ix input@Input { inputType = ty, inputName = n } [] qs | isCalType "seqTo" -> fromFunction $ return . gSeqTo "pad2" -> fromFunction $ return . gPad2 _ -> toGVal () +renderInput form ix input@Input { inputType = "color" } [] qs = + template' "color.html" form ix input qs $ \x -> case x of + "colours" -> V.list $ L.map colourGVal tailwindColours + "shades" -> toGVal False + "subfolder" -> toGVal False + _ -> toGVal () +renderInput form ix input@Input { inputType = "color", inputName = n } [c, ""] qs = + template' "color.html" form ix input qs $ \x -> case x of + "colours" -> V.list $ L.map colourGVal tailwindColours + "shades" -> case Txt.unpack c `lookup` tailwindColours of + Just shades -> V.list $ L.map shadeGVal shades + Nothing -> toGVal False + "subfolder" -> toGVal True + _ -> toGVal () renderInput form ix input [keyboard] qs = renderInput form ix input [keyboard, ""] qs renderInput form ix input [keyboard, ""] qs | Just (Just _) <- resolveSource path = @@ -193,6 +210,11 @@ renderInput form ix input [] qs = do renderInput _ _ input _ _ = return $ Just $ Right $ Txt.concat ["Unknown input type: ", inputType input] +colourGVal :: (ToGVal m a1, ToGVal m b, Eq a2, Num a2) => (a1, [(a2, b)]) -> GVal m +colourGVal (key, hues) = orderedDict ["label"~>key, "value"~>lookup 500 hues] +shadeGVal :: (ToGVal m a1, ToGVal m a2) => (a1, a2) -> GVal m +shadeGVal (key, val) = orderedDict ["label"~>key, "value"~>val] + utf8 :: Text -> ByteString utf8 = Txt.encodeUtf8 utf8' :: String -> ByteString diff --git a/src/Text/HTML/Form/WebApp/Ginger/Hourglass.hs b/src/Text/HTML/Form/WebApp/Ginger/Hourglass.hs index 89d6860..148c2c7 100644 --- a/src/Text/HTML/Form/WebApp/Ginger/Hourglass.hs +++ b/src/Text/HTML/Form/WebApp/Ginger/Hourglass.hs @@ -106,6 +106,8 @@ modifyTime op time = case op of "+month" -> addPeriod' time mempty { periodMonths = 1 } "-date" -> addPeriod' time mempty { periodDays = -1 } "+date" -> addPeriod' time mempty { periodDays = 1 } + "-date7" -> addPeriod' time mempty { periodDays = -7 } + "+date7" -> addPeriod' time mempty { periodDays = 7 } _ -> Nothing modLTime :: LocalTime a -> (a -> b) -> Maybe (LocalTime b) modLTime a = Just . flip fmap a diff --git a/tpl/base.html b/tpl/base.html index d4f476b..ecc1b01 100644 --- a/tpl/base.html +++ b/tpl/base.html @@ -40,7 +40,10 @@ {% else %}{{ input.label }} {% endif %} {% if input.type != 'password' %} -
{{ input.value }}
+
+ {{ input.value }} +
{% endif %} {% endfor %} diff --git a/tpl/color.html b/tpl/color.html new file mode 100644 index 0000000..6d377d7 --- /dev/null +++ b/tpl/color.html @@ -0,0 +1,21 @@ +{% extends "base.html" %} + +{%- block main -%} + {% if shades %}
+ +
{% endif %} +
+ +
+{%- endblock -%} diff --git a/tpl/gregorian.html b/tpl/gregorian.html index 2178dff..4363d64 100644 --- a/tpl/gregorian.html +++ b/tpl/gregorian.html @@ -28,7 +28,8 @@ ↑ {% endif %} - {% if input.inputType != "date" %} + {# NOTE: "week" handling is largely a matter of switching to +/- 7days #} + {% if input.inputType != "date" && input.inputType != "week" %} ↓ {{ T.hour|pad2 }} ↑ @@ -66,6 +67,7 @@ {% endif %} {% if input.inputType != "month" %} + {# TODO: Do we want to refine this for "week" inputs? #} {% if input.inputType != "time" %} {% endif %} - {% if input.inputType != "date" %} + {% if input.inputType != "date" && input.inputType != "week" %} -- 2.30.2