{-# LANGUAGE OverloadedStrings #-}

module Lucid.Alpine where

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

-- | x-data
-- Declare a new Alpine component and its data for a block of HTML
xData_ :: Text -> Attribute
xData_ :: Text -> Attribute
xData_ = Text -> Text -> Attribute
makeAttribute Text
"x-data"

{-
<div x-data="{ open: false }">
    ...
</div>
-}

-- | x-bind
-- Dynamically set HTML attributes on an element
xBind_ ::
  -- | Attribute name
  Text ->
  Text ->
  Attribute
xBind_ :: Text -> Text -> Attribute
xBind_ Text
attr = Text -> Text -> Attribute
makeAttribute (Text
"x-bind:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attr)

{-
<div x-bind:class="! open ? 'hidden' : ''">
  ...
</div>
-}

-- | x-on
-- Listen for browser events on an element
xOn_ ::
  -- | Event name
  Text ->
  Text ->
  Attribute
xOn_ :: Text -> Text -> Attribute
xOn_ Text
event = Text -> Text -> Attribute
makeAttribute (Text
"x-on:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
event)

{-
<button x-on:click="open = ! open">
  Toggle
</button>
-}

-- | x-text
-- Set the text content of an element
xText_ :: Text -> Attribute
xText_ :: Text -> Attribute
xText_ = Text -> Text -> Attribute
makeAttribute Text
"x-text"

{-
<div>
  Copyright ©

  <span x-text="new Date().getFullYear()"></span>
</div>
-}

-- | x-html
-- Set the inner HTML of an element
xHtml_ :: Text -> Attribute
xHtml_ :: Text -> Attribute
xHtml_ = Text -> Text -> Attribute
makeAttribute Text
"x-html"

{-
<div x-html="(await axios.get('/some/html/partial')).data">
  ...
</div>
-}

-- | x-model
-- Synchronize a piece of data with an input element
xModel_ ::
  -- | List of x-model modifiers
  [Text] ->
  Text ->
  Attribute
xModel_ :: [Text] -> Text -> Attribute
xModel_ [Text]
mods = case [Text]
mods of
  [] -> Text -> Text -> Attribute
makeAttribute Text
"x-model"
  [Text]
_ -> Text -> Text -> Attribute
makeAttribute (Text
"x-model." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
"." [Text]
mods)

{-
<div x-data="{ search: '' }">
  <input type="text" x-model="search">

  Searching for: <span x-text="search"></span>
</div>
-}

-- | x-show
-- Toggle the visibility of an element
xShow_ :: Text -> Attribute
xShow_ :: Text -> Attribute
xShow_ = Text -> Text -> Attribute
makeAttribute Text
"x-show"

{-
<div x-show="open">
  ...
</div>
-}

-- | x-transition
-- Transition an element in and out using CSS transitions
xTransition_ ::
  -- | Transition directive
  Maybe Text ->
  -- | List of x-transition modifiers
  [Text] ->
  Text ->
  Attribute
xTransition_ :: Maybe Text -> [Text] -> Text -> Attribute
xTransition_ Maybe Text
Nothing [] Text
_ = Text -> Text -> Attribute
makeAttribute Text
"x-transition" Text
forall a. Monoid a => a
mempty -- No directive or modifiers
xTransition_ (Just Text
dir) [] Text
attrVal = Text -> Text -> Attribute
makeAttribute (Text
"x-transition:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dir) Text
attrVal -- Directive with custom transition classes
xTransition_ Maybe Text
Nothing [Text]
mods Text
_ = Text -> Text -> Attribute
makeAttribute (Text
"x-transition." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
"." [Text]
mods) Text
forall a. Monoid a => a
mempty -- No directive, but with modifiers
xTransition_ (Just Text
dir) [Text]
mods Text
_ = Text -> Text -> Attribute
makeAttribute (Text
"x-transition:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
"." [Text]
mods) Text
forall a. Monoid a => a
mempty -- Directive with modifiers

{-
<div x-show="open" x-transition>
  ...
</div>
-}

-- | x-for
-- Repeat a block of HTML based on a data set
xFor_ :: Text -> Attribute
xFor_ :: Text -> Attribute
xFor_ = Text -> Text -> Attribute
makeAttribute Text
"x-for"

xForKey_ :: Text -> Attribute
xForKey_ :: Text -> Attribute
xForKey_ = Text -> Text -> Attribute
makeAttribute Text
":key"

{-
<template x-for="post in posts">
  <h2 x-text="post.title"></h2>
</template>
-}

-- | x-if
-- Conditionally add/remove a block of HTML from the page entirely.
xIf_ :: Text -> Attribute
xIf_ :: Text -> Attribute
xIf_ = Text -> Text -> Attribute
makeAttribute Text
"x-if"

{-
<template x-if="open">
  <div>...</div>
</template>
-}

-- | x-init
-- Run code when an element is initialized by Alpine
xInit_ :: Text -> Attribute
xInit_ :: Text -> Attribute
xInit_ = Text -> Text -> Attribute
makeAttribute Text
"x-init"

{-
<div x-init="date = new Date()"></div>
-}

-- | x-effect
-- Execute a script each time one of its dependancies change
xEffect_ :: Text -> Attribute
xEffect_ :: Text -> Attribute
xEffect_ = Text -> Text -> Attribute
makeAttribute Text
"x-effect"

{-
<div x-effect="console.log('Count is '+count)"></div>
-}

-- | x-ref
-- Reference elements directly by their specified keys using the $refs magic property
xRef_ :: Text -> Attribute
xRef_ :: Text -> Attribute
xRef_ = Text -> Text -> Attribute
makeAttribute Text
"x-ref"

{-
<input type="text" x-ref="content">

<button x-on:click="navigator.clipboard.writeText($refs.content.value)">
  Copy
</button>
-}

-- | x-cloak
-- Hide a block of HTML until after Alpine is finished initializing its contents
xCloak_ :: Attribute
xCloak_ :: Attribute
xCloak_ = Text -> Text -> Attribute
makeAttribute Text
"x-cloak" Text
forall a. Monoid a => a
mempty

{-
<div x-cloak>
  ...
</div>
-}

-- | x-ignore
-- Prevent a block of HTML from being initialized by Alpine
xIgnore_ :: Attribute
xIgnore_ :: Attribute
xIgnore_ = Text -> Text -> Attribute
makeAttribute Text
"x-ignore" Text
forall a. Monoid a => a
mempty

{-
<div x-ignore>
  ...
</div>
-}

-- | Use this value in your @head_@ tag to use Alpine.js in your lucid templates
useAlpine :: Monad m => HtmlT m ()
useAlpine :: HtmlT m ()
useAlpine = [Attribute] -> Html () -> HtmlT m ()
forall arg result. TermRaw arg result => arg -> result
script_ [Text -> Attribute
defer_ Text
"", Text -> Attribute
src_ Text
alpineSrc] (Html ()
"" :: Html ())

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

alpineSrc :: Text
alpineSrc :: Text
alpineSrc = Text
"https://unpkg.com/alpinejs"

alpineSrcWithSemVer :: (Int, Int, Int) -> Text
alpineSrcWithSemVer :: (Int, Int, Int) -> Text
alpineSrcWithSemVer (Int
major, Int
minor, Int
patch) =
  Text
alpineSrc
    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

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