{-# LANGUAGE RankNTypes #-}
module Fresnel.Setter
( -- * Setters
  Setter
, Setter'
, IsSetter
  -- * Construction
, sets
, mapped
, contramapped
  -- * Elimination
, over
, (%~)
, set
, (.~)
, (+~)
, (-~)
, (*~)
, (/~)
, (^~)
, (^^~)
, (**~)
) where

import Data.Functor.Contravariant
import Data.Profunctor.Mapping
import Fresnel.Optic
import Fresnel.Traversal.Internal (IsTraversal)

-- Setters

type Setter s t a b = forall p . IsSetter p => Optic p s t a b

type Setter' s a = Setter s s a a

class (IsTraversal p, Mapping p) => IsSetter p

instance IsSetter (->)


-- Construction

sets :: ((a -> b) -> (s -> t)) -> Setter s t a b
sets :: ((a -> b) -> s -> t) -> Setter s t a b
sets (a -> b) -> s -> t
f = ((a -> b) -> s -> t
f ((a -> b) -> s -> t) -> p a b -> p s t
forall (p :: * -> * -> *) a b s t.
Mapping p =>
((a -> b) -> s -> t) -> p a b -> p s t
`roam`) -- written thus to placate hlint


mapped :: Functor f => Setter (f a) (f b) a b
mapped :: Setter (f a) (f b) a b
mapped = ((a -> b) -> f a -> f b) -> Setter (f a) (f b) a b
forall a b s t. ((a -> b) -> s -> t) -> Setter s t a b
sets (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

contramapped :: Contravariant f => Setter (f a) (f b) b a
contramapped :: Setter (f a) (f b) b a
contramapped = ((b -> a) -> f a -> f b) -> Setter (f a) (f b) b a
forall a b s t. ((a -> b) -> s -> t) -> Setter s t a b
sets (b -> a) -> f a -> f b
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap


-- Elimination

over, (%~) :: Setter s t a b -> (a -> b) -> (s -> t)
over :: Setter s t a b -> (a -> b) -> s -> t
over Setter s t a b
o = (a -> b) -> s -> t
Setter s t a b
o

%~ :: Setter s t a b -> (a -> b) -> s -> t
(%~) = Setter s t a b -> (a -> b) -> s -> t
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
over

infixr 4 %~


set, (.~) :: Setter s t a b -> b -> s -> t
set :: Setter s t a b -> b -> s -> t
set Setter s t a b
o = Setter s t a b -> (a -> b) -> s -> t
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
over Setter s t a b
o ((a -> b) -> s -> t) -> (b -> a -> b) -> b -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a -> b
forall a b. a -> b -> a
const

.~ :: Setter s t a b -> b -> s -> t
(.~) = Setter s t a b -> b -> s -> t
forall s t a b. Setter s t a b -> b -> s -> t
set

infixr 4 .~


(+~), (-~), (*~) :: Num a => Setter s t a a -> a -> s -> t
Setter s t a a
o +~ :: Setter s t a a -> a -> s -> t
+~ a
a = Setter s t a a -> (a -> a) -> s -> t
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
over Setter s t a a
o (a -> a -> a
forall a. Num a => a -> a -> a
+ a
a)
Setter s t a a
o -~ :: Setter s t a a -> a -> s -> t
-~ a
a = Setter s t a a -> (a -> a) -> s -> t
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
over Setter s t a a
o (a -> a -> a
forall a. Num a => a -> a -> a
subtract a
a)
Setter s t a a
o *~ :: Setter s t a a -> a -> s -> t
*~ a
a = Setter s t a a -> (a -> a) -> s -> t
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
over Setter s t a a
o (a -> a -> a
forall a. Num a => a -> a -> a
* a
a)

infixr 4 +~, -~, *~

(/~) :: Fractional a => Setter s t a a -> a -> s -> t
Setter s t a a
o /~ :: Setter s t a a -> a -> s -> t
/~ a
a = Setter s t a a -> (a -> a) -> s -> t
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
over Setter s t a a
o (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
a)

infixr 4 /~

(^~) :: (Num a, Integral b) => Setter s t a a -> b -> s -> t
Setter s t a a
o ^~ :: Setter s t a a -> b -> s -> t
^~ b
a = Setter s t a a -> (a -> a) -> s -> t
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
over Setter s t a a
o (a -> b -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ b
a)

infixr 4 ^~

(^^~) :: (Fractional a, Integral b) => Setter s t a a -> b -> s -> t
Setter s t a a
o ^^~ :: Setter s t a a -> b -> s -> t
^^~ b
a = Setter s t a a -> (a -> a) -> s -> t
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
over Setter s t a a
o (a -> b -> a
forall a b. (Fractional a, Integral b) => a -> b -> a
^^ b
a)

infixr 4 ^^~

(**~) :: Floating a => Setter s t a a -> a -> s -> t
Setter s t a a
o **~ :: Setter s t a a -> a -> s -> t
**~ a
a = Setter s t a a -> (a -> a) -> s -> t
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
over Setter s t a a
o (a -> a -> a
forall a. Floating a => a -> a -> a
** a
a)

infixr 4 **~