{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeOperators       #-}
{-# LANGUAGE ViewPatterns        #-}

module Composite.Lens.Extra
  (
    rlensS,
    rlensS',
    rlensS'',
  )
where

import           Composite.Record           (Rec, Record, getVal, (:->) (Val))
import qualified Control.Lens               as L
import           Data.Functor.Contravariant (Contravariant (contramap))
import qualified Data.Vinyl                 as Vinyl
import           Data.Vinyl.TypeLevel       (RIndex)

-- | Type changing lens over a `Record` field.
--
-- @since 0.0.1.0
rlensS ::
  forall p p' s s' a b g rs rs'.
  ( (p ~ (s :-> a)),
    (p' ~ (s' :-> b)),
    Vinyl.RecElem
      Rec
      (s :-> a)
      (s' :-> b)
      rs
      rs'
      (RIndex (s :-> a) rs),
    Functor g
  ) =>
  (a -> g b) ->
  Record rs ->
  g (Record rs')
rlensS :: forall p p' (s :: Symbol) (s' :: Symbol) a b (g :: * -> *)
       (rs :: [*]) (rs' :: [*]).
(p ~ (s :-> a), p' ~ (s' :-> b),
 RecElem Rec (s :-> a) (s' :-> b) rs rs' (RIndex (s :-> a) rs),
 Functor g) =>
(a -> g b) -> Record rs -> g (Record rs')
rlensS a -> g b
f = forall {k} (r :: k) (r' :: k) (record :: (k -> *) -> [k] -> *)
       (rs :: [k]) (rs' :: [k]) (f :: k -> *) (g :: * -> *).
(RecElem record r r' rs rs' (RIndex r rs), RecElemFCtx record f,
 Functor g) =>
(f r -> g (f r')) -> record f rs -> g (record f rs')
Vinyl.rlens' @p @p' forall a b. (a -> b) -> a -> b
$ \(L.Identity (forall (s :: Symbol) a. (s :-> a) -> a
getVal -> a
a)) -> forall a. a -> Identity a
L.Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Symbol) a. a -> s :-> a
Val forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> g b
f a
a

-- | Type changing lens over a `Rec f` (Covariant).
--
-- @since 0.0.1.0
rlensS' ::
  forall p p' s s' a b f g rs rs'.
  ( (p ~ (s :-> a)),
    (p' ~ (s' :-> b)),
    Vinyl.RecElem
      Rec
      (s :-> a)
      (s' :-> b)
      rs
      rs'
      (Data.Vinyl.TypeLevel.RIndex (s :-> a) rs),
    Functor f,
    Functor g
  ) =>
  (f a -> g (f b)) ->
  Rec f rs ->
  g (Rec f rs')
rlensS' :: forall p p' (s :: Symbol) (s' :: Symbol) a b (f :: * -> *)
       (g :: * -> *) (rs :: [*]) (rs' :: [*]).
(p ~ (s :-> a), p' ~ (s' :-> b),
 RecElem Rec (s :-> a) (s' :-> b) rs rs' (RIndex (s :-> a) rs),
 Functor f, Functor g) =>
(f a -> g (f b)) -> Rec f rs -> g (Rec f rs')
rlensS' f a -> g (f b)
f = forall {k} (r :: k) (r' :: k) (record :: (k -> *) -> [k] -> *)
       (rs :: [k]) (rs' :: [k]) (f :: k -> *) (g :: * -> *).
(RecElem record r r' rs rs' (RIndex r rs), RecElemFCtx record f,
 Functor g) =>
(f r -> g (f r')) -> record f rs -> g (record f rs')
Vinyl.rlens' @p @p' forall a b. (a -> b) -> a -> b
$ \(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (s :: Symbol) a. (s :-> a) -> a
getVal -> f a
a) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (s :: Symbol) a. a -> s :-> a
Val forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> g (f b)
f f a
a

-- | Type changing lens over a `Rec f` (Contravariant).
--
-- @since 0.0.1.0
rlensS'' ::
  forall p p' s s' a b f g rs rs'.
  ( (p ~ (s :-> a)),
    (p' ~ (s' :-> b)),
    Vinyl.RecElem
      Rec
      (s :-> a)
      (s' :-> b)
      rs
      rs'
      (Data.Vinyl.TypeLevel.RIndex (s :-> a) rs),
    Contravariant f,
    Functor g
  ) =>
  (f a -> g (f b)) ->
  Rec f rs ->
  g (Rec f rs')
rlensS'' :: forall p p' (s :: Symbol) (s' :: Symbol) a b (f :: * -> *)
       (g :: * -> *) (rs :: [*]) (rs' :: [*]).
(p ~ (s :-> a), p' ~ (s' :-> b),
 RecElem Rec (s :-> a) (s' :-> b) rs rs' (RIndex (s :-> a) rs),
 Contravariant f, Functor g) =>
(f a -> g (f b)) -> Rec f rs -> g (Rec f rs')
rlensS'' f a -> g (f b)
f = forall {k} (r :: k) (r' :: k) (record :: (k -> *) -> [k] -> *)
       (rs :: [k]) (rs' :: [k]) (f :: k -> *) (g :: * -> *).
(RecElem record r r' rs rs' (RIndex r rs), RecElemFCtx record f,
 Functor g) =>
(f r -> g (f r')) -> record f rs -> g (record f rs')
Vinyl.rlens' @p @p' forall a b. (a -> b) -> a -> b
$ \(forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall (s :: Symbol) a. a -> s :-> a
Val -> f a
a) -> forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall (s :: Symbol) a. (s :-> a) -> a
getVal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> g (f b)
f f a
a