{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
module Composite.Lens.Extra
( pattern (:!:),
rlens'',
rlensS,
rlensS',
rlensS'',
)
where
import Composite.Record
import qualified Control.Lens as L
import Data.Functor.Contravariant
import qualified Data.Vinyl as Vinyl
import Data.Vinyl.TypeLevel
pattern (:!:) :: forall s f rs a. Contravariant f => () => f a -> Rec f rs -> Rec f (s :-> a ': rs)
pattern $b:!: :: f a -> Rec f rs -> Rec f ((s :-> a) : rs)
$m:!: :: forall r (s :: Symbol) (f :: * -> *) (rs :: [*]) a.
Contravariant f =>
Rec f ((s :-> a) : rs)
-> (f a -> Rec f rs -> r) -> (Void# -> r) -> r
(:!:) fa rs <-
(contramap Val -> fa) :& rs
where
(:!:) f a
fa Rec f rs
rs = ((s :-> a) -> a) -> f a -> f (s :-> a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (s :-> a) -> a
forall (s :: Symbol) a. (s :-> a) -> a
getVal f a
fa f (s :-> a) -> Rec f rs -> Rec f ((s :-> a) : rs)
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec f rs
rs
infixr 5 :!:
rlens'' :: (Contravariant f, Functor g, RElem (s :-> a) rs) => proxy (s :-> a) -> (f a -> g (f a)) -> Rec f rs -> g (Rec f rs)
rlens'' :: proxy (s :-> a) -> (f a -> g (f a)) -> Rec f rs -> g (Rec f rs)
rlens'' proxy (s :-> a)
proxy f a -> g (f a)
f =
(f (s :-> a) -> g (f (s :-> a))) -> Rec f rs -> g (Rec f rs)
forall k (r :: k) (record :: (k -> *) -> [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 ((f (s :-> a) -> g (f (s :-> a))) -> Rec f rs -> g (Rec f rs))
-> (f (s :-> a) -> g (f (s :-> a))) -> Rec f rs -> g (Rec f rs)
forall a b. (a -> b) -> a -> b
$ \((a -> s :-> a) -> f (s :-> a) -> f a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (proxy (s :-> a) -> (s :-> a) -> s :-> a
forall (proxy :: * -> *) (s :: Symbol) a.
proxy (s :-> a) -> (s :-> a) -> s :-> a
reifyVal proxy (s :-> a)
proxy ((s :-> a) -> s :-> a) -> (a -> s :-> a) -> a -> s :-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> s :-> a
forall (s :: Symbol) a. a -> s :-> a
Val) -> f a
fa) ->
((s :-> a) -> a) -> f a -> f (s :-> a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (s :-> a) -> a
forall (s :: Symbol) a. (s :-> a) -> a
getVal (f a -> f (s :-> a)) -> g (f a) -> g (f (s :-> a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> g (f a)
f f a
fa
{-# INLINE rlens'' #-}
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 :: (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')
forall (record :: (* -> *) -> [*] -> *) (rs :: [*]) (rs' :: [*])
(f :: * -> *) (g :: * -> *).
(RecElem record p p' rs rs' (RIndex p rs), RecElemFCtx record f,
Functor g) =>
(f p -> g (f p')) -> record f rs -> g (record f rs')
Vinyl.rlens' @p @p' ((Identity p -> g (Identity p')) -> Record rs -> g (Record rs'))
-> (Identity p -> g (Identity p')) -> Record rs -> g (Record rs')
forall a b. (a -> b) -> a -> b
$ \(L.Identity (p -> a
forall (s :: Symbol) a. (s :-> a) -> a
getVal -> a
a)) -> (s' :-> b) -> Identity (s' :-> b)
forall a. a -> Identity a
L.Identity ((s' :-> b) -> Identity (s' :-> b))
-> (b -> s' :-> b) -> b -> Identity (s' :-> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> s' :-> b
forall (s :: Symbol) a. a -> s :-> a
Val (b -> Identity (s' :-> b)) -> g b -> g (Identity (s' :-> b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> g b
f a
a
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' :: (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')
forall (record :: (* -> *) -> [*] -> *) (rs :: [*]) (rs' :: [*])
(f :: * -> *) (g :: * -> *).
(RecElem record p p' rs rs' (RIndex p rs), RecElemFCtx record f,
Functor g) =>
(f p -> g (f p')) -> record f rs -> g (record f rs')
Vinyl.rlens' @p @p' ((f p -> g (f p')) -> Rec f rs -> g (Rec f rs'))
-> (f p -> g (f p')) -> Rec f rs -> g (Rec f rs')
forall a b. (a -> b) -> a -> b
$ \(((s :-> a) -> a) -> f (s :-> a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s :-> a) -> a
forall (s :: Symbol) a. (s :-> a) -> a
getVal -> f a
a) -> (b -> s' :-> b) -> f b -> f (s' :-> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> s' :-> b
forall (s :: Symbol) a. a -> s :-> a
Val (f b -> f (s' :-> b)) -> g (f b) -> g (f (s' :-> b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> g (f b)
f f a
a
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'' :: (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')
forall (record :: (* -> *) -> [*] -> *) (rs :: [*]) (rs' :: [*])
(f :: * -> *) (g :: * -> *).
(RecElem record p p' rs rs' (RIndex p rs), RecElemFCtx record f,
Functor g) =>
(f p -> g (f p')) -> record f rs -> g (record f rs')
Vinyl.rlens' @p @p' ((f p -> g (f p')) -> Rec f rs -> g (Rec f rs'))
-> (f p -> g (f p')) -> Rec f rs -> g (Rec f rs')
forall a b. (a -> b) -> a -> b
$ \((a -> s :-> a) -> f (s :-> a) -> f a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> s :-> a
forall (s :: Symbol) a. a -> s :-> a
Val -> f a
a) -> ((s' :-> b) -> b) -> f b -> f (s' :-> b)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (s' :-> b) -> b
forall (s :: Symbol) a. (s :-> a) -> a
getVal (f b -> f (s' :-> b)) -> g (f b) -> g (f (s' :-> b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> g (f b)
f f a
a