{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE RankNTypes #-}
module Miso.Lens
(
Lens (..)
, Getter
, Setter
, lens
, (&)
, (<&>)
, (.~)
, (?~)
, set
, (%~)
, over
, (^.)
, (+~)
, (*~)
, (//~)
, (-~)
, (%=)
, modifying
, (+=)
, (*=)
, (//=)
, (-=)
, (.=)
, (<~)
, (<%=)
, (<.=)
, (<?=)
, (<<.=)
, (<<%=)
, assign
, use
, view
, (?=)
, (<>~)
, _1
, _2
, _id
, this
, compose
, Lens'
, toVL
, fromVL
) where
import Control.Monad.Reader (MonadReader, asks)
import Control.Monad.State (MonadState, modify, gets)
import Control.Monad.Identity (Identity(..))
import Control.Category (Category (..))
import Control.Arrow ((<<<))
import Data.Functor.Const (Const(..))
import Data.Function ((&))
import Data.Functor((<&>))
import Data.Kind (Type)
import Prelude hiding ((.))
import Miso.Util (compose)
data Lens record field
= Lens
{ forall record field. Lens record field -> Getter record field
_get :: Getter record field
, forall record field. Lens record field -> Setter record field
_set :: Setter record field
}
type Getter record field = record -> field
type Setter record field = field -> record -> record
type Lens' s a = forall (f :: Type -> Type). Functor f => (a -> f a) -> s -> f s
toVL :: Lens record field -> Lens' record field
toVL :: forall record field. Lens record field -> Lens' record field
toVL Lens {Getter record field
Setter record field
_get :: forall record field. Lens record field -> Getter record field
_set :: forall record field. Lens record field -> Setter record field
_get :: Getter record field
_set :: Setter record field
..} = \field -> f field
f record
record -> Setter record field -> record -> field -> record
forall a b c. (a -> b -> c) -> b -> a -> c
flip Setter record field
_set record
record (field -> record) -> f field -> f record
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> field -> f field
f (Getter record field
_get record
record)
fromVL
:: Lens' record field
-> Lens record field
fromVL :: forall record field. Lens' record field -> Lens record field
fromVL Lens' record field
lens_ = Lens {Getter record field
Setter record field
_get :: Getter record field
_set :: Setter record field
_get :: Getter record field
_set :: Setter record field
..}
where
_get :: Getter record field
_get record
record = Const field record -> field
forall {k} a (b :: k). Const a b -> a
getConst ((field -> Const field field) -> record -> Const field record
Lens' record field
lens_ field -> Const field field
forall {k} a (b :: k). a -> Const a b
Const record
record)
_set :: Setter record field
_set field
field = Identity record -> record
forall a. Identity a -> a
runIdentity (Identity record -> record)
-> (record -> Identity record) -> record -> record
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (field -> Identity field) -> record -> Identity record
Lens' record field
lens_ (\field
_ -> field -> Identity field
forall a. a -> Identity a
Identity field
field)
instance Category Lens where
id :: forall a. Lens a a
id = Getter a a -> Setter a a -> Lens a a
forall record field.
Getter record field -> Setter record field -> Lens record field
Lens Getter a a
forall a. a -> a
Prelude.id Setter a a
forall a b. a -> b -> a
const
Lens Getter b c
g1 Setter b c
s1 . :: forall b c a. Lens b c -> Lens a b -> Lens a c
. Lens Getter a b
g2 Setter a b
s2 = Lens
{ _get :: Getter a c
_get = Getter b c
g1 Getter b c -> Getter a b -> Getter a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< Getter a b
g2
, _set :: Setter a c
_set = \c
f a
r -> Setter a b
s2 (Setter b c
s1 c
f (Getter a b
g2 a
r)) a
r
}
infixr 4 .~
(.~) :: Lens record field -> field -> record -> record
.~ :: forall record field. Lens record field -> Setter record field
(.~) Lens record field
_lens = Lens record field -> Setter record field
forall record field. Lens record field -> Setter record field
_set Lens record field
_lens
set :: Lens record field -> field -> record -> record
set :: forall record field. Lens record field -> Setter record field
set = Lens record field -> field -> record -> record
forall record field. Lens record field -> Setter record field
(.~)
infixr 4 ?~
(?~) :: Lens record (Maybe field) -> field -> record -> record
?~ :: forall record field.
Lens record (Maybe field) -> field -> record -> record
(?~) Lens record (Maybe field)
_lens field
f record
r = record
r record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record (Maybe field)
_lens Lens record (Maybe field) -> Maybe field -> record -> record
forall record field. Lens record field -> Setter record field
.~ field -> Maybe field
forall a. a -> Maybe a
Just field
f
infixr 4 %~
(%~) :: Lens record field -> (field -> field) -> record -> record
%~ :: forall record field.
Lens record field -> (field -> field) -> record -> record
(%~) Lens record field
_lens field -> field
f record
record = Lens record field -> Setter record field
forall record field. Lens record field -> Setter record field
_set Lens record field
_lens (field -> field
f (record
record record -> Lens record field -> field
forall record field. record -> Lens record field -> field
^. Lens record field
_lens)) record
record
over :: Lens record field -> (field -> field) -> record -> record
over :: forall record field.
Lens record field -> (field -> field) -> record -> record
over = Lens record field -> (field -> field) -> record -> record
forall record field.
Lens record field -> (field -> field) -> record -> record
(%~)
infixl 8 ^.
(^.) :: record -> Lens record field -> field
^. :: forall record field. record -> Lens record field -> field
(^.) = (Lens record field -> record -> field)
-> record -> Lens record field -> field
forall a b c. (a -> b -> c) -> b -> a -> c
flip Lens record field -> record -> field
forall record field. Lens record field -> Getter record field
_get
infixr 4 +~
(+~) :: Num field => Lens record field -> field -> record -> record
+~ :: forall field record.
Num field =>
Lens record field -> field -> record -> record
(+~) Lens record field
_lens field
x record
record = record
record record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> (field -> field) -> record -> record
forall record field.
Lens record field -> (field -> field) -> record -> record
%~ (field -> field -> field
forall a. Num a => a -> a -> a
+field
x)
infixr 4 *~
(*~) :: Num field => Lens record field -> field -> record -> record
*~ :: forall field record.
Num field =>
Lens record field -> field -> record -> record
(*~) Lens record field
_lens field
x record
record = record
record record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> (field -> field) -> record -> record
forall record field.
Lens record field -> (field -> field) -> record -> record
%~ (field -> field -> field
forall a. Num a => a -> a -> a
*field
x)
infixr 4 //~
(//~) :: Fractional field => Lens record field -> field -> record -> record
//~ :: forall field record.
Fractional field =>
Lens record field -> field -> record -> record
(//~) Lens record field
_lens field
x record
record = record
record record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> (field -> field) -> record -> record
forall record field.
Lens record field -> (field -> field) -> record -> record
%~ (field -> field -> field
forall a. Fractional a => a -> a -> a
/field
x)
infixr 4 -~
(-~) :: Num field => Lens record field -> field -> record -> record
-~ :: forall field record.
Num field =>
Lens record field -> field -> record -> record
(-~) Lens record field
_lens field
x record
record = record
record record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> (field -> field) -> record -> record
forall record field.
Lens record field -> (field -> field) -> record -> record
%~ field -> field -> field
forall a. Num a => a -> a -> a
subtract field
x
infixr 4 <>~
(<>~) :: Monoid field => Lens record field -> field -> record -> record
<>~ :: forall field record.
Monoid field =>
Lens record field -> field -> record -> record
(<>~) Lens record field
_lens field
x record
record = record
record record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> (field -> field) -> record -> record
forall record field.
Lens record field -> (field -> field) -> record -> record
%~ (field -> field -> field
forall a. Semigroup a => a -> a -> a
<> field
x)
infixr 2 <~
(<~) :: MonadState record m => Lens record field -> m field -> m ()
Lens record field
l <~ :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> m field -> m ()
<~ m field
mb = do
b <- m field
mb
l .= b
infix 4 %=
(%=) :: MonadState record m => Lens record field -> (field -> field) -> m ()
%= :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
(%=) Lens record field
_lens field -> field
f = (record -> record) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\record
r -> record
r record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> (field -> field) -> record -> record
forall record field.
Lens record field -> (field -> field) -> record -> record
%~ field -> field
f)
modifying :: MonadState record m => Lens record field -> (field -> field) -> m ()
modifying :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
modifying = Lens record field -> (field -> field) -> m ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
(%=)
infix 4 <%=
(<%=) :: MonadState record m => Lens record field -> (field -> field) -> m field
Lens record field
l <%= :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m field
<%= field -> field
f = do
Lens record field
l Lens record field -> (field -> field) -> m ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
%= field -> field
f
Lens record field -> m field
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> m field
use Lens record field
l
infix 4 <.=
(<.=) :: MonadState record m => Lens record field -> field -> m field
Lens record field
l <.= :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m field
<.= field
b = do
Lens record field
l Lens record field -> field -> m ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
.= field
b
field -> m field
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return field
b
infix 4 <?=
(<?=) :: MonadState record m => Lens record (Maybe field) -> field -> m field
Lens record (Maybe field)
l <?= :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record (Maybe field) -> field -> m field
<?= field
b = do
Lens record (Maybe field)
l Lens record (Maybe field) -> Maybe field -> m ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
.= field -> Maybe field
forall a. a -> Maybe a
Just field
b
field -> m field
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return field
b
infix 4 <<.=
(<<.=) :: MonadState record m => Lens record field -> field -> m field
Lens record field
l <<.= :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m field
<<.= field
b = do
old <- Lens record field -> m field
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> m field
use Lens record field
l
l .= b
return old
view :: MonadReader record m => Lens record field -> m field
view :: forall record (m :: * -> *) field.
MonadReader record m =>
Lens record field -> m field
view Lens record field
lens_ = (record -> field) -> m field
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (record -> Lens record field -> field
forall record field. record -> Lens record field -> field
^. Lens record field
lens_)
infix 4 <<%=
(<<%=) :: MonadState record m => Lens record field -> (field -> field) -> m field
Lens record field
l <<%= :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m field
<<%= field -> field
f = do
old <- Lens record field -> m field
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> m field
use Lens record field
l
l %= f
return old
infix 4 .=
(.=) :: MonadState record m => Lens record field -> field -> m ()
.= :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
(.=) Lens record field
_lens field
f = (record -> record) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\record
r -> record
r record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> field -> record -> record
forall record field. Lens record field -> Setter record field
.~ field
f)
assign :: MonadState record m => Lens record field -> field -> m ()
assign :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
assign = Lens record field -> field -> m ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
(.=)
use :: MonadState record m => Lens record field -> m field
use :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> m field
use Lens record field
_lens = (record -> field) -> m field
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (record -> Lens record field -> field
forall record field. record -> Lens record field -> field
^. Lens record field
_lens)
infix 4 ?=
(?=) :: MonadState record m => Lens record (Maybe field) -> field -> m ()
?= :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record (Maybe field) -> field -> m ()
(?=) Lens record (Maybe field)
_lens field
value = Lens record (Maybe field)
_lens Lens record (Maybe field) -> Maybe field -> m ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
.= field -> Maybe field
forall a. a -> Maybe a
Just field
value
infix 4 +=
(+=) :: (MonadState record m, Num field) => Lens record field -> field -> m ()
+= :: forall record (m :: * -> *) field.
(MonadState record m, Num field) =>
Lens record field -> field -> m ()
(+=) Lens record field
_lens field
f = (record -> record) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\record
r -> record
r record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> field -> record -> record
forall field record.
Num field =>
Lens record field -> field -> record -> record
+~ field
f)
infix 4 *=
(*=) :: (MonadState record m, Num field) => Lens record field -> field -> m ()
*= :: forall record (m :: * -> *) field.
(MonadState record m, Num field) =>
Lens record field -> field -> m ()
(*=) Lens record field
_lens field
f = (record -> record) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\record
r -> record
r record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> field -> record -> record
forall field record.
Num field =>
Lens record field -> field -> record -> record
*~ field
f)
infix 4 //=
(//=) :: (MonadState record m, Fractional field) => Lens record field -> field -> m ()
//= :: forall record (m :: * -> *) field.
(MonadState record m, Fractional field) =>
Lens record field -> field -> m ()
(//=) Lens record field
_lens field
f = (record -> record) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\record
r -> record
r record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> (field -> field) -> record -> record
forall record field.
Lens record field -> (field -> field) -> record -> record
%~ (field -> field -> field
forall a. Fractional a => a -> a -> a
/ field
f))
infix 4 -=
(-=) :: (MonadState record m, Num field) => Lens record field -> field -> m ()
-= :: forall record (m :: * -> *) field.
(MonadState record m, Num field) =>
Lens record field -> field -> m ()
(-=) Lens record field
_lens field
f = (record -> record) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\record
r -> record
r record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> field -> record -> record
forall field record.
Num field =>
Lens record field -> field -> record -> record
-~ field
f)
_1 :: Lens (a,b) a
_1 :: forall a b. Lens (a, b) a
_1 = ((a, b) -> a) -> ((a, b) -> a -> (a, b)) -> Lens (a, b) a
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens (a, b) -> a
forall a b. (a, b) -> a
fst (((a, b) -> a -> (a, b)) -> Lens (a, b) a)
-> ((a, b) -> a -> (a, b)) -> Lens (a, b) a
forall a b. (a -> b) -> a -> b
$ \(a
_,b
b) a
x -> (a
x,b
b)
_2 :: Lens (a,b) b
_2 :: forall a b. Lens (a, b) b
_2 = ((a, b) -> b) -> ((a, b) -> b -> (a, b)) -> Lens (a, b) b
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens (a, b) -> b
forall a b. (a, b) -> b
snd (((a, b) -> b -> (a, b)) -> Lens (a, b) b)
-> ((a, b) -> b -> (a, b)) -> Lens (a, b) b
forall a b. (a -> b) -> a -> b
$ \(a
a,b
_) b
x -> (a
a,b
x)
_id :: Lens a a
_id :: forall a. Lens a a
_id = Lens a a
forall a. Lens a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Control.Category.id
this :: Lens a a
this :: forall a. Lens a a
this = Lens a a
forall a. Lens a a
_id
lens
:: (record -> field)
-> (record -> field -> record)
-> Lens record field
lens :: forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens record -> field
getter record -> field -> record
setter = (record -> field) -> Setter record field -> Lens record field
forall record field.
Getter record field -> Setter record field -> Lens record field
Lens record -> field
getter ((record -> field -> record) -> Setter record field
forall a b c. (a -> b -> c) -> b -> a -> c
flip record -> field -> record
setter)