{- |
Module      : Htmx.Lucid.Core
Description : Provides core htmx tags

This module defines the "core" 11 HTMX attributes
<https://htmx.org/reference/#attributes>
-}
module Htmx.Lucid.Core where

import Data.Text (Text, pack)
import Htmx.Event
import Htmx.Render
import Htmx.Swap (Swap)
import Lucid (Html, HtmlT, script_, src_)
import Lucid.Base (Attribute, makeAttribute)

-- | <https://htmx.org/attributes/hx-get/>
-- issues a GET to the specified URL
hxGet_ :: Text -> Attribute
hxGet_ :: Text -> Attribute
hxGet_ = Text -> Text -> Attribute
makeAttribute Text
"hx-get"

-- | <https://htmx.org/attributes/hx-get/>
-- issues a POST to the specified URL
hxPost_ :: Text -> Attribute
hxPost_ :: Text -> Attribute
hxPost_ = Text -> Text -> Attribute
makeAttribute Text
"hx-post"

-- | <https://htmx.org/attributes/hx-push-url/>
-- push a URL into the browser location bar to create history
hxPushUrl_ :: Text -> Attribute
hxPushUrl_ :: Text -> Attribute
hxPushUrl_ = Text -> Text -> Attribute
makeAttribute Text
"hx-push-url"

-- | <https://htmx.org/attributes/hx-select/>
-- select content to swap in from a response
hxSelect_ :: Text -> Attribute
hxSelect_ :: Text -> Attribute
hxSelect_ = Text -> Text -> Attribute
makeAttribute Text
"hx-select"

-- | <https://htmx.org/attributes/hx-select-oob/>
-- select content to swap in from a response, somewhere other than the target
-- (out of band)
hxSelectOob_ :: Text -> Attribute
hxSelectOob_ :: Text -> Attribute
hxSelectOob_ = Text -> Text -> Attribute
makeAttribute Text
"hx-select-oob"

-- | <https://htmx.org/attributes/hx-swap/>
-- controls how content will swap in (outerHTML, beforeend, afterend, …)
hxSwap_ :: Text -> Attribute
hxSwap_ :: Text -> Attribute
hxSwap_ = Text -> Text -> Attribute
makeAttribute Text
"hx-swap"

-- | Like 'hxSwap' but takes a strongly typed swap style.
-- This doesn't allow [modifiers](https://htmx.org/attributes/hx-swap/#modifiers) to be applied.
hxSwapS_ :: Swap -> Attribute
hxSwapS_ :: Swap -> Attribute
hxSwapS_ = Text -> Text -> Attribute
makeAttribute Text
"hx-swap" (Text -> Attribute) -> (Swap -> Text) -> Swap -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Swap -> Text
forall a. Render a => a -> Text
render

-- | <https://htmx.org/attributes/hx-swap-oob/>
-- mark element to swap in from a response (out of band)
hxSwapOob_ :: Text -> Attribute
hxSwapOob_ :: Text -> Attribute
hxSwapOob_ = Text -> Text -> Attribute
makeAttribute Text
"hx-swap-oob"

-- | <https://htmx.org/attributes/hx-target/>
-- specifies the target element to be swapped
hxTarget_ :: Text -> Attribute
hxTarget_ :: Text -> Attribute
hxTarget_ = Text -> Text -> Attribute
makeAttribute Text
"hx-target"

-- | <https://htmx.org/attributes/hx-trigger/>
-- specifies the event that triggers the request
hxTrigger_ :: Text -> Attribute
hxTrigger_ :: Text -> Attribute
hxTrigger_ = Text -> Text -> Attribute
makeAttribute Text
"hx-trigger"

-- | <https://htmx.org/attributes/hx-vals/>
-- add values to submit with the request (JSON format)
hxVals_ :: Text -> Attribute
hxVals_ :: Text -> Attribute
hxVals_ = Text -> Text -> Attribute
makeAttribute Text
"hx-vals"

data OnEvent = DomOnEvent Text | HtmxOnEvent HtmxEvent

-- | <https://htmx.org/attributes/hx-on/>
-- handle events with inline scripts on elements
hxOn_ :: OnEvent -> Text -> Attribute
hxOn_ :: OnEvent -> Text -> Attribute
hxOn_ = \case
    DomOnEvent Text
event -> Text -> Text -> Attribute
makeAttribute (Text -> Text -> Attribute) -> Text -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ Text
"hx-on:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
event
    HtmxOnEvent HtmxEvent
htmxEvent -> Text -> Text -> Attribute
makeAttribute (Text -> Text -> Attribute) -> Text -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ Text
"hx-on::" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HtmxEvent -> Text
forall a. Render a => a -> Text
render HtmxEvent
htmxEvent