{-| Default lenses for simple total getters and total possibly polymorphic,
updates. Useful for creating accessor labels for single constructor datatypes.
Also useful field labels that are shared between all the constructors of a
multi constructor datatypes.
-}

{-# LANGUAGE CPP, TypeOperators #-}

module Data.Label.Total
( (:->)
, Total
, lens
, get
, modify
, set

-- * Working in contexts.
, traverse
, lifted
)
where

#if MIN_VERSION_base(4,8,0)
import Prelude hiding (traverse)
#endif
import Control.Monad ((<=<), liftM)
import Data.Label.Poly (Lens)
import Data.Label.Point (Total)

import qualified Data.Label.Poly as Poly

{-# INLINE lens   #-}
{-# INLINE get    #-}
{-# INLINE modify #-}
{-# INLINE set    #-}

-------------------------------------------------------------------------------

-- | Total lens type specialized for total accessor functions.

type f :-> o = Lens Total f o

-- | Create a total lens from a getter and a modifier.
--
-- We expect the following law to hold:
--
-- > get l (set l a f) == a
--
-- > set l (get l f) f == f

lens :: (f -> o)              -- ^ Getter.
     -> ((o -> i) -> f -> g)  -- ^ Modifier.
     -> (f -> g) :-> (o -> i)
lens :: (f -> o) -> ((o -> i) -> f -> g) -> (f -> g) :-> (o -> i)
lens f -> o
g (o -> i) -> f -> g
s = (f -> o) -> Total (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 -> o
g (((o -> i) -> f -> g) -> Total (o -> i, f) g
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (o -> i) -> f -> g
s)

-- | Get the getter function from a lens.

get :: ((f -> g) :-> (o -> i)) -> f -> o
get :: ((f -> g) :-> (o -> i)) -> f -> o
get = ((f -> g) :-> (o -> i)) -> f -> o
forall (cat :: * -> * -> *) f g o i.
Lens cat (f -> g) (o -> i) -> cat f o
Poly.get

-- | Get the modifier function from a lens.

modify :: (f -> g) :-> (o -> i) -> (o -> i) -> f -> g
modify :: ((f -> g) :-> (o -> i)) -> (o -> i) -> f -> g
modify = ((o -> i, f) -> g) -> (o -> i) -> f -> g
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((o -> i, f) -> g) -> (o -> i) -> f -> g)
-> (((f -> g) :-> (o -> i)) -> (o -> i, f) -> g)
-> ((f -> g) :-> (o -> i))
-> (o -> i)
-> f
-> g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((f -> g) :-> (o -> i)) -> (o -> i, f) -> g
forall (cat :: * -> * -> *) f g o i.
Lens cat (f -> g) (o -> i) -> cat (cat o i, f) g
Poly.modify

-- | Get the setter function from a lens.

set :: ((f -> g) :-> (o -> i)) -> i -> f -> g
set :: ((f -> g) :-> (o -> i)) -> i -> f -> g
set = ((i, f) -> g) -> i -> f -> g
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((i, f) -> g) -> i -> f -> g)
-> (((f -> g) :-> (o -> i)) -> (i, f) -> g)
-> ((f -> g) :-> (o -> i))
-> i
-> f
-> g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((f -> g) :-> (o -> i)) -> (i, f) -> g
forall (arr :: * -> * -> *) f g o i.
Arrow arr =>
Lens arr (f -> g) (o -> i) -> arr (i, f) g
Poly.set

-- | Modify in some context.

traverse :: Functor m => (f -> g) :-> (o -> i) -> (o -> m i) -> f -> m g
traverse :: ((f -> g) :-> (o -> i)) -> (o -> m i) -> f -> m g
traverse (f -> g) :-> (o -> i)
l o -> m i
m f
f = (\i
w -> ((f -> g) :-> (o -> i)) -> i -> f -> g
forall f g o i. ((f -> g) :-> (o -> i)) -> i -> f -> g
set (f -> g) :-> (o -> i)
l i
w f
f) (i -> g) -> m i -> m g
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` o -> m i
m (((f -> g) :-> (o -> i)) -> f -> o
forall f g o i. ((f -> g) :-> (o -> i)) -> f -> o
get (f -> g) :-> (o -> i)
l f
f)


-- | Lifted lens composition.
--
-- For example, useful when specialized to lists:
--
-- > :: (f :-> [o])
-- > -> (o :-> [a])
-- > -> (f :-> [a])

lifted
  :: Monad m
  => (f -> g) :-> (m o -> m i)
  -> (o -> i) :-> (m a -> m b)
  -> (f -> g) :-> (m a -> m b)
lifted :: ((f -> g) :-> (m o -> m i))
-> ((o -> i) :-> (m a -> m b)) -> (f -> g) :-> (m a -> m b)
lifted (f -> g) :-> (m o -> m i)
a (o -> i) :-> (m a -> m b)
b = (f -> m a) -> ((m a -> m b) -> f -> g) -> (f -> g) :-> (m a -> m b)
forall f o i g.
(f -> o) -> ((o -> i) -> f -> g) -> (f -> g) :-> (o -> i)
lens (((o -> i) :-> (m a -> m b)) -> o -> m a
forall f g o i. ((f -> g) :-> (o -> i)) -> f -> o
get (o -> i) :-> (m a -> m b)
b (o -> m a) -> (f -> m o) -> f -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ((f -> g) :-> (m o -> m i)) -> f -> m o
forall f g o i. ((f -> g) :-> (o -> i)) -> f -> o
get (f -> g) :-> (m o -> m i)
a) (((f -> g) :-> (m o -> m i)) -> (m o -> m i) -> f -> g
forall f g o i. ((f -> g) :-> (o -> i)) -> (o -> i) -> f -> g
modify (f -> g) :-> (m o -> m i)
a ((m o -> m i) -> f -> g)
-> ((m a -> m b) -> m o -> m i) -> (m a -> m b) -> f -> g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (o -> i) -> m o -> m i
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((o -> i) -> m o -> m i)
-> ((m a -> m b) -> o -> i) -> (m a -> m b) -> m o -> m i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((o -> i) :-> (m a -> m b)) -> (m a -> m b) -> o -> i
forall f g o i. ((f -> g) :-> (o -> i)) -> (o -> i) -> f -> g
modify (o -> i) :-> (m a -> m b)
b)