{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE GADTs                     #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE Rank2Types                #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE TypeFamilyDependencies    #-}
{-# LANGUAGE TypeOperators             #-}
{-# LANGUAGE TupleSections             #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Generics.Internal.VL.Lens
-- Copyright   :  (C) 2020 Csongor Kiss
-- License     :  BSD3
-- Maintainer  :  Csongor Kiss <kiss.csongor.kiss@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Internal lens helpers. Only exported for Haddock
--
-----------------------------------------------------------------------------
module Data.Generics.Internal.VL.Lens where

import "generic-lens-core" Data.Generics.Internal.Profunctor.Lens (ALens (..), idLens)

import Control.Applicative    (Const(..))
import Data.Coerce            (coerce)
import Data.Functor.Identity  (Identity(..))

-- | Type alias for lens
type Lens' s a
  = Lens s s a a

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

view :: ((a -> Const a a) -> s -> Const a s) -> s -> a
view :: ((a -> Const a a) -> s -> Const a s) -> s -> a
view (a -> Const a a) -> s -> Const a s
l s
s = s -> ((a -> Const a a) -> s -> Const a s) -> a
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
(^.) s
s (a -> Const a a) -> s -> Const a s
l

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

infixr 4 .~
(.~) :: ((a -> Identity b) -> s -> Identity t) -> b -> s -> t
.~ :: ((a -> Identity b) -> s -> Identity t) -> b -> s -> t
(.~) (a -> Identity b) -> s -> Identity t
f 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
f (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
. b -> a -> b
forall a b. a -> b -> a
const b
b)

set :: Lens s t a b -> b -> s -> t
set :: Lens s t a b -> b -> s -> t
set Lens s t a b
l b
x = (a -> Identity b) -> s -> Identity t
Lens s t a b
l ((a -> Identity b) -> s -> Identity t) -> b -> s -> t
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> b -> s -> t
.~ b
x

over :: ((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over :: ((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over = ((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
coerce

lens2lensvl :: ALens a b i s t -> Lens s t a b
lens2lensvl :: ALens a b i s t -> Lens s t a b
lens2lensvl (ALens s -> (c, a)
_get (c, b) -> t
_set) =
  \a -> f b
f s
x ->
    case s -> (c, a)
_get s
x of
      (c
c, a
a) -> (c, b) -> t
_set ((c, b) -> t) -> (b -> (c, b)) -> b -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c
c, ) (b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
{-# INLINE lens2lensvl #-}

ravel :: (ALens a b i a b -> ALens a b i s t)
      ->  Lens s t a b
ravel :: (ALens a b i a b -> ALens a b i s t) -> Lens s t a b
ravel ALens a b i a b -> ALens a b i s t
l a -> f b
pab = (ALens a b i s t -> Lens s t a b
forall a b i s t. ALens a b i s t -> Lens s t a b
lens2lensvl (ALens a b i s t -> Lens s t a b)
-> ALens a b i s t -> Lens s t a b
forall a b. (a -> b) -> a -> b
$ ALens a b i a b -> ALens a b i s t
l ALens a b i a b
forall a b i. ALens a b i a b
idLens) a -> f b
pab


lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
lens s -> a
get s -> b -> t
_set = \a -> f b
f s
x -> s -> b -> t
_set s
x (b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f (s -> a
get s
x)
{-# INLINE lens #-}