paul/utoy
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Compare commits

base: paul:647b5c2ad1cbac737b2372fdf371e0863a059640
Branches Tags
paul:main
paul:static-build
paul:feature/search
paul:0.6.3
paul:0.6.2
paul:0.6
paul:0.5
paul:0.4
paul:0.3
..
compare: paul:fde68ee8339b57737c8db6aa4a53dc9558748dc2
Branches Tags
paul:static-build
paul:main
paul:feature/search
paul:0.6.3
paul:0.6.2
paul:0.6
paul:0.5
paul:0.4
paul:0.3

No commits in common. "647b5c2ad1cbac737b2372fdf371e0863a059640" and "fde68ee8339b57737c8db6aa4a53dc9558748dc2" have entirely different histories.
647b5c2ad1 ... fde68ee833

1 changed files with 8 additions and 18 deletions
Show Stats Expand all files Collapse all files

26
app/Main.hs
View File

@ -61,17 +61,17 @@ app :: Application
app = serve (Proxy :: Proxy API) server app = serve (Proxy :: Proxy API) server
type API = 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 :<|> "codepoints" :> Capture "codepoints" Text :> Get '[PlainText, HTML] CodepointsModel
:<|> "text" :> Capture "text" Text :> Get '[HTML] TextModel :<|> "text" :> Capture "text" Text :> Get '[HTML] TextModel
server :: Server API server :: Server API
server = server =
utf8R :<|> codepointsR :<|> textR bytesR :<|> codepointsR :<|> textR
where where
utf8R bytesP = do bytesR bytesP = do
bytes <- Parsers.parseHexBytes bytesP `orThrow` const err400 bytes <- Parsers.parseHexBytes bytesP `orThrow` const err400
pure $ mkUtf8Model bytes pure $ BytesModel $ Decode.decodeUtf8 bytes
codepointsR codepointsP = do codepointsR codepointsP = do
codepoints' <- Parsers.parseCodepoints codepointsP `orThrow` const err400 codepoints' <- Parsers.parseCodepoints codepointsP `orThrow` const err400
@ -82,14 +82,11 @@ server =
-- /bytes/<bytes> -- /bytes/<bytes>
newtype Utf8Model = Utf8Model newtype BytesModel = BytesModel
{ codepoints :: [([Word8], Either String Char)] { codepoints :: [([Word8], Either String Char)]
} }
mkUtf8Model :: [Word8] -> Utf8Model instance MimeRender PlainText BytesModel where
mkUtf8Model = Utf8Model . Decode.decodeUtf8
instance MimeRender PlainText Utf8Model where
mimeRender _ model = renderText $ mimeRender _ model = renderText $
Table.render " " $ concat Table.render " " $ concat
[ [ [ Table.cl $ Text.pack $ unwords $ map showByteHex bytes [ [ [ Table.cl $ Text.pack $ unwords $ map showByteHex bytes
@ -110,7 +107,7 @@ instance MimeRender PlainText Utf8Model where
| (bytes, eiC) <- model.codepoints | (bytes, eiC) <- model.codepoints
] ]
instance MimeRender HTML Utf8Model where instance MimeRender HTML BytesModel where
mimeRender _ model = renderHtml $ documentWithBody $ do mimeRender _ model = renderHtml $ documentWithBody $ do
H.table $ for_ model.codepoints $ \(bytes, eiC) -> do H.table $ for_ model.codepoints $ \(bytes, eiC) -> do
H.tr $ do H.tr $ do
@ -131,14 +128,7 @@ newtype CodepointsModel = CodepointsModel
} }
mkCodepointsModel :: [(Word, Word)] -> CodepointsModel mkCodepointsModel :: [(Word, Word)] -> CodepointsModel
mkCodepointsModel = mkCodepointsModel = CodepointsModel . map go . concatMap (uncurry enumFromTo)
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)
where where
go codepoint = (codepoint, toChar codepoint) go codepoint = (codepoint, toChar codepoint)