Copyright | (c) Alice Rixte 2024 |
---|---|
License | BSD 3 |
Maintainer | alice.rixte@u-bordeaux.fr |
Stability | unstable |
Portability | non-portable (GHC extensions) |
Safe Haskell | None |
Language | Haskell2010 |
Data.Act.Act
Description
Usage
For both
and LAct
, the acting type is the second parameter. This
is a bit counter intuitive when using RAct
, but it allows to use the
LAct
DerivingVia
mechanism to derive instances of
and LAct
for
newtypes that wrap the acting type. For example, you can use RAct
as
follow to derive instances for ActSelf'
and LAct
:RAct
{-# LANGUAGE DerivingVia #-} import Data.Act import Data.Semigroup newtype Seconds = Seconds Float newtype Duration = Duration Seconds deriving (Semigroup, Monoid) via (Sum Float) deriving (LAct
Seconds,RAct
Seconds) via (ActSelf'
(Sum Float)) -- derives LAct Second Duration deriving (LAct
[Seconds], RAct [Seconds]) via (ActMap
(ActSelf'
(Sum Float))) -- derives LAct [Second] Duration newtype Durations = Durations [Duration] deriving (LAct
Seconds,RAct
Seconds) via (ActFold
[Duration]) -- derives LAct Second Durations
>>>
Duration (Seconds 1) <>$ (Seconds 2)
Seconds 3.0>>>
Duration 2 <>$ Seconds 3
Seconds 5.0>>>
Duration 2 <>$ [Seconds 3, Seconds 4]
[Seconds 5.0,Seconds 6.0]>>>
[Duration 2, Duration 3] <>$ Seconds 4
[Seconds 5.0,Seconds 6.0]>>>
Durations [Duration 2, Duration 3] <>$ Seconds 4
Seconds 9.0
Synopsis
- class LAct x s where
- class (LAct x s, Semigroup s) => LActSg x s
- class (LActSg x s, Monoid s) => LActMn x s
- type LActGp x s = (LActMn x s, Group s)
- class (LAct x s, Semigroup x) => LActDistrib x s
- type LActSgMorph x s = (LActSg x s, LActDistrib x s)
- class (LAct x s, Monoid x) => LActNeutral x s
- type LActMnMorph x s = (LActMn x s, LActSgMorph x s, LActNeutral x s)
- class RAct x s where
- class (RAct x s, Semigroup s) => RActSg x s
- class (RActSg x s, Monoid s) => RActMn x s
- type RActGp x s = (RActMn x s, Group s)
- class (RAct x s, Semigroup x) => RActDistrib x s
- type RActSgMorph x s = (RActSg x s, RActDistrib x s)
- class (RAct x s, Monoid x) => RActNeutral x s
- type RActMnMorph x s = (RActMn x s, RActSgMorph x s, RActNeutral x s)
- newtype ActSelf s = ActSelf {
- unactSelf :: s
- newtype ActSelf' x = ActSelf' {
- unactCoerce :: x
- newtype ActMap s = ActMap {
- unactMap :: s
- newtype ActFold s = ActFold {
- unactFold :: s
- newtype ActFold' s = ActFold' {
- unactFold' :: s
- newtype ActTrivial x = ActTrivial {
- unactId :: x
Left actions
A left action of a set s
on another set x
is a function that maps
elements of s
to functions on x
.
There are no additional laws for this class to satisfy.
One example of useful set action that is not a semigroup action is declared in this file :
instance (LAct x s, LAct x t) => LAct x (Either s t) where Left s <>$ x = s <>$ x Right s <>$ x = s <>$ x
This is often useful when dealing with free monoids :
>>>
ActFold [Right (Product (2 :: Int)) , Left (Sum (1 :: Int))] <>$ (2 :: Int)
6>>>
(2 :: Int) $<> ActFold [Right (Product (2 :: Int)) , Left (Sum (1 :: Int))]
5
The order
's arguments is counter intuitive : even though we write
left actions as LAct
s <>$ x
, we declare the constraint as LAct x s
. The
reason for this is to be able to derive instances of LAct
while driving the
instances by the acting type.
Instances of LAct
are driven by the second parameter (the acting type).
Concretely, this means you should never write instances of the form
instance LAct SomeType s
where s
is a type variable.
Methods
lact :: s -> x -> x infixr 5 Source #
Lifts an element of the set s
into a function on the set x
(<>$) :: s -> x -> x infixr 5 Source #
Infix synonym or lact
The acting part is on the right of the operator (symbolized by <>
) and
the actee on the right (symbolized by $
), hence the notation <>$
Instances
LAct () s Source # | Action by morphism of semigroups (resp. monoids) when |
LAct Bool All Source # | Monoid action |
LAct Bool Any Source # | Monoid action |
LAct x () Source # | Action by morphism of monoids |
Semigroup s => LAct s (ActSelf s) Source # | Semigroup action (monoid action when |
LAct x s => LAct x (Identity s) Source # | Preserves action properties of |
LAct x (First x) Source # | Monoid action |
LAct x (First x) Source # | Semigroup action |
RAct x s => LAct x (Dual s) Source # | Preserves action properties of |
LAct x (Endo x) Source # | Monoid action |
Num x => LAct x (Product x) Source # | Monoid action |
Num x => LAct x (Sum x) Source # | Monoid action |
(Foldable f, LAct x s) => LAct x (ActFold (f s)) Source # | When used with lists |
(Foldable f, LAct x s) => LAct x (ActFold' (f s)) Source # | When used with lists |
(Semigroup s, Coercible x s) => LAct x (ActSelf' s) Source # | Semigroup action (monoid action when |
LAct x (ActTrivial s) Source # | |
Defined in Data.Act.Act | |
LAct x s => LAct x (Maybe s) Source # | Monoid action when |
(LAct x s, LAct x t) => LAct x (Either s t) Source # | No additionnal properties. In particular this is _not_ a semigroup action. |
LAct x s => LAct (Identity x) (Identity s) Source # | Preserves action properties of |
Num x => LAct (Product x) (Product x) Source # | Monoid action |
Num x => LAct (Sum x) (Product x) Source # | Action by morphism of monoids |
Num x => LAct (Sum x) (Sum x) Source # | Monoid action |
(LAct x s, Functor f) => LAct (f x) (ActMap s) Source # | Preserves the semigroup (resp. monoid) property of |
(LAct x1 s1, LAct x2 s2) => LAct (x1, x2) (s1, s2) Source # | Same action propety as the weaker properties of |
class (LAct x s, Semigroup s) => LActSg x s Source #
A left semigroup action
Instances must satisfy the following law :
(s <> t) <>$ x == s <>$ (t <>$ x)
Instances
class (LActSg x s, Monoid s) => LActMn x s Source #
A left monoid action, also called a left unitary action.
In addition to the laws of
, instances must satisfy the following
law :LActSg
mempty
<>$ x == x
Instances
type LActGp x s = (LActMn x s, Group s) Source #
A left action of groups. No additional laws are needed.
class (LAct x s, Semigroup x) => LActDistrib x s Source #
A left distributive action
Instances must satisfy the following law :
s <>$ (x <> y) == (s <>$ x) <> (s <>$ y)
Instances
LActDistrib () s Source # | |
Defined in Data.Act.Act | |
Semigroup x => LActDistrib x () Source # | |
Defined in Data.Act.Act | |
LActDistrib x s => LActDistrib x (Identity s) Source # | |
Defined in Data.Act.Act | |
RActDistrib x s => LActDistrib x (Dual s) Source # | |
Defined in Data.Act.Act | |
Semigroup x => LActDistrib x (ActTrivial s) Source # | |
Defined in Data.Act.Act | |
LActDistrib x s => LActDistrib (Identity x) (Identity s) Source # | |
Defined in Data.Act.Act | |
Num x => LActDistrib (Sum x) (Product x) Source # | |
Defined in Data.Act.Act | |
LAct x s => LActDistrib [x] (ActMap s) Source # | |
Defined in Data.Act.Act | |
(LActDistrib x1 s1, LActDistrib x2 s2) => LActDistrib (x1, x2) (s1, s2) Source # | |
Defined in Data.Act.Act |
type LActSgMorph x s = (LActSg x s, LActDistrib x s) Source #
A left action by morphism of semigroups
Whenever the constaints
and LActSg
x s
are satisfied,
LActDistrib
x s(s <>$)
is a morphism of semigroups for any s
.
class (LAct x s, Monoid x) => LActNeutral x s Source #
A left action on a monoid that preserves its neutral element.
Instances must satisfy the following law :
s <>$mempty
==mempty
Instances
LActNeutral () s Source # | |
Defined in Data.Act.Act | |
Monoid x => LActNeutral x () Source # | |
Defined in Data.Act.Act | |
LActNeutral x s => LActNeutral x (Identity s) Source # | |
Defined in Data.Act.Act | |
RActNeutral x s => LActNeutral x (Dual s) Source # | |
Defined in Data.Act.Act | |
Monoid x => LActNeutral x (ActTrivial s) Source # | |
Defined in Data.Act.Act | |
LActNeutral x s => LActNeutral (Identity x) (Identity s) Source # | |
Defined in Data.Act.Act | |
Num x => LActNeutral (Sum x) (Product x) Source # | |
Defined in Data.Act.Act | |
LAct x s => LActNeutral [x] (ActMap s) Source # | |
Defined in Data.Act.Act | |
(LActNeutral x1 s1, LActNeutral x2 s2) => LActNeutral (x1, x2) (s1, s2) Source # | |
Defined in Data.Act.Act |
type LActMnMorph x s = (LActMn x s, LActSgMorph x s, LActNeutral x s) Source #
A left action by morphism of monoids i.e. such that (s <>$)
is a morphism of monoids.
This is equivalent to satisfy the three following properties :
- left action by morphism of semigroups (i.e.
)LActSgMorph
x s - left monoid action (i.e.
)LActMn
x s - preseving neutral element (i.e.
)LActNeutral
x s
Right actions
A right action of a set s
on another set x
.
There are no additional laws for this class to satisfy.
Methods
ract :: x -> s -> x infixl 5 Source #
Act on the right of some element of x
($<>) :: x -> s -> x infixl 5 Source #
Infix synonym or ract
The acting part is on the right of the operator (symbolized by <>
) and
the actee on the left (symbolized by $
), hence the notation $<>
.
Instances
RAct () s Source # | Action by morphism of semigroups (resp. monoids) when |
RAct Bool All Source # | Monoid action |
RAct Bool Any Source # | Monoid action |
RAct x () Source # | Monoid action |
Semigroup s => RAct s (ActSelf s) Source # | Semigroup action (monoid action when |
RAct x s => RAct x (Identity s) Source # | Preserves action properties of |
RAct x (Last x) Source # | Monoid action |
RAct x (Last x) Source # | Semigroup action |
LAct x s => RAct x (Dual s) Source # | Preserves action properties of |
Num x => RAct x (Product x) Source # | Monoid action |
Num x => RAct x (Sum x) Source # | Monoid action |
(Foldable f, RAct x s) => RAct x (ActFold (f s)) Source # | When used with lists |
(Foldable f, RAct x s) => RAct x (ActFold' (f s)) Source # | When used with lists |
(Semigroup s, Coercible x s) => RAct x (ActSelf' s) Source # | Semigroup action (monoid action when |
RAct x (ActTrivial s) Source # | |
Defined in Data.Act.Act | |
RAct x s => RAct x (Maybe s) Source # | Monoid action when |
(RAct x s, RAct x t) => RAct x (Either s t) Source # | No additionnal properties. In particular this is _not_ a semigroup action. |
RAct x s => RAct (Identity x) (Identity s) Source # | Preserves action properties of |
Num x => RAct (Product x) (Product x) Source # | Monoid action |
Num x => RAct (Sum x) (Product x) Source # | Action by morphism of monoids |
Num x => RAct (Sum x) (Sum x) Source # | Monoid action |
(RAct x s, Functor f) => RAct (f x) (ActMap s) Source # | Preserves the semigroup (resp. monoid) property of |
(RAct x1 s1, RAct x2 s2) => RAct (x1, x2) (s1, s2) Source # | Same action propety as the weaker properties of |
class (RAct x s, Semigroup s) => RActSg x s Source #
A right semigroup action
Instances must satisfy the following law :
x $<> (s <> t) == (x $<> s) $<> t
Instances
class (RActSg x s, Monoid s) => RActMn x s Source #
A right monoid action, also called a right unitary action.
In addition to the laws of
, instances must satisfy the following
law :RActSg
x $<> mempty
== x
Instances
type RActGp x s = (RActMn x s, Group s) Source #
A left action of groups. No additional laws are needed.
class (RAct x s, Semigroup x) => RActDistrib x s Source #
A right distributive action
Instances must satisfy the following law :
(x <> y) $<> s == (x $<> s) <> (y $<> s)
Instances
RActDistrib () s Source # | |
Defined in Data.Act.Act | |
Semigroup x => RActDistrib x () Source # | |
Defined in Data.Act.Act | |
RActDistrib x s => RActDistrib x (Identity s) Source # | |
Defined in Data.Act.Act | |
LActDistrib x s => RActDistrib x (Dual s) Source # | |
Defined in Data.Act.Act | |
Semigroup x => RActDistrib x (ActTrivial s) Source # | |
Defined in Data.Act.Act | |
RActDistrib x s => RActDistrib (Identity x) (Identity s) Source # | |
Defined in Data.Act.Act | |
Num x => RActDistrib (Sum x) (Product x) Source # | |
Defined in Data.Act.Act | |
RAct x s => RActDistrib [x] (ActMap s) Source # | |
Defined in Data.Act.Act | |
(RActDistrib x1 s1, RActDistrib x2 s2) => RActDistrib (x1, x2) (s1, s2) Source # | |
Defined in Data.Act.Act |
type RActSgMorph x s = (RActSg x s, RActDistrib x s) Source #
A right action by morphism of semigroups
Whenever the constaints
and RActSg
x s
are satisfied,
RActDistrib
x s($<> s)
is a morphism of semigroups for any s
.
class (RAct x s, Monoid x) => RActNeutral x s Source #
A right action on a monoid that preserves its neutral element.
Instances must satisfy the following law :
x $<> mempty == x
Instances
RActNeutral () s Source # | |
Defined in Data.Act.Act | |
Monoid x => RActNeutral x () Source # | |
Defined in Data.Act.Act | |
RActNeutral x s => RActNeutral x (Identity s) Source # | |
Defined in Data.Act.Act | |
LActNeutral x s => RActNeutral x (Dual s) Source # | |
Defined in Data.Act.Act | |
Monoid x => RActNeutral x (ActTrivial s) Source # | |
Defined in Data.Act.Act | |
RActNeutral x s => RActNeutral (Identity x) (Identity s) Source # | |
Defined in Data.Act.Act | |
Num x => RActNeutral (Sum x) (Product x) Source # | |
Defined in Data.Act.Act | |
RAct x s => RActNeutral [x] (ActMap s) Source # | |
Defined in Data.Act.Act | |
(RActNeutral x1 s1, RActNeutral x2 s2) => RActNeutral (x1, x2) (s1, s2) Source # | |
Defined in Data.Act.Act |
type RActMnMorph x s = (RActMn x s, RActSgMorph x s, RActNeutral x s) Source #
A right action by morphism of monoids i.e. such that
($<> s)
is a morphism of monoids
Newtypes for instance derivation
A semigroup always acts on itself by translation.
Notice that whenever there is an instance LAct x s
with x
different from
s
, this action is lifted to an ActSelf
action.
>>>
ActSelf "Hello" <>$ " World !"
"Hello World !"
Instances
Actions of ActSelf'
behave similarly to those of
, but first
try to coerce ActSelf
x
to s
before using the Semigroup
instance. If x
can be
coerced to s
, then we use the ActSelf
action.
This is meant to be used in conjunction with the deriving via
strategy when
defining newtype wrappers. Here is a concrete example, where durations act on
time. Here, Seconds
is not a semigroup and Duration
is a group that acts
on time via the derived instance LAct Seconds Duration
.
import Data.Semigroup newtype Seconds = Seconds Float newtype Duration = Duration Seconds deriving (Semigroup
,Monoid
,Group
) via (Sum
Float) deriving (LAct
Seconds) via (ActSelf'
(Sum
Float))
>>>
Duration 2 <>$ Seconds 3
Seconds 5.0
Constructors
ActSelf' | |
Fields
|
Instances
An action on any functor that uses the fmap
function. For example :
>>>
ActMap (ActSelf "Hello") <>$ [" World !", " !"]
["Hello World !","Hello !"]
Instances
Monoid s => Monoid (ActMap s) Source # | |
Semigroup s => Semigroup (ActMap s) Source # | |
Show s => Show (ActMap s) Source # | |
Eq s => Eq (ActMap s) Source # | |
Group s => Group (ActMap s) Source # | |
(LAct x s, Functor f) => LAct (f x) (ActMap s) Source # | Preserves the semigroup (resp. monoid) property of |
LAct x s => LActDistrib [x] (ActMap s) Source # | |
Defined in Data.Act.Act | |
(LActMn x s, Functor f) => LActMn (f x) (ActMap s) Source # | |
Defined in Data.Act.Act | |
LAct x s => LActNeutral [x] (ActMap s) Source # | |
Defined in Data.Act.Act | |
(LActSg x s, Functor f) => LActSg (f x) (ActMap s) Source # | |
Defined in Data.Act.Act | |
(RAct x s, Functor f) => RAct (f x) (ActMap s) Source # | Preserves the semigroup (resp. monoid) property of |
RAct x s => RActDistrib [x] (ActMap s) Source # | |
Defined in Data.Act.Act | |
(RActMn x s, Functor f) => RActMn (f x) (ActMap s) Source # | |
Defined in Data.Act.Act | |
RAct x s => RActNeutral [x] (ActMap s) Source # | |
Defined in Data.Act.Act | |
(RActSg x s, Functor f) => RActSg (f x) (ActMap s) Source # | |
Defined in Data.Act.Act |
Lifting an a container as an action using
(for left actions) or
foldr
(for right actions). For a strict version, use foldl
.ActFold'
A left action (<>$)
can be seen as an operator for the
function,
and a allowing to lift any action to some foldr
container.Foldable
> ActFold [Sum (1 :: Int), Sum 2, Sum 3] <>$ (4 :: Int) 10
Instances
(Foldable f, LAct x s) => LAct x (ActFold (f s)) Source # | When used with lists |
LAct x s => LActSg x (ActFold [s]) Source # | |
Defined in Data.Act.Act | |
(Foldable f, RAct x s) => RAct x (ActFold (f s)) Source # | When used with lists |
Monoid s => Monoid (ActFold s) Source # | |
Semigroup s => Semigroup (ActFold s) Source # | |
Show s => Show (ActFold s) Source # | |
Eq s => Eq (ActFold s) Source # | |
Group s => Group (ActFold s) Source # | |
Lifting an a container as an action using
(for left actions)
or fold'r
(for right actions). For a lazy version, use foldl'
.ActFold
A left action (<>$)
can be seen as an operator for the
function,
and a allowing to lift any action to some foldr
container.Foldable
>>>
ActFold' [Sum (1 :: Int), Sum 2, Sum 3] <>$ (4 :: Int)
10
Constructors
ActFold' | |
Fields
|
Instances
(Foldable f, LAct x s) => LAct x (ActFold' (f s)) Source # | When used with lists |
LAct x s => LActSg x (ActFold' [s]) Source # | |
Defined in Data.Act.Act | |
(Foldable f, RAct x s) => RAct x (ActFold' (f s)) Source # | When used with lists |
Monoid s => Monoid (ActFold' s) Source # | |
Semigroup s => Semigroup (ActFold' s) Source # | |
Show s => Show (ActFold' s) Source # | |
Eq s => Eq (ActFold' s) Source # | |
Group s => Group (ActFold' s) Source # | |
newtype ActTrivial x Source #
The trivial action where any element of s
acts as the identity function
on x
>>>
ActTrivial "Hello !" <>$ "Hi !"
" Hi !"
Constructors
ActTrivial | |
Fields
|