292 lines
8 KiB
Idris
292 lines
8 KiB
Idris
module Control.Lens.Setter
|
|
|
|
import Data.Contravariant
|
|
import Data.Profunctor
|
|
import Data.Profunctor.Costrong
|
|
import Data.Profunctor.Traversing
|
|
import Data.Profunctor.Mapping
|
|
import Control.Monad.State
|
|
import Control.Lens.Optic
|
|
import Control.Lens.Indexed
|
|
import Control.Lens.Traversal
|
|
|
|
%default total
|
|
|
|
|
|
------------------------------------------------------------------------------
|
|
-- Type definitions
|
|
------------------------------------------------------------------------------
|
|
|
|
|
|
public export
|
|
record IsSetter p where
|
|
constructor MkIsSetter
|
|
runIsSetter : Mapping p
|
|
|
|
|
|
export %hint
|
|
setterToTraversal : IsSetter p => IsTraversal p
|
|
setterToTraversal @{MkIsSetter _} = MkIsTraversal %search
|
|
|
|
|
|
||| A setter is an optic that only supports setting, not getting.
|
|
|||
|
|
||| More specifically, a setter can modify zero or more focus elements. This
|
|
||| means that all traversals are setters.
|
|
|||
|
|
||| Setters can be thought of as a generalization of the `Functor` interface,
|
|
||| allowing one to map over the contents of a structure.
|
|
public export
|
|
0 Setter : (s,t,a,b : Type) -> Type
|
|
Setter = Optic IsSetter
|
|
|
|
||| `Setter'` is the `Simple` version of `Setter`.
|
|
public export
|
|
0 Setter' : (s,a : Type) -> Type
|
|
Setter' = Simple Setter
|
|
|
|
public export
|
|
0 IndexedSetter : (i,s,t,a,b : Type) -> Type
|
|
IndexedSetter = IndexedOptic IsSetter
|
|
|
|
public export
|
|
0 IndexedSetter' : (i,s,a : Type) -> Type
|
|
IndexedSetter' = Simple . IndexedSetter
|
|
|
|
|
|
------------------------------------------------------------------------------
|
|
-- Utilities for setters
|
|
------------------------------------------------------------------------------
|
|
|
|
|
|
||| Construct a setter from a modifying function.
|
|
public export
|
|
sets : ((a -> b) -> s -> t) -> Setter s t a b
|
|
sets f @{MkIsSetter _} = roam f
|
|
|
|
public export
|
|
isets : ((i -> a -> b) -> s -> t) -> IndexedSetter i s t a b
|
|
isets f @{MkIsSetter _} @{ind} = roam (f . curry) . indexed @{ind}
|
|
|
|
||| Derive a setter from a `Functor` implementation.
|
|
public export
|
|
mapped : Functor f => Setter (f a) (f b) a b
|
|
mapped @{_} @{MkIsSetter _} = map'
|
|
|
|
||| Derive a setter from a `Contravariant` implementation.
|
|
public export
|
|
contramapped : Contravariant f => Setter (f a) (f b) b a
|
|
contramapped = sets contramap
|
|
|
|
|
|
||| Modify the focus or focuses of an optic.
|
|
public export
|
|
over : Setter s t a b -> (a -> b) -> s -> t
|
|
over l = l @{MkIsSetter Function}
|
|
|
|
infixr 4 %~
|
|
|
|
||| Modify the focus or focuses of an optic.
|
|
|||
|
|
||| This is the operator form of `over`.
|
|
public export
|
|
(%~) : Setter s t a b -> (a -> b) -> s -> t
|
|
(%~) = over
|
|
|
|
|
|
public export
|
|
iover : IndexedSetter i s t a b -> (i -> a -> b) -> s -> t
|
|
iover l = l @{MkIsSetter Function} @{Idxed} . uncurry
|
|
|
|
infixr 4 %@~
|
|
|
|
public export
|
|
(%@~) : IndexedSetter i s t a b -> (i -> a -> b) -> s -> t
|
|
(%@~) = iover
|
|
|
|
|
|
||| Set the focus or focuses of an optic to a constant value.
|
|
public export
|
|
set : Setter s t a b -> b -> s -> t
|
|
set l = over l . const
|
|
|
|
infixr 4 .~
|
|
|
|
||| Set the focus or focuses of an optic to a constant value.
|
|
|||
|
|
||| This is the operator form of `set`.
|
|
public export
|
|
(.~) : Setter s t a b -> b -> s -> t
|
|
(.~) = set
|
|
|
|
|
|
public export
|
|
iset : IndexedSetter i s t a b -> (i -> b) -> s -> t
|
|
iset l = iover l . (const .)
|
|
|
|
infix 4 .@~
|
|
|
|
public export
|
|
(.@~) : IndexedSetter i s t a b -> (i -> b) -> s -> t
|
|
(.@~) = iset
|
|
|
|
|
|
------------------------------------------------------------------------------
|
|
-- More operators
|
|
------------------------------------------------------------------------------
|
|
|
|
infixr 4 ?~; infixr 4 <.~; infixr 4 <?~; infixr 4 +~; infixr 4 *~; infixr 4 -~
|
|
infixr 4 /~; infixr 4 ||~; infixr 4 &&~; infixr 4 <+>~
|
|
|
|
infix 4 %=; infix 4 %@=; infix 4 .=; infix 4 .@=; infix 4 ?=; infix 4 <.=
|
|
infix 4 <?=; infix 4 +=; infix 4 *=; infix 4 -=; infix 4 /=; infix 4 ||=
|
|
infix 4 &&=; infixr 4 <+>=
|
|
|
|
infixr 4 <~
|
|
|
|
|
|
||| Set the focus of an optic to `Just` a value.
|
|
public export
|
|
(?~) : Setter s t a (Maybe b) -> b -> s -> t
|
|
(?~) l = set l . Just
|
|
|
|
||| Set a value with pass-through.
|
|
public export
|
|
(<.~) : Setter s t a b -> b -> s -> (b, t)
|
|
(<.~) l x = (x,) . set l x
|
|
|
|
||| Set `Just` a value with pass-through.
|
|
public export
|
|
(<?~) : Setter s t a (Maybe b) -> b -> s -> (b, t)
|
|
(<?~) l x = (x,) . (?~) l x
|
|
|
|
|
|
||| Add a constant value to the focus of an optic.
|
|
public export
|
|
(+~) : Num a => Setter s t a a -> a -> s -> t
|
|
(+~) l = over l . (+)
|
|
|
|
||| Multiply the focus of an optic by a constant value.
|
|
public export
|
|
(*~) : Num a => Setter s t a a -> a -> s -> t
|
|
(*~) l = over l . (*)
|
|
|
|
||| Subtract a constant value from the focus of an optic.
|
|
public export
|
|
(-~) : Neg a => Setter s t a a -> a -> s -> t
|
|
(-~) l = over l . flip (-)
|
|
|
|
||| Divide the focus of an optic by a constant value.
|
|
public export
|
|
(/~) : Fractional a => Setter s t a a -> a -> s -> t
|
|
(/~) l = over l . flip (/)
|
|
|
|
||| Logically OR the focus of an optic with a constant value.
|
|
|||
|
|
||| Like `(||)`, this operator takes a lazy second argument.
|
|
public export
|
|
(||~) : Setter s t Bool Bool -> Lazy Bool -> s -> t
|
|
(||~) l = over l . flip (||)
|
|
|
|
||| Logically AND the focus of an optic with a constant value.
|
|
|||
|
|
||| Like `(&&)`, this operator takes a lazy second argument.
|
|
public export
|
|
(&&~) : Setter s t Bool Bool -> Lazy Bool -> s -> t
|
|
(&&~) l = over l . flip (&&)
|
|
|
|
||| Modify the focus of an optic using the semigroup/monoid operator.
|
|
|||
|
|
||| The constant value is applied to the focus from the right:
|
|
||| ```idris
|
|
||| l <+>~ x = over l (<+> x)
|
|
||| ```
|
|
public export
|
|
(<+>~) : Semigroup a => Setter s t a a -> a -> s -> t
|
|
(<+>~) l = over l . flip (<+>)
|
|
|
|
|
|
||| Modify the focus of an optic within a state monad.
|
|
public export
|
|
(%=) : MonadState s m => Setter s s a b -> (a -> b) -> m ()
|
|
(%=) = modify .: over
|
|
|
|
public export
|
|
(%@=) : MonadState s m => IndexedSetter i s s a b -> (i -> a -> b) -> m ()
|
|
(%@=) = modify .: iover
|
|
|
|
||| Set the focus of an optic within a state monad.
|
|
public export
|
|
(.=) : MonadState s m => Setter s s a b -> b -> m ()
|
|
(.=) = modify .: set
|
|
|
|
public export
|
|
(.@=) : MonadState s m => IndexedSetter i s s a b -> (i -> b) -> m ()
|
|
(.@=) = modify .: iset
|
|
|
|
||| Set the focus of an optic within a state monad to `Just` a value.
|
|
public export
|
|
(?=) : MonadState s m => Setter s s a (Maybe b) -> b -> m ()
|
|
(?=) = modify .: (?~)
|
|
|
|
||| Set within a state monad with pass-through.
|
|
public export
|
|
(<.=) : MonadState s m => Setter s s a b -> b -> m b
|
|
(<.=) l x = (l .= x) >> pure x
|
|
|
|
||| Set to `Just` a value within a state monad with pass-through.
|
|
public export
|
|
(<?=) : MonadState s m => Setter s s a (Maybe b) -> b -> m b
|
|
(<?=) l x = (l ?= x) >> pure x
|
|
|
|
||| Add a constant value to the focus of an optic within a state monad.
|
|
public export
|
|
(+=) : Num a => MonadState s m => Setter' s a -> a -> m ()
|
|
(+=) = modify .: (+~)
|
|
|
|
||| Multiply the focus of an optic into state by a constant value.
|
|
public export
|
|
(*=) : Num a => MonadState s m => Setter' s a -> a -> m ()
|
|
(*=) = modify .: (*~)
|
|
|
|
||| Subtract a constant value from the focus of an optic within a state monad.
|
|
public export
|
|
(-=) : Neg a => MonadState s m => Setter' s a -> a -> m ()
|
|
(-=) = modify .: (-~)
|
|
|
|
||| Divide the focus of an optic into state by a constant value.
|
|
public export
|
|
(//=) : Fractional a => MonadState s m => Setter' s a -> a -> m ()
|
|
(//=) = modify .: (/~)
|
|
|
|
||| Logically OR the focus of an optic into state with a constant value.
|
|
|||
|
|
||| Like `(||)`, this operator takes a lazy second argument.
|
|
public export
|
|
(||=) : MonadState s m => Setter' s Bool -> Lazy Bool -> m ()
|
|
(||=) = modify .: (||~)
|
|
|
|
||| Logically AND the focus of an optic into state with a constant value.
|
|
|||
|
|
||| Like `(&&)`, this operator takes a lazy second argument.
|
|
public export
|
|
(&&=) : MonadState s m => Setter' s Bool -> Lazy Bool -> m ()
|
|
(&&=) = modify .: (&&~)
|
|
|
|
||| Modify the focus of an optic into state using the semigroup/monoid operator.
|
|
|||
|
|
||| The constant value is applied to the focus from the right.
|
|
public export
|
|
(<+>=) : Semigroup a => MonadState s m => Setter' s a -> a -> m ()
|
|
(<+>=) = modify .: (<+>~)
|
|
|
|
|
|
||| Run a monadic action and set the focus of an optic in state to the result.
|
|
|||
|
|
||| This can be thought of as a variation on the do-notation pseudo-operator (<-),
|
|
||| storing the result of a computation within state instead of in a local
|
|
||| variable.
|
|
public export
|
|
(<~) : MonadState s m => Setter s s a b -> m b -> m ()
|
|
(<~) l m = m >>= (l .=)
|