defmodule TypeClass do
@moduledoc ~S"""
Helpers for defining (bootstrapped, semi-)principled type classes
Generates a few modules and several functions and aliases. There is no need
to use these internals directly, as the top-level API will suffice for actual
productive use.
## Example
defclass Semigroup do
use Operator
where do
@operator :<|>
def concat(a, b)
end
properties do
def associative(data) do
a = generate(data)
b = generate(data)
c = generate(data)
left = a |> Semigroup.concat(b) |> Semigroup.concat(c)
right = Semigroup.concat(a, Semigroup.concat(b, c))
left == right
end
end
end
definst Semigroup, for: List do
def concat(a, b), do: a ++ b
end
defclass Monoid do
extend Semigroup
where do
def empty(sample)
end
properties do
def left_identity(data) do
a = generate(data)
Semigroup.concat(empty(a), a) == a
end
def right_identity(data) do
a = generate(data)
Semigroup.concat(a, empty(a)) == a
end
end
end
definst Monoid, for: List do
def empty(_), do: []
end
## Internal Structure
A `type_class` is composed of several parts:
- Dependencies
- Protocol
- Properties
### Dependencies
Dependencies are the other type classes that the type class being
defined extends. For instance, Monoid has a Semigroup dependency.
It only needs the immediate parents in
the chain, as those type classes will have performed all of the checks required
for their parents.
### Protocol
`defclass Foo` generates a `Foo.Proto` submodule that holds all of the functions
to be implemented (it's a normal protocol). It's a very lightweight & straightforward,
but The `Protocol` should never need to be called explicitly.
Macro: `where do`
Optional
### Properties
Being a (quasi-)principled type class also means having properties. Users must
define _at least one_ property, plus _at least one_ sample data generator.
These will be run at compile time and refuse to compile if they don't pass.
All custom structs need to implement the `TypeClass.Property.Generator` protocol.
This is called automatically by the prop checker. Base types have been implemented
by this library.
Please note that class functions are aliased to the last segment of their name.
ex. `Foo.Bar.MyClass.quux` is automatically usable as `MyClass.quux` in the `proprties` block
Macro: `properties do`
Non-optional
"""
@doc ~S"""
Top-level wrapper for all type class modules. Used as a replacement for `defmodule`.
## Examples
defclass Semigroup do
# @force_type_class true
where do
def concat(a, b)
end
properties do
def associative(data) do
a = generate(data)
b = generate(data)
c = generate(data)
left = a |> Semigroup.concat(b) |> Semigroup.concat(c)
right = Semigroup.concat(a, Semigroup.concat(b, c))
left == right
end
end
end
See [`@force_type_class`](readme.html#force_type_class-true) section in the README for more.
"""
defmacro defclass(class_name, do: body) do
quote do
defmodule unquote(class_name) do
import TypeClass.Property.Generator, only: [generate: 1]
import TypeClass.Property.Generator.Custom
require TypeClass.Property
use TypeClass.Dependency
# Force type classes by default
# accepts configuration options based on FORCE_TYPE_CLASS env variable
# and :doma_type_class > :force_type_class configuration path.
high_prio = case System.get_env("FORCE_TYPE_CLASS") do
nil -> nil
"false" -> false
_ -> true
end
# Friendship ended with false, now true is my best friend
force_default_const = if is_nil(high_prio) do
if Application.get_env(:doma_type_class, :force_type_class, true), do: true, else: false
else
high_prio
end
Module.register_attribute(__MODULE__, :force_type_class, [])
@force_type_class force_default_const
Module.register_attribute(__MODULE__, :class_methods, [])
@class_methods false
unquote(body)
@doc false
def __force_type_class__, do: @force_type_class
TypeClass.run_where!()
TypeClass.Dependency.run()
TypeClass.Property.ensure!()
end
end
end
@doc ~S"""
Define an instance of the type class. The rough equivalent of `defimpl`.
`definst` will check the properties at compile time, and prevent compilation
if the datatype does not conform to the protocol.
## Examples
definst Semigroup, for: List do
# @force_type_instance true
def concat(a, b), do: a ++ b
end
See [`@force_type_instance`](readme.html#force_type_instance-true) section in the README for more.
## `__MODULE__`'s meaning changes inside `definst`
Beware that the value of `__MODULE__` inside
`definst` will be different from the outside
context: `definst`'s `do` block will be invoked
inside `defimpl` macro's body, and `defimpl` creates
its own container module to run things in.
For example, the code below won't compile:
defmodule Name do
import Algae
import TypeClass
use Witchcraft
defdata do
name :: String.t()
end
definst Witchcraft.Functor, for: __MODULE__ do
@force_type_instance true
def map(%__MODULE__{name: name}, f) do
__MODULE__.new(name)
end
end
end
# ** (CompileError) lib/instance/assword.ex:13:
# Witchcraft.Functor.Proto.Instance.Name.__struct__/0 is undefined,
# cannot expand struct Witchcraft.Functor.Proto.Instance.Name
Either use the full module name, or `alias` it, if
too long, such as
defmodule Name do
# (...)
# here
definst Witchcraft.Functor, for: __MODULE__ do
# or here
# (...)
end
end
"""
defmacro definst(class, opts, do: body) do
# __MODULE__ == TypeClass
[for: datatype] = opts
quote do
instance = Module.concat([unquote(class), Proto, unquote(datatype)])
# __MODULE__ == datatype
datatype_module = unquote(datatype)
defimpl unquote(class).Proto, for: datatype_module do
import TypeClass.Property.Generator.Custom
# __MODULE__ == class.Proto.datatype
Module.register_attribute(__MODULE__, :force_type_instance, [])
@force_type_instance false
Module.register_attribute(__MODULE__, :datatype, [])
@datatype datatype_module
@doc false
def __custom_generator__, do: false
defoverridable __custom_generator__: 0
unquote(body)
@doc false
def __force_type_instance__, do: @force_type_instance
end
high_prio = case System.get_env("NOWARN_FORCED_TYPE_CLASS") do
nil -> nil
"false" -> false
_ -> true
end
nowarn_force_default_const = if is_nil(high_prio) do
if Application.get_env(:doma_type_class, :force_type_class, true), do: true, else: false
else
high_prio
end
cond do
unquote(class).__force_type_class__() ->
unless nowarn_force_default_const do
IO.warn("""
The type class #{unquote(class)} has been forced to bypass \
all property checks for all data types. This is very rarely valid, \
as all type classes should have properties associted with them.
For more, please see the TypeClass README:
https://github.com/expede/type_class/blob/master/README.md
""")
end
:ok
instance.__force_type_instance__() ->
unless nowarn_force_default_const do
IO.warn("""
The data type #{unquote(datatype)} has been forced to skip property \
validation for the type class #{unquote(class)}
This is sometimes valid, since TypeClass's property checker \
may not be able to accurately validate all data types correctly for \
all possible cases. Forcing a type instance in this way is like telling \
the checker "trust me this is correct", and should only be used as \
a last resort.
For more, please see the TypeClass README:
https://github.com/expede/type_class/blob/master/README.md
""")
end
:ok
true ->
unquote(datatype) |> conforms(to: unquote(class))
end
end
end
@doc ~S"""
Convenience alises for `definst/3`
## 1. Implicit `:for`
Shortcut for
definst ATypeClass, for: __MODULE__ do
# required function definitions
end
when implementing type class instances inside
the module where the data type is defined.
### Examples
defmodule Name do
import Algae
import TypeClass
use Witchcraft
defdata do
name :: String.t()
end
definst Witchcraft.Functor do
@force_type_instance true
def map(%{name: name}, f), do: %{name: f.(name)}
# def map(_, _), do: 27 # %{name: f.(name)}
end
def add_title(%__MODULE__{} = name, title) do
name ~> &Kernel.<>(title, &1)
end
end
iex(3)> name = X.new("Kilgore Troutman")
%X{name: "Kilgore Troutman"}
iex(4)> X.add_title(name, "Dr. ")
%{name: "Dr. Kilgore Troutman"}
NOTE: copy-pasting the above in IEx won't work because `definst`
checks properties at **compile** time.
## 2. No body
When you only want to check the properties (ex.
when there is no `where` block, such as in
[`Witchcraft.Monad`](https://hexdocs.pm/witchcraft/Witchcraft.Monad.html#content)).
### Examples
# Dependency
defclass Base do
where do
def plus_one(a)
end
properties do
def pass(_), do: true
end
end
# No `where`
defclass MoreProps do
extend Base
properties do
def yep(a), do: equal?(a, a)
end
end
definst Base, for: Integer do
def plus_one(a), do: a + 5
end
definst MoreProps, for: Integer
"""
defmacro definst(class, for: datatype) do
quote do
definst unquote(class), for: unquote(datatype) do
# Intentionally blank; hooking into definst magic
end
end
end
defmacro definst(class, do: body) do
quote do
definst unquote(class), for: __MODULE__ do
unquote(body)
end
end
end
@doc ~S"""
Describe functions to be instantiated. Creates an internal protocol.
## Examples
defclass Semigroup do
where do
def concat(a, b)
end
# ...
end
"""
defmacro where(do: fun_specs) do
Module.put_attribute(__CALLER__.module, :class_methods, fun_specs)
end
defmacro run_where! do
class = __CALLER__.module
fun_specs = Module.get_attribute(class, :class_methods)
proto = (Module.split(class) ++ ["Proto"]) |> Enum.map(&String.to_atom/1)
fun_stubs =
case fun_specs do
nil -> []
{:__block__, _ctx, funs} -> funs
fun = {:def, _ctx, _inner} -> [fun]
end
delegates =
fun_stubs
|> List.wrap()
|> Enum.map(fn
{:def, ctx, fun} ->
{
:defdelegate,
ctx,
fun ++ [[to: {:__aliases__, [alias: false], proto}]]
}
ast ->
ast
end)
quote do
defprotocol Proto do
@moduledoc ~s"""
Protocol for the `#{unquote(class)}` type class
For this type class's API, please refer to `#{unquote(class)}`
"""
import TypeClass.Property.Generator.Custom
Macro.escape(unquote(fun_specs), unquote: true)
end
unquote(delegates)
end
end
@doc ~S"""
Define properties that any instance of the type class must satisfy.
They must by unary (takes a data seed), and return a boolean (true if passes).
`generate` is automatically imported
## Examples
defclass Semigroup do
# ...
properties do
def associative(data) do
a = generate(data)
b = generate(data)
c = generate(data)
left = a |> Semigroup.concat(b) |> Semigroup.concat(c)
right = Semigroup.concat(a, Semigroup.concat(b, c))
left == right
end
end
end
"""
defmacro properties(do: prop_funs) do
class = __CALLER__.module
proto = Module.concat(Module.split(class) ++ [Proto])
leaf =
class
|> Module.split()
|> List.last()
|> List.wrap()
|> Module.concat()
quote do
defmodule Property do
@moduledoc false
import TypeClass.Property, only: [equal?: 2]
alias unquote(class)
alias unquote(proto), as: unquote(leaf)
unquote(prop_funs)
end
end
end
@doc "Delegate to a local function"
defmacro defalias(fun_head, as: as_name) do
quote do
defdelegate unquote(fun_head), to: __MODULE__, as: unquote(as_name)
end
end
@doc "Check that a datatype conforms to the class hierarchy and properties"
defmacro conforms(datatype, opts) do
class = Keyword.get(opts, :to)
quote do
for dependency <- unquote(class).__dependencies__ do
proto = Module.concat(Module.split(dependency) ++ ["Proto"])
# NOTE: does not follow chain if dependency has no `where`
if Exceptional.Safe.safe(&Protocol.assert_protocol!/1).(proto) == :ok do
Protocol.assert_impl!(proto, unquote(datatype))
end
end
for {prop_name, _one} <- unquote(class).Property.__info__(:functions) do
TypeClass.Property.run!(unquote(datatype), unquote(class), prop_name)
end
end
end
@doc "Variant of `conforms/2` that can be called within a data module"
defmacro conforms(opts) do
quote do: conforms(__MODULE__, unquote(opts))
end
end
