Type composition
Jump to navigation
Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
Introduction
I'd like to get some forms of type composition into a standard library. Below is my first shot at it. I'm using these definitions in a new version of Phooey.
Comments & suggestions, please. Conal 23:16, 8 March 2007 (UTC)
Code, first draft
{-# OPTIONS -fglasgow-exts #-}
----------------------------------------------------------------------
-- |
-- Module : Control.Compose
-- Copyright : (c) Conal Elliott 2007
-- License : LGPL
--
-- Maintainer : conal@conal.net
-- Stability : experimental
-- Portability : portable
--
-- Various type constructor compositions and instances for them.
----------------------------------------------------------------------
module Control.Compose ((:.:)(..), (:.::)(..), (::.:)(..), App(..)) where
import Control.Applicative
import Control.Arrow hiding (pure)
import Data.Monoid
-- | Composition of type constructors: unary & unary.
newtype (g :.: f) a = T_T { runT_T :: g (f a) }
instance (Functor g, Functor f) => Functor (g :.: f) where
fmap f (T_T m) = T_T (fmap (fmap f) m)
instance (Applicative g, Applicative f) => Applicative (g :.: f) where
pure = T_T . pure . pure
T_T getf <*> T_T getx = T_T (liftA2 (<*>) getf getx)
-- | Composition of type constructors: unary & binary.
newtype (f :.:: (~>)) a b = T_TT { runT_TT :: f (a ~> b) }
instance (Applicative f, Arrow (~>)) => Arrow (f :.:: (~>)) where
arr = T_TT . pure . arr
T_TT g >>> T_TT h = T_TT (liftA2 (>>>) g h)
first (T_TT g) = T_TT (liftA first g)
-- For instance, /\ a b. f (a -> m b) =~ f :.:: Kleisli m
-- | Composition of type constructors: unary & binary.
-- Wolfgang Jeltsch pointed out a problem with these definitions: 'splitA'
-- and 'mergeA' are not inverses. The definition of 'first', e.g.,
-- violates the \"extension\" law and causes repeated execution. Look for
-- a reformulation or a clarification of required properties of the
-- applicative functor @f@.
newtype ((~>) ::.: f) a b = TT_T {runTT_T :: f a ~> f b}
instance (Arrow (~>), Applicative f) => Arrow ((~>) ::.: f) where
arr = TT_T . arr . liftA
TT_T g >>> TT_T h = TT_T (g >>> h)
first (TT_T a) =
TT_T (arr splitA >>> first a >>> arr mergeA)
instance (ArrowLoop (~>), Applicative f) => ArrowLoop ((~>) ::.: f) where
-- loop :: UI (b,d) (c,d) -> UI b c
loop (TT_T k) =
TT_T (loop (arr mergeA >>> k >>> arr splitA))
mergeA :: Applicative m => (m a, m c) -> m (a,c)
mergeA ~(ma,mc) = liftA2 (,) ma mc
splitA :: Applicative m => m (a,b) -> (m a, m b)
splitA m = (liftA fst m, liftA snd m)
-- | Type application
newtype App f a = App { runApp :: f a }
-- Example: App IO ()
instance (Applicative f, Monoid m) => Monoid (App f m) where
mempty = App (pure mempty)
App a `mappend` App b = App (a *> b)
{-
-- We can also drop the App constructor, but then we overlap with many
-- other instances, like [a].
instance (Applicative f, Monoid a) => Monoid (f a) where
mempty = pure mempty
a `mappend` b = a *> b
-}