From 9881b44fa2ed73e7d3739c48e84a94eb5ec1b9c7 Mon Sep 17 00:00:00 2001
From: Paul Brinkmeier <hallo@pbrinkmeier.de>
Date: Sun, 12 Mar 2023 20:50:33 +0100
Subject: [PATCH] Add HTML version of /codepoints

---
 app/Main.hs | 26 ++++++++++++++++++++++----
 1 file changed, 22 insertions(+), 4 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 92a5ac3..e2e42f1 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -62,7 +62,7 @@ app = serve (Proxy :: Proxy API) server
 
 type API =
   "bytes" :> Capture "bytes" Text :> Get '[PlainText, HTML] BytesModel
-  :<|> "codepoints" :> Capture "codepoints" Text :> Get '[PlainText] CodepointsModel
+  :<|> "codepoints" :> Capture "codepoints" Text :> Get '[PlainText, HTML] CodepointsModel
   :<|> "text" :> Capture "text" Text :> Get '[HTML] TextModel
 
 server :: Server API
@@ -121,9 +121,8 @@ instance MimeRender HTML BytesModel where
             Left err ->
               H.td ! A.colspan "4" $ H.toHtml $ "Decoding error: " ++ err
             Right c -> do
-              H.td $ do
-                H.input ! A.class_ "charbox" ! A.value (H.toValue [c])
-                H.td $ H.code $ printfHtml "U+%04X" c
+              H.td $ H.input ! A.class_ "charbox" ! A.value (H.toValue [c])
+              H.td $ H.code $ printfHtml "U+%04X" c
               H.td $ H.code $ H.toHtml $ intercalate ", " $ maybeToList (UnicodeNames.name c) ++ map (++ "*") (UnicodeNames.nameAliases c)
               H.td $ H.code $ H.toHtml $ fromMaybe "" $ blockName c
 
@@ -162,6 +161,25 @@ instance MimeRender PlainText CodepointsModel where
     | (codepoint, eiC) <- model.codepoints
     ]
 
+instance MimeRender HTML CodepointsModel where
+  mimeRender _ model = renderHtml $ H.docTypeHtml $ do
+    H.head $ do
+      H.meta ! A.charset "utf-8"
+      H.title "utoy"
+      H.style $ H.toHtml $ Encoding.decodeUtf8 $(embedFile "static/utoy.css")
+    H.body $ do
+      H.table $ for_ model.codepoints $ \(codepoint, eiC) ->
+        H.tr $ do
+          H.td $ H.code $ H.toHtml $ Text.pack $ printf "0x%X" codepoint
+          case eiC of
+            Left err -> do
+              H.td ! A.colspan "4" $ H.code $ H.toHtml $ "Decoding error: " <> Text.pack err
+            Right c -> do
+              H.td $ H.input ! A.class_ "charbox" ! A.value (H.toValue [c])
+              H.td $ H.code $ printfHtml "U+%04X" c
+              H.td $ H.code $ H.toHtml $ intercalate ", " $ maybeToList (UnicodeNames.name c) ++ map (++ "*") (UnicodeNames.nameAliases c)
+              H.td $ H.code $ H.toHtml $ fromMaybe "" $ blockName c
+
 -- /text/<text>
 
 newtype TextModel = TextModel