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, HTML] CodepointsModel
+  :<|> "codepoints" :> Capture "codepoints" Text :> Get '[PlainText] CodepointsModel
   :<|> "text" :> Capture "text" Text :> Get '[HTML] TextModel
 
 server :: Server API
@@ -108,7 +108,12 @@ instance MimeRender PlainText BytesModel where
       ]
 
 instance MimeRender HTML BytesModel where
-  mimeRender _ model = renderHtml $ documentWithBody $ do
+  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]
@@ -116,7 +121,8 @@ instance MimeRender HTML BytesModel where
             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 $ do
+                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
@@ -156,20 +162,6 @@ instance MimeRender PlainText CodepointsModel where
     | (codepoint, eiC) <- model.codepoints
     ]
 
-instance MimeRender HTML CodepointsModel where
-  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>
 
 newtype TextModel = TextModel
@@ -177,7 +169,12 @@ newtype TextModel = TextModel
   }
 
 instance MimeRender HTML TextModel where
-  mimeRender _ model = renderHtml $ documentWithBody $ do
+  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])
@@ -206,15 +203,6 @@ 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