# Type composition

### From HaskellWiki

(Difference between revisions)

m (→Code, first draft: simplified code in final comment) |
(→Code: added ref to ListMap in "Arrows and Computation") |
||

(8 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 () |

## 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 = (*>) -}