{-# LANGUAGE RankNTypes #-}

-- | Compose polymorphic record updates with /van Laarhoven/ lenses
module Mini.Optics.Lens (
  -- * Type
  Lens,

  -- * Construction
  lens,

  -- * Operations
  view,
  over,
  set,
) where

import Control.Applicative (
  Const (
    Const,
    getConst
  ),
 )
import Data.Functor.Identity (
  Identity (
    Identity,
    runIdentity
  ),
 )

{-
 - Type
 -}

-- | A reference updating structures from /s/ to /t/ and fields from /a/ to /b/
type Lens s t a b = forall f. (Functor f) => (a -> f b) -> (s -> f t)

{-
 - Construction
 -}

-- | Make a lens from a getter and a setter
lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
lens :: forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens s -> a
sa s -> b -> t
sbt a -> f b
ab s
s = s -> b -> t
sbt s
s (b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
ab (s -> a
sa s
s)

{-
 - Operations
 -}

-- | Fetch the field referenced by a lens from a structure
view :: Lens s t a b -> s -> a
view :: forall s t a b. Lens s t a b -> s -> a
view Lens s t a b
o = Const a t -> a
forall {k} a (b :: k). Const a b -> a
getConst (Const a t -> a) -> (s -> Const a t) -> s -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const a b) -> s -> Const a t
Lens s t a b
o a -> Const a b
forall {k} a (b :: k). a -> Const a b
Const

-- | Update the field referenced by a lens with an operation on a structure
over :: Lens s t a b -> (a -> b) -> s -> t
over :: forall s t a b. Lens s t a b -> (a -> b) -> s -> t
over Lens s t a b
o a -> b
ab = Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Identity b) -> s -> Identity t
Lens s t a b
o (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
ab)

-- | Overwrite the field referenced by a lens with a value on a structure
set :: Lens s t a b -> b -> s -> t
set :: forall s t a b. Lens s t a b -> b -> s -> t
set Lens s t a b
o b
b = Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Identity b) -> s -> Identity t
Lens s t a b
o (Identity b -> a -> Identity b
forall a b. a -> b -> a
const (Identity b -> a -> Identity b) -> Identity b -> a -> Identity b
forall a b. (a -> b) -> a -> b
$ b -> Identity b
forall a. a -> Identity a
Identity b
b)