8 files changed, 137 insertions(+), 7 deletions(-)

M bureaucromancy.cabal
M form.html
A src/Text/HTML/Form/Colours.hs
M src/Text/HTML/Form/WebApp.hs
M src/Text/HTML/Form/WebApp/Ginger/Hourglass.hs
M tpl/base.html
A tpl/color.html
M tpl/gregorian.html

@@ 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:

@@ 17,7 17,8 @@
     <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>
+    <label><input type="week" name="published" />Published at</label>
+    <label><input type="color" name="colour" />What is your favourite colour?</label>
   </form>
 </body>
 </html>

@@ 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)

@@ 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

@@ 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

@@ 40,7 40,10 @@
       {% else %}<a href="/{{input.index}}/{{Q}}" title="{{input.title}}">{{ input.label }}</a>
       {% endif %}</dt>
     {% if input.type != 'password' %}
-      <dd class="{% if input.readonly %}readonly{% endif %}">{{ input.value }}</dd>
+      <dd class="{% if input.readonly %}readonly{% endif %}"
+          {% if input.inputType == "color" %}style="background-color: {{ input.value }}"{% endif %}>
+        {{ input.value }}
+      </dd>
     {% endif %}
   {% endfor %}</dl></aside>
 

@@ 0,0 1,21 @@
+{% extends "base.html" %}
+
+{%- block main -%}
+  {% if shades %}<section>
+    <ul style="list-style: none; background: linear-gradient(black, white, white)">
+      {% for shade in shades %}
+        <li><a href="={{ shade.value|xURI }}{{Q}}" style="color: {{ shade.value }}">
+            {{ shade.label }}
+        </a></li>
+      {% endfor %}
+    </ul>
+  </section>{% endif %}
+  <section>
+    <ul style="list-style: none; display: grid; grid-template-columns: repeat(5, 1fr); gap: 10px">
+      {% for colour in colours %}
+        <li><a href="{% if subfolder %}../{% endif %}{{ colour.label|xURI }}/={{ colour.value|xURI }}{{Q}}"
+            style="color: {{ colour.value }}">{{ colour.label }}</a></li>
+      {% endfor %}
+    </ul>
+  </section>
+{%- endblock -%}

@@ 28,7 28,8 @@
         <a href="+date{{Q}}" title="Next day">↑</a>
         {% endif %}
 
-        {% if input.inputType != "date" %}
+        {# NOTE: "week" handling is largely a matter of switching to +/- 7days #}
+        {% if input.inputType != "date" && input.inputType != "week" %}
         <a href="-hour{{Q}}" title="Past hour">↓</a>
         {{ T.hour|pad2 }}
         <a href="+hour{{Q}}" title="Next hour">↑</a>


@@ 66,6 67,7 @@
       {% endif %}
 
       {% if input.inputType != "month" %}
+      {# TODO: Do we want to refine this for "week" inputs? #}
       {% if input.inputType != "time" %}
       <ul style="grid-template-columns: repeat(7, min-content)">
         {% for i in 1|seqTo(T.daysInMonth) %}


@@ 76,7 78,7 @@
       </ul>
       {% endif %}
 
-      {% if input.inputType != "date" %}
+      {% if input.inputType != "date" && input.inputType != "week" %}
       <ul>{% for i in 1|seqTo(12) %}
         <li><a href="hour={{ i }}{{Q}}">{{ i|pad2 }}:{{ T.minute|pad2 }}</a></li>
       {% endfor %}</ul>