{-# 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 :: forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view (a -> Const a a) -> s -> Const a s
l s
s = 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 ^. :: forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (a -> Const a a) -> s -> Const a s
l = forall {k} a (b :: k). Const a b -> a
getConst ((a -> Const a a) -> s -> Const a s
l 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
.~ :: forall a b s t.
((a -> Identity b) -> s -> Identity t) -> b -> s -> t
(.~) (a -> Identity b) -> s -> Identity t
f b
b = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Identity b) -> s -> Identity t
f (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const b
b)

set :: Lens s t a b -> b -> s -> t
set :: forall s t a b. Lens s t a b -> b -> s -> t
set Lens s t a b
l b
x = Lens s t a b
l 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 :: forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over = coerce :: forall a b. Coercible a b => a -> b
coerce

lens2lensvl :: ALens a b i s t -> Lens s t a b
lens2lensvl :: forall a b i s t. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c
c, ) 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 :: forall a b i s t.
(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 = (forall a b i s t. ALens a b i s t -> Lens s t a b
lens2lensvl forall a b. (a -> b) -> a -> b
$ ALens a b i a b -> ALens a b i s t
l 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 :: forall s a b t. (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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f (s -> a
get s
x)
{-# INLINE lens #-}