packages feed

htmx (empty) → 0.0.0.1

raw patch · 14 files changed

+934/−0 lines, 14 filesdep +basedep +htmxdep +lucid

Dependencies added: base, htmx, lucid, servant, text

Files

+ README.md view
@@ -0,0 +1,1 @@+# htmx for Haskell
+ htmx.cabal view
@@ -0,0 +1,63 @@+cabal-version:      3.6+name:               htmx+version:            0.0.0.1+synopsis:           Use htmx with various haskell libraries+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.Event+    Htmx.Extension+    Htmx.Lucid.Core+    Htmx.Lucid.Extension.IncludeVals+    Htmx.Lucid.Extra+    Htmx.Lucid.Head+    Htmx.Lucid.Servant+    Htmx.Render+    Htmx.Servant.RequestHeaders+    Htmx.Servant.ResponseHeaders+    Htmx.Swap++  hs-source-dirs:   src+  build-depends:+    , base     >=4.7      && <5+    , lucid    >=2.9.12.1 && <2.11.20230408.0+    , servant  >=0.19     && <0.30+    , text     >=2        && <3++  default-language: Haskell2010++test-suite htmx-test+  import:           def-exts+  type:             exitcode-stdio-1.0+  main-is:          Spec.hs+  hs-source-dirs:   test+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N+  build-depends:+    , base     >=4.7      && <5+    , htmx+    , lucid    >=2.9.12.1 && <2.11.20230408.0+    , servant  >=0.19     && <0.30+    , text     >=2        && <3++  default-language: Haskell2010
+ src/Htmx/Event.hs view
@@ -0,0 +1,154 @@+{- |+Module      : Htmx.Event+Description : Enumerates htmx specific events++This module defines a type that represents events that originate from the HTMX+library itself+<https://htmx.org/reference/#events>+-}+module Htmx.Event where++import Data.Text (Text)+import Htmx.Render++-- | <https://htmx.org/reference/#events>+-- A sum type that represents possible events originating from the HTMX+-- javascript library+data HtmxEvent+    = -- | send this event to an element to abort a request+      Abort+    | -- | triggered after an AJAX request has completed processing a successful+      -- response+      AfterOnLoad+    | -- | triggered after htmx has initialized a node+      AfterProcessNode+    | -- | triggered after an AJAX request has completed+      AfterRequest+    | -- | triggered after the DOM has settled+      AfterSettle+    | -- | triggered after new content has been swapped in+      AfterSwap+    | -- | triggered before htmx disables an element or removes it from the DOM+      BeforeCleanupElement+    | -- | triggered before any response processing occurs+      BeforeOnLoad+    | -- | triggered before htmx initializes a node+      BeforeProcessNode+    | -- | triggered before an AJAX request is made+      BeforeRequest+    | -- | triggered before a swap is done, allows you to configure the swap+      BeforeSwap+    | -- | triggered just before an ajax request is sent+      BeforeSend+    | -- | triggered before the request, allows you to customize parameters,+      -- headers+      ConfigRequest+    | -- | triggered after a trigger occurs on an element, allows you to cancel+      -- (or delay) issuing the AJAX request+      Confirm+    | -- | triggered on an error during cache writing+      HistoryCacheError+    | -- | triggered on a cache miss in the history subsystem+      HistoryCacheMiss+    | -- | triggered on a unsuccessful remote retrieval+      HistoryCacheMissError+    | -- | triggered on a successful remote retrieval+      HistoryCacheMissLoad+    | -- | triggered when htmx handles a history restoration action+      HistoryRestore+    | -- | triggered before content is saved to the history cache+      BeforeHistorySave+    | -- | triggered when new content is added to the DOM+      Load+    | -- | triggered when an element refers to a SSE event in its trigger, but+      -- no parent SSE source has been defined+      NoSSESourceError+    | -- | triggered when an exception occurs during the onLoad handling in htmx+      OnLoadError+    | -- | triggered after an out of band element as been swapped in+      OobAfterSwap+    | -- | triggered before an out of band element swap is done, allows you to+      -- configure the swap+      OobBeforeSwap+    | -- | triggered when an out of band element does not have a matching ID in+      -- the current DOM+      OobErrorNoTarget+    | -- | triggered after a prompt is shown+      Prompt+    | -- | triggered after an url is pushed into history+      PushedIntoHistory+    | -- | triggered when an HTTP response error (non-200 or 300 response code)+      -- occurs+      ResponseError+    | -- | triggered when a network error prevents an HTTP request from happening+      SendError+    | -- | triggered when an error occurs with a SSE source+      SseError+    | -- | triggered when a SSE source is opened+      SseOpen+    | -- | triggered when an error occurs during the swap phase+      SwapError+    | -- | triggered when an invalid target is specified+      TargetError+    | -- | triggered when a request timeout occurs+      Timeout+    | -- | triggered before an element is validated+      ValidationValidate+    | -- | triggered when an element fails validation+      ValidationFailed+    | -- | triggered when a request is halted due to validation errors+      ValidationHalted+    | -- | triggered when an ajax request aborts+      XhrAbort+    | -- | triggered when an ajax request ends+      XhrLoadend+    | -- | triggered when an ajax request starts+      XhrLoadstart+    | -- | triggered periodically during an ajax request that supports progress+      -- events+      XhrProgress++instance Render HtmxEvent where+    render = \case+        Abort -> "abort"+        AfterOnLoad -> "afterOnLoad"+        AfterProcessNode -> "afterProcessNode"+        AfterRequest -> "afterRequest"+        AfterSettle -> "afterSettle"+        AfterSwap -> "afterSwap"+        BeforeCleanupElement -> "beforeCleanupElement"+        BeforeOnLoad -> "beforeOnLoad"+        BeforeProcessNode -> "beforeProcessNode"+        BeforeRequest -> "beforeRequest"+        BeforeSwap -> "beforeSwap"+        BeforeSend -> "beforeSend"+        ConfigRequest -> "configRequest"+        Confirm -> "confirm"+        HistoryCacheError -> "historyCacheError"+        HistoryCacheMiss -> "historyCacheMiss"+        HistoryCacheMissError -> "historyCacheMissError"+        HistoryCacheMissLoad -> "historyCacheMissLoad"+        HistoryRestore -> "historyRestore"+        BeforeHistorySave -> "beforeHistorySave"+        Load -> "load"+        NoSSESourceError -> "noSSESourceError"+        OnLoadError -> "onLoadError"+        OobAfterSwap -> "oobAfterSwap"+        OobBeforeSwap -> "oobBeforeSwap"+        OobErrorNoTarget -> "oobErrorNoTarget"+        Prompt -> "prompt"+        PushedIntoHistory -> "pushedIntoHistory"+        ResponseError -> "responseError"+        SendError -> "sendError"+        SseError -> "sseError"+        SseOpen -> "sseOpen"+        SwapError -> "swapError"+        TargetError -> "targetError"+        Timeout -> "timeout"+        ValidationValidate -> "validation:validate"+        ValidationFailed -> "validation:failed"+        ValidationHalted -> "validation:halted"+        XhrAbort -> "xhr:abort"+        XhrLoadend -> "xhr:loadend"+        XhrLoadstart -> "xhr:loadstart"+        XhrProgress -> "xhr:progress"
+ src/Htmx/Extension.hs view
@@ -0,0 +1,92 @@+{- |+Module      : Htmx.Extension+Description : Enumerates official HTMX extensions++This module defines a sum type that represents the "included" HTMX extensions+<https://htmx.org/extensions/#included>+-}+module Htmx.Extension where++import Data.Text (Text)+import Htmx.Render++-- | <https://htmx.org/extensions/>+--+-- htmx includes a set of extensions out of the box that address common+-- developer needs. These extensions are tested against htmx in each distribution.+--+-- You can find the source for the bundled extensions at https://unpkg.com/+-- browse/htmx.org@1.9.12/dist/ext/. You will need to include the javascript file+-- for the extension and then install it using the hx-ext attributes.+-- See the individual extension documentation for more details.+data HtmxExtension+    = -- | <https://htmx.org/extensions/ajax-header/> includes the commonly-used X-Requested-With header that identifies ajax requests in many backend frameworks+      AjaxHeader+    | -- | <https://htmx.org/extensions/alpine-morph/> an extension for using the Alpine.js morph plugin as the swapping mechanism in htmx.+      AlpineMorph+    | -- | <https://htmx.org/extensions/class-tools/> an extension for manipulating timed addition and removal of classes on HTML elements+      ClassTools+    | -- | <https://htmx.org/extensions/client-side-templates/> support for client side template processing of JSON/XML responses+      ClientSideTemplates+    | -- | <https://htmx.org/extensions/debug/> an extension for debugging of a particular element using htmx+      Debug+    | -- | <https://htmx.org/extensions/event-header/> includes a JSON serialized version of the triggering event, if any+      EventHeader+    | -- | <https://htmx.org/extensions/head-support/> support for merging the head tag from responses into the existing documents head+      HeadSupport+    | -- | <https://htmx.org/extensions/include-vals/> allows you to include additional values in a request+      IncludeVals+    | -- | <https://htmx.org/extensions/json-enc/> use JSON encoding in the body of requests, rather than the default x-www-form-urlencoded+      JsonEnc+    | -- | <https://htmx.org/extensions/idiomorph/> an extension for using the idiomorph morphing algorithm as a swapping mechanism+      Idiomorph+    | -- | <https://htmx.org/extensions/loding-states/> allows you to disable inputs, add and remove CSS classes to any element while a request is in-flight.+      LoadingStates+    | -- | <https://htmx.org/extensions/method-override/> use the X-HTTP-Method-Override header for non-GET and POST requests+      MethodOverride+    | -- | <https://htmx.org/extensions/morphdom-swap/> an extension for using the morphdom library as the swapping mechanism in htmx.+      MorphdomSwap+    | -- | <https://htmx.org/extensions/multi-swap/> allows to swap multiple elements with different swap methods+      MultiSwap+    | -- | <https://htmx.org/extensions/path-deps/> an extension for expressing path-based dependencies similar to intercoolerjs+      PathDeps+    | -- | <https://htmx.org/extensions/preload/> preloads selected href and hx-get targets based on rules you control.+      Preload+    | -- | <https://htmx.org/extensions/remove-me/> allows you to remove an element after a given amount of time+      RemoveMe+    | -- | <https://htmx.org/extensions/response-targets/> allows to specify different target elements to be swapped when different HTTP response codes are received+      ResponseTargets+    | -- | <https://htmx.org/extensions/restored/> allows you to trigger events when the back button has been pressed+      Restored+    | -- | <https://htmx.org/extensions/server-sent-events/> uni-directional server push messaging via EventSource+      ServerSentEvents+    | -- | <https://htmx.org/extensions/web-sockets/> bi-directional connection to WebSocket servers+      WebSockets+    | -- | <https://htmx.org/extensions/path-params/> allows to use parameters for path variables instead of sending them in query or body+      PathParams+    deriving (Eq, Ord, Show)++instance Render HtmxExtension where+    render = \case+        AjaxHeader -> "ajax-header"+        AlpineMorph -> "alpine-morph"+        ClassTools -> "class-tools"+        ClientSideTemplates -> "client-side-templates"+        Debug -> "debug"+        EventHeader -> "event-header"+        HeadSupport -> "head-support"+        IncludeVals -> "include-vals"+        JsonEnc -> "json-enc"+        Idiomorph -> "idiomorph"+        LoadingStates -> "loading-states"+        MethodOverride -> "method-override"+        MorphdomSwap -> "morphdom-swap"+        MultiSwap -> "multi-swap"+        PathDeps -> "path-deps"+        Preload -> "preload"+        RemoveMe -> "remove-me"+        ResponseTargets -> "response-targets"+        Restored -> "restored"+        ServerSentEvents -> "server-sent-events"+        WebSockets -> "web-sockets"+        PathParams -> "path-params"
+ 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"
+ src/Htmx/Lucid/Servant.hs view
@@ -0,0 +1,55 @@+{- |+Module      : Htmx.Lucid.Servant+Description : Typesafe versions of HTMX request tags++This module exports Lucid combinators that leverage the Servant 'Link'+type to guarantee that they are live URLs, therefore making the requests+"safe".+-}+module Htmx.Lucid.Servant (+    hxDeleteSafe_,+    hxGetSafe_,+    hxPatchSafe_,+    hxPostSafe_,+    hxPushUrlSafe_,+    hxPutSafe_,+)+where++import Data.Text (Text)+import Htmx.Lucid.Core (+    hxGet_,+    hxPost_,+    hxPushUrl_,+ )+import Htmx.Lucid.Extra (+    hxDelete_,+    hxPatch_,+    hxPut_,+ )+import Lucid.Base (Attribute)+import Servant.API (ToHttpApiData (..), toUrlPiece)+import Servant.Links (Link)++hxDeleteSafe_ :: Link -> Attribute+hxDeleteSafe_ = hxDelete_ . toUrl++hxGetSafe_ :: Link -> Attribute+hxGetSafe_ = hxGet_ . toUrl++hxPatchSafe_ :: Link -> Attribute+hxPatchSafe_ = hxPatch_ . toUrl++hxPostSafe_ :: Link -> Attribute+hxPostSafe_ = hxPost_ . toUrl++hxPushUrlSafe_ :: Either Bool Link -> Attribute+hxPushUrlSafe_ boolOrUrl = hxPushUrl_ $ case boolOrUrl of+    Left bool -> if bool then "true" else "false"+    Right url -> toUrl url++hxPutSafe_ :: Link -> Attribute+hxPutSafe_ = hxPut_ . toUrl++toUrl :: (ToHttpApiData a) => a -> Text+toUrl = ("/" <>) . toUrlPiece
+ src/Htmx/Render.hs view
@@ -0,0 +1,16 @@+{- |+Module      : Htmx.Render+Description : Typeclass for rendering domain types as HTMX compatible 'Text'++This module defines a typeclass that doesn't have the historical baggage or+connotations of other text serialization typeclasses (like 'Show' or Display).+The semantics of this class are supposed to be HTMX specific, i.e. serializing+attribute values+-}+module Htmx.Render where++import Data.Text (Text)++-- | A typeclass for rendering domain types into attribute values+class Render a where+    render :: a -> Text
+ src/Htmx/Servant/RequestHeaders.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE DataKinds #-}++{- |+Module      : Htmx.Servant.RequestHeaders+Description : Helper types for HTMX request headers++<https://htmx.org/reference/#request_headers>+-}+module Htmx.Servant.RequestHeaders where++import Data.Text (Text)+import Servant.API.Header (Header)++-- | indicates that the request is via an element using hx-boost+type HXBoosted = Header "HX-Boosted" Bool++-- | the current URL of the browser+type HXCurrentURL = Header "HX-Current-URL" Text++-- | “true” if the request is for history restoration after a miss in the local history cache+type HXHistoryRestoreRequest = Header "HX-History-Restore-Request" Bool++-- | the user response to an hx-prompt+type HXPrompt a = Header "HX-Prompt" a++-- | always “true”+type HXRequest = Header "HX-Prompt" Bool++-- | the id of the target element if it exists+type HXTarget = Header "HX-Target" Text++-- | the name of the triggered element if it exists+type HXTriggerName = Header "HX-Trigger-Name" Text++-- | the id of the triggered element if it exists+type HXTrigger = Header "HX-Trigger" Text
+ src/Htmx/Servant/ResponseHeaders.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE DataKinds #-}++{- |+Module      : Htmx.Servant.ResponseHeaders+Description : Helper types for HTMX response headers++<https://htmx.org/reference/#response_headers>+-}+module Htmx.Servant.ResponseHeaders where++import Data.Text (Text)+import Htmx.Swap (Swap)+import Servant.API.Header (Header)++-- | allows you to do a client-side redirect that does not do a full page reload+type HXLocation = Header "HX-Location" Text++-- | pushes a new url into the history stack+type HXPushURL = Header "HX-Push-Url" Text++-- | can be used to do a client-side redirect to a new location+type HXRedirect = Header "HX-Redirect" Text++-- | if set to “true” the client-side will do a full refresh of the page+type HXRefresh = Header "HX-Refresh" Bool++-- | replaces the current URL in the location bar+type HXReplaceUrl = Header "HX-Replace-Url" Bool++-- | replaces the current URL in the location bar+type HXReswap = Header "HX-Reswap" Swap++-- | a CSS selector that updates the target of the+-- content update to a different element on the page+type HXRetarget = Header "HX-Retarget" Text++-- | a CSS selector that allows you to choose which part of the response is used+-- to be swapped in. Overrides an existing hx-select on the triggering element+type HXReselect = Header "HX-Reselect" Text++-- | allows you to trigger client-side events+type HXTrigger = Header "HX-Trigger" Text++-- | allows you to trigger client-side events after the settle step+type HXTriggerAfterSettle = Header "HX-Trigger-After-Settle" Text++-- | allows you to trigger client-side events after the swap stepallows you to+-- trigger client-side events after the settle step+type HXTriggerAfterSwap = Header "HX-Trigger-After-Swap" Text
+ src/Htmx/Swap.hs view
@@ -0,0 +1,63 @@+{- |+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 Servant.API (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 = \case+        InnerHTML -> "innerHTML"+        OuterHTML -> "outerHTML"+        TextContent -> "textContent"+        BeforeBegin -> "beforeBegin"+        AfterBegin -> "afterBegin"+        BeforeEnd -> "beforeEnd"+        AfterEnd -> "afterEnd"+        Delete -> "delete"+        None -> "none"++instance ToHttpApiData Swap where+    toUrlPiece = render++instance FromHttpApiData Swap where+    parseUrlPiece = \case+        "innerHTML" -> Right InnerHTML+        "outerHTML" -> Right OuterHTML+        "textContent" -> Right TextContent+        "beforeBegin" -> Right BeforeBegin+        "afterBegin" -> Right AfterBegin+        "beforeEnd" -> Right BeforeEnd+        "afterEnd" -> Right AfterEnd+        "delete" -> Right Delete+        "none" -> Right None+        t -> Left $ "Could not parse " <> t <> ". Expected a valid Swap"
+ test/Spec.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE OverloadedStrings, ExtendedDefaultRules #-}+import Lucid+import Lucid.Htmx+import System.IO (stdout, hSetEncoding, utf8)+import Data.Text.Lazy.IO as L++main :: IO ()+main = do+  hSetEncoding stdout utf8+  L.hPutStr stdout (renderText template1)++template1 :: Html ()+template1 =+  div_ [id_ "someId" , hxPost_ "/some/url" ] "Content of div"