{-# LANGUAGE RankNTypes #-}

{- | Minimal library of /van Laarhoven/ lenses: composable polymorphic record
updates
-}
module Mini.Lens (
  -- * Types
  Lens,

  -- * Construction
  lens,

  -- * Reading
  view,

  -- * Modifying
  over,

  -- * Writing
  set,
) where

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

{-
 - Types
 -}

{- | A purely functional reference for updating structures of type /s/ with
fields of type /a/ to structures of type /t/ with fields of type /b/
-}
type Lens s t a b = forall f. (Functor f) => (a -> f b) -> (s -> f t)

{-
 - Construction
 -}

{- | From a getter and a setter to a lens

> data Foo = Foo { _bar :: Bar } deriving Show
> data Bar = Bar { _baz :: Int } deriving Show
>
> bar :: Lens Foo Foo Bar Bar
> bar = lens _bar $ \s b -> s { _bar = b }
>
> baz :: Lens Bar Bar Int Int
> baz = lens _baz $ \s b -> s { _baz = b }
-}
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)

{-
 - Reading
 -}

{- | From a lens and a structure to the value of the field of the structure
referenced by the lens

> ghci> view (bar . baz) $ Foo (Bar 73)
> 73
-}
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

{-
 - Modifying
 -}

{- | From a lens, an operation and a structure to the structure updated by
applying the operation to the value of the field referenced by the lens

> ghci> over (bar . baz) (+ 1) $ Foo (Bar 73)
> Foo {_bar = Bar {_baz = 74}}
-}
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)

{-
 - Writing
 -}

{- | From a lens, a value and a structure to the structure updated by setting
the field referenced by the lens to the value

> ghci> set (bar . baz) 21 $ Foo (Bar 73)
> Foo {_bar = Bar {_baz = 21}}
-}
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)