{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Web.Page.Html
( class__
, toText
, genName
, genNamePre
, libCss
, libJs
, fromHex
, toHex
, Html
) where
import Data.Text
import Lucid
import Protolude hiding ((%))
import qualified Data.Text.Lazy as Lazy
import Codec.Picture.Types (PixelRGB8(..))
import Data.Attoparsec.Text
import Numeric
import Data.Text.Format
import Data.Text.Lazy.Builder (toLazyText)
class__ :: Text -> Attribute
class__ t = class_ (" " <> t <> " ")
toText :: Html a -> Text
toText = Lazy.toStrict . renderText
genName :: (MonadState Int m) => m Text
genName = do
modify (+1)
show <$> get
genNamePre :: (MonadState Int m) => Text -> m Text
genNamePre pre = (pre <>) <$> genName
libCss :: Text -> Html ()
libCss url = link_
[ rel_ "stylesheet"
, href_ url
]
libJs :: Text -> Html ()
libJs url = with (script_ mempty) [src_ url]
fromHex :: Parser PixelRGB8
fromHex =
(\((r,g),b) ->
PixelRGB8 (fromIntegral r) (fromIntegral g) (fromIntegral b)) .
(\(f,b) -> (f `divMod` (256 :: Int), b)) .
(`divMod` 256) <$>
(string "#" *> hexadecimal)
toHex :: PixelRGB8 -> Text
toHex (PixelRGB8 r g b) =
"#"
<> justifyRight 2 '0' (toStrict $ toLazyText $ hex r)
<> justifyRight 2 '0' (toStrict $ toLazyText $ hex g)
<> justifyRight 2 '0' (toStrict $ toLazyText $ hex b)
instance ToHtml Double where
toHtml = toHtml . (show :: Double -> Text)
toHtmlRaw = toHtmlRaw . (show :: Double -> Text)
instance ToHtml Bool where
toHtml = toHtml . bool ("false" :: Text) "true"
toHtmlRaw = toHtmlRaw . bool ("false" :: Text) "true"
instance ToHtml Int where
toHtml = toHtml . (show :: Int -> Text)
toHtmlRaw = toHtmlRaw . (show :: Int -> Text)
instance ToHtml PixelRGB8 where
toHtml = toHtml . toHex
toHtmlRaw = toHtmlRaw . toHex
instance ToHtml () where
toHtml = const "()"
toHtmlRaw = const "()"