{-# LANGUAGE RankNTypes #-}

module Network.Riak.Lens
  ( (&)
  , (^.)
  , (.~)
  , (%~)
  , mapped
  ) where

import Data.Function ((&))
import Data.Functor.Const
import Data.Functor.Identity

type Lens s a
  = forall f. Functor f => (a -> f a) -> (s -> f s)

type Setter s a
  = (a -> Identity a) -> (s -> Identity s)

infixl 8 ^.
(^.) :: s -> Lens s a -> a
s
s ^. :: s -> Lens s a -> a
^. Lens s a
l =
  Const a s -> a
forall a k (b :: k). Const a b -> a
getConst ((a -> Const a a) -> s -> Const a s
Lens s a
l a -> Const a a
forall k a (b :: k). a -> Const a b
Const s
s)

infixr 4 .~
(.~) :: Setter s a -> a -> s -> s
(Setter s a
l .~ :: Setter s a -> a -> s -> s
.~ a
a) s
s =
  Identity s -> s
forall a. Identity a -> a
runIdentity (Setter s a
l (\a
_ -> a -> Identity a
forall a. a -> Identity a
Identity a
a) s
s)

infixr 4 %~
(%~) :: Setter s a -> (a -> a) -> (s -> s)
(Setter s a
l %~ :: Setter s a -> (a -> a) -> s -> s
%~ a -> a
f) s
s =
  Identity s -> s
forall a. Identity a -> a
runIdentity (Setter s a
l (\a
a -> a -> Identity a
forall a. a -> Identity a
Identity (a -> a
f a
a)) s
s)


mapped :: Functor f => Setter (f a) a
mapped :: Setter (f a) a
mapped a -> Identity a
f f a
s =
  f a -> Identity (f a)
forall a. a -> Identity a
Identity ((a -> a) -> f a -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> (a -> Identity a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity a
f) f a
s)