feat: Implement Ltree Type (#385)

Author: maennchen

lib/resource_generator/spec.ex

@@ -903,6 +903,7 @@ defmodule AshPostgres.ResourceGenerator.Spec do
   defp type("tsvector"), do: {:ok, AshPostgres.Tsvector}
   defp type("uuid"), do: {:ok, :uuid}
   defp type("citext"), do: {:ok, :ci_string}
+  defp type("ltree"), do: {:ok, AshPostgres.Ltree}
   defp type(_), do: :error
 
   defp set_sensitive(attributes) do

lib/types/ltree.ex

@@ -0,0 +1,221 @@
+defmodule AshPostgres.Ltree do
+  @constraints [
+    escape?: [
+      type: :boolean,
+      doc: """
+      Escape the ltree segments to make it possible to include characters that
+      are either `.` (the separation character) or any other unsupported
+      character like `-` (Postgres <= 15).  
+        
+      If the option is enabled, any characters besides `[0-9a-zA-Z]` will be
+      replaced with `_[HEX Ascii Code]`.  
+        
+      Additionally the type will no longer take strings as user input since
+      it's impossible to decide between `.` being a separator or part of a
+      segment.  
+        
+      If the option is disabled, any string will be relayed directly to
+      postgres. If the segments are provided as a list, they can't contain `.`
+      since postgres would split the segment.
+      """
+    ],
+    min_length: [
+      type: :non_neg_integer,
+      doc: "A minimum length for the tree segments."
+    ],
+    max_length: [
+      type: :non_neg_integer,
+      doc: "A maximum length for the tree segments."
+    ]
+  ]
+
+  @moduledoc """
+  Ash Type for [postgres `ltree`](https://www.postgresql.org/docs/current/ltree.html),
+  a hierarchical tree-like data type.
+
+  ## Postgres Extension
+
+  To be able to use the `ltree` type, you'll have to enable the postgres `ltree`
+  extension first.
+
+  See `m:AshPostgres.Repo#module-installed-extensions`
+
+  ## Constraints
+
+  #{Spark.Options.docs(@constraints)}
+  """
+
+  use Ash.Type
+
+  @type t() :: [segment()]
+  @type segment() :: String.t()
+
+  @impl Ash.Type
+  def storage_type(_constraints), do: :ltree
+
+  @impl Ash.Type
+  def constraints, do: @constraints
+
+  @impl Ash.Type
+  def matches_type?(list, _constraints) when is_list(list), do: true
+
+  def matches_type?(binary, constraints) when is_binary(binary),
+    do: not Keyword.get(constraints, :escape?, false)
+
+  def matches_type?(_ltree, _constraints), do: false
+
+  @impl Ash.Type
+  def generator(constraints) do
+    segment =
+      if constraints[:escape?],
+        do: StreamData.string(:utf8, min_length: 1),
+        else: StreamData.string(:alphanumeric, min_length: 1)
+
+    StreamData.list_of(segment, Keyword.take(constraints, [:min_length, :max_length]))
+  end
+
+  @impl Ash.Type
+  def apply_constraints(nil, _constraints), do: {:ok, nil}
+
+  def apply_constraints(ltree, constraints) do
+    segment_validation =
+      Enum.reduce_while(ltree, :ok, fn segment, :ok ->
+        cond do
+          segment == "" ->
+            {:halt, {:error, message: "Ltree segments can't be empty.", value: segment}}
+
+          not String.valid?(segment) ->
+            {:halt,
+             {:error, message: "Ltree segments must be valid UTF-8 strings.", value: segment}}
+
+          String.contains?(segment, ".") and !constraints[:escape?] ->
+            {:halt,
+             {:error,
+              message: ~S|Ltree segments can't contain "." if :escape? is not enabled.|,
+              value: segment}}
+
+          true ->
+            {:cont, :ok}
+        end
+      end)
+
+    with :ok <- segment_validation do
+      cond do
+        constraints[:min_length] && length(ltree) < constraints[:min_length] ->
+          {:error, message: "must have %{min} or more items", min: constraints[:min_length]}
+
+        constraints[:max_length] && length(ltree) > constraints[:max_length] ->
+          {:error, message: "must have %{max} or less items", max: constraints[:max_length]}
+
+        true ->
+          :ok
+      end
+    end
+  end
+
+  @impl Ash.Type
+  def cast_input(nil, _constraints), do: {:ok, nil}
+
+  def cast_input(string, constraints) when is_binary(string) do
+    if constraints[:escape?] do
+      {:error, "String input casting is not supported when the :escape? constraint is enabled"}
+    else
+      string |> String.split(".") |> cast_input(constraints)
+    end
+  end
+
+  def cast_input(list, _constraints) when is_list(list) do
+    if Enum.all?(list, &is_binary/1) do
+      {:ok, list}
+    else
+      {:error, "Ltree segments must be strings. #{inspect(list)} provided."}
+    end
+  end
+
+  def cast_input(_ltree, _constraints), do: :error
+
+  @impl Ash.Type
+  def cast_stored(nil, _constraints), do: {:ok, nil}
+
+  def cast_stored(ltree, constraints) when is_binary(ltree) do
+    segments =
+      ltree
+      |> String.split(".", trim: true)
+      |> then(
+        if constraints[:escape?] do
+          fn segments -> Enum.map(segments, &unescape_segment/1) end
+        else
+          & &1
+        end
+      )
+
+    {:ok, segments}
+  end
+
+  def cast_stored(_ltree, _constraints), do: :error
+
+  @impl Ash.Type
+  def dump_to_native(nil, _constraints), do: {:ok, nil}
+
+  def dump_to_native(ltree, constraints) when is_list(ltree) do
+    if constraints[:escape?] do
+      {:ok, Enum.map_join(ltree, ".", &escape_segment/1)}
+    else
+      {:ok, Enum.join(ltree, ".")}
+    end
+  end
+
+  def dump_to_native(_ltree, _constraints), do: :error
+
+  @doc """
+  Get shared root of given ltrees.
+
+  ## Examples
+
+      iex> Ltree.shared_root(["1", "2"], ["1", "1"])
+      ["1"]
+
+      iex> Ltree.shared_root(["1", "2"], ["2", "1"])
+      []
+
+  """
+  @spec shared_root(ltree1 :: t(), ltree2 :: t()) :: t()
+  def shared_root(ltree1, ltree2) do
+    ltree1
+    |> List.myers_difference(ltree2)
+    |> case do
+      [{:eq, shared} | _] -> shared
+      _other -> []
+    end
+  end
+
+  @spec escape_segment(segment :: String.t()) :: String.t()
+  defp escape_segment(segment)
+  defp escape_segment(<<>>), do: <<>>
+
+  defp escape_segment(<<letter, rest::binary>>)
+       when letter in ?0..?9
+       when letter in ?a..?z
+       when letter in ?A..?Z,
+       do: <<letter, escape_segment(rest)::binary>>
+
+  defp escape_segment(<<letter, rest::binary>>) do
+    escape_code = letter |> Integer.to_string(16) |> String.pad_leading(2, "0")
+    <<?_, escape_code::binary, escape_segment(rest)::binary>>
+  end
+
+  @spec unescape_segment(segment :: String.t()) :: String.t()
+  defp unescape_segment(segment)
+  defp unescape_segment(<<>>), do: <<>>
+
+  defp unescape_segment(<<letter, rest::binary>>)
+       when letter in ?0..?9
+       when letter in ?a..?z
+       when letter in ?A..?Z,
+       do: <<letter, unescape_segment(rest)::binary>>
+
+  defp unescape_segment(<<?_, h, l, rest::binary>>) do
+    {letter, ""} = Integer.parse(<<h, l>>, 16)
+    <<letter, unescape_segment(rest)::binary>>
+  end
+end

mix.exs

@@ -134,6 +134,7 @@ defmodule AshPostgres.MixProject do
           AshPostgres.Statement
         ],
         Types: [
+          AshPostgres.Ltree,
           AshPostgres.Type,
           AshPostgres.Tsquery,
           AshPostgres.Tsvector,

priv/resource_snapshots/test_repo/extensions.json

@@ -1,10 +1,11 @@
 {
+  "ash_functions_version": 4,
   "installed": [
     "ash-functions",
     "uuid-ossp",
     "pg_trgm",
     "citext",
-    "demo-functions_v1"
-  ],
-  "ash_functions_version": 4
+    "demo-functions_v1",
+    "ltree"
+  ]
 }