-- | This module is provided for Haskell 98 compatibility.
-- If you are able to use @Rank2Types@, I advise you to instead use the rank 2 aliases
--
-- * @Lens@, @Lens'@
--
-- * @Traversal@, @Traversal'@
--
-- * @Setter@, @Setter'@
--
-- * @Fold@, @Fold'@
--
-- * @Getter@, @Getter'@
--
-- 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' a a' b b'@ (or @'ALens'' a b@).
-- Then, inside a @where@ clause, you use 'cloneLens' to create a 'Lens' type.
--
-- For example.
--
-- > example :: ALens a a' b 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.
--
-- 'cloneTraversal', 'cloneGetter', 'cloneSetter', and 'cloneFold' provides similar functionality for traversals, getters, setters, and folds respectively.
--
-- /Note/: Cloning is only need if you use a functional reference multiple times with different instances.
module Lens.Family.Clone
  ( cloneLens, cloneTraversal, cloneSetter, cloneGetter, cloneFold
  -- * Types
  , ALens, ALens'
  , ATraversal, ATraversal'
  , AGetter, AGetter'
  , AFold, AFold'
  , IStore, IKleeneStore
  -- * Re-exports
  , LensLike, LensLike', FoldLike, FoldLike', ASetter
  , Applicative, Phantom, Identical
  ) where

import Control.Applicative (Applicative, pure, (<*>), (<$>))
import Lens.Family.Unchecked (Identical, setting)
import Lens.Family ( LensLike, LensLike'
                   , ASetter, over
                   , FoldLike, FoldLike', toListOf, folding
                   , to, view
                   , Phantom
                   )

data IStore b b' a = IStore (b' -> a) b
instance Functor (IStore b b') where
  fmap f (IStore g b) = IStore (f . g) b

-- | ALens a a' b b' is a universal Lens a a' b b' instance
type ALens a a' b b' = LensLike (IStore b b') a a' b b'

-- | ALens' a b is a universal Lens' a b instance
type ALens' a b = LensLike' (IStore b b) a b

-- | Converts a universal lens instance back into a polymorphic lens.
cloneLens :: Functor f => ALens a a' b b' -> LensLike f a a' b b'
cloneLens univ f = experiment f . univ (IStore id)

experiment :: Functor f => (b -> f b') -> IStore b b' a -> f a
experiment f (IStore g b) = g <$> f b

data IKleeneStore b b' a = Unit a
                         | Battery (IKleeneStore b b' (b' -> a)) b

instance Functor (IKleeneStore b b') where
  fmap f (Unit a) = Unit (f a)
  fmap f (Battery g b) = Battery (fmap (f .) g) b

instance Applicative (IKleeneStore b b') where
  pure = Unit
  Unit f <*> a = fmap f a
  Battery f b <*> a = Battery (flip <$> f <*> a) b

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

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

-- | Converts a universal traversal instance back into a polymorphic traversal.
cloneTraversal :: Applicative f => ATraversal a a' b b' -> LensLike f a a' b b'
cloneTraversal univ f = research f . univ (Battery (Unit id))

research :: Applicative f => (b -> f b') -> IKleeneStore b b' a -> f a
research _ (Unit a) = pure a
research f (Battery g b) = research f g <*> f b

-- | Converts a universal setter instance back into a polymorphic setter.
cloneSetter :: Identical f => ASetter a a' b b' -> LensLike f a a' b b'
cloneSetter = setting . over

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

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

-- | Converts a universal fold instance back into a polymorphic fold.
cloneFold :: (Phantom f, Applicative f) => AFold a a' b b' -> LensLike f a a' b b'
cloneFold univ = folding (toListOf univ)

-- | AGetter a a' b b' is a universal Fold a a' b b' instance
type AGetter a a' b b' = FoldLike b a a' b b'

-- | AGetter' a b is a universal Fold' a b instance
type AGetter' a b = FoldLike' b a b

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