{-# LANGUAGE RankNTypes #-}

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

  -- * Construction
  lens,

  -- * Operations
  view,
  over,
  set,

  -- * Tutorial
  -- $tutorial
) where

import Control.Applicative (
  Const (
    Const
  ),
  getConst,
 )
import Data.Functor.Identity (
  Identity (
    Identity
  ),
  runIdentity,
 )
import Prelude (
  Functor,
  const,
  ($),
  (.),
  (<$>),
 )

{-
 - 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)

{-
 - Tutorial
 -}

{- $tutorial
Record syntax is excellent for modeling data. But modifying records can be
cumbersome, especially when nested. Below we define some data and compare common
ways of modifying it, illustrating the need for something better. Then we
satisfy that need with lenses, showing how to use them.

Lenses essentially take the place of accessor functions. The accessor names of
the records below start with an underscore; this is to avoid name clashing when
creating the corresponding lenses.

> data Parcel = Parcel
>   { _weight :: Int
>   , _size :: Size
>   }
>
> data Size = Size
>   { _length :: Int
>   , _width :: Int
>   , _height :: Int
>   }

Let's create a function that doubles the width of a parcel and sets its weight
to 500. First using record syntax, then pattern matching.

> foo :: Parcel -> Parcel
> foo p =
>   let s = _size p
>       w = _width s
>    in p
>         { _weight = 500
>         , _size = s{_width = w * 2}
>         }
>
> foo' :: Parcel -> Parcel
> foo' (Parcel _ (Size l w h)) =
>   Parcel
>     500
>     (Size l (w * 2) h)

Record syntax lets us specify only the fields we wish to modify but we have to
use the accessors repeatedly. Pattern matching looks cleaner but we have to
unpack and repack all the data. It's not hard to imagine how unwieldy it would
be with heavily nested records no matter which way we choose.

Lenses provide a concise, declarative, composable way to inspect and modify
records. The downside is that some initial boilerplate code is required to
create the lenses.

> weight :: Lens Parcel Parcel Int Int
> weight = lens _weight $ \s b -> s{_weight = b}
>
> size :: Lens Parcel Parcel Size Size
> size = lens _size $ \s b -> s{_size = b}
>
> width :: Lens Size Size Int Int
> width = lens _width $ \s b -> s{_width = b}

Each lens can be used with 'view', 'over', and 'set' to inspect or modify a
field, letting us complete our task with ease.

> foo'' :: Parcel -> Parcel
> foo'' =
>   over (size . width) (* 2)
>     . set weight 500

Note the reversed ordering of the composed lenses. Inspecting is similar to
using regular accessors, but again, composed in reverse.

> bar :: Parcel -> Int
> bar = view (size . width)

This covers the most typical use case, where the lenses preserve the structure
of the records (e.g. @weight@ is a @Lens@ from @Parcel@ to @Parcel@, from @Int@
to @Int@). Creating lenses that change the structure is left as an exercise to
the reader.
-}