{-# LANGUAGE OverloadedStrings #-}

module Lucid.Htmx.Servant
  ( hxDeleteSafe_,
    hxGetSafe_,
    hxPatchSafe_,
    hxPostSafe_,
    hxPushUrlSafe_,
    hxPutSafe_,
  )
where

import Data.Text (Text)
import Lucid.Base (Attribute)
import Lucid.Htmx
  ( hxDelete_,
    hxGet_,
    hxPatch_,
    hxPost_,
    hxPushUrl_,
    hxPut_,
  )
import Servant.API (ToHttpApiData (..), toUrlPiece)
import Servant.Links (Link)

hxDeleteSafe_ :: Link -> Attribute
hxDeleteSafe_ :: Link -> Attribute
hxDeleteSafe_ = Text -> Attribute
hxDelete_ (Text -> Attribute) -> (Link -> Text) -> Link -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Link -> Text
forall a. ToHttpApiData a => a -> Text
toUrl

hxGetSafe_ :: Link -> Attribute
hxGetSafe_ :: Link -> Attribute
hxGetSafe_ = Text -> Attribute
hxGet_ (Text -> Attribute) -> (Link -> Text) -> Link -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Link -> Text
forall a. ToHttpApiData a => a -> Text
toUrl

hxPatchSafe_ :: Link -> Attribute
hxPatchSafe_ :: Link -> Attribute
hxPatchSafe_ = Text -> Attribute
hxPatch_ (Text -> Attribute) -> (Link -> Text) -> Link -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Link -> Text
forall a. ToHttpApiData a => a -> Text
toUrl

hxPostSafe_ :: Link -> Attribute
hxPostSafe_ :: Link -> Attribute
hxPostSafe_ = Text -> Attribute
hxPost_ (Text -> Attribute) -> (Link -> Text) -> Link -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Link -> Text
forall a. ToHttpApiData a => a -> Text
toUrl

hxPushUrlSafe_ :: Either Bool Link -> Attribute
hxPushUrlSafe_ :: Either Bool Link -> Attribute
hxPushUrlSafe_ Either Bool Link
boolOrUrl = Text -> Attribute
hxPushUrl_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ case Either Bool Link
boolOrUrl of
  Left Bool
bool -> if Bool
bool then Text
"true" else Text
"false"
  Right Link
url -> Link -> Text
forall a. ToHttpApiData a => a -> Text
toUrl Link
url

hxPutSafe_ :: Link -> Attribute
hxPutSafe_ :: Link -> Attribute
hxPutSafe_ = Text -> Attribute
hxPut_ (Text -> Attribute) -> (Link -> Text) -> Link -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Link -> Text
forall a. ToHttpApiData a => a -> Text
toUrl

toUrl :: ToHttpApiData a => a -> Text
toUrl :: a -> Text
toUrl = (Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece