Personal tools

Type composition

From HaskellWiki

(Difference between revisions)
Jump to: navigation, search
m (Code, first draft)
(Code: added ref to ListMap in "Arrows and Computation")
 
(9 intermediate revisions by 3 users not shown)
Line 1: Line 1:
  +
[[Category:Proposals]] [[Category:Code]]
 
== Introduction ==
 
== Introduction ==
   
Line 5: Line 6:
 
Comments & suggestions, please. [[User:Conal|Conal]] 23:16, 8 March 2007 (UTC)
 
Comments & suggestions, please. [[User:Conal|Conal]] 23:16, 8 March 2007 (UTC)
   
== Code, first draft ==
+
== Code ==
   
 
<haskell>
 
<haskell>
{-# OPTIONS -fglasgow-exts #-}
+
{-# OPTIONS -fglasgow-exts -cpp #-}
---- Various type constructor compositions and instances for them.
 
   
  +
----------------------------------------------------------------------
  +
-- Various type constructor compositions and instances for them.
  +
-- References:
  +
-- [1] \"Applicative Programming with Effects\"
  +
-- <http://www.soi.city.ac.uk/~ross/papers/Applicative.html>
  +
----------------------------------------------------------------------
   
module Control.Compose ((:.:)(..), (:.::)(..), (::.:)(..), App(..)) where
+
module Control.Compose
  +
( Cofunctor(..)
  +
, Compose(..), onComp
  +
, StaticArrow(..)
  +
, Flip(..)
  +
, ArrowAp(..)
  +
, App(..)
  +
) where
   
 
import Control.Applicative
 
import Control.Applicative
Line 17: Line 24:
 
import Data.Monoid
 
import Data.Monoid
   
-- | Composition of type constructors: unary & unary.
+
-- | Often useful for /acceptors/ (consumers, sinks) of values.
newtype (g :.: f) a = T_T { runT_T :: g (f a) }
+
class Cofunctor acc where
  +
cofmap :: (a -> b) -> (acc b -> acc 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
+
-- | Composition of type constructors: unary & unary. Called \"g . f\" in
pure = T_T . pure . pure
+
-- [1], section 5, but GHC won't parse that, nor will it parse any infix
T_T getf <*> T_T getx = T_T (liftA2 (<*>) getf getx)
+
-- type operators in an export list. Haddock won't parse any type infixes
  +
-- at all.
  +
newtype Compose g f a = Comp { unComp :: g (f a) }
   
  +
-- | Apply a function within the 'Comp' constructor.
  +
onComp :: (g (f a) -> g' (f' a')) -> ((Compose g f) a -> (Compose g' f') a')
  +
onComp h (Comp gfa) = Comp (h gfa)
   
-- | Composition of type constructors: unary & binary.
+
instance (Functor g, Functor f) => Functor (Compose g f) where
newtype (f :.:: (~>)) a b = T_TT { runT_TT :: f (a ~> b) }
+
fmap h (Comp gf) = Comp (fmap (fmap h) gf)
   
instance (Applicative f, Arrow (~>)) => Arrow (f :.:: (~>)) where
+
instance (Applicative g, Applicative f) => Applicative (Compose g f) where
arr = T_TT . pure . arr
+
pure = Comp . pure . pure
T_TT g >>> T_TT h = T_TT (liftA2 (>>>) g h)
+
Comp getf <*> Comp getx = Comp (liftA2 (<*>) getf getx)
first (T_TT g) = T_TT (liftA first g)
 
   
-- For instance, /\ a b. f (a -> m b) =~ f :.:: Kleisli m
+
-- instance (Functor g, Cofunctor f) => Cofunctor (Compose g f) where
  +
-- cofmap h (Comp gf) = Comp (fmap (cofmap h) gf)
   
  +
-- Or this alternative. Having both yields "Duplicate instance
  +
-- declarations".
  +
instance (Cofunctor g, Functor f) => Cofunctor (Compose g f) where
  +
cofmap h (Comp gf) = Comp (cofmap (fmap h) gf)
  +
  +
  +
  +
-- standard Monoid instance for Applicative applied to Monoid
  +
instance (Applicative (Compose g f), Monoid a) => Monoid (Compose g f a) where
  +
{ mempty = pure mempty; mappend = (*>) }
  +
  +
-- | Composition of type constructors: unary with binary.
  +
newtype StaticArrow f (~>) a b = Static { unStatic :: f (a ~> b) }
  +
  +
instance (Applicative f, Arrow (~>)) => Arrow (StaticArrow f (~>)) where
  +
arr = Static . pure . arr
  +
Static g >>> Static h = Static (liftA2 (>>>) g h)
  +
first (Static g) = Static (liftA first g)
  +
  +
-- For instance, /\ a b. f (a -> m b) =~ StaticArrow f Kleisli m
  +
  +
  +
-- | Composition of type constructors: binary with unary.
  +
  +
newtype ArrowAp (~>) f a b = ArrowAp {unArrowAp :: f a ~> f b}
  +
  +
instance (Arrow (~>), Applicative f) => Arrow (ArrowAp (~>) f) where
  +
arr = ArrowAp . arr . liftA
  +
ArrowAp g >>> ArrowAp h = ArrowAp (g >>> h)
  +
first (ArrowAp a) =
  +
ArrowAp (arr splitA >>> first a >>> arr mergeA)
  +
  +
instance (ArrowLoop (~>), Applicative f) => ArrowLoop (ArrowAp (~>) f) where
  +
-- loop :: UI (b,d) (c,d) -> UI b c
  +
loop (ArrowAp k) =
  +
ArrowAp (loop (arr mergeA >>> k >>> arr splitA))
   
-- | Composition of type constructors: unary & binary.
 
 
-- Wolfgang Jeltsch pointed out a problem with these definitions: 'splitA'
 
-- Wolfgang Jeltsch pointed out a problem with these definitions: 'splitA'
 
-- and 'mergeA' are not inverses. The definition of 'first', e.g.,
 
-- and 'mergeA' are not inverses. The definition of 'first', e.g.,
Line 44: Line 87:
 
-- a reformulation or a clarification of required properties of the
 
-- a reformulation or a clarification of required properties of the
 
-- applicative functor @f@.
 
-- applicative functor @f@.
  +
--
  +
-- See also "Arrows and Computation", which notes that the following type
  +
-- is "almost an arrow" (http://www.soi.city.ac.uk/~ross/papers/fop.html).
  +
--
  +
-- > newtype ListMap i o = LM ([i] -> [o])
   
newtype ((~>) ::.: f) a b = TT_T {runTT_T :: f a ~> f b}
+
mergeA :: Applicative f => (f a, f b) -> f (a,b)
  +
mergeA ~(fa,fb) = liftA2 (,) fa fb
   
instance (Arrow (~>), Applicative f) => Arrow ((~>) ::.: f) where
+
splitA :: Applicative f => f (a,b) -> (f a, f b)
arr = TT_T . arr . liftA
+
splitA fab = (liftA fst fab, liftA snd fab)
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)
+
-- | Flip type arguments
splitA m = (liftA fst m, liftA snd m)
+
newtype Flip (~>) b a = Flip (a ~> b)
   
  +
instance Arrow (~>) => Cofunctor (Flip (~>) b) where
  +
cofmap h (Flip f) = Flip (arr h >>> f)
   
   
 
-- | Type application
 
-- | Type application
newtype App f a = App { runApp :: f a }
+
newtype App f a = App { unApp :: f a }
   
 
-- Example: App IO ()
 
-- Example: App IO ()
Line 71: Line 119:
 
instance (Applicative f, Monoid a) => Monoid (f a) where
 
instance (Applicative f, Monoid a) => Monoid (f a) where
 
mempty = pure mempty
 
mempty = pure mempty
a `mappend` b = a *> b
+
mappend = (*>)
 
-}
 
-}
   

Latest revision as of 19:57, 21 March 2007

[edit] 1 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)

