{- |
Module      : Htmx.Swap
Description : Provides a type for swap styles

Provides a type and utilities for the "swap style" for hx-swap
<https://htmx.org/attributes/hx-swap/>
-}
module Htmx.Swap where

import Data.Text (Text, pack)
import Htmx.Render
import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..))

-- | <https://htmx.org/attributes/hx-swap/>
-- The different styles that can be used for swapping in content.
-- Usually defaults to 'InnerHTML'
data Swap
    = -- | Replace the inner html of the target element
      InnerHTML
    | -- | Replace the entire target element with the response
      OuterHTML
    | -- | Replace the text content of the target element, without parsing the response as HTML
      TextContent
    | -- | Insert the response before the target element
      BeforeBegin
    | -- | Insert the response before the first child of the target element
      AfterBegin
    | -- | Insert the response after the last child of the target element
      BeforeEnd
    | -- | Insert the response after the target element
      AfterEnd
    | -- | Deletes the target element regardless of the response
      Delete
    | -- | Does not append content from response (out of band items will still be processed).
      None

instance Render Swap where
    render :: Swap -> Text
render = \case
        Swap
InnerHTML -> Text
"innerHTML"
        Swap
OuterHTML -> Text
"outerHTML"
        Swap
TextContent -> Text
"textContent"
        Swap
BeforeBegin -> Text
"beforeBegin"
        Swap
AfterBegin -> Text
"afterBegin"
        Swap
BeforeEnd -> Text
"beforeEnd"
        Swap
AfterEnd -> Text
"afterEnd"
        Swap
Delete -> Text
"delete"
        Swap
None -> Text
"none"

instance ToHttpApiData Swap where
    toUrlPiece :: Swap -> Text
toUrlPiece = Swap -> Text
forall a. Render a => a -> Text
render

instance FromHttpApiData Swap where
    parseUrlPiece :: Text -> Either Text Swap
parseUrlPiece = \case
        Text
"innerHTML" -> Swap -> Either Text Swap
forall a b. b -> Either a b
Right Swap
InnerHTML
        Text
"outerHTML" -> Swap -> Either Text Swap
forall a b. b -> Either a b
Right Swap
OuterHTML
        Text
"textContent" -> Swap -> Either Text Swap
forall a b. b -> Either a b
Right Swap
TextContent
        Text
"beforeBegin" -> Swap -> Either Text Swap
forall a b. b -> Either a b
Right Swap
BeforeBegin
        Text
"afterBegin" -> Swap -> Either Text Swap
forall a b. b -> Either a b
Right Swap
AfterBegin
        Text
"beforeEnd" -> Swap -> Either Text Swap
forall a b. b -> Either a b
Right Swap
BeforeEnd
        Text
"afterEnd" -> Swap -> Either Text Swap
forall a b. b -> Either a b
Right Swap
AfterEnd
        Text
"delete" -> Swap -> Either Text Swap
forall a b. b -> Either a b
Right Swap
Delete
        Text
"none" -> Swap -> Either Text Swap
forall a b. b -> Either a b
Right Swap
None
        Text
t -> Text -> Either Text Swap
forall a b. a -> Either a b
Left (Text -> Either Text Swap) -> Text -> Either Text Swap
forall a b. (a -> b) -> a -> b
$ Text
"Could not parse " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". Expected a valid Swap"