{-# LANGUAGE TypeOperators #-}
module Data.Label.Partial
( (:~>)
, Partial
, lens
, get
, modify
, set
, embed
, set'
, modify'
, update
)
where
import Control.Applicative
import Control.Arrow
import Control.Category
import Data.Label.Point (Partial)
import Data.Label.Poly (Lens)
import Data.Maybe
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 f :~> o = Lens Partial f o
lens :: (f -> Maybe o)
-> ((o -> Maybe i) -> f -> Maybe g)
-> (f -> g) :~> (o -> i)
lens :: (f -> Maybe o)
-> ((o -> Maybe i) -> f -> Maybe g) -> (f -> g) :~> (o -> i)
lens f -> Maybe o
g (o -> Maybe i) -> f -> Maybe g
s = Kleisli Maybe f o
-> Kleisli Maybe (Kleisli Maybe o i, f) g -> (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 -> Maybe o) -> Kleisli Maybe f o
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli f -> Maybe o
g) (((Kleisli Maybe o i, f) -> Maybe g)
-> Kleisli Maybe (Kleisli Maybe o i, f) g
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli (\(Kleisli Maybe o i
m, f
f) -> (o -> Maybe i) -> f -> Maybe g
s (Kleisli Maybe o i -> o -> Maybe i
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli Kleisli Maybe o i
m) f
f))
get :: (f -> g) :~> (o -> i) -> f -> Maybe o
get :: ((f -> g) :~> (o -> i)) -> f -> Maybe o
get (f -> g) :~> (o -> i)
l = Kleisli Maybe f o -> f -> Maybe o
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli (((f -> g) :~> (o -> i)) -> Kleisli Maybe f o
forall (cat :: * -> * -> *) f g o i.
Lens cat (f -> g) (o -> i) -> cat f o
Poly.get (f -> g) :~> (o -> i)
l)
modify :: (f -> g) :~> (o -> i) -> (o -> i) -> f -> Maybe g
modify :: ((f -> g) :~> (o -> i)) -> (o -> i) -> f -> Maybe g
modify (f -> g) :~> (o -> i)
l o -> i
m = Kleisli Maybe f g -> f -> Maybe g
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli (((f -> g) :~> (o -> i)) -> Partial (Partial o i, f) g
forall (cat :: * -> * -> *) f g o i.
Lens cat (f -> g) (o -> i) -> cat (cat o i, f) g
Poly.modify (f -> g) :~> (o -> i)
l Partial (Partial o i, f) g
-> Partial f (Partial o i, f) -> Kleisli Maybe 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 -> (Partial o i, f)) -> Partial f (Partial o i, f)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((,) ((o -> i) -> Partial o i
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr o -> i
m)))
set :: (f -> g) :~> (o -> i) -> i -> f -> Maybe g
set :: ((f -> g) :~> (o -> i)) -> i -> f -> Maybe g
set (f -> g) :~> (o -> i)
l i
v = Kleisli Maybe f g -> f -> Maybe g
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli (((f -> g) :~> (o -> i)) -> Partial (i, f) g
forall (arr :: * -> * -> *) f g o i.
Arrow arr =>
Lens arr (f -> g) (o -> i) -> arr (i, f) g
Poly.set (f -> g) :~> (o -> i)
l Partial (i, f) g -> Partial f (i, f) -> Kleisli Maybe 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)) -> Partial f (i, f)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((,) i
v))
embed :: Lens (->) (f -> g) (Maybe o -> Maybe i) -> (f -> g) :~> (o -> i)
embed :: Lens (->) (f -> g) (Maybe o -> Maybe i) -> (f -> g) :~> (o -> i)
embed Lens (->) (f -> g) (Maybe o -> Maybe i)
l = (f -> Maybe o)
-> ((o -> Maybe i) -> f -> Maybe g) -> (f -> g) :~> (o -> i)
forall f o i g.
(f -> Maybe o)
-> ((o -> Maybe i) -> f -> Maybe g) -> (f -> g) :~> (o -> i)
lens (Lens (->) (f -> g) (Maybe o -> Maybe i) -> f -> Maybe o
forall (cat :: * -> * -> *) f g o i.
Lens cat (f -> g) (o -> i) -> cat f o
Poly.get Lens (->) (f -> g) (Maybe o -> Maybe i)
l) (\o -> Maybe i
m f
f -> g -> o -> g
forall a b. a -> b -> a
const (Lens (->) (f -> g) (Maybe o -> Maybe i)
-> (Maybe o -> Maybe 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) (Maybe o -> Maybe i)
l ((Maybe o -> (o -> Maybe i) -> Maybe i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= o -> Maybe i
m), f
f)) (o -> g) -> Maybe o -> Maybe g
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lens (->) (f -> g) (Maybe o -> Maybe i) -> f -> Maybe o
forall (cat :: * -> * -> *) f g o i.
Lens cat (f -> g) (o -> i) -> cat f o
Poly.get Lens (->) (f -> g) (Maybe o -> Maybe i)
l f
f)
modify' :: (f -> f) :~> (o -> o) -> (o -> o) -> f -> f
modify' :: ((f -> f) :~> (o -> o)) -> (o -> o) -> f -> f
modify' (f -> f) :~> (o -> o)
l o -> o
m f
f = f
f f -> Maybe f -> f
forall a. a -> Maybe a -> a
`fromMaybe` ((f -> f) :~> (o -> o)) -> (o -> o) -> f -> Maybe f
forall f g o i. ((f -> g) :~> (o -> i)) -> (o -> i) -> f -> Maybe g
modify (f -> f) :~> (o -> o)
l o -> o
m f
f
set' :: (f -> f) :~> (o -> o) -> o -> f -> f
set' :: ((f -> f) :~> (o -> o)) -> o -> f -> f
set' (f -> f) :~> (o -> o)
l o
v f
f = f
f f -> Maybe f -> f
forall a. a -> Maybe a -> a
`fromMaybe` ((f -> f) :~> (o -> o)) -> o -> f -> Maybe f
forall f g o i. ((f -> g) :~> (o -> i)) -> i -> f -> Maybe g
set (f -> f) :~> (o -> o)
l o
v f
f
update :: (f -> b) :~> (o -> i) -> (o -> Maybe i) -> f -> Maybe b
update :: ((f -> b) :~> (o -> i)) -> (o -> Maybe i) -> f -> Maybe b
update (f -> b) :~> (o -> i)
l o -> Maybe i
m = Kleisli Maybe f b -> f -> Maybe b
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli (((f -> b) :~> (o -> i)) -> Partial (Partial o i, f) b
forall (cat :: * -> * -> *) f g o i.
Lens cat (f -> g) (o -> i) -> cat (cat o i, f) g
Poly.modify (f -> b) :~> (o -> i)
l Partial (Partial o i, f) b
-> Partial f (Partial o i, f) -> Kleisli Maybe f b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (f -> (Partial o i, f)) -> Partial f (Partial o i, f)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((,) ((o -> Maybe i) -> Partial o i
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli o -> Maybe i
m)))