diff --git a/app/Main.hs b/app/Main.hs index 48e7072..c6d4eea 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -61,17 +61,17 @@ app :: Application app = serve (Proxy :: Proxy API) server type API = - "bytes" :> Capture "bytes" Text :> Get '[PlainText, HTML] BytesModel + "utf8" :> Capture "bytes" Text :> Get '[PlainText, HTML] Utf8Model :<|> "codepoints" :> Capture "codepoints" Text :> Get '[PlainText, HTML] CodepointsModel :<|> "text" :> Capture "text" Text :> Get '[HTML] TextModel server :: Server API server = - bytesR :<|> codepointsR :<|> textR + utf8R :<|> codepointsR :<|> textR where - bytesR bytesP = do + utf8R bytesP = do bytes <- Parsers.parseHexBytes bytesP `orThrow` const err400 - pure $ BytesModel $ Decode.decodeUtf8 bytes + pure $ mkUtf8Model bytes codepointsR codepointsP = do codepoints' <- Parsers.parseCodepoints codepointsP `orThrow` const err400 @@ -82,11 +82,14 @@ server = -- /bytes/ -newtype BytesModel = BytesModel +newtype Utf8Model = Utf8Model { codepoints :: [([Word8], Either String Char)] } -instance MimeRender PlainText BytesModel where +mkUtf8Model :: [Word8] -> Utf8Model +mkUtf8Model = Utf8Model . Decode.decodeUtf8 + +instance MimeRender PlainText Utf8Model where mimeRender _ model = renderText $ Table.render " " $ concat [ [ [ Table.cl $ Text.pack $ unwords $ map showByteHex bytes @@ -107,7 +110,7 @@ instance MimeRender PlainText BytesModel where | (bytes, eiC) <- model.codepoints ] -instance MimeRender HTML BytesModel where +instance MimeRender HTML Utf8Model where mimeRender _ model = renderHtml $ documentWithBody $ do H.table $ for_ model.codepoints $ \(bytes, eiC) -> do H.tr $ do