{-# LANGUAGE UndecidableInstances  #-}
{-|
Module: IHP.HSX.Attribute
Copyright: (c) digitally induced GmbH, 2023
-}
module IHP.HSX.Attribute
( ApplyAttribute (..)
) where

import Prelude
import Text.Blaze.Html5 ((!))
import qualified Text.Blaze.Html5 as Html5
import Text.Blaze.Internal (attribute, MarkupM (Parent, Leaf), StaticString (..))
import Data.String.Conversions
import IHP.HSX.ToHtml
import qualified Data.Text as Text
import Data.Text (Text)

class ApplyAttribute value where
    applyAttribute :: Text -> Text -> value -> (Html5.Html -> Html5.Html)

instance ApplyAttribute Bool where
    applyAttribute :: Text -> Text -> Bool -> Html -> Html
applyAttribute Text
attr Text
attr' Bool
True Html
h = Html
h Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! (Tag -> Tag -> AttributeValue -> Attribute
attribute (Text -> Tag
Html5.textTag Text
attr) (Text -> Tag
Html5.textTag Text
attr') (Text -> AttributeValue
Html5.textValue Text
value))
        where
            value :: Text
value = if Text
"data-" Text -> Text -> Bool
`Text.isPrefixOf` Text
attr
                    then Text
"true" -- "true" for data attributes
                    else Text
attr -- normal html boolean attriubtes, like <input disabled="disabled"/>, see https://html.spec.whatwg.org/multipage/common-microsyntaxes.html#boolean-attributes
    applyAttribute Text
attr Text
attr' Bool
false Html
h | Text
"data-" Text -> Text -> Bool
`Text.isPrefixOf` Text
attr = Html
h Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! (Tag -> Tag -> AttributeValue -> Attribute
attribute (Text -> Tag
Html5.textTag Text
attr) (Text -> Tag
Html5.textTag Text
attr') AttributeValue
"false") -- data attribute set to "false"
    applyAttribute Text
attr Text
attr' Bool
false Html
h = Html
h -- html boolean attribute, like <input disabled/> will be dropped as there is no other way to specify that it's set to false
    {-# INLINE applyAttribute #-}

instance ApplyAttribute attribute => ApplyAttribute (Maybe attribute) where
    applyAttribute :: Text -> Text -> Maybe attribute -> Html -> Html
applyAttribute Text
attr Text
attr' (Just attribute
value) Html
h = Text -> Text -> attribute -> Html -> Html
forall value.
ApplyAttribute value =>
Text -> Text -> value -> Html -> Html
applyAttribute Text
attr Text
attr' attribute
value Html
h
    applyAttribute Text
attr Text
attr' Maybe attribute
Nothing Html
h = Html
h
    {-# INLINE applyAttribute #-}

instance ApplyAttribute Html5.AttributeValue where
    applyAttribute :: Text -> Text -> AttributeValue -> Html -> Html
applyAttribute Text
attr Text
attr' AttributeValue
value Html
h = Html
h Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! (Tag -> Tag -> AttributeValue -> Attribute
attribute (Text -> Tag
Html5.textTag Text
attr) (Text -> Tag
Html5.textTag Text
attr') AttributeValue
value)
    {-# INLINE applyAttribute #-}

instance {-# OVERLAPPABLE #-} ConvertibleStrings value Html5.AttributeValue => ApplyAttribute value where
    applyAttribute :: Text -> Text -> value -> Html -> Html
applyAttribute Text
attr Text
attr' value
value Html
h = Text -> Text -> AttributeValue -> Html -> Html
forall value.
ApplyAttribute value =>
Text -> Text -> value -> Html -> Html
applyAttribute Text
attr Text
attr' ((value -> AttributeValue
forall a b. ConvertibleStrings a b => a -> b
cs value
value) :: Html5.AttributeValue) Html
h
    {-# INLINE applyAttribute #-}