summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorConalElliott <>2007-03-30 20:10:14 (GMT)
committerLuite Stegeman <luite@luite.com>2007-03-30 20:10:14 (GMT)
commit9039eacb1a2fc176c3c7bd9c30de1c2465fdf206 (patch)
tree2894b164d58bb008050f9bae3e83a3177cfef77a
version 0.00.0
-rwxr-xr-xCHANGES1
-rwxr-xr-xMakefile7
-rwxr-xr-xREADME15
-rwxr-xr-xSetup.lhs3
-rwxr-xr-xTODO0
-rwxr-xr-xTypeCompose.cabal34
-rwxr-xr-xsrc/Control/Compose.hs133
-rwxr-xr-xsrc/Control/DataDriven.hs90
-rwxr-xr-xsrc/Control/Instances.hs33
9 files changed, 316 insertions, 0 deletions
diff --git a/CHANGES b/CHANGES
new file mode 100755
index 0000000..8b13789
--- /dev/null
+++ b/CHANGES
@@ -0,0 +1 @@
+
diff --git a/Makefile b/Makefile
new file mode 100755
index 0000000..8f1c794
--- /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 100755
index 0000000..db6056e
--- /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 100755
index 0000000..69b0ff1
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain \ No newline at end of file
diff --git a/TODO b/TODO
new file mode 100755
index 0000000..e69de29
--- /dev/null
+++ b/TODO
diff --git a/TypeCompose.cabal b/TypeCompose.cabal
new file mode 100755
index 0000000..0becceb
--- /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: <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/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 100755
index 0000000..1df5fbc
--- /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\"
+-- <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 . 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 100755
index 0000000..b8c05c7
--- /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 100755
index 0000000..0b9f70c
--- /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 }
+