module Data.Extensible.Wrapper (
Wrapper(..)
, _WrapperAs
, Const'(..)
, Comp(..)
, comp
) where
import Data.Typeable (Typeable)
import Data.Proxy (Proxy(..))
import Data.Profunctor.Unsafe (Profunctor(..))
import Data.Functor.Identity (Identity(..))
import Data.Extensible.Internal.Rig (Optic', withIso)
class Wrapper (h :: k -> *) where
type Repr h (v :: k) :: *
_Wrapper :: (Functor f, Profunctor p) => Optic' p f (h v) (Repr h v)
_WrapperAs :: (Functor f, Profunctor p, Wrapper h) => proxy v -> Optic' p f (h v) (Repr h v)
_WrapperAs _ = _Wrapper
instance Wrapper Identity where
type Repr Identity a = a
_Wrapper = dimap runIdentity (fmap Identity)
instance Wrapper Maybe where
type Repr Maybe a = Maybe a
_Wrapper = id
instance Wrapper [] where
type Repr [] a = [a]
_Wrapper = id
newtype Comp (f :: j -> *) (g :: i -> j) (a :: i) = Comp { getComp :: f (g a) } deriving (Show, Eq, Ord, Typeable)
comp :: Functor f => (a -> g b) -> f a -> Comp f g b
comp f = Comp #. fmap f
instance (Functor f, Wrapper g) => Wrapper (Comp f g) where
type Repr (Comp f g) x = f (Repr g x)
_Wrapper = withIso _Wrapper $ \f g -> dimap (fmap f .# getComp) (fmap (comp g))
newtype Const' a x = Const' { getConst' :: a } deriving (Show, Eq, Ord, Typeable)
instance Wrapper (Const' a) where
type Repr (Const' a) b = a
_Wrapper = dimap getConst' (fmap Const')
instance Wrapper Proxy where
type Repr Proxy x = ()
_Wrapper = dimap (const ()) (fmap (const Proxy))