htmx-lucid (empty) → 0.1.0.0

raw patch · 6 files changed

+433/−0 lines, 6 filesdep +basedep +htmxdep +lucid

Dependencies added: base, htmx, lucid, text

Files

README.md +1/−0
htmx-lucid.cabal +41/−0
src/Htmx/Lucid/Core.hs +80/−0
src/Htmx/Lucid/Extension/IncludeVals.hs +18/−0
src/Htmx/Lucid/Extra.hs +202/−0
src/Htmx/Lucid/Head.hs +91/−0

+ README.md view

@@ -0,0 +1,1 @@+# htmx-lucid

+ htmx-lucid.cabal view

@@ -0,0 +1,41 @@+cabal-version:      3.6+name:               htmx-lucid+version:            0.1.0.0+synopsis:           Use htmx with lucid+description:+  Please see the README on GitHub at <https://github.com/JonathanLorimer/htmx#readme>++license:            MIT+category:           Web, HTML+author:             Jonathan Lorimer+maintainer:         jonathanlorimer@pm.me+build-type:         Simple+extra-source-files: README.md++source-repository head+  type:     git+  location: https://github.com/JonathanLorimer/htmx++common def-exts+  default-extensions:+    LambdaCase+    OverloadedStrings++library+  import:           def-exts++  -- cabal-fmt: expand src+  exposed-modules:+    Htmx.Lucid.Core+    Htmx.Lucid.Extension.IncludeVals+    Htmx.Lucid.Extra+    Htmx.Lucid.Head++  hs-source-dirs:   src+  build-depends:+    , base   >=4.7      && <5+    , htmx+    , lucid  >=2.9.12.1 && <2.11.20230408.0+    , text   >=2        && <3++  default-language: Haskell2010

+ src/Htmx/Lucid/Core.hs view

