-- | This module is provided for "Haskell 2022" compatibility.
-- If you are able to use @Rank2Types@, I advise you to instead use the rank 2 aliases
--
-- * @Adapter@, @Adapter'@
--
-- * @Prism@, @Prism'@
--
-- * @Lens@, @Lens'@
--
-- * @Traversal@, @Traversal'@
--
-- * @Setter@, @Setter'@
--
-- * @Grate@, @Grate'@
--
-- * @Resetter@, @Resetter'@
--
-- * @Grid@, @Grid'@
--
-- * @Fold@, @Fold'@
--
-- * @Getter@, @Getter'@
--
-- * @Reviewer@, @Reviewer'@
--
-- from the @lens-family@ package instead.
--
-- 'cloneLens' allows one to circumvent the need for rank 2 types by allowing one to take a universal monomorphic lens instance and rederive a polymorphic instance.
-- When you require a lens family parameter you use the type @'ALens' s t a b@ (or @'ALens'' s a@).
-- Then, inside a @where@ clause, you use 'cloneLens' to create a 'Lens' type.
--
-- For example.
--
-- > example :: ALens s t a b -> Example
-- > example l = ... x^.cl ... cl .~ y ...
-- >  where
-- >   cl x = cloneLens l x
--
-- /Note/: It is important to eta-expand the definition of 'cl' to avoid the dreaded monomorphism restriction.
--
-- 'cloneAdapter', 'cloneGrate', 'cloneTraversal', 'cloneSetter', 'cloneResetter', 'cloneGetter', and 'cloneFold' provides similar functionality for adapters, grates, traversals, setters, resetters, getters, and folds respectively.  Unfortunately, it is not yet known how to clone prisms and grids.
--
-- /Note/: Cloning is only need if you use a functional reference multiple times with different instances.
module Lens.Family.Clone
  ( cloneAdapter, cloneLens, cloneGrate, cloneTraversal, cloneSetter, cloneResetter, cloneGetter, cloneFold
  -- * Types
  , AnAdapter, AnAdapter'
  , ALens, ALens'
  , ATraversal, ATraversal'
  , AGetter, AGetter'
  , AFold, AFold'
  , PStore, PKleeneStore
  -- * Re-exports
  , LensLike, LensLike', GrateLike, GrateLike', FoldLike, FoldLike', AGrate, ASetter, AResetter
  , Phantom, Identical
  ) where

import Lens.Family.Unchecked
import Lens.Family

data PStore i j a = PStore (j -> a) i
instance Functor (PStore i j) where
  fmap :: (a -> b) -> PStore i j a -> PStore i j b
fmap a -> b
f (PStore j -> a
g i
i) = (j -> b) -> i -> PStore i j b
forall i j a. (j -> a) -> i -> PStore i j a
PStore (a -> b
f (a -> b) -> (j -> a) -> j -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. j -> a
g) i
i

-- | AnAdapter s t a b is a universal Adapter s t a b instance
type AnAdapter s t a b = AdapterLike (PStore (s -> a) b) ((->) s) s t a b
-- | AnAdapter' s a is a universal Adapter' s a instance
type AnAdapter' s a = AdapterLike' (PStore (s -> a) a) ((->) s) s a

-- | Converts a universal adapter instance back into a polymorphic adapter.
cloneAdapter :: (Functor f, Functor g) => AnAdapter s t a b -> AdapterLike f g s t a b
cloneAdapter :: AnAdapter s t a b -> AdapterLike f g s t a b
cloneAdapter AnAdapter s t a b
univ = (s -> a) -> (b -> t) -> AdapterLike f g s t a b
forall (f :: * -> *) (g :: * -> *) s a b t.
(Functor f, Functor g) =>
(s -> a) -> (b -> t) -> AdapterLike f g s t a b
adapter s -> a
yin b -> t
yang
 where
  PStore b -> t
yang s -> a
yin = AnAdapter s t a b
univ ((b -> b) -> (s -> a) -> PStore (s -> a) b b
forall i j a. (j -> a) -> i -> PStore i j a
PStore b -> b
forall a. a -> a
id) s -> s
forall a. a -> a
id

-- | ALens s t a b is a universal Lens s t a b instance
type ALens s t a b = LensLike (PStore a b) s t a b

-- | ALens' s a is a universal Lens' s a instance
type ALens' s a = LensLike' (PStore a a) s a

-- | Converts a universal lens instance back into a polymorphic lens.
cloneLens :: Functor f => ALens s t a b -> LensLike f s t a b
cloneLens :: ALens s t a b -> LensLike f s t a b
cloneLens ALens s t a b
univ a -> f b
f = (a -> f b) -> PStore a b t -> f t
forall (f :: * -> *) a b t.
Functor f =>
(a -> f b) -> PStore a b t -> f t
experiment a -> f b
f (PStore a b t -> f t) -> (s -> PStore a b t) -> s -> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ALens s t a b
univ ((b -> b) -> a -> PStore a b b
forall i j a. (j -> a) -> i -> PStore i j a
PStore b -> b
forall a. a -> a
id)

experiment :: Functor f => (a -> f b) -> PStore a b t -> f t
experiment :: (a -> f b) -> PStore a b t -> f t
experiment a -> f b
f (PStore b -> t
g a
a) = b -> t
g (b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a

data PKleeneStore i j a = Unit a
                        | Battery (PKleeneStore i j (j -> a)) i

instance Functor (PKleeneStore i j) where
  fmap :: (a -> b) -> PKleeneStore i j a -> PKleeneStore i j b
fmap a -> b
f (Unit a
a) = b -> PKleeneStore i j b
forall i j a. a -> PKleeneStore i j a
Unit (a -> b
f a
a)
  fmap a -> b
f (Battery PKleeneStore i j (j -> a)
g i
i) = PKleeneStore i j (j -> b) -> i -> PKleeneStore i j b
forall i j a. PKleeneStore i j (j -> a) -> i -> PKleeneStore i j a
Battery (((j -> a) -> j -> b)
-> PKleeneStore i j (j -> a) -> PKleeneStore i j (j -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
f (a -> b) -> (j -> a) -> j -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) PKleeneStore i j (j -> a)
g) i
i

instance Applicative (PKleeneStore i j) where
  pure :: a -> PKleeneStore i j a
pure = a -> PKleeneStore i j a
forall i j a. a -> PKleeneStore i j a
Unit
  Unit a -> b
f <*> :: PKleeneStore i j (a -> b)
-> PKleeneStore i j a -> PKleeneStore i j b
<*> PKleeneStore i j a
a = a -> b
f (a -> b) -> PKleeneStore i j a -> PKleeneStore i j b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PKleeneStore i j a
a
  Battery PKleeneStore i j (j -> a -> b)
f i
b <*> PKleeneStore i j a
a = PKleeneStore i j (j -> b) -> i -> PKleeneStore i j b
forall i j a. PKleeneStore i j (j -> a) -> i -> PKleeneStore i j a
Battery ((j -> a -> b) -> a -> j -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((j -> a -> b) -> a -> j -> b)
-> PKleeneStore i j (j -> a -> b) -> PKleeneStore i j (a -> j -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PKleeneStore i j (j -> a -> b)
f PKleeneStore i j (a -> j -> b)
-> PKleeneStore i j a -> PKleeneStore i j (j -> b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PKleeneStore i j a
a) i
b

-- | ATraversal s t a b is a universal Traversal s t a b instance
type ATraversal s t a b = LensLike (PKleeneStore a b) s t a b

-- | ATraversal' a b is a universal Traversal' a b instance
type ATraversal' s a = LensLike' (PKleeneStore a a) s a

-- | Converts a universal traversal instance back into a polymorphic traversal.
cloneTraversal :: Applicative f => ATraversal s t a b -> LensLike f s t a b
cloneTraversal :: ATraversal s t a b -> LensLike f s t a b
cloneTraversal ATraversal s t a b
univ a -> f b
f = (a -> f b) -> PKleeneStore a b t -> f t
forall (f :: * -> *) a b t.
Applicative f =>
(a -> f b) -> PKleeneStore a b t -> f t
research a -> f b
f (PKleeneStore a b t -> f t)
-> (s -> PKleeneStore a b t) -> s -> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATraversal s t a b
univ (PKleeneStore a b (b -> b) -> a -> PKleeneStore a b b
forall i j a. PKleeneStore i j (j -> a) -> i -> PKleeneStore i j a
Battery ((b -> b) -> PKleeneStore a b (b -> b)
forall i j a. a -> PKleeneStore i j a
Unit b -> b
forall a. a -> a
id))

research :: Applicative f => (a -> f b) -> PKleeneStore a b t -> f t
research :: (a -> f b) -> PKleeneStore a b t -> f t
research a -> f b
_ (Unit t
a) = t -> f t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
a
research a -> f b
f (Battery PKleeneStore a b (b -> t)
g a
b) = (a -> f b) -> PKleeneStore a b (b -> t) -> f (b -> t)
forall (f :: * -> *) a b t.
Applicative f =>
(a -> f b) -> PKleeneStore a b t -> f t
research a -> f b
f PKleeneStore a b (b -> t)
g f (b -> t) -> f b -> f t
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
b

-- | Converts a universal setter instance back into a polymorphic setter.
cloneSetter :: Identical f => ASetter s t a b -> LensLike f s t a b
cloneSetter :: ASetter s t a b -> LensLike f s t a b
cloneSetter = ((a -> b) -> s -> t) -> LensLike f s t a b
forall (f :: * -> *) a b s t.
Identical f =>
((a -> b) -> s -> t) -> LensLike f s t a b
setting (((a -> b) -> s -> t) -> LensLike f s t a b)
-> (ASetter s t a b -> (a -> b) -> s -> t)
-> ASetter s t a b
-> LensLike f s t a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter s t a b -> (a -> b) -> s -> t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over

-- | AFold s t a b is a universal Fold s t a b instance
type AFold s t a b = FoldLike [a] s t a b

-- | AFold' s a is a universal Fold' s a instance
type AFold' s a = FoldLike' [a] s a

-- | Converts a universal fold instance back into a polymorphic fold.
cloneFold :: (Phantom f, Applicative f) => AFold s t a b -> LensLike f s t a b
cloneFold :: AFold s t a b -> LensLike f s t a b
cloneFold AFold s t a b
univ = (s -> [a]) -> LensLike f s t a b
forall (g :: * -> *) (f :: * -> *) s a t b.
(Foldable g, Phantom f, Applicative f) =>
(s -> g a) -> LensLike f s t a b
folding (AFold s t a b -> s -> [a]
forall a s t b. FoldLike [a] s t a b -> s -> [a]
toListOf AFold s t a b
univ)

-- | Converts a universal resetter instance back into a polymorphic resetter.
cloneResetter :: Identical f => AResetter s t a b -> GrateLike f s t a b
cloneResetter :: AResetter s t a b -> GrateLike f s t a b
cloneResetter = ((a -> b) -> s -> t) -> GrateLike f s t a b
forall (g :: * -> *) a b s t.
Identical g =>
((a -> b) -> s -> t) -> GrateLike g s t a b
resetting (((a -> b) -> s -> t) -> GrateLike f s t a b)
-> (AResetter s t a b -> (a -> b) -> s -> t)
-> AResetter s t a b
-> GrateLike f s t a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AResetter s t a b -> (a -> b) -> s -> t
forall s t a b. AResetter s t a b -> (a -> b) -> s -> t
under

-- | AGetter s t a b is a universal Getter s t a b instance
type AGetter s t a b = FoldLike a s t a b

-- | AGetter' s a is a universal Getter' s a instance
type AGetter' s a = FoldLike' a s a

-- | Converts a universal getter instance back into a polymorphic getter.
cloneGetter :: Phantom f => AGetter s t a b -> LensLike f s t a b
cloneGetter :: AGetter s t a b -> LensLike f s t a b
cloneGetter AGetter s t a b
univ = (s -> a) -> LensLike f s t a b
forall (f :: * -> *) s a t b.
Phantom f =>
(s -> a) -> LensLike f s t a b
to (AGetter s t a b -> s -> a
forall a s t b. FoldLike a s t a b -> s -> a
view AGetter s t a b
univ)

-- | Converts a universal grate instance back into a polymorphic grater.
cloneGrate :: Functor g => AGrate s t a b -> GrateLike g s t a b
cloneGrate :: AGrate s t a b -> GrateLike g s t a b
cloneGrate = (((s -> a) -> b) -> t) -> GrateLike g s t a b
forall (g :: * -> *) s a b t.
Functor g =>
(((s -> a) -> b) -> t) -> GrateLike g s t a b
grate ((((s -> a) -> b) -> t) -> GrateLike g s t a b)
-> (AGrate s t a b -> ((s -> a) -> b) -> t)
-> AGrate s t a b
-> GrateLike g s t a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AGrate s t a b -> ((s -> a) -> b) -> t
forall s t a b. AGrate s t a b -> ((s -> a) -> b) -> t
degrating