Add text/plain rendering for /text

This commit is contained in:
Paul Brinkmeier 2023-03-24 12:59:34 +01:00
parent 0d59ded2ec
commit 976fbada7e

View File

@ -63,7 +63,7 @@ app = serve (Proxy :: Proxy API) server
type API = type API =
"utf8" :> Capture "bytes" Text :> Get '[PlainText, HTML] Utf8Model "utf8" :> Capture "bytes" Text :> Get '[PlainText, HTML] Utf8Model
:<|> "codepoints" :> Capture "codepoints" Text :> Get '[PlainText, HTML] CodepointsModel :<|> "codepoints" :> Capture "codepoints" Text :> Get '[PlainText, HTML] CodepointsModel
:<|> "text" :> Capture "text" Text :> Get '[HTML] TextModel :<|> "text" :> Capture "text" Text :> Get '[PlainText, HTML] TextModel
server :: Server API server :: Server API
server = server =
@ -195,6 +195,18 @@ instance MimeRender HTML TextModel where
H.td $ H.code $ H.toHtml $ intercalate ", " $ maybeToList (UnicodeNames.name c) ++ map (++ "*") (UnicodeNames.nameAliases 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 H.td $ H.code $ H.toHtml $ fromMaybe "" $ blockName c
instance MimeRender PlainText TextModel where
mimeRender _ model = renderText $ Table.render " "
[ map (Table.cl)
[ Text.pack [c]
, Text.pack $ printf "U+%04X" c
, Text.pack $ intercalate ", " $ maybeToList (UnicodeNames.name c) ++ map (++ "*") (UnicodeNames.nameAliases c)
, Text.pack $ fromMaybe "" $ blockName c
]
| c <- Text.unpack model.text
]
-- Utilities -- Utilities
renderText :: Text -> BL.ByteString renderText :: Text -> BL.ByteString