-- | This module is only provided for Haskell 98 compatibility.
-- If you are able to use @Rank2Types@, I strongly advise you to instead use 'Lens.Family2.Stock.LensFamily' and 'Lens.Family2.Stock.Lens' from the lens-family package instead.
-- 
-- 'clone' 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 @'ClonerFamily' a a' b b'@ (or @'Cloner' a b@).
-- Then, inside a @where@ clause, you use 'clone' to create a 'LensFamily' type.
--
-- For example.
--
-- > example :: ClonerFamily a a' b b' -> Example
-- > example l = ... x ^. cl ... cl ^= y ...
-- >  where
-- >   cl x = clone l x
--
-- /Note/: It is important to eta-expand the definition of 'cl' to avoid the dreaded monomorphism restriction.
--
-- /Note/: Cloning is only need if you use both @Getter@s and @Setter@s in the function.
-- Otherwise you only need to use the monomorphic 'Lens.Family.GetterFamily' \/ 'Lens.Family.Getter' or 'Lens.Family.SetterFamily' \/ 'Lens.Family.Setter'.
module Lens.Family.Clone
  ( clone
  -- * Types
  , LensFamily
  , ClonerFamily, Cloner
  ) where

import Lens.Family.Unchecked (LensFamily)

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

type ClonerFamily a a' b b' = LensFamily (Cloning b' b) a a' b b'
type Cloner a b = ClonerFamily a a b b

-- | Converts a universal lens instance back into a polymorphic lens.
clone :: Functor f => ClonerFamily a a' b b' -> LensFamily f a a' b b'
clone univ f a = fmap g (f b)
  where
    Cloning g b = univ (Cloning id) a