Add plain text version of /hex

app/Main.hs

@@ -23,6 +23,7 @@ import Servant
   , MimeRender (..)
   , Server
   , ServerError (..)
+  , PlainText
   , Proxy (..)
   , Capture
   , Get
@@ -35,6 +36,8 @@ import Text.Blaze.Html5 ((!))
 import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
 import Text.Printf (PrintfArg, printf)
 
+import qualified Data.Text.Lazy as Text
+import qualified Data.Text.Lazy.Encoding as Encoding
 import qualified Network.Wai.Handler.Warp as Warp
 import qualified Text.Blaze.Html5 as H
 import qualified Text.Blaze.Html5.Attributes as A
@@ -51,7 +54,7 @@ app :: Application
 app = serve (Proxy :: Proxy API) server
 
 type API =
-  "hex" :> Capture "bytes" Text :> Get '[HTML] HexModel
+  "hex" :> Capture "bytes" Text :> Get '[PlainText, HTML] HexModel
 
 server :: Server API
 server =
@@ -65,6 +68,22 @@ newtype HexModel = HexModel
   { codepoints :: [([Word8], Either String Char)]
   }
 
+instance MimeRender PlainText HexModel where
+  mimeRender _ model = Encoding.encodeUtf8 $ Text.intercalate "\n" $ concat
+    [ [ Text.pack $ unwords $ map showByteHex bytes
+      , Text.intercalate "  " $
+        Text.pack (unwords $ map showByteBin bytes)
+        : case eiC of
+          Left err -> [Text.pack err]
+          Right c -> map Text.pack
+            [ [c]
+            , printf "U+%04X" c
+            , intercalate ", " $ maybeToList (UnicodeNames.name c) ++ map (++ "*") (UnicodeNames.nameAliases c)
+            ]
+      ]
+    | (bytes, eiC) <- model.codepoints
+    ]
+
 instance MimeRender HTML HexModel where
   mimeRender _ model = renderHtml $ H.docTypeHtml $ do
     H.head $ do
@@ -85,14 +104,18 @@ instance MimeRender HTML HexModel where
               H.td $ H.code $ H.toHtml $ intercalate ", " $ maybeToList (UnicodeNames.name c) ++ map (++ "*") (UnicodeNames.nameAliases c)
               H.td $ H.toHtml $ fromMaybe "" $ blockName c
     where
-      showByteHex = printf "      %02X"
-      showByteBin = printf "%8b"
 
       blockName :: Char -> Maybe String
       blockName c = UnicodeBlocks.blockName . UnicodeBlocks.blockDefinition <$> UnicodeBlocks.block c
 
 -- Utilities
 
+showByteHex :: Word8 -> String
+showByteHex = printf "      %02X"
+
+showByteBin :: Word8 -> String
+showByteBin = printf "%8b"
+
 orThrow :: Either a b -> (a -> ServerError) -> Handler b
 orThrow (Left err) f = throwError $ f err
 orThrow (Right val) _ = pure val