diff --git a/CHANGES b/CHANGES new file mode 100644 --- /dev/null +++ b/CHANGES @@ -0,0 +1,1 @@ + diff --git a/Makefile b/Makefile new file mode 100644 --- /dev/null +++ b/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 diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,15 @@ +TypeCompose provides some classes & instances for forms of type +composition. It also includes a very simple implementation of data-driven +computation. 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 diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/TODO b/TODO new file mode 100644 --- /dev/null +++ b/TODO diff --git a/TypeCompose.cabal b/TypeCompose.cabal new file mode 100644 --- /dev/null +++ b/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: + . + * Use of TypeCompose in Phooey: + . + The module documentation pages have links to colorized source code and + to wiki pages where you can read and contribute /user comments/. Enjoy! + . + © 2007 by Conal Elliott; BSD3 license. +Author: Conal Elliott +Maintainer: conal@conal.net +Homepage: http://haskell.org/haskellwiki/TypeCompose +Copyright: (c) 2007 by Conal Elliott +License: BSD3 +Stability: provisional +Hs-Source-Dirs: src +Extensions: +Build-Depends: base, mtl +Exposed-Modules: + Control.Instances + Control.Compose + Control.DataDriven +Extra-Source-Files: +ghc-options: -O -Wall diff --git a/src/Control/Compose.hs b/src/Control/Compose.hs new file mode 100644 --- /dev/null +++ b/src/Control/Compose.hs @@ -0,0 +1,133 @@ +{-# 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. +-- References: +-- [1] \"Applicative Programming with Effects\" +-- +---------------------------------------------------------------------- + +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 . h . unComp + +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 = (*>) +-} diff --git a/src/Control/DataDriven.hs b/src/Control/DataDriven.hs new file mode 100644 --- /dev/null +++ b/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 + diff --git a/src/Control/Instances.hs b/src/Control/Instances.hs new file mode 100644 --- /dev/null +++ b/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 } +