{-# LANGUAGE OverloadedStrings #-}

module Lucid.Htmx
  ( hxBoost_,
    hxConfirm_,
    hxEncoding_,
    hxExt_,
    hxDelete_,
    hxDisable_,
    hxGet_,
    hxHeaders_,
    hxHistoryElt_,
    hxInclude_,
    hxIndicator_,
    hxParams_,
    hxPatch_,
    hxPost_,
    hxPreserve_,
    hxPrompt_,
    hxPushUrl_,
    hxPut_,
    hxRequest_,
    hxSelect_,
    hxSse_,
    hxSwapOob_,
    hxSwap_,
    hxTarget_,
    hxTrigger_,
    hxVals_,
    hxWs_,
    useHtmx,
    useHtmxExtension,
    useHtmxVersion,
    useHtmxVersionExtension,
  )
where

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

-- | <https://htmx.org/attributes/hx-boost/>
hxBoost_ :: Text -> Attribute
hxBoost_ :: Text -> Attribute
hxBoost_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-boost"

-- | <https://htmx.org/attributes/hx-confirm/>
hxConfirm_ :: Text -> Attribute
hxConfirm_ :: Text -> Attribute
hxConfirm_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-confirm"

-- | <https://htmx.org/attributes/hx-delete/>
hxDelete_ :: Text -> Attribute
hxDelete_ :: Text -> Attribute
hxDelete_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-delete"

-- | <https://htmx.org/attributes/hx-disable/>
hxDisable_ :: Attribute
hxDisable_ :: Attribute
hxDisable_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-disable" Text
forall a. Monoid a => a
mempty

-- | <https://htmx.org/attributes/hx-encoding/>
hxEncoding_ :: Text -> Attribute
hxEncoding_ :: Text -> Attribute
hxEncoding_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-encoding"

-- | <https://htmx.org/attributes/hx-ext/>
hxExt_ :: Text -> Attribute
hxExt_ :: Text -> Attribute
hxExt_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-ext"

-- | <https://htmx.org/attributes/hx-get/>
hxGet_ :: Text -> Attribute
hxGet_ :: Text -> Attribute
hxGet_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-get"

-- | <https://htmx.org/attributes/hx-headers/>
hxHeaders_ :: Text -> Attribute
hxHeaders_ :: Text -> Attribute
hxHeaders_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-headers"

-- | <https://htmx.org/attributes/hx-history-elt/>
hxHistoryElt_ :: Attribute
hxHistoryElt_ :: Attribute
hxHistoryElt_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-history-elt" Text
forall a. Monoid a => a
mempty

-- | <https://htmx.org/attributes/hx-include/>
hxInclude_ :: Text -> Attribute
hxInclude_ :: Text -> Attribute
hxInclude_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-include"

-- | <https://htmx.org/attributes/hx-indicator/>
hxIndicator_ :: Text -> Attribute
hxIndicator_ :: Text -> Attribute
hxIndicator_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-indicator"

-- | <https://htmx.org/attributes/hx-params/>
hxParams_ :: Text -> Attribute
hxParams_ :: Text -> Attribute
hxParams_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-params"

-- | <https://htmx.org/attributes/hx-patch/>
hxPatch_ :: Text -> Attribute
hxPatch_ :: Text -> Attribute
hxPatch_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-patch"

-- | <https://htmx.org/attributes/hx-post/>
hxPost_ :: Text -> Attribute
hxPost_ :: Text -> Attribute
hxPost_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-post"

-- | <https://htmx.org/attributes/hx-preserve/>
hxPreserve_ :: Text -> Attribute
hxPreserve_ :: Text -> Attribute
hxPreserve_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-preserve"

-- | <https://htmx.org/attributes/hx-prompt/>
hxPrompt_ :: Text -> Attribute
hxPrompt_ :: Text -> Attribute
hxPrompt_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-prompt"

-- | <https://htmx.org/attributes/hx-push-url/>
hxPushUrl_ :: Text -> Attribute
hxPushUrl_ :: Text -> Attribute
hxPushUrl_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-push-url"

-- | <https://htmx.org/attributes/hx-put/>
hxPut_ :: Text -> Attribute
hxPut_ :: Text -> Attribute
hxPut_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-put"

-- | <https://htmx.org/attributes/hx-request/>
hxRequest_ :: Text -> Attribute
hxRequest_ :: Text -> Attribute
hxRequest_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-request"

-- | <https://htmx.org/attributes/hx-select/>
hxSelect_ :: Text -> Attribute
hxSelect_ :: Text -> Attribute
hxSelect_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-select"

-- | <https://htmx.org/attributes/hx-sse/>
hxSse_ :: Text -> Attribute
hxSse_ :: Text -> Attribute
hxSse_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-sse"

-- | <https://htmx.org/attributes/hx-swap-oob/>
hxSwapOob_ :: Text -> Attribute
hxSwapOob_ :: Text -> Attribute
hxSwapOob_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-swap-oob"

-- | <https://htmx.org/attributes/hx-swap/>
hxSwap_ :: Text -> Attribute
hxSwap_ :: Text -> Attribute
hxSwap_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-swap"

-- | <https://htmx.org/attributes/hx-target/>
hxTarget_ :: Text -> Attribute
hxTarget_ :: Text -> Attribute
hxTarget_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-target"

-- | <https://htmx.org/attributes/hx-trigger/>
hxTrigger_ :: Text -> Attribute
hxTrigger_ :: Text -> Attribute
hxTrigger_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-trigger"

-- | <https://htmx.org/attributes/hx-vals/>
hxVals_ :: Text -> Attribute
hxVals_ :: Text -> Attribute
hxVals_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-vals"

-- | <https://htmx.org/attributes/hx-ws/>
hxWs_ :: Text -> Attribute
hxWs_ :: Text -> Attribute
hxWs_ = Text -> Text -> Attribute
makeAttribute Text
"data-hx-ws"

-- | Place in your @head_@ tag to use htmx attributes in your lucid template
useHtmx :: Monad m => HtmlT m ()
useHtmx :: HtmlT m ()
useHtmx = [Attribute] -> Html () -> HtmlT m ()
forall arg result. TermRaw arg result => arg -> result
script_ [Text -> Attribute
src_ Text
htmxSrc] (Html ()
"" :: Html ())

-- | Place in your template after @useHtmx@, but before where the extension is used via @hxExt_@
useHtmxExtension :: Monad m => Text -> HtmlT m ()
useHtmxExtension :: Text -> HtmlT m ()
useHtmxExtension Text
ext = [Attribute] -> Html () -> HtmlT m ()
forall arg result. TermRaw arg result => arg -> result
script_ [Text -> Attribute
src_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ Text
htmxSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
extensionPath Text
ext] (Html ()
"" :: Html ())

-- | Choose the version of htmx to use using a 3-tuple representing semantic versioning
useHtmxVersion :: Monad m => (Int, Int, Int) -> HtmlT m ()
useHtmxVersion :: (Int, Int, Int) -> HtmlT m ()
useHtmxVersion (Int, Int, Int)
semVer = [Attribute] -> Html () -> HtmlT m ()
forall arg result. TermRaw arg result => arg -> result
script_ [Text -> Attribute
src_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ (Int, Int, Int) -> Text
htmxSrcWithSemVer (Int, Int, Int)
semVer] (Html ()
"" :: Html ())

-- | Choose the version of a htmx extension you want to use.
-- Should only be used when using @useHtmxVersion@ and the semantic version should be the same
useHtmxVersionExtension :: Monad m => (Int, Int, Int) -> Text -> HtmlT m ()
useHtmxVersionExtension :: (Int, Int, Int) -> Text -> HtmlT m ()
useHtmxVersionExtension (Int, Int, Int)
semVer Text
ext = [Attribute] -> Html () -> HtmlT m ()
forall arg result. TermRaw arg result => arg -> result
script_ [Text -> Attribute
src_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ (Int, Int, Int) -> Text
htmxSrcWithSemVer (Int, Int, Int)
semVer Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
extensionPath Text
ext] (Html ()
"" :: Html ())

htmxSrc :: Text
htmxSrc :: Text
htmxSrc = Text
"https://unpkg.com/htmx.org"

showT :: Show a => a -> Text
showT :: a -> Text
showT = String -> Text
pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

htmxSrcWithSemVer :: (Int, Int, Int) -> Text
htmxSrcWithSemVer :: (Int, Int, Int) -> Text
htmxSrcWithSemVer (Int
major, Int
minor, Int
patch) =
  Text
htmxSrc
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
major
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
minor
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
patch

extensionPath :: Text -> Text
extensionPath :: Text -> Text
extensionPath Text
ext = Text
"/dist/ext/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ext Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".js"