init

darcs-hash:20070316193422-fb517-6036c65cf7afb6de2ad01c08f41355ac315acc0b.gz

CHANGES

@@ -0,0 +1 @@
+

Makefile

@@ -0,0 +1,7 @@
+# For special configuration, especially for docs.  Otherwise see README.
+
+haddock-interfaces=\
+  http://haskell.org/ghc/docs/latest/html/libraries/base,c:/ghc/ghc-6.6/doc/html/libraries/base/base.haddock \
+  http://haskell.org/ghc/docs/latest/html/libraries/mtl,c:/ghc/ghc-6.6/doc/html/libraries/mtl/mtl.haddock \
+
+include ../my-cabal-make.inc

README

@@ -0,0 +1,14 @@
+TypeCompose provides some classes & instances for forms of type
+composition.  See the description and link to documentation:
+
+  http://haskell.org/haskellwiki/TypeCompose
+
+Please share any comments & suggestions on the discussion (talk) page
+there.
+
+You can configure, build, and install all in the usual way with Cabal
+commands.
+
+  runhaskell Setup.lhs configure
+  runhaskell Setup.lhs build
+  runhaskell Setup.lhs install

Setup.lhs

@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain

TypeCompose.cabal

@@ -0,0 +1,34 @@
+Name:                TypeCompose
+Version:             0.0
+Synopsis: 	     Type composition classes & instances
+Category:            Composition, Control
+Description:
+  TypeCompose provides some classes & instances for forms of type
+  composition.  Bonus: a very simple implementation of data-driven
+  computation.
+  .
+  See also
+  .
+  * The project wiki page: <http://haskell.org/haskellwiki/TypeCompose>
+  .
+  * Use of TypeCompose in Phooey: <http://haskell.org/haskellwiki/Phooey>
+  .
+  The module documentation pages have links to colorized source code and
+  to wiki pages where you can read and contribute /user comments/.  Enjoy!
+  .
+  &#169; 2007 by Conal Elliott; BSD3 license.
+Author:              Conal Elliott 
+Maintainer:          conal@conal.net
+Homepage:            http://haskell.org/haskellwiki/TypeCmpose
+Copyright:           (c) 2007 by Conal Elliott
+License:             BSD3
+Stability:           provisional
+Hs-Source-Dirs:      src
+Extensions:          CPP, Arrows, UndecidableInstances
+Build-Depends:       base, mtl
+Exposed-Modules:     
+                     Control.Instances
+                     Control.Compose
+                     Control.DataDriven
+Extra-Source-Files:
+ghc-options:         -O -Wall

src/Control/Compose.hs

@@ -0,0 +1,128 @@
+{-# OPTIONS -fglasgow-exts -cpp #-}
+
+----------------------------------------------------------------------
+-- |
+-- 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.
+-- 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@.
+
+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 = (*>)
+-}

src/Control/DataDriven.hs

@@ -0,0 +1,90 @@
+{-# OPTIONS -fglasgow-exts #-}
+
+----------------------------------------------------------------------
+-- |
+-- Module      :  Control.DataDriven
+-- Copyright   :  (c) Conal Elliott 2007
+-- License     :  LGPL
+-- 
+-- Maintainer  :  conal@conal.net
+-- Stability   :  experimental
+-- Portability :  portable
+-- 
+-- Data-driven computations
+----------------------------------------------------------------------
+
+module Control.DataDriven
+  (
+  -- * Plumbing for \"events\" and subscription 
+    Sink, Updater, News
+  -- * Data-driven computations
+  , DataDrivenG, dd, mapSrc
+  , DataDriven, runDD, joinDD
+  ) where
+
+import Control.Applicative
+import Control.Monad (join)
+import Control.Arrow (second)
+
+import Data.Monoid
+
+import Control.Compose
+
+
+{----------------------------------------------------------
+    Plumbing for event publishing
+----------------------------------------------------------}
+
+-- | Sinks (consumers) of values
+type Sink src a = a -> Updater src
+
+-- | Updaters (actions)
+type Updater src = src ()
+
+-- | News publisher -- somewhere to register updaters to be executed
+-- when events occur.
+type News src = Sink src (Updater src)
+
+
+{----------------------------------------------------------
+    Data-driven computations
+----------------------------------------------------------}
+
+-- | The general type of data-driven computations.  Represented as a
+-- /news/ publisher (@news@) and a source of new values (@src@).  Clients
+-- interested in the value subscribe to @news@ and extract a new value
+-- from @src@ when notified that the value may have changed.  When @news@
+-- is a monoid and @src@ is an applicative functor, @DataDriven news src@
+-- is an applicative functor also.  The applicative property is very
+-- convenient for composition.  See the more specific type 'DataDriven'.
+
+type DataDrivenG news src = Compose ((,) news) src
+
+-- | Construct a data-driven computation from a subscription service
+-- (@Monoid@) and a value source subscriber (@Applicative@).
+dd :: news -> src a -> DataDrivenG news src a
+dd = curry Comp
+
+-- | Modify the source part of a 'DataDriven' computation.
+mapSrc :: (src a -> src b) -> (DataDrivenG news src a -> DataDrivenG news src b)
+mapSrc f = onComp (second f)
+
+
+-- | Data driven with news publisher
+type DataDriven src = DataDrivenG (News src) src
+
+
+-- | Run a unit-valued 'DataDriven' computation.  Causes the source to be
+-- executed /and/ registered with the subscriber.
+runDD :: (Monoid (Updater src), Applicative src)
+      => DataDriven src () -> Updater src
+runDD (Comp (news,src)) = news src `mappend` src
+
+-- | Apply 'join' to a source
+joinDD :: Monad src => DataDriven src (src a) -> DataDriven src a
+joinDD = mapSrc join
+
+-- runDDJoin :: (Monad src, Applicative src, Monoid (Updater src))
+--           => DataDriven src (Updater src) -> Updater src
+-- runDDJoin = runDD . joinDD
+

src/Control/Instances.hs

@@ -0,0 +1,33 @@
+{-# OPTIONS #-}
+
+----------------------------------------------------------------------
+-- |
+-- Module      :  Control.Instances
+-- Copyright   :  (c) Conal Elliott 2007
+-- License     :  LGPL
+-- 
+-- Maintainer  :  conal@conal.net
+-- Stability   :  experimental
+-- Portability :  portable
+-- 
+-- Some (orphan) instances that belong elsewhere (where they wouldn't be orphans).
+-- Add the following line to get these instances
+-- 
+-- > import Control.Instances ()
+-- 
+----------------------------------------------------------------------
+
+module Control.Instances () where
+
+import Data.Monoid
+import Control.Applicative
+import Control.Monad.Reader
+import Control.Monad
+
+
+-- Standard instance: Applicative functor applied to monoid
+instance Monoid a => Monoid (IO a) where { mempty = pure mempty; mappend = (*>) }
+
+-- standard Applicative instance for Monad
+instance Monad m => Applicative (ReaderT r m) where { pure = return; (<*>) = ap }
+