----------------------------------------------------------------------------- -- | -- Module : Data.Extensible.League -- Copyright : (c) Fumiaki Kinoshita 2015 -- License : BSD3 -- -- Maintainer : Fumiaki Kinoshita <fumiexcel@gmail.com> -- Stability : experimental -- Portability : non-portable -- -- Efficient extensible functor ------------------------------------------------------------------------ module Data.Extensible.League where import Data.Extensible.Internal import Data.Extensible.Sum import Data.Extensible.Product import Data.Extensible.Match import Data.Typeable -- | A much more efficient representation for 'Union' of 'Functor's. newtype League fs a = League { getLeague :: Fuse a :| fs } deriving Typeable -- | fast fmap instance Functor (League fs) where fmap f (League (UnionAt pos s)) = League (UnionAt pos (mapFuse f s)) {-# INLINE fmap #-} -- | /O(log n)/ Embed a functor. liftL :: (Functor f, f ∈ fs) => f a -> League fs a liftL f = League $ embed $ Fuse $ \g -> fmap g f {-# INLINE liftL #-} -- | Flipped <http://hackage.haskell.org/package/kan-extensions-4.1.0.1/docs/Data-Functor-Yoneda.html Yoneda> newtype Fuse a f = Fuse { getFuse :: forall b. (a -> b) -> f b } -- | Fuse 'Fuse' to retract a substantial functor. meltdown :: Fuse a f -> f a meltdown (Fuse f) = f id {-# INLINE meltdown #-} -- | 'fmap' for the content. mapFuse :: (a -> b) -> Fuse a f -> Fuse b f mapFuse f (Fuse g) = Fuse (\h -> g (h . f)) {-# INLINE mapFuse #-} -- | Prepend a clause for @'Match' ('Fuse' x)@ as well as ('<?!'). (<?~) :: (f x -> a) -> Match (Fuse x) a :* fs -> Match (Fuse x) a :* (f ': fs) (<?~) f = (<:) (Match (f . meltdown)) {-# INLINE (<?~) #-} infixr 1 <?~