module Data.Lens.Light.Core
  ( Lens(..)
  , lens
  , iso
  , getL
  , setL
  , modL
  , modL'
  , (^.)
  , vanLaarhoven
  )
  where

import Prelude hiding (id, (.))
import Control.Category

-- | Simple lens data type
newtype Lens a b = Lens { forall a b. Lens a b -> a -> (b -> a, b)
runLens :: a -> (b -> a, b) }

instance Category Lens where
  id :: forall a. Lens a a
id = forall a b. (a -> b) -> (b -> a) -> Lens a b
iso forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  Lens b c
x . :: forall b c a. Lens b c -> Lens a b -> Lens a c
. Lens a b
y =
    forall a b. (a -> b) -> (b -> a -> a) -> Lens a b
lens
      (forall a b. Lens a b -> a -> b
getL Lens b c
x 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. Lens a b -> a -> b
getL Lens a b
y)
      (\c
b -> forall a b. Lens a b -> (b -> b) -> a -> a
modL Lens a b
y forall a b. (a -> b) -> a -> b
$ forall a b. Lens a b -> b -> a -> a
setL Lens b c
x c
b)

-- | Build a lens out of a getter and setter
lens :: (a -> b) -> (b -> a -> a) -> Lens a b
lens :: forall a b. (a -> b) -> (b -> a -> a) -> Lens a b
lens a -> b
get b -> a -> a
set = forall a b. (a -> (b -> a, b)) -> Lens a b
Lens forall a b. (a -> b) -> a -> b
$ \a
a -> (forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> a -> a
set a
a, a -> b
get a
a)

-- | Build a lens out of an isomorphism
iso :: (a -> b) -> (b -> a) -> Lens a b
iso :: forall a b. (a -> b) -> (b -> a) -> Lens a b
iso a -> b
f b -> a
g = forall a b. (a -> b) -> (b -> a -> a) -> Lens a b
lens a -> b
f (\b
x a
_ -> b -> a
g b
x)

-- | Get the getter function from a lens
getL :: Lens a b -> a -> b
getL :: forall a b. Lens a b -> a -> b
getL Lens a b
l = forall a b. (a, b) -> b
snd 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. Lens a b -> a -> (b -> a, b)
runLens Lens a b
l

-- | Get the setter function from a lens
setL :: Lens a b -> b -> a -> a
setL :: forall a b. Lens a b -> b -> a -> a
setL Lens a b
l = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst 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. Lens a b -> a -> (b -> a, b)
runLens Lens a b
l

-- | Get the modifier function from a lens
modL :: Lens a b -> (b -> b) -> a -> a
modL :: forall a b. Lens a b -> (b -> b) -> a -> a
modL Lens a b
l b -> b
f a
a =
  case forall a b. Lens a b -> a -> (b -> a, b)
runLens Lens a b
l a
a of
    (b -> a
setx, b
x) -> b -> a
setx (b -> b
f b
x)

-- | Get the modifier function from a lens. Forces function application.
modL' :: Lens a b -> (b -> b) -> a -> a
modL' :: forall a b. Lens a b -> (b -> b) -> a -> a
modL' Lens a b
l b -> b
f a
a =
  case forall a b. Lens a b -> a -> (b -> a, b)
runLens Lens a b
l a
a of
    (b -> a
setx, b
x) -> b -> a
setx forall a b. (a -> b) -> a -> b
$! b -> b
f b
x

-- | Infix version of 'getL' (with the reverse order of the arguments)
infixl 9 ^.
(^.) :: b -> Lens b c -> c
^. :: forall b c. b -> Lens b c -> c
(^.) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Lens a b -> a -> b
getL

-- | Convert a lens to its van Laarhoven representation
vanLaarhoven :: Functor f => Lens a b -> (b -> f b) -> (a -> f a)
vanLaarhoven :: forall (f :: * -> *) a b.
Functor f =>
Lens a b -> (b -> f b) -> a -> f a
vanLaarhoven Lens a b
l b -> f b
f a
a =
  let
    fb :: f b
fb = b -> f b
f (a
a forall b c. b -> Lens b c -> c
^. Lens a b
l)
    fa :: f a
fa = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
b -> forall a b. Lens a b -> b -> a -> a
setL Lens a b
l b
b a
a) f b
fb
  in f a
fa