From 3fd4177cd44e6ad4699bbed4427998345f3db923 Mon Sep 17 00:00:00 2001
From: Paul Brinkmeier <hallo@pbrinkmeier.de>
Date: Sun, 12 Mar 2023 20:53:43 +0100
Subject: [PATCH] Move common html code to its own function

---
 app/Main.hs | 86 +++++++++++++++++++++++++----------------------------
 1 file changed, 40 insertions(+), 46 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index e2e42f1..be62138 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -108,23 +108,18 @@ instance MimeRender PlainText BytesModel where
       ]
 
 instance MimeRender HTML BytesModel 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 $ \(bytes, eiC) -> do
-        H.tr $ do
-          H.td $ H.pre $ H.toHtml $ unlines $ map unwords [map showByteHex bytes, map showByteBin bytes]
-          case eiC of
-            Left err ->
-              H.td ! A.colspan "4" $ H.toHtml $ "Decoding error: " ++ 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
+  mimeRender _ model = renderHtml $ documentWithBody $ do
+    H.table $ for_ model.codepoints $ \(bytes, eiC) -> do
+      H.tr $ do
+        H.td $ H.pre $ H.toHtml $ unlines $ map unwords [map showByteHex bytes, map showByteBin bytes]
+        case eiC of
+          Left err ->
+            H.td ! A.colspan "4" $ H.toHtml $ "Decoding error: " ++ 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
 
 -- /codepoints/<codepoints>
 
@@ -162,23 +157,18 @@ instance MimeRender PlainText CodepointsModel where
     ]
 
 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
+  mimeRender _ model = renderHtml $ documentWithBody $ 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>
 
@@ -187,18 +177,13 @@ newtype TextModel = TextModel
   }
 
 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
+  mimeRender _ model = renderHtml $ documentWithBody $ 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
 
@@ -221,6 +206,15 @@ orThrow (Right val) _ = pure val
 printfHtml :: PrintfArg a => String -> a -> H.Html
 printfHtml fmt = (H.toHtml :: String -> H.Html) . printf fmt
 
+documentWithBody :: H.Html -> H.Html
+documentWithBody body =
+  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 body
+
 -- HTML routes
 
 data HTML