From f5fd1089b19e1921625498f5c5512e977675f9cb Mon Sep 17 00:00:00 2001
From: Paul Brinkmeier <hallo@pbrinkmeier.de>
Date: Fri, 10 Mar 2023 18:46:34 +0100
Subject: [PATCH] Add /text endpoint

---
 app/Main.hs     | 32 ++++++++++++++++++++++++++++----
 static/utoy.css |  6 ++++++
 2 files changed, 34 insertions(+), 4 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 3a63b4b..92a5ac3 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -63,10 +63,11 @@ app = serve (Proxy :: Proxy API) server
 type API =
   "bytes" :> Capture "bytes" Text :> Get '[PlainText, HTML] BytesModel
   :<|> "codepoints" :> Capture "codepoints" Text :> Get '[PlainText] CodepointsModel
+  :<|> "text" :> Capture "text" Text :> Get '[HTML] TextModel
 
 server :: Server API
 server =
-  bytesR :<|> codepointsR
+  bytesR :<|> codepointsR :<|> textR
   where
     bytesR bytesP = do
       bytes <- Parsers.parseHexBytes bytesP `orThrow` const err400
@@ -76,6 +77,9 @@ server =
       codepoints' <- Parsers.parseCodepoints codepointsP `orThrow` const err400
       pure $ mkCodepointsModel codepoints'
 
+    textR textP = do
+      pure $ TextModel textP
+
 -- /bytes/<bytes>
 
 newtype BytesModel = BytesModel
@@ -118,10 +122,10 @@ instance MimeRender HTML BytesModel where
               H.td ! A.colspan "4" $ H.toHtml $ "Decoding error: " ++ err
             Right c -> do
               H.td $ do
-                H.input ! A.value (H.toValue [c]) ! A.style "text-align: center; width: 2em; font-size: 1em;"
-              H.td $ H.code $ printfHtml "U+%04X" c
+                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.toHtml $ fromMaybe "" $ blockName c
+              H.td $ H.code $ H.toHtml $ fromMaybe "" $ blockName c
 
 -- /codepoints/<codepoints>
 
@@ -158,6 +162,26 @@ instance MimeRender PlainText CodepointsModel where
     | (codepoint, eiC) <- model.codepoints
     ]
 
+-- /text/<text>
+
+newtype TextModel = TextModel
+  { text :: Text
+  }
+
+instance MimeRender HTML TextModel 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_ (Text.unpack model.text) $ \c -> do
+        H.tr $ 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
+
 -- Utilities
 
 renderText :: Text -> BL.ByteString
diff --git a/static/utoy.css b/static/utoy.css
index c4e93e6..c4754b6 100644
--- a/static/utoy.css
+++ b/static/utoy.css
@@ -19,3 +19,9 @@ pre, code {
 pre {
   margin: 0; font-size: 0.5em;
 }
+
+.charbox {
+  text-align: center;
+  width: 2em;
+  font-size: 1em;
+}