{-# LANGUAGE
FlexibleInstances
, GADTs
, MultiParamTypeClasses
, TypeOperators #-}
module Data.Label.Poly
(
Lens
, lens
, point
, get
, modify
, set
, iso
, (>-)
, for
)
where
import Control.Category
import Control.Arrow
import Prelude ()
import Data.Label.Point (Point (Point), Iso(..), identity, compose)
import qualified Data.Label.Point as Point
{-# INLINE lens #-}
{-# INLINE get #-}
{-# INLINE modify #-}
{-# INLINE set #-}
{-# INLINE (>-) #-}
{-# INLINE point #-}
{-# INLINE unpack #-}
data Lens cat f o where
Lens :: !(Point cat g i f o) -> Lens cat (f -> g) (o -> i)
Id :: ArrowApply cat => Lens cat f f
lens :: cat f o
-> cat (cat o i, f) g
-> Lens cat (f -> g) (o -> i)
lens :: forall (cat :: * -> * -> *) f o i g.
cat f o -> cat (cat o i, f) g -> Lens cat (f -> g) (o -> i)
lens cat f o
g cat (cat o i, f) g
m = forall (cat :: * -> * -> *) g i f o.
Point cat g i f o -> Lens cat (f -> g) (o -> i)
Lens (forall (cat :: * -> * -> *) g i f o.
cat f o -> cat (cat o i, f) g -> Point cat g i f o
Point cat f o
g cat (cat o i, f) g
m)
point :: Point cat g i f o -> Lens cat (f -> g) (o -> i)
point :: forall (cat :: * -> * -> *) g i f o.
Point cat g i f o -> Lens cat (f -> g) (o -> i)
point = forall (cat :: * -> * -> *) g i f o.
Point cat g i f o -> Lens cat (f -> g) (o -> i)
Lens
get :: Lens cat (f -> g) (o -> i) -> cat f o
get :: forall (cat :: * -> * -> *) f g o i.
Lens cat (f -> g) (o -> i) -> cat f o
get = forall (cat :: * -> * -> *) g i f o. Point cat g i f o -> cat f o
Point.get forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (cat :: * -> * -> *) f g o i.
Lens cat (f -> g) (o -> i) -> Point cat g i f o
unpack
modify :: Lens cat (f -> g) (o -> i) -> cat (cat o i, f) g
modify :: forall (cat :: * -> * -> *) f g o i.
Lens cat (f -> g) (o -> i) -> cat (cat o i, f) g
modify = forall (cat :: * -> * -> *) g i f o.
Point cat g i f o -> cat (cat o i, f) g
Point.modify forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (cat :: * -> * -> *) f g o i.
Lens cat (f -> g) (o -> i) -> Point cat g i f o
unpack
set :: Arrow arr => Lens arr (f -> g) (o -> i) -> arr (i, f) g
set :: forall (arr :: * -> * -> *) f g o i.
Arrow arr =>
Lens arr (f -> g) (o -> i) -> arr (i, f) g
set = forall (arr :: * -> * -> *) g i f o.
Arrow arr =>
Point arr g i f o -> arr (i, f) g
Point.set forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (cat :: * -> * -> *) f g o i.
Lens cat (f -> g) (o -> i) -> Point cat g i f o
unpack
iso :: ArrowApply cat => Iso cat f o -> Iso cat g i -> Lens cat (f -> g) (o -> i)
iso :: forall (cat :: * -> * -> *) f o g i.
ArrowApply cat =>
Iso cat f o -> Iso cat g i -> Lens cat (f -> g) (o -> i)
iso (Iso cat f o
f cat o f
_) (Iso cat g i
_ cat i g
y) = forall (cat :: * -> * -> *) f o i g.
cat f o -> cat (cat o i, f) g -> Lens cat (f -> g) (o -> i)
lens cat f o
f (forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c
app forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(cat o i
m, f
v) -> (cat i g
y forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. cat o i
m forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. cat f o
f, f
v)))
instance ArrowApply arr => Category (Lens arr) where
id :: forall a. Lens arr a a
id = forall (cat :: * -> * -> *) f. ArrowApply cat => Lens cat f f
Id
Lens Point arr g i f o
f . :: forall b c a. Lens arr b c -> Lens arr a b -> Lens arr a c
. Lens Point arr g i f o
g = forall (cat :: * -> * -> *) g i f o.
Point cat g i f o -> Lens cat (f -> g) (o -> i)
Lens (forall (cat :: * -> * -> *) t i b o g f.
ArrowApply cat =>
Point cat t i b o -> Point cat g t f b -> Point cat g i f o
compose Point arr g i f o
f Point arr g i f o
g)
Lens arr b c
Id . Lens arr a b
u = Lens arr a b
u
Lens arr b c
u . Lens arr a b
Id = Lens arr b c
u
{-# INLINE id #-}
{-# INLINE (.) #-}
infix 7 >-
(>-) :: Arrow arr => Lens arr (j -> a) (i -> b) -> Lens arr (f -> g) (o -> i) -> Point arr g j f o
>- :: forall (arr :: * -> * -> *) j a i b f g o.
Arrow arr =>
Lens arr (j -> a) (i -> b)
-> Lens arr (f -> g) (o -> i) -> Point arr g j f o
(>-) (Lens (Point arr f o
f arr (arr o i, f) g
_)) (Lens Point arr g i f o
l) = forall (cat :: * -> * -> *) g i f o.
cat f o -> cat (cat o i, f) g -> Point cat g i f o
Point (forall (cat :: * -> * -> *) g i f o. Point cat g i f o -> cat f o
Point.get Point arr g i f o
l) (forall (cat :: * -> * -> *) g i f o.
Point cat g i f o -> cat (cat o i, f) g
Point.modify Point arr g i f o
l forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (arr f o
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.)))
(>-) (Lens (Point arr f o
f arr (arr o i, f) g
_)) Lens arr (f -> g) (o -> i)
Id = forall (cat :: * -> * -> *) g i f o.
cat f o -> cat (cat o i, f) g -> Point cat g i f o
Point forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c
app forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (arr f o
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.)))
(>-) Lens arr (j -> a) (i -> b)
Id Lens arr (f -> g) (o -> i)
l = forall (cat :: * -> * -> *) f g o i.
Lens cat (f -> g) (o -> i) -> Point cat g i f o
unpack Lens arr (f -> g) (o -> i)
l
infix 7 `for`
for :: Arrow arr => Lens arr (j -> a) (i -> b) -> Lens arr (f -> g) (o -> i) -> Point arr g j f o
for :: forall (arr :: * -> * -> *) j a i b f g o.
Arrow arr =>
Lens arr (j -> a) (i -> b)
-> Lens arr (f -> g) (o -> i) -> Point arr g j f o
for = forall (arr :: * -> * -> *) j a i b f g o.
Arrow arr =>
Lens arr (j -> a) (i -> b)
-> Lens arr (f -> g) (o -> i) -> Point arr g j f o
(>-)
unpack :: Lens cat (f -> g) (o -> i) -> Point cat g i f o
unpack :: forall (cat :: * -> * -> *) f g o i.
Lens cat (f -> g) (o -> i) -> Point cat g i f o
unpack Lens cat (f -> g) (o -> i)
Id = forall (arr :: * -> * -> *) f o.
ArrowApply arr =>
Point arr f f o o
identity
unpack (Lens Point cat g i f o
p) = Point cat g i f o
p