{-# LANGUAGE RankNTypes #-}
module Graphics.Rasterific.MiniLens
    ( -- * Types

      Lens
    , Lens'
    , Traversal
    , Traversal'
    , lens

      -- * Getter

    , (.^)
    , view
    , use

      -- * Setter

    , (.~)
    , (.=)
    , (%=)
    , (+=)
    , set

      -- * Helper

    , (&)
    ) where

import Control.Monad.Identity
import Control.Applicative
import Control.Monad.State        as State
import Data.Function( (&) )

infixl 8 .^
infixr 4 .~
infix  4 .=,%=,+=

-- | Does it look familiar? yes it's the official

-- Lens type.

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

-- | Try to match the Lens' type alias.

type Lens' s a = Lens s s a a

-- | Traversal type, matched to the one of the lens

-- package.

type Traversal s t a b =
    forall f. Applicative f => (a -> f b) -> s -> f t

type Traversal' s a = Traversal s s a a

-- | Create a full lens out of setter and getter

lens :: (s -> a)
     -> (s -> b -> t)
     -> Lens s t a b
{-# INLINE lens #-}
lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
lens s -> a
accessor s -> b -> t
setter = \a -> f b
f s
src ->
  (b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s -> b -> t
setter s
src) (f b -> f t) -> f b -> f t
forall a b. (a -> b) -> a -> b
$ a -> f b
f (s -> a
accessor s
src)

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

(.^) :: s -> Lens s t a b -> a
{-# INLINE (.^) #-}
.^ :: s -> Lens s t a b -> a
(.^) = s -> Lens s t a b -> a
forall s t a b. s -> Lens s t a b -> a
view

set :: Lens' s a -> a -> s -> s
{-# INLINE set #-}
set :: Lens' s a -> a -> s -> s
set Lens' s a
l a
new s
v = Identity s -> s
forall a. Identity a -> a
runIdentity (Identity s -> s) -> Identity s -> s
forall a b. (a -> b) -> a -> b
$ (a -> Identity a) -> s -> Identity s
Lens' s a
l (\a
_ -> a -> Identity a
forall a. a -> Identity a
Identity a
new) s
v

(.~) :: Lens' s a -> a -> s -> s
{-# INLINE (.~) #-}
.~ :: Lens' s a -> a -> s -> s
(.~) = Lens' s a -> a -> s -> s
forall s a. Lens' s a -> a -> s -> s
set

(.=) :: MonadState s m => Lens' s a -> a -> m ()
{-# INLINE (.=) #-}
.= :: Lens' s a -> a -> m ()
(.=) Lens' s a
l a
v = (s -> s) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (Lens' s a
l Lens' s a -> a -> s -> s
forall s a. Lens' s a -> a -> s -> s
.~ a
v)

(%=) :: MonadState s m => Lens' s a -> (a -> a) -> m ()
{-# INLINE (%=) #-}
%= :: Lens' s a -> (a -> a) -> m ()
(%=) Lens' s a
l a -> a
f = (s -> s) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ((s -> s) -> m ()) -> (s -> s) -> m ()
forall a b. (a -> b) -> a -> b
$ \s
s -> s
s s -> (s -> s) -> s
forall a b. a -> (a -> b) -> b
& Lens' s a
l Lens' s a -> a -> s -> s
forall s a. Lens' s a -> a -> s -> s
.~ a -> a
f (s
s s -> Lens' s a -> a
forall s t a b. s -> Lens s t a b -> a
.^ Lens' s a
l)

(+=) :: (Num a, MonadState s m) => Lens' s a -> a -> m ()
{-# INLINE (+=) #-}
+= :: Lens' s a -> a -> m ()
(+=) Lens' s a
l a
n = Lens' s a
l Lens' s a -> (a -> a) -> m ()
forall s (m :: * -> *) a.
MonadState s m =>
Lens' s a -> (a -> a) -> m ()
%= (a -> a -> a
forall a. Num a => a -> a -> a
+ a
n)

use :: MonadState s m => Lens s t a b -> m a
{-# INLINE use #-}
use :: Lens s t a b -> m a
use Lens s t a b
l = (s -> a) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
State.gets (s -> Lens s t a b -> a
forall s t a b. s -> Lens s t a b -> a
.^ Lens s t a b
l)