Move common html code to its own function
This commit is contained in:
parent
9881b44fa2
commit
3fd4177cd4
30
app/Main.hs
30
app/Main.hs
@ -108,12 +108,7 @@ instance MimeRender PlainText BytesModel where
|
|||||||
]
|
]
|
||||||
|
|
||||||
instance MimeRender HTML BytesModel where
|
instance MimeRender HTML BytesModel where
|
||||||
mimeRender _ model = renderHtml $ H.docTypeHtml $ do
|
mimeRender _ model = renderHtml $ documentWithBody $ 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_ model.codepoints $ \(bytes, eiC) -> do
|
H.table $ for_ model.codepoints $ \(bytes, eiC) -> do
|
||||||
H.tr $ do
|
H.tr $ do
|
||||||
H.td $ H.pre $ H.toHtml $ unlines $ map unwords [map showByteHex bytes, map showByteBin bytes]
|
H.td $ H.pre $ H.toHtml $ unlines $ map unwords [map showByteHex bytes, map showByteBin bytes]
|
||||||
@ -162,12 +157,7 @@ instance MimeRender PlainText CodepointsModel where
|
|||||||
]
|
]
|
||||||
|
|
||||||
instance MimeRender HTML CodepointsModel where
|
instance MimeRender HTML CodepointsModel where
|
||||||
mimeRender _ model = renderHtml $ H.docTypeHtml $ do
|
mimeRender _ model = renderHtml $ documentWithBody $ 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_ model.codepoints $ \(codepoint, eiC) ->
|
H.table $ for_ model.codepoints $ \(codepoint, eiC) ->
|
||||||
H.tr $ do
|
H.tr $ do
|
||||||
H.td $ H.code $ H.toHtml $ Text.pack $ printf "0x%X" codepoint
|
H.td $ H.code $ H.toHtml $ Text.pack $ printf "0x%X" codepoint
|
||||||
@ -187,12 +177,7 @@ newtype TextModel = TextModel
|
|||||||
}
|
}
|
||||||
|
|
||||||
instance MimeRender HTML TextModel where
|
instance MimeRender HTML TextModel where
|
||||||
mimeRender _ model = renderHtml $ H.docTypeHtml $ do
|
mimeRender _ model = renderHtml $ documentWithBody $ 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.table $ for_ (Text.unpack model.text) $ \c -> do
|
||||||
H.tr $ do
|
H.tr $ do
|
||||||
H.td $ H.input ! A.class_ "charbox" ! A.value (H.toValue [c])
|
H.td $ H.input ! A.class_ "charbox" ! A.value (H.toValue [c])
|
||||||
@ -221,6 +206,15 @@ orThrow (Right val) _ = pure val
|
|||||||
printfHtml :: PrintfArg a => String -> a -> H.Html
|
printfHtml :: PrintfArg a => String -> a -> H.Html
|
||||||
printfHtml fmt = (H.toHtml :: String -> H.Html) . printf fmt
|
printfHtml fmt = (H.toHtml :: String -> H.Html) . printf fmt
|
||||||
|
|
||||||
|
documentWithBody :: H.Html -> H.Html
|
||||||
|
documentWithBody body =
|
||||||
|
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 body
|
||||||
|
|
||||||
-- HTML routes
|
-- HTML routes
|
||||||
|
|
||||||
data HTML
|
data HTML
|
||||||
|
Loading…
x
Reference in New Issue
Block a user