{-# 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 sa sbt ab s = sbt s <$> ab (sa 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 o = getConst . o 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 o ab = runIdentity . o (Identity . 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 o b = runIdentity . o (const $ Identity b)