[edit] 2 Code

{-# OPTIONS -fglasgow-exts -cpp #-}
 
----------------------------------------------------------------------
-- Various type constructor compositions and instances for them.
-- References:
-- [1] \"Applicative Programming with Effects\"
-- <http://www.soi.city.ac.uk/~ross/papers/Applicative.html>
----------------------------------------------------------------------
 
module Control.Compose
  ( Cofunctor(..)
  , Compose(..), onComp
  , StaticArrow(..)
  , Flip(..)
  , ArrowAp(..)
  , App(..)
  ) where
 
import Control.Applicative
import Control.Arrow hiding (pure)
import Data.Monoid
 
-- | Often useful for /acceptors/ (consumers, sinks) of values.
class Cofunctor acc where
  cofmap :: (a -> b) -> (acc b -> acc a)
 
 
-- | Composition of type constructors: unary & unary.  Called \"g . f\" in
-- [1], section 5, but GHC won't parse that, nor will it parse any infix
-- type operators in an export list.  Haddock won't parse any type infixes
-- at all.
newtype Compose g f a = Comp { unComp :: g (f a) }
 
-- | Apply a function within the 'Comp' constructor.
onComp :: (g (f a) -> g' (f' a')) -> ((Compose g f) a -> (Compose g' f') a')
onComp h (Comp gfa) = Comp (h gfa)
 
instance (Functor g, Functor f) => Functor (Compose g f) where
  fmap h (Comp gf) = Comp (fmap (fmap h) gf)
 
instance (Applicative g, Applicative f) => Applicative (Compose g f) where
  pure                   = Comp . pure . pure
  Comp getf <*> Comp getx  = Comp (liftA2 (<*>) getf getx)
 
-- instance (Functor g, Cofunctor f) => Cofunctor (Compose g f) where
--   cofmap h (Comp gf) = Comp (fmap (cofmap h) gf)
 
-- Or this alternative.  Having both yields "Duplicate instance
-- declarations".
instance (Cofunctor g, Functor f) => Cofunctor (Compose g f) where
  cofmap h (Comp gf) = Comp (cofmap (fmap h) gf)
 
 
 
-- standard Monoid instance for Applicative applied to Monoid
instance (Applicative (Compose g f), Monoid a) => Monoid (Compose g f a) where
  { mempty = pure mempty; mappend = (*>) }
 
-- | Composition of type constructors: unary with binary.
newtype StaticArrow f (~>) a b = Static { unStatic :: f (a ~> b) }
 
instance (Applicative f, Arrow (~>)) => Arrow (StaticArrow f (~>)) where
  arr                   = Static . pure . arr
  Static g >>> Static h = Static (liftA2 (>>>) g h)
  first (Static g)      = Static (liftA first g)
 
-- For instance, /\ a b. f (a -> m b) =~ StaticArrow f Kleisli m
 
 
-- | Composition of type constructors: binary with unary.
 
newtype ArrowAp (~>) f a b = ArrowAp {unArrowAp :: f a ~> f b}
 
instance (Arrow (~>), Applicative f) => Arrow (ArrowAp (~>) f) where
  arr                     = ArrowAp . arr . liftA
  ArrowAp g >>> ArrowAp h = ArrowAp (g >>> h)
  first (ArrowAp a)       =
    ArrowAp (arr splitA >>> first a >>> arr mergeA)
 
instance (ArrowLoop (~>), Applicative f) => ArrowLoop (ArrowAp (~>) f) where
  -- loop :: UI (b,d) (c,d) -> UI b c
  loop (ArrowAp k) =
    ArrowAp (loop (arr mergeA >>> k >>> arr splitA))
 
-- 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@.
-- 
-- See also "Arrows and Computation", which notes that the following type
-- is "almost an arrow" (http://www.soi.city.ac.uk/~ross/papers/fop.html).
-- 
-- > newtype ListMap i o = LM ([i] -> [o])
 
mergeA :: Applicative f => (f a, f b) -> f (a,b)
mergeA ~(fa,fb) = liftA2 (,) fa fb
 
splitA :: Applicative f => f (a,b) -> (f a, f b)
splitA fab = (liftA fst fab, liftA snd fab)
 
 
-- | Flip type arguments
newtype Flip (~>) b a = Flip (a ~> b)
 
instance Arrow (~>) => Cofunctor (Flip (~>) b) where
  cofmap h (Flip f) = Flip (arr h >>> f)
 
 
-- | Type application
newtype App f a = App { unApp :: 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
  mappend = (*>)
-}

[edit] 3 Comments