-- | 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 :: forall a b. (a -> b) -> PStore i j a -> PStore i j b
fmap a -> b
f (PStore j -> a
g i
i) = forall i j a. (j -> a) -> i -> PStore i j a
PStore (a -> b
f 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 :: forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnAdapter s t a b -> AdapterLike f g s t a b
cloneAdapter AnAdapter s t a b
univ = 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 (forall i j a. (j -> a) -> i -> PStore i j a
PStore forall a. a -> a
id) 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 :: forall (f :: * -> *) s t a b.
Functor f =>
ALens s t a b -> LensLike f s t a b
cloneLens ALens s t a b
univ a -> f b
f = forall (f :: * -> *) a b t.
Functor f =>
(a -> f b) -> PStore a b t -> f t
experiment a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. ALens s t a b
univ (forall i j a. (j -> a) -> i -> PStore i j a
PStore forall a. a -> a
id)

experiment :: Functor f => (a -> f b) -> PStore a b t -> f t
experiment :: forall (f :: * -> *) a b t.
Functor f =>
(a -> f b) -> PStore a b t -> f t
experiment a -> f b
f (PStore b -> t
g a
a) = b -> t
g 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 :: forall a b. (a -> b) -> PKleeneStore i j a -> PKleeneStore i j b
fmap a -> b
f (Unit a
a) = 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) = forall i j a. PKleeneStore i j (j -> a) -> i -> PKleeneStore i j a
Battery (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
f 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 :: forall a. a -> PKleeneStore i j a
pure = forall i j a. a -> PKleeneStore i j a
Unit
  Unit a -> b
f <*> :: forall a b.
PKleeneStore i j (a -> b)
-> PKleeneStore i j a -> PKleeneStore i j b
<*> PKleeneStore i j a
a = a -> b
f 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 = forall i j a. PKleeneStore i j (j -> a) -> i -> PKleeneStore i j a
Battery (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PKleeneStore i j (j -> a -> b)
f 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 :: forall (f :: * -> *) s t a b.
Applicative f =>
ATraversal s t a b -> LensLike f s t a b
cloneTraversal ATraversal s t a b
univ a -> f b
f = forall (f :: * -> *) a b t.
Applicative f =>
(a -> f b) -> PKleeneStore a b t -> f t
research a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATraversal s t a b
univ (forall i j a. PKleeneStore i j (j -> a) -> i -> PKleeneStore i j a
Battery (forall i j a. a -> PKleeneStore i j a
Unit forall a. a -> a
id))

research :: Applicative f => (a -> f b) -> PKleeneStore a b t -> f t
research :: forall (f :: * -> *) a b t.
Applicative f =>
(a -> f b) -> PKleeneStore a b t -> f t
research a -> f b
_ (Unit t
a) = 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) = 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 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 :: forall (f :: * -> *) s t a b.
Identical f =>
ASetter s t a b -> LensLike f s t a b
cloneSetter = forall (f :: * -> *) a b s t.
Identical f =>
((a -> b) -> s -> t) -> LensLike f s t a b
setting forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (f :: * -> *) s t a b.
(Phantom f, Applicative f) =>
AFold s t a b -> LensLike f s t a b
cloneFold AFold s t a b
univ = forall (g :: * -> *) (f :: * -> *) s a t b.
(Foldable g, Phantom f, Applicative f) =>
(s -> g a) -> LensLike f s t a b
folding (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 :: forall (f :: * -> *) s t a b.
Identical f =>
AResetter s t a b -> GrateLike f s t a b
cloneResetter = forall (g :: * -> *) a b s t.
Identical g =>
((a -> b) -> s -> t) -> GrateLike g s t a b
resetting forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (f :: * -> *) s t a b.
Phantom f =>
AGetter s t a b -> LensLike f s t a b
cloneGetter AGetter s t a b
univ = forall (f :: * -> *) s a t b.
Phantom f =>
(s -> a) -> LensLike f s t a b
to (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 :: forall (g :: * -> *) s t a b.
Functor g =>
AGrate s t a b -> GrateLike g s t a b
cloneGrate = forall (g :: * -> *) s a b t.
Functor g =>
(((s -> a) -> b) -> t) -> GrateLike g s t a b
grate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. AGrate s t a b -> ((s -> a) -> b) -> t
degrating