Compare commits
2 Commits
da2540c3fa
...
f5fd1089b1
Author | SHA1 | Date | |
---|---|---|---|
f5fd1089b1 | |||
5bdf69ef91 |
32
app/Main.hs
32
app/Main.hs
@ -63,10 +63,11 @@ app = serve (Proxy :: Proxy API) server
|
|||||||
type API =
|
type API =
|
||||||
"bytes" :> Capture "bytes" Text :> Get '[PlainText, HTML] BytesModel
|
"bytes" :> Capture "bytes" Text :> Get '[PlainText, HTML] BytesModel
|
||||||
:<|> "codepoints" :> Capture "codepoints" Text :> Get '[PlainText] CodepointsModel
|
:<|> "codepoints" :> Capture "codepoints" Text :> Get '[PlainText] CodepointsModel
|
||||||
|
:<|> "text" :> Capture "text" Text :> Get '[HTML] TextModel
|
||||||
|
|
||||||
server :: Server API
|
server :: Server API
|
||||||
server =
|
server =
|
||||||
bytesR :<|> codepointsR
|
bytesR :<|> codepointsR :<|> textR
|
||||||
where
|
where
|
||||||
bytesR bytesP = do
|
bytesR bytesP = do
|
||||||
bytes <- Parsers.parseHexBytes bytesP `orThrow` const err400
|
bytes <- Parsers.parseHexBytes bytesP `orThrow` const err400
|
||||||
@ -76,6 +77,9 @@ server =
|
|||||||
codepoints' <- Parsers.parseCodepoints codepointsP `orThrow` const err400
|
codepoints' <- Parsers.parseCodepoints codepointsP `orThrow` const err400
|
||||||
pure $ mkCodepointsModel codepoints'
|
pure $ mkCodepointsModel codepoints'
|
||||||
|
|
||||||
|
textR textP = do
|
||||||
|
pure $ TextModel textP
|
||||||
|
|
||||||
-- /bytes/<bytes>
|
-- /bytes/<bytes>
|
||||||
|
|
||||||
newtype BytesModel = BytesModel
|
newtype BytesModel = BytesModel
|
||||||
@ -118,10 +122,10 @@ instance MimeRender HTML BytesModel where
|
|||||||
H.td ! A.colspan "4" $ H.toHtml $ "Decoding error: " ++ err
|
H.td ! A.colspan "4" $ H.toHtml $ "Decoding error: " ++ err
|
||||||
Right c -> do
|
Right c -> do
|
||||||
H.td $ do
|
H.td $ do
|
||||||
H.input ! A.value (H.toValue [c]) ! A.style "text-align: center; width: 2em; font-size: 1em;"
|
H.input ! A.class_ "charbox" ! A.value (H.toValue [c])
|
||||||
H.td $ H.code $ printfHtml "U+%04X" c
|
H.td $ H.code $ printfHtml "U+%04X" c
|
||||||
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.toHtml $ fromMaybe "" $ blockName c
|
H.td $ H.code $ H.toHtml $ fromMaybe "" $ blockName c
|
||||||
|
|
||||||
-- /codepoints/<codepoints>
|
-- /codepoints/<codepoints>
|
||||||
|
|
||||||
@ -158,6 +162,26 @@ instance MimeRender PlainText CodepointsModel where
|
|||||||
| (codepoint, eiC) <- model.codepoints
|
| (codepoint, eiC) <- model.codepoints
|
||||||
]
|
]
|
||||||
|
|
||||||
|
-- /text/<text>
|
||||||
|
|
||||||
|
newtype TextModel = TextModel
|
||||||
|
{ text :: Text
|
||||||
|
}
|
||||||
|
|
||||||
|
instance MimeRender HTML TextModel where
|
||||||
|
mimeRender _ model = renderHtml $ H.docTypeHtml $ do
|
||||||
|
H.head $ do
|
||||||
|
H.meta ! A.charset "utf-8"
|
||||||
|
H.title "utoy"
|
||||||
|
H.style $ H.toHtml $ Encoding.decodeUtf8 $(embedFile "static/utoy.css")
|
||||||
|
H.body $ do
|
||||||
|
H.table $ for_ (Text.unpack model.text) $ \c -> do
|
||||||
|
H.tr $ do
|
||||||
|
H.td $ H.input ! A.class_ "charbox" ! A.value (H.toValue [c])
|
||||||
|
H.td $ H.code $ printfHtml "U+%04X" 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
|
||||||
|
|
||||||
-- Utilities
|
-- Utilities
|
||||||
|
|
||||||
renderText :: Text -> BL.ByteString
|
renderText :: Text -> BL.ByteString
|
||||||
|
2
hie.yaml
2
hie.yaml
@ -4,7 +4,7 @@ cradle:
|
|||||||
component: "utoy:lib"
|
component: "utoy:lib"
|
||||||
|
|
||||||
- path: "./app/Main.hs"
|
- path: "./app/Main.hs"
|
||||||
component: "utoy:exe:utoy-exe"
|
component: "utoy:exe:utoy"
|
||||||
|
|
||||||
- path: "./test"
|
- path: "./test"
|
||||||
component: "utoy:test:utoy-test"
|
component: "utoy:test:utoy-test"
|
||||||
|
@ -19,3 +19,9 @@ pre, code {
|
|||||||
pre {
|
pre {
|
||||||
margin: 0; font-size: 0.5em;
|
margin: 0; font-size: 0.5em;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
.charbox {
|
||||||
|
text-align: center;
|
||||||
|
width: 2em;
|
||||||
|
font-size: 1em;
|
||||||
|
}
|
||||||
|
Loading…
x
Reference in New Issue
Block a user