Safe Haskell | None |
---|---|
Language | Haskell2010 |
A version of the Newtype
typeclass and related functions. The API is
primarily pulled from Conor McBride's Epigram work. The general idea is that we
can manipulate types in terms of newtypes around them or newtypes in terms of
their underlying types. Some examples:
>>>
ala Sum foldMap [1,2,3,4]
10
>>>
ala Endo foldMap [(+1), (+2), (subtract 1), (*2)] 3
8
>>>
under2 Min (<>) 2 1
1
>>>
over All not (All False)
All {getAll = True)
The version of the Newtype
class exported by this module has an instance for
*all* and *only* newtypes with Generic
instances whose generated
Coercible
instances are visible. Users need not, and probably should not, write
their own instances.
Like McBride's version, and unlike the one in newtype-generics
, this version
has two parameters: one for the newtype and one for the underlying type. This
is mostly a matter of taste.
Note: Most functions in this module take an argument representing a newtype
constructor. This is used only for its type. To make that clear, the type of
that argument is allowed to be extremely polymorphic: o `to` n
rather than
o -> n
. Unfortunately, GHCi displays this as to o n
, which is ugly but
equivalent.
General approach: When the type variables n
and o
appear, n
is required
to be a newtype wrapper around o
. Similarly, when the type variables n'
and
o'
appear as well, n'
is required to be a newtype wrapper around o'
.
Furthermore, in this case, n
and n'
are required to be the same newtype,
with possibly different type arguments. See Similar
for detailed
documentation.
@since TODO
Synopsis
- class Coercible n o => Newtype (n :: k) (o :: k)
- class Newtype n (O n) => IsNewtype n
- class Newtype n o => HasUnderlying o n
- type O x = GO (Rep x)
- class Similar (n :: k) (n' :: k)
- pack :: Newtype n o => o -> n
- unpack :: Newtype n o => n -> o
- op :: Coercible a b => (a `to` b) -> b -> a
- ala :: (Newtype n o, Newtype n' o', Similar n n') => (o `to` n) -> ((o -> n) -> b -> n') -> b -> o'
- ala' :: (Newtype n o, Newtype n' o', Similar n n') => (o `to` n) -> ((a -> n) -> b -> n') -> (a -> o) -> b -> o'
- under :: (Newtype n o, Newtype n' o', Similar n n') => (o `to` n) -> (n -> n') -> o -> o'
- over :: (Newtype n o, Newtype n' o', Similar n n') => (o `to` n) -> (o -> o') -> n -> n'
- under2 :: (Newtype n o, Newtype n' o', Similar n n') => (o `to` n) -> (n -> n -> n') -> o -> o -> o'
- over2 :: (Newtype n o, Newtype n' o', Similar n n') => (o `to` n) -> (o -> o -> o') -> n -> n -> n'
- underF :: (Newtype n o, Coercible (f o) (f n), Coercible (g n') (g o'), Newtype n' o', Similar n n') => (o `to` n) -> (f n -> g n') -> f o -> g o'
- overF :: (Newtype n o, Coercible (f n) (f o), Coercible (g o') (g n'), Newtype n' o', Similar n n') => (o `to` n) -> (f o -> g o') -> f n -> g n'
Documentation
class Newtype n (O n) => IsNewtype n Source #
A single-parameter version of Newtype
, similar to the Newtype
class in
newtype-generics
.
Newtype n o
is equivalent to (IsNewtype n, o ~ O n)
.
class Newtype n o => HasUnderlying o n Source #
A version of Newtype
with the parameters flipped, for partial
application.
Instances
Newtype n o => HasUnderlying (o :: k) (n :: k) Source # | |
Defined in CoercibleUtils.Newtype |
type O x = GO (Rep x) Source #
Get the underlying type of a newtype.
data N = N Int deriving Generic -- O N = Int
class Similar (n :: k) (n' :: k) Source #
Two types are Similar
if they are built from
the same type constructor and the same kind arguments.
Sum Int
and Sum Bool
are Similar
.
Sum Int
and Product Int
are not Similar
because they are built from different type constructors.
Const Int Char
and Const Int Maybe
are not Similar
because they have different kind arguments.
Instances
(Similar' n n', Similar' n' n) => Similar (n :: k) (n' :: k) Source # | |
Defined in CoercibleUtils.Newtype |
op :: Coercible a b => (a `to` b) -> b -> a Source #
Reverse the type of a "packer".
>>>
op All (All True)
True>>>
op (Identity . Sum) (Identity (Sum 3))
3
ala :: (Newtype n o, Newtype n' o', Similar n n') => (o `to` n) -> ((o -> n) -> b -> n') -> b -> o' Source #
The workhorse of the package. Given a "packer" and a "higher order function" (hof), it handles the packing and unpacking, and just sends you back a regular old function, with the type varying based on the hof you passed.
The reason for the signature of the hof is due to ala
not caring about structure.
To illustrate why this is important, consider this alternative implementation of under2
:
under2 :: (Newtype n o, Newtype n' o') => (o -> n) -> (n -> n -> n') -> (o -> o -> o') under2' pa f o0 o1 = ala pa (\p -> uncurry f . bimap p p) (o0, o1)
Being handed the "packer", the hof may apply it in any structure of its choosing – in this case a tuple.
>>>
ala Sum foldMap [1,2,3,4]
10
ala' :: (Newtype n o, Newtype n' o', Similar n n') => (o `to` n) -> ((a -> n) -> b -> n') -> (a -> o) -> b -> o' Source #
This is the original function seen in Conor McBride's work.
The way it differs from the ala
function in this package,
is that it provides an extra hook into the "packer" passed to the hof.
However, this normally ends up being id
, so ala
wraps this function and
passes id
as the final parameter by default.
If you want the convenience of being able to hook right into the hof,
you may use this function.
>>>
ala' Sum foldMap length ["hello", "world"]
10
>>>
ala' First foldMap (readMaybe @Int) ["x", "42", "1"]
Just 42
under :: (Newtype n o, Newtype n' o', Similar n n') => (o `to` n) -> (n -> n') -> o -> o' Source #
A very simple operation involving running the function 'under' the newtype.
>>>
under Product (stimes 3) 3
27
over :: (Newtype n o, Newtype n' o', Similar n n') => (o `to` n) -> (o -> o') -> n -> n' Source #
The opposite of under
. I.e., take a function which works on the
underlying types, and switch it to a function that works on the newtypes.
>>>
over All not (All False)
All {getAll = True}
under2 :: (Newtype n o, Newtype n' o', Similar n n') => (o `to` n) -> (n -> n -> n') -> o -> o -> o' Source #
Lower a binary function to operate on the underlying values.
>>>
under2 Any (<>) True False
True
over2 :: (Newtype n o, Newtype n' o', Similar n n') => (o `to` n) -> (o -> o -> o') -> n -> n -> n' Source #
The opposite of under2
.