{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE IncoherentInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Key generators and miscellaneous html utilities.
--
-- Uses the lucid 'Lucid.Html'.
module Web.Rep.Html
  ( class__,
    toText,
    libCss,
    libJs,
    HtmlT,
    Html,
  )
where

import Data.Bool
import Data.List (intersperse)
import Data.Text (Text, pack)
import qualified Data.Text.Lazy as Lazy
import Lucid

-- $setup
-- >>> :set -XOverloadedStrings

-- | FIXME: A horrible hack to separate class id's
class__ :: Text -> Attribute
class__ :: Text -> Attribute
class__ Text
t = Text -> Attribute
class_ (Text
" " forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
" ")

-- | Convert html to text
toText :: Html a -> Text
toText :: forall a. Html a -> Text
toText = Text -> Text
Lazy.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Html a -> Text
renderText

-- | Convert a link to a css library from text to html.
--
-- >>> libCss "https://stackpath.bootstrapcdn.com/bootstrap/4.3.1/css/bootstrap.min.css"
-- <link rel="stylesheet" href="https://stackpath.bootstrapcdn.com/bootstrap/4.3.1/css/bootstrap.min.css">
libCss :: Text -> Html ()
libCss :: Text -> Html ()
libCss Text
url =
  forall (m :: * -> *). Monad m => [Attribute] -> HtmlT m ()
link_
    [ Text -> Attribute
rel_ Text
"stylesheet",
      Text -> Attribute
href_ Text
url
    ]

-- | Convert a link to a js library from text to html.
--
-- >>> libJs "https://code.jquery.com/jquery-3.3.1.slim.min.js"
-- <script src="https://code.jquery.com/jquery-3.3.1.slim.min.js"></script>
libJs :: Text -> Html ()
libJs :: Text -> Html ()
libJs Text
url = forall a. With a => a -> [Attribute] -> a
with (forall arg result. TermRaw arg result => arg -> result
script_ forall a. Monoid a => a
mempty) [Text -> Attribute
src_ Text
url]

-- | FIXME: `ToHtml a` is used throughout, mostly because `Show a` gives "\"text\"" for show "text", and hilarity ensues when rendering this to a web page, and I couldn't work out how to properly get around this.
--
-- Hence, these orphans.
instance ToHtml Double where
  toHtml :: forall (m :: * -> *). Monad m => Double -> HtmlT m ()
toHtml = forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)

  toHtmlRaw :: forall (m :: * -> *). Monad m => Double -> HtmlT m ()
toHtmlRaw = forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtmlRaw forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)

instance ToHtml Bool where
  toHtml :: forall (m :: * -> *). Monad m => Bool -> HtmlT m ()
toHtml = forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> a -> Bool -> a
bool (Text
"false" :: Text) Text
"true"

  toHtmlRaw :: forall (m :: * -> *). Monad m => Bool -> HtmlT m ()
toHtmlRaw = forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtmlRaw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> a -> Bool -> a
bool (Text
"false" :: Text) Text
"true"

instance ToHtml Int where
  toHtml :: forall (m :: * -> *). Monad m => Int -> HtmlT m ()
toHtml = forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)

  toHtmlRaw :: forall (m :: * -> *). Monad m => Int -> HtmlT m ()
toHtmlRaw = forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtmlRaw forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)

instance ToHtml () where
  toHtml :: forall (m :: * -> *). Monad m => () -> HtmlT m ()
toHtml = forall a b. a -> b -> a
const HtmlT m ()
"()"

  toHtmlRaw :: forall (m :: * -> *). Monad m => () -> HtmlT m ()
toHtmlRaw = forall a b. a -> b -> a
const HtmlT m ()
"()"

-- I'm going to hell for sure.
instance {-# INCOHERENT #-} (ToHtml a) => ToHtml [a] where
  toHtml :: forall (m :: * -> *). Monad m => [a] -> HtmlT m ()
toHtml = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
Data.List.intersperse (forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml (Text
"," :: Text)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml

  toHtmlRaw :: forall (m :: * -> *). Monad m => [a] -> HtmlT m ()
toHtmlRaw = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
Data.List.intersperse (forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtmlRaw (Text
"," :: Text)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtmlRaw