{- | Lenses that only allow monomorphic updates. Monomorphic lenses are simply
polymorphic lenses with the input and output type variables constraint to the
same type. -}

{-# LANGUAGE
    FlexibleInstances
  , MultiParamTypeClasses
  , TypeOperators
  #-}

module Data.Label.Mono
( Lens
, lens
, get
, modify
, point
, set
, iso

-- * Specialized monomorphic lens operators.
, (:->)
, (:~>)
)
where

import Control.Category
import Control.Arrow
import Data.Label.Point (Point, Iso (..), Total, Partial)
import Prelude ()

import qualified Data.Label.Poly as Poly

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

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

-- | Abstract monomorphic lens datatype. The getter and setter functions work
-- in some category. Categories allow for effectful lenses, for example, lenses
-- that might fail or use state.

type Lens cat f o = Poly.Lens cat (f -> f) (o -> o)

-- | Create a lens out of a getter and setter.

lens :: cat f o               -- ^ Getter.
     -> (cat (cat o o, f) f)  -- ^ Modifier.
     -> Lens cat f o
lens :: cat f o -> cat (cat o o, f) f -> Lens cat f o
lens = cat f o -> cat (cat o o, f) f -> Lens cat f o
forall (cat :: * -> * -> *) f o i g.
cat f o -> cat (cat o i, f) g -> Lens cat (f -> g) (o -> i)
Poly.lens

-- | Get the getter arrow from a lens.

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

-- | Get the modifier arrow from a lens.

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

-- | Get the setter arrow from a lens.

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

-- | Create lens from a `Point`.

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

-- | Lift an isomorphism into a `Lens`.

iso :: ArrowApply cat => Iso cat f o -> Lens cat f o
iso :: Iso cat f o -> Lens cat f o
iso (Iso cat f o
f cat o f
b) = cat f o -> cat (cat o o, f) f -> Lens cat f o
forall (cat :: * -> * -> *) f o.
cat f o -> cat (cat o o, f) f -> Lens cat f o
lens cat f o
f (cat (cat f f, f) f
forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c
app cat (cat f f, f) f
-> cat (cat o o, f) (cat f f, f) -> cat (cat o o, f) f
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((cat o o, f) -> (cat f f, f)) -> cat (cat o o, f) (cat f f, f)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(cat o o
m, f
v) -> (cat o f
b cat o f -> cat f o -> cat f f
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. cat o o
m cat o o -> cat f o -> cat f o
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)))

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

-- | Total monomorphic lens.

type f :-> o = Lens Total f o

-- | Partial monomorphic lens.

type f :~> o = Lens Partial f o