{-# LANGUAGE TypeOperators, TupleSections #-}
module Data.Label.Failing
( Lens
, Failing
, lens
, get
, modify
, set
, embed
, set'
, modify'
)
where
import Control.Applicative
import Control.Arrow
import Control.Category
import Data.Label.Point (Failing)
import Prelude hiding ((.), id)
import qualified Data.Label.Poly as Poly
{-# INLINE lens #-}
{-# INLINE get #-}
{-# INLINE modify #-}
{-# INLINE set #-}
{-# INLINE embed #-}
{-# INLINE set' #-}
{-# INLINE modify' #-}
type Lens e f o = Poly.Lens (Failing e) f o
lens :: (f -> Either e o)
-> ((o -> Either e i) -> f -> Either e g)
-> Lens e (f -> g) (o -> i)
lens :: (f -> Either e o)
-> ((o -> Either e i) -> f -> Either e g)
-> Lens e (f -> g) (o -> i)
lens f -> Either e o
g (o -> Either e i) -> f -> Either e g
s = Kleisli (Either e) f o
-> Kleisli (Either e) (Kleisli (Either e) o i, f) g
-> Lens e (f -> g) (o -> i)
forall (cat :: * -> * -> *) f o i g.
cat f o -> cat (cat o i, f) g -> Lens cat (f -> g) (o -> i)
Poly.lens ((f -> Either e o) -> Kleisli (Either e) f o
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli f -> Either e o
g) (((Kleisli (Either e) o i, f) -> Either e g)
-> Kleisli (Either e) (Kleisli (Either e) o i, f) g
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli (\(Kleisli (Either e) o i
m, f
f) -> (o -> Either e i) -> f -> Either e g
s (Kleisli (Either e) o i -> o -> Either e i
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli Kleisli (Either e) o i
m) f
f))
get :: Lens e (f -> g) (o -> i) -> f -> Either e o
get :: Lens e (f -> g) (o -> i) -> f -> Either e o
get Lens e (f -> g) (o -> i)
l = Kleisli (Either e) f o -> f -> Either e o
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli (Lens e (f -> g) (o -> i) -> Kleisli (Either e) f o
forall (cat :: * -> * -> *) f g o i.
Lens cat (f -> g) (o -> i) -> cat f o
Poly.get Lens e (f -> g) (o -> i)
l)
modify :: Lens e (f -> g) (o -> i) -> (o -> i) -> f -> Either e g
modify :: Lens e (f -> g) (o -> i) -> (o -> i) -> f -> Either e g
modify Lens e (f -> g) (o -> i)
l o -> i
m = Kleisli (Either e) f g -> f -> Either e g
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli (Lens e (f -> g) (o -> i) -> Failing e (Failing e o i, f) g
forall (cat :: * -> * -> *) f g o i.
Lens cat (f -> g) (o -> i) -> cat (cat o i, f) g
Poly.modify Lens e (f -> g) (o -> i)
l Failing e (Failing e o i, f) g
-> Failing e f (Failing e o i, f) -> Kleisli (Either e) f g
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (f -> (Failing e o i, f)) -> Failing e f (Failing e o i, f)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((o -> i) -> Failing e o i
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr o -> i
m,))
set :: Lens e (f -> g) (o -> i) -> i -> f -> Either e g
set :: Lens e (f -> g) (o -> i) -> i -> f -> Either e g
set Lens e (f -> g) (o -> i)
l i
v = Kleisli (Either e) f g -> f -> Either e g
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli (Lens e (f -> g) (o -> i) -> Failing e (i, f) g
forall (arr :: * -> * -> *) f g o i.
Arrow arr =>
Lens arr (f -> g) (o -> i) -> arr (i, f) g
Poly.set Lens e (f -> g) (o -> i)
l Failing e (i, f) g -> Failing e f (i, f) -> Kleisli (Either e) f g
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (f -> (i, f)) -> Failing e f (i, f)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (i
v,))
embed :: Poly.Lens (->) (f -> g) (Either e o -> Either e i) -> Lens e (f -> g) (o -> i)
embed :: Lens (->) (f -> g) (Either e o -> Either e i)
-> Lens e (f -> g) (o -> i)
embed Lens (->) (f -> g) (Either e o -> Either e i)
l = (f -> Either e o)
-> ((o -> Either e i) -> f -> Either e g)
-> Lens e (f -> g) (o -> i)
forall f e o i g.
(f -> Either e o)
-> ((o -> Either e i) -> f -> Either e g)
-> Lens e (f -> g) (o -> i)
lens (Lens (->) (f -> g) (Either e o -> Either e i) -> f -> Either e o
forall (cat :: * -> * -> *) f g o i.
Lens cat (f -> g) (o -> i) -> cat f o
Poly.get Lens (->) (f -> g) (Either e o -> Either e i)
l) (\o -> Either e i
m f
f -> g -> o -> g
forall a b. a -> b -> a
const (Lens (->) (f -> g) (Either e o -> Either e i)
-> (Either e o -> Either e i, f) -> g
forall (cat :: * -> * -> *) f g o i.
Lens cat (f -> g) (o -> i) -> cat (cat o i, f) g
Poly.modify Lens (->) (f -> g) (Either e o -> Either e i)
l ((Either e o -> (o -> Either e i) -> Either e i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= o -> Either e i
m), f
f)) (o -> g) -> Either e o -> Either e g
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lens (->) (f -> g) (Either e o -> Either e i) -> f -> Either e o
forall (cat :: * -> * -> *) f g o i.
Lens cat (f -> g) (o -> i) -> cat f o
Poly.get Lens (->) (f -> g) (Either e o -> Either e i)
l f
f)
modify' :: Lens e (f -> f) (o -> o) -> (o -> o) -> f -> f
modify' :: Lens e (f -> f) (o -> o) -> (o -> o) -> f -> f
modify' Lens e (f -> f) (o -> o)
l o -> o
m f
f = (e -> f) -> (f -> f) -> Either e f -> f
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (f -> e -> f
forall a b. a -> b -> a
const f
f) f -> f
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (Lens e (f -> f) (o -> o) -> (o -> o) -> f -> Either e f
forall e f g o i.
Lens e (f -> g) (o -> i) -> (o -> i) -> f -> Either e g
modify Lens e (f -> f) (o -> o)
l o -> o
m f
f)
set' :: Lens e (f -> f) (o -> o) -> o -> f -> f
set' :: Lens e (f -> f) (o -> o) -> o -> f -> f
set' Lens e (f -> f) (o -> o)
l o
v f
f = (e -> f) -> (f -> f) -> Either e f -> f
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (f -> e -> f
forall a b. a -> b -> a
const f
f) f -> f
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (Lens e (f -> f) (o -> o) -> o -> f -> Either e f
forall e f g o i. Lens e (f -> g) (o -> i) -> i -> f -> Either e g
set Lens e (f -> f) (o -> o)
l o
v f
f)