{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

#if HLINT
#include "cabal_macros.h"
#endif

-- | Small replacement for <http://hackage.haskell.org/package/lens lens>.
module Control.Lens
    ( (&)
    , Iso, Iso', iso
    , from
    , review, ( # )
    , Lens, Lens', lens
    , view, (^.)
    , set, over, (%~), assign, (.=)
    ) where

import Control.Applicative
import Control.Monad.Identity
import Control.Monad.State.Class as State
import Data.Profunctor
import Data.Profunctor.Unsafe
#if __GLASGOW_HASKELL__ >= 708 && MIN_VERSION_profunctors(4,4,0)
import Data.Coerce
#else
import Unsafe.Coerce
#endif

infixl 1 &
(&) :: a -> (a -> b) -> b
a
a & :: forall a b. a -> (a -> b) -> b
& a -> b
f = a -> b
f a
a
{-# INLINE (&) #-}

type Overloaded p f s t a b = p a (f b) -> p s (f t)

------------------------------------------------------------------------

type Iso s t a b = forall p f. (Profunctor p, Functor f) => Overloaded p f s t a b
type Iso' s a = Iso s s a a

iso :: (s -> a) -> (b -> t) -> Iso s t a b
iso :: forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso s -> a
sa b -> t
bt = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> a
sa (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> t
bt)
{-# INLINE iso #-}

------------------------------------------------------------------------

data Exchange a b s t = Exchange (s -> a) (b -> t)

instance Profunctor (Exchange a b) where
  dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Exchange a b b c -> Exchange a b a d
dimap a -> b
f c -> d
g (Exchange b -> a
sa b -> c
bt) = forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange (b -> a
sa forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (c -> d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
bt)
  {-# INLINE dimap #-}
  lmap :: forall a b c. (a -> b) -> Exchange a b b c -> Exchange a b a c
lmap a -> b
f (Exchange b -> a
sa b -> c
bt) = forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange (b -> a
sa forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) b -> c
bt
  {-# INLINE lmap #-}
  rmap :: forall b c a. (b -> c) -> Exchange a b a b -> Exchange a b a c
rmap b -> c
f (Exchange a -> a
sa b -> b
bt) = forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange a -> a
sa (b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
bt)
  {-# INLINE rmap #-}
#if __GLASGOW_HASKELL__ >= 708 && MIN_VERSION_profunctors(4,4,0)
  ( #. ) q b c
_ = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. a -> a
id :: t -> t) :: forall t u. Coercible t u => u -> t
  ( .# ) Exchange a b b c
p q a b
_ = coerce :: forall a b. Coercible a b => a -> b
coerce Exchange a b b c
p
#else
  ( #. ) _ = unsafeCoerce
  ( .# ) p _ = unsafeCoerce p
#endif
  {-# INLINE ( #. ) #-}
  {-# INLINE ( .# ) #-}

type AnIso s t a b = Overloaded (Exchange a b) Identity s t a b

from :: AnIso s t a b -> Iso b a t s
from :: forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso s t a b
l = case AnIso s t a b
l (forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange forall a. a -> a
id forall a. a -> Identity a
Identity) of
  Exchange s -> a
sa b -> Identity t
bt -> forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall a. Identity a -> a
runIdentity forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. b -> Identity t
bt) s -> a
sa
{-# INLINE from #-}

------------------------------------------------------------------------

newtype Reviewed a b = Reviewed
    { forall a b. Reviewed a b -> b
runReviewed :: b
    } deriving (forall a b. a -> Reviewed a b -> Reviewed a a
forall a b. (a -> b) -> Reviewed a a -> Reviewed a b
forall a a b. a -> Reviewed a b -> Reviewed a a
forall a a b. (a -> b) -> Reviewed a a -> Reviewed a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Reviewed a b -> Reviewed a a
$c<$ :: forall a a b. a -> Reviewed a b -> Reviewed a a
fmap :: forall a b. (a -> b) -> Reviewed a a -> Reviewed a b
$cfmap :: forall a a b. (a -> b) -> Reviewed a a -> Reviewed a b
Functor)

instance Profunctor Reviewed where
  dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Reviewed b c -> Reviewed a d
dimap a -> b
_ c -> d
f (Reviewed c
c) = forall a b. b -> Reviewed a b
Reviewed (c -> d
f c
c)
  {-# INLINE dimap #-}
  lmap :: forall a b c. (a -> b) -> Reviewed b c -> Reviewed a c
lmap a -> b
_ (Reviewed c
c) = forall a b. b -> Reviewed a b
Reviewed c
c
  {-# INLINE lmap #-}
  rmap :: forall b c a. (b -> c) -> Reviewed a b -> Reviewed a c
rmap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  {-# INLINE rmap #-}
  Reviewed c
b .# :: forall a b c (q :: * -> * -> *).
Coercible b a =>
Reviewed b c -> q a b -> Reviewed a c
.# q a b
_ = forall a b. b -> Reviewed a b
Reviewed c
b
  {-# INLINE ( .# ) #-}
#if __GLASGOW_HASKELL__ >= 708 && MIN_VERSION_profunctors(4,4,0)
  ( #. ) q b c
_ = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. a -> a
id :: t -> t) :: forall t u. Coercible t u => u -> t
#else
  ( #. ) _ = unsafeCoerce
#endif
  {-# INLINE ( #. ) #-}

type AReview s t a b = Overloaded Reviewed Identity s t a b

review :: AReview s t a b -> b -> t
review :: forall s t a b. AReview s t a b -> b -> t
review AReview s t a b
p = forall a. Identity a -> a
runIdentity forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall a b. Reviewed a b -> b
runReviewed forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. AReview s t a b
p forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# forall a b. b -> Reviewed a b
Reviewed forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# forall a. a -> Identity a
Identity
{-# INLINE review #-}

infixr 8 #
( # ) :: AReview s t a b -> b -> t
( # ) = forall s t a b. AReview s t a b -> b -> t
review
{-# INLINE ( # ) #-}

------------------------------------------------------------------------

type Lens s t a b = forall f. Functor f => Overloaded (->) f s t a b
type Lens' s a = Lens s s a a

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
afb s
s = s -> b -> t
sbt s
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
afb (s -> a
sa s
s)
{-# INLINE lens #-}

------------------------------------------------------------------------

type Getting r s a = Overloaded (->) (Const r) s s a a

view :: Getting a s a -> s -> a
view :: forall a s. Getting a s a -> s -> a
view Getting a s a
l s
s = forall {k} a (b :: k). Const a b -> a
getConst (Getting a s a
l forall {k} a (b :: k). a -> Const a b
Const s
s)
{-# INLINE view #-}

infixl 8 ^.
(^.) :: s -> Getting a s a -> a
^. :: forall s a. s -> Getting a s a -> a
(^.) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a s. Getting a s a -> s -> a
view
{-# INLINE (^.) #-}

------------------------------------------------------------------------

type Setter s t a b = Overloaded (->) Identity s t a b

set :: Setter s t a b -> b -> s -> t
set :: forall s t a b. Setter s t a b -> b -> s -> t
set Setter s t a b
l b
b = forall a. Identity a -> a
runIdentity forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Setter s t a b
l (\ a
_ -> forall a. a -> Identity a
Identity b
b)
{-# INLINE set #-}

over :: Setter s t a b -> (a -> b) -> s -> t
over :: forall s t a b. Setter s t a b -> (a -> b) -> s -> t
over Setter s t a b
l a -> b
f = forall a. Identity a -> a
runIdentity forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Setter s t a b
l (forall a. a -> Identity a
Identity forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. a -> b
f)
{-# INLINE over #-}

infixr 4 %~
(%~) :: Setter s t a b -> (a -> b) -> s -> t
%~ :: forall s t a b. Setter s t a b -> (a -> b) -> s -> t
(%~) = forall s t a b. Setter s t a b -> (a -> b) -> s -> t
over
{-# INLINE (%~) #-}

assign :: (MonadState s m) => Setter s s a b -> b -> m ()
assign :: forall s (m :: * -> *) a b.
MonadState s m =>
Setter s s a b -> b -> m ()
assign Setter s s a b
l b
b = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall s t a b. Setter s t a b -> b -> s -> t
set Setter s s a b
l b
b)
{-# INLINE assign #-}

infix 4 .=
(.=) :: (MonadState s m) => Setter s s a b -> b -> m ()
.= :: forall s (m :: * -> *) a b.
MonadState s m =>
Setter s s a b -> b -> m ()
(.=) = forall s (m :: * -> *) a b.
MonadState s m =>
Setter s s a b -> b -> m ()
assign
{-# INLINE (.=) #-}