Compare commits
No commits in common. "647b5c2ad1cbac737b2372fdf371e0863a059640" and "fde68ee8339b57737c8db6aa4a53dc9558748dc2" have entirely different histories.
647b5c2ad1
...
fde68ee833
26
app/Main.hs
26
app/Main.hs
@ -61,17 +61,17 @@ app :: Application
|
||||
app = serve (Proxy :: Proxy API) server
|
||||
|
||||
type API =
|
||||
"utf8" :> Capture "bytes" Text :> Get '[PlainText, HTML] Utf8Model
|
||||
"bytes" :> Capture "bytes" Text :> Get '[PlainText, HTML] BytesModel
|
||||
:<|> "codepoints" :> Capture "codepoints" Text :> Get '[PlainText, HTML] CodepointsModel
|
||||
:<|> "text" :> Capture "text" Text :> Get '[HTML] TextModel
|
||||
|
||||
server :: Server API
|
||||
server =
|
||||
utf8R :<|> codepointsR :<|> textR
|
||||
bytesR :<|> codepointsR :<|> textR
|
||||
where
|
||||
utf8R bytesP = do
|
||||
bytesR bytesP = do
|
||||
bytes <- Parsers.parseHexBytes bytesP `orThrow` const err400
|
||||
pure $ mkUtf8Model bytes
|
||||
pure $ BytesModel $ Decode.decodeUtf8 bytes
|
||||
|
||||
codepointsR codepointsP = do
|
||||
codepoints' <- Parsers.parseCodepoints codepointsP `orThrow` const err400
|
||||
@ -82,14 +82,11 @@ server =
|
||||
|
||||
-- /bytes/<bytes>
|
||||
|
||||
newtype Utf8Model = Utf8Model
|
||||
newtype BytesModel = BytesModel
|
||||
{ codepoints :: [([Word8], Either String Char)]
|
||||
}
|
||||
|
||||
mkUtf8Model :: [Word8] -> Utf8Model
|
||||
mkUtf8Model = Utf8Model . Decode.decodeUtf8
|
||||
|
||||
instance MimeRender PlainText Utf8Model where
|
||||
instance MimeRender PlainText BytesModel where
|
||||
mimeRender _ model = renderText $
|
||||
Table.render " " $ concat
|
||||
[ [ [ Table.cl $ Text.pack $ unwords $ map showByteHex bytes
|
||||
@ -110,7 +107,7 @@ instance MimeRender PlainText Utf8Model where
|
||||
| (bytes, eiC) <- model.codepoints
|
||||
]
|
||||
|
||||
instance MimeRender HTML Utf8Model where
|
||||
instance MimeRender HTML BytesModel where
|
||||
mimeRender _ model = renderHtml $ documentWithBody $ do
|
||||
H.table $ for_ model.codepoints $ \(bytes, eiC) -> do
|
||||
H.tr $ do
|
||||
@ -131,14 +128,7 @@ newtype CodepointsModel = CodepointsModel
|
||||
}
|
||||
|
||||
mkCodepointsModel :: [(Word, Word)] -> CodepointsModel
|
||||
mkCodepointsModel =
|
||||
CodepointsModel
|
||||
-- Limit number of returned codepoints. Otherwise it's
|
||||
-- too easy to provoke massive response bodies with requests like
|
||||
-- /codepoints/0-99999999
|
||||
. take 100000
|
||||
. map go
|
||||
. concatMap (uncurry enumFromTo)
|
||||
mkCodepointsModel = CodepointsModel . map go . concatMap (uncurry enumFromTo)
|
||||
where
|
||||
go codepoint = (codepoint, toChar codepoint)
|
||||
|
||||
|
Loading…
x
Reference in New Issue
Block a user