@@ -0,0 +1,80 @@+{- |+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_ = makeAttribute "hx-get"++-- | <https://htmx.org/attributes/hx-get/>+-- issues a POST to the specified URL+hxPost_ :: Text -> Attribute+hxPost_ = makeAttribute "hx-post"++-- | <https://htmx.org/attributes/hx-push-url/>+-- push a URL into the browser location bar to create history+hxPushUrl_ :: Text -> Attribute+hxPushUrl_ = makeAttribute "hx-push-url"++-- | <https://htmx.org/attributes/hx-select/>+-- select content to swap in from a response+hxSelect_ :: Text -> Attribute+hxSelect_ = makeAttribute "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_ = makeAttribute "hx-select-oob"++-- | <https://htmx.org/attributes/hx-swap/>+-- controls how content will swap in (outerHTML, beforeend, afterend, …)+hxSwap_ :: Text -> Attribute+hxSwap_ = makeAttribute "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_ = makeAttribute "hx-swap" . render++-- | <https://htmx.org/attributes/hx-swap-oob/>+-- mark element to swap in from a response (out of band)+hxSwapOob_ :: Text -> Attribute+hxSwapOob_ = makeAttribute "hx-swap-oob"++-- | <https://htmx.org/attributes/hx-target/>+-- specifies the target element to be swapped+hxTarget_ :: Text -> Attribute+hxTarget_ = makeAttribute "hx-target"++-- | <https://htmx.org/attributes/hx-trigger/>+-- specifies the event that triggers the request+hxTrigger_ :: Text -> Attribute+hxTrigger_ = makeAttribute "hx-trigger"++-- | <https://htmx.org/attributes/hx-vals/>+-- add values to submit with the request (JSON format)+hxVals_ :: Text -> Attribute+hxVals_ = makeAttribute "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_ = \case+    DomOnEvent event -> makeAttribute $ "hx-on:" <> event+    HtmxOnEvent htmxEvent -> makeAttribute $ "hx-on::" <> render htmxEvent

+ src/Htmx/Lucid/Extension/IncludeVals.hs view

@@ -0,0 +1,18 @@+{- |+Module      : Htmx.Lucid.Extension.IncludeVals+Description : Attribute for adding values to a request++This module defines an attribute that allows you to include additional values in a request+<https://github.com/bigskysoftware/htmx-extensions/blob/main/src/include-vals/README.md>+-}+module Htmx.Lucid.Extension.IncludeVals where++import Data.Text (Text)+import Lucid+import Lucid.Base (makeAttribute)++-- | <https://github.com/bigskysoftware/htmx-extensions/blob/main/src/include-vals/README.md>+-- The value of this attribute is one or more name/value pairs, which will be evaluated as the fields in a javascript object literal.+-- i.e. "included:true, computed: computeValue()"+includeVals_ :: Text -> Attribute+includeVals_ = makeAttribute "include-vals"

+ src/Htmx/Lucid/Extra.hs view

@@ -0,0 +1,202 @@+{- |+Module      : Htmx.Lucid.Extra+Description : Provides extra htmx tags++This module defines additional attributes that can be used to get additional+behaviour+<https://htmx.org/reference/#attributes-additional>+-}+module Htmx.Lucid.Extra where++import Data.Foldable+import Data.List (intersperse)+import Data.Text (Text, pack)+import Htmx.Extension+import Htmx.Render+import Lucid (Html, HtmlT, script_, src_)+import Lucid.Base (Attribute, makeAttribute)++-- | <https://htmx.org/attributes/hx-boost/>+-- add progressive enhancement for links and forms+hxBoost_ :: Text -> Attribute+hxBoost_ = makeAttribute "hx-boost"++-- | <https://htmx.org/attributes/hx-confirm/>+-- shows a confirm() dialog before issuing a request+hxConfirm_ :: Text -> Attribute+hxConfirm_ = makeAttribute "hx-confirm"++-- | <https://htmx.org/attributes/hx-delete/>+-- issues a DELETE to the specified URL+hxDelete_ :: Text -> Attribute+hxDelete_ = makeAttribute "hx-delete"++-- | <https://htmx.org/attributes/hx-disable/>+-- disables htmx processing for the given node and any children nodes+hxDisable_ :: Attribute+hxDisable_ = makeAttribute "hx-disable" mempty++-- | <https://htmx.org/attributes/hx-disabled-elt/>+-- adds the disabled attribute to the specified elements while a request is in flight+hxDisabledElt_ :: Text -> Attribute+hxDisabledElt_ = makeAttribute "hx-disabled-elt"++-- | <https://htmx.org/attributes/hx-disinherit/>+-- control and disable automatic attribute inheritance for child nodes+hxDisinherit_ :: Text -> Attribute+hxDisinherit_ = makeAttribute "hx-disinherit"++-- | <https://htmx.org/attributes/hx-encoding/>+-- changes the request encoding type+hxEncoding_ :: Text -> Attribute+hxEncoding_ = makeAttribute "hx-encoding"++-- | <https://htmx.org/attributes/hx-ext/>+-- extensions to use for this element+hxExt_ :: Text -> Attribute+hxExt_ = makeAttribute "hx-ext"++-- | A typesafe version of 'hxExt_' that works with the "included" extensions+-- that the htmx codebase is tested against+hxExtension_ :: HtmxExtension -> Attribute+hxExtension_ = makeAttribute "hx-ext" . render++-- | Include multiple extensions in one declaration+hxExtensions_ :: [HtmxExtension] -> Attribute+hxExtensions_ = makeAttribute "hx-ext" . fold . intersperse "," . fmap render++-- | <https://htmx.org/attributes/hx-headers/>+-- adds to the headers that will be submitted with the request+hxHeaders_ :: Text -> Attribute+hxHeaders_ = makeAttribute "hx-headers"++-- | <https://htmx.org/attributes/hx-history/>+-- prevent sensitive data being saved to the history cache+hxHistory_ :: Text -> Attribute+hxHistory_ = makeAttribute "hx-history"++-- | <https://htmx.org/attributes/hx-history-elt/>+-- the element to snapshot and restore during history navigation+hxHistoryElt_ :: Attribute+hxHistoryElt_ = makeAttribute "hx-history-elt" mempty++-- | <https://htmx.org/attributes/hx-include/>+-- include additional data in requests+hxInclude_ :: Text -> Attribute+hxInclude_ = makeAttribute "hx-include"++-- | <https://htmx.org/attributes/hx-indicator/>+-- the element to put the htmx-request class on during the request+hxIndicator_ :: Text -> Attribute+hxIndicator_ = makeAttribute "hx-indicator"++data ParamsFilter+    = -- | Include all parameters (default)+      All+    | -- | Include no parameters+      None+    | -- | Include all except the list of parameter names+      Exclude [Text]+    | -- | Include all the list of parameter names+      Include [Text]++-- | <https://htmx.org/attributes/hx-params/>+-- filters the parameters that will be submitted with a request+hxParams_ :: ParamsFilter -> Attribute+hxParams_ = \case+    All -> makeAttribute "hx-params" "*"+    None -> makeAttribute "hx-params" "none"+    Exclude ps -> makeAttribute "hx-params" $ "not " <> (fold . intersperse "," $ ps)+    Include ps -> makeAttribute "hx-params" $ fold . intersperse "," $ ps++-- | <https://htmx.org/attributes/hx-patch/>+-- issues a PATCH to the specified URL+hxPatch_ :: Text -> Attribute+hxPatch_ = makeAttribute "hx-patch"++-- | <https://htmx.org/attributes/hx-preserve/>+-- specifies elements to keep unchanged between requests+hxPreserve_ :: Attribute+hxPreserve_ = makeAttribute "hx-preserve" mempty++-- | <https://htmx.org/attributes/hx-prompt/>+-- shows a prompt() before submitting a request+hxPrompt_ :: Text -> Attribute+hxPrompt_ = makeAttribute "hx-prompt"++-- | <https://htmx.org/attributes/hx-put/>+-- issues a PUT to the specified URL+hxPut_ :: Text -> Attribute+hxPut_ = makeAttribute "hx-put"++-- | <https://htmx.org/attributes/hx-replace-url/>+-- replace the URL in the browser location bar+hxReplaceUrl_ :: Text -> Attribute+hxReplaceUrl_ = makeAttribute "hx-replace-url"++-- | <https://htmx.org/attributes/hx-request/>+-- configures various aspects of the request+hxRequest_ :: Text -> Attribute+hxRequest_ = makeAttribute "hx-request"++{-# DEPRECATED+    hxSse_+    "Don't use hx-sse directly, please use the server sent events extension instead https://htmx.org/extensions/server-sent-events/"+    #-}++-- | <https://htmx.org/attributes/hx-sse/>+-- has been moved to an extension. Documentation for older versions+hxSse_ :: Text -> Attribute+hxSse_ = makeAttribute "hx-sse"++data SyncStrategy+    = -- | drop (ignore) this request if an existing request is in flight (the default)+      SyncDrop+    | -- | drop (ignore) this request if an existing request is in flight, and, if+      -- that is not the case, abort this request if another request occurs while it is+      -- still in flight+      SyncAbort+    | -- | abort the current request, if any, and replace it with this request+      SyncReplace+    | -- | queue the first request to show up while a request is in flight+      SyncQueueFirst+    | -- | queue the last request to show up while a request is in flight+      SyncQueueLast+    | -- | queue all requests that show up while a request is in flight+      SyncQueueAll++-- | <https://htmx.org/attributes/hx-sync/>+-- control how requests made by different elements are synchronized+hxSync_ :: Text -> Attribute+hxSync_ = makeAttribute "hx-sync"++-- | <https://htmx.org/attributes/hx-sync/>+-- the same as 'hxSync_' but accepts a strongly typed htmx 'SyncStrategy'+hxSyncStrategy_ :: Text -> SyncStrategy -> Attribute+hxSyncStrategy_ selector = \case+    SyncDrop -> makeAttribute "hx-sync" $ selector <> ":" <> "drop"+    SyncAbort -> makeAttribute "hx-sync" $ selector <> ":" <> "abort"+    SyncReplace -> makeAttribute "hx-sync" $ selector <> ":" <> "replace"+    SyncQueueFirst -> makeAttribute "hx-sync" $ selector <> ":" <> "queue first"+    SyncQueueLast -> makeAttribute "hx-sync" $ selector <> ":" <> "queue last"+    SyncQueueAll -> makeAttribute "hx-sync" $ selector <> ":" <> "queue all"++-- | <https://htmx.org/attributes/hx-validate/>+-- force elements to validate themselves before a request+hxValidate_ :: Text -> Attribute+hxValidate_ = makeAttribute "hx-validate"++-- | <https://htmx.org/attributes/hx-vars/>+-- adds values dynamically to the parameters to submit with the request (deprecated, please use hx-vals)+hxVars_ :: Text -> Attribute+hxVars_ = makeAttribute "hx-vars"++{-# DEPRECATED+    hxWs_+    "Don't use hx-ws directly, please use the web sockets extension instead https://htmx.org/extensions/server-sent-events/https://htmx.org/extensions/web-sockets/"+    #-}++-- | <https://htmx.org/attributes/hx-ws/>+-- has been moved to an extension. Documentation for older versions+hxWs_ :: Text -> Attribute+hxWs_ = makeAttribute "hx-ws"

+ src/Htmx/Lucid/Head.hs view

@@ -0,0 +1,91 @@+{- |+Module      : Htmx.Lucid.Head+Description : Utilities for including HTMX in the html head tag++This module defines utilities for installing HTMX and HTMX extensions+via the head tag in your html document+<https://htmx.org/docs/#installing>+-}+module Htmx.Lucid.Head (+    useHtmx,+    useHtmxVersion,+    useHtmxExtension,+    useHtmxExtensionV,+    useHtmxExtensions,+    useHtmxExtensionsV,+    recommendedVersion,+    htmxSrc,+    htmxSrcWithSemVer,+    htmxExtSrc,+) where++import Data.Foldable (forM_)+import Data.Text (Text, pack)+import GHC.Natural (Natural)+import Htmx.Extension+import Htmx.Render+import Lucid (Html, HtmlT, script_, src_)+import Lucid.Base (Attribute, makeAttribute)++-- | Place in your template after @useHtmx@, but before where the extension is used via @hxExt_@+-- NOTE: This uses 'recommendedVersion' as the version section of the URL+useHtmxExtension :: (Monad m) => HtmxExtension -> HtmlT m ()+useHtmxExtension = useHtmxExtensionV recommendedVersion++-- | Same as 'useHtmxExt' but lets you choose the version url+useHtmxExtensionV ::+    (Monad m) => (Natural, Natural, Natural) -> HtmxExtension -> HtmlT m ()+useHtmxExtensionV v ext = script_ [src_ $ htmxExtSrc v (render ext)] ("" :: Html ())++-- | A typesafe version of 'useHtmxExtension' based on the "included" extensions+-- that the htmx codebase is tested against+-- NOTE: This uses 'recommendedVersion' as the version section of the URL+useHtmxExtensions :: (Monad m) => [HtmxExtension] -> HtmlT m ()+useHtmxExtensions exts = forM_ exts useHtmxExtension++-- | Same as 'useHtmxExts' but with a versioned url+useHtmxExtensionsV ::+    (Monad m) => (Natural, Natural, Natural) -> [HtmxExtension] -> HtmlT m ()+useHtmxExtensionsV v exts = forM_ exts (useHtmxExtensionV v)++-- | Place in your @head_@ tag to use htmx attributes in your lucid template+useHtmx :: (Monad m) => HtmlT m ()+useHtmx = useHtmxVersion recommendedVersion++-- | Choose the version of htmx to use using a 3-tuple representing semantic versioning+useHtmxVersion :: (Monad m) => (Natural, Natural, Natural) -> HtmlT m ()+useHtmxVersion semVer = script_ [src_ $ htmxSrcWithSemVer semVer] ("" :: Html ())++-- | This is the recommended version of htmx for using this library+-- (lucid-htmx). It is the version of the documentation that the implementation+-- is based off of.+recommendedVersion :: (Natural, Natural, Natural)+recommendedVersion = (2, 0, 0)++htmxSrc :: Text+htmxSrc = "https://unpkg.com/htmx.org"++showT :: (Show a) => a -> Text+showT = pack . show++showSemVer :: (Natural, Natural, Natural) -> Text+showSemVer (major, minor, patch) =+    "@"+        <> showT major+        <> "."+        <> showT minor+        <> "."+        <> showT patch++htmxSrcWithSemVer :: (Natural, Natural, Natural) -> Text+htmxSrcWithSemVer ver =+    htmxSrc <> showSemVer ver++htmxExtSrc :: (Natural, Natural, Natural) -> Text -> Text+htmxExtSrc ver ext =+    "https://unpkg.com/htmx-ext-"+        <> ext+        <> showSemVer ver+        <> "/"+        <> ext+        <> ".js"