Skip to content

Instantly share code, notes, and snippets.

@tjdevries

tjdevries/hx.ml

Created August 9, 2023 01:33
Show Gist options
  • Save tjdevries/b430176615b13c68faef6cf6404fac79 to your computer and use it in GitHub Desktop.
Save tjdevries/b430176615b13c68faef6cf6404fac79 to your computer and use it in GitHub Desktop.
Download ZIP
hx wrapper lib
Raw
hx.ml
open Base
(** Typesafe htmlx wrappers for OCaml. Emits attributes to be used with TyXML *)
(** hx-get [url] *)
let get url = Tyxml.Html.Unsafe.string_attrib "hx-get" url
(** hx-put [url] *)
let put url = Tyxml.Html.Unsafe.string_attrib "hx-put" url
(** hx-post [url] *)
let post url = Tyxml.Html.Unsafe.string_attrib "hx-post" url
(** hx-delete [url] *)
let delete url = Tyxml.Html.Unsafe.string_attrib "hx-delete" url
module TargetType = struct
type t =
| This
| Css of string
| Closest of string
| Find of string
| Previous of string
let to_string = function
| This -> "this"
| Css s -> s
| Closest s -> "closest " ^ s
| Find s -> "find " ^ s
| Previous s -> "previous " ^ s
;;
end
(** Typesafe hx-target wrapper *)
let target t =
Tyxml.Html.Unsafe.string_attrib "hx-target" (TargetType.to_string t)
;;
(** hx-select. Select the content to swap into the page *)
let select sel = Tyxml.Html.Unsafe.string_attrib "hx-select" sel
let select_oob sel =
Tyxml.Html.Unsafe.string_attrib "hx-select" (String.concat ~sep:"," sel)
;;
module SwapType = struct
module Modifiers = struct
type scrolldir =
| Top
| Bottom
type scrolling = scrolldir * string option
let scroll_to_string prefix scroll =
let map_dir = function
| Top -> "top"
| Bottom -> "bottom"
in
match scroll with
| dir, Some modifier -> Fmt.str "%s:%s:%s" prefix modifier (map_dir dir)
| dir, None -> Fmt.str "%s:%s" prefix (map_dir dir)
;;
type data =
{ transition : bool option
; swap : string option
; settle : string option
; scroll : scrolling option
; show : scrolling option
; focus_scroll : bool option
}
type t = data option
let create ~transition ~swap ~settle ~scroll ~show ~focus_scroll =
match transition, swap with
| None, None -> None
| _, _ -> Some { transition; swap; settle; scroll; show; focus_scroll }
;;
let to_string = function
| None -> ""
| Some data ->
[ Some "" (* Empty string to start, to prefix with space *)
; Option.map data.transition ~f:(Fmt.str "transition:%b")
; Option.map data.swap ~f:(Fmt.str "swap:%s")
; Option.map data.settle ~f:(Fmt.str "settle:%s")
; Option.map data.scroll ~f:(scroll_to_string "scroll")
; Option.map data.show ~f:(scroll_to_string "show")
; Option.map data.focus_scroll ~f:(Fmt.str "focus-scroll:%b")
]
|> List.filter_opt
|> String.concat ~sep:" "
;;
(* Option.map *)
end
type attr =
| InnerHTML
(** The default, replace the inner html of the target element *)
| OuterHTML
(** Replace the entire target element with the response *)
| BeforeBegin
(** Insert the response before the target element *)
| AfterBegin
(** Insert the response before the first child of the target element *)
| BeforeEnd
(** Insert the response after the last child of the target element *)
| AfterEnd
(** Insert the response after the target element *)
| Delete
(** Deletes the target element regardless of the response *)
| None
(** Does not append content from response (out of band items will still be processed). *)
type t =
{ attr : attr
; modifiers : Modifiers.t
}
let to_attr t =
let attr =
match t.attr with
| InnerHTML -> "innerHTML"
| OuterHTML -> "outerHTML"
| BeforeBegin -> "beforebegin"
| AfterBegin -> "afterbegin"
| BeforeEnd -> "beforeend"
| AfterEnd -> "afterend"
| Delete -> "delete"
| None -> "none"
in
let modifiers = Modifiers.to_string t.modifiers in
Tyxml.Html.Unsafe.string_attrib "hx-swap" (attr ^ modifiers)
;;
end
(** Typesafe hx-swap wrapper *)
let swap ?transition ?swap ?settle ?scroll ?show ?focus_scroll attr =
let open SwapType in
to_attr
{ attr
; modifiers =
Modifiers.create ~transition ~swap ~settle ~scroll ~show ~focus_scroll
}
;;
module TriggerType = struct
type trigger =
| Event of string
| Every of string
type modifier =
| Once
| Changed
| Delay of string
| Throttle of string
| Target of string
| From of [ `Document | `Window | `Closest of string | `Find of string ]
| Consume
| Queue of [ `First | `Last | `All | `None ]
| Load
(** Trigged on load (useful for lazy-loading) *)
| Revealed
(** Triggered when an element is scrolled into the viewport (useful for lazy-loading).
If you are using `overflow` you should `intersect once` instead of Revealed *)
| Intersect of [ `Default | `Root of string | `Threshold of float ]
type t = trigger list * modifier list
let init ?(modifiers = []) triggers = triggers, modifiers
end
(* Misc Attributes *)
let boost status =
Tyxml.Html.Unsafe.string_attrib "hx-boost" (Bool.to_string status)
;;
let push_url status =
Tyxml.Html.Unsafe.string_attrib "hx-push-url" (Bool.to_string status)
;;
let include_ link = Tyxml.Html.Unsafe.string_attrib "hx-include" link
let indicator elt = Tyxml.Html.Unsafe.string_attrib "hx-indicator" elt
(* TODO: hx-on. Would be very cool to use melange and encode the function name into some script:
https://htmx.org/attributes/hx-on/ *)
module Headers = struct
(* don't expose *)
let htmx_truthy_header header req =
Dream.headers req header
|> List.find ~f:(fun header -> String.(header = "true"))
|> Option.is_some
;;
let is_htmx req = htmx_truthy_header "HX-Request" req
let is_boosted req = htmx_truthy_header "HX-Boosted" req
let is_history_restore req =
htmx_truthy_header "HX-History-Restore-Request" req
;;
(** This will contain the user response to an hx-prompt *)
let get_prompt req = Dream.headers req "HX-Prompt" |> List.hd
(** This value will be the id of the target element, if it exists *)
let get_target_id req = Dream.headers req "HX-Target" |> List.hd
(** This value will be the id of the triggered element, if it exists *)
let get_trigger_id req = Dream.headers req "HX-Trigger" |> List.hd
(** This value will be the name of the triggered element, if it exists *)
let get_trigger_name req = Dream.headers req "HX-Trigger-Name" |> List.hd
end
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment