Added Apply and Bind.

Author: joneshf

src/Control/Apply.purs

@@ -0,0 +1,24 @@
+module Control.Apply where
+
+  -- This should currently replace everything in Control.Applicative.
+  -- Ideally it would be its superclass.
+
+  infixl 4 <.
+  infixl 4 .>
+
+  -- This should be a subclass of Functor.
+  class Apply f where
+    -- Until we get default implementations, use `<.>` as `<*>`
+    (<.>) :: forall a b. (Functor f) => f (a -> b) -> f a -> f b
+
+  (<.) :: forall a b f. (Apply f, Functor f) => f a -> f b -> f a
+  (<.) a b = const <$> a <.> b
+
+  (.>) :: forall a b f. (Apply f, Functor f) => f a -> f b -> f b
+  (.>) a b = const id <$> a <.> b
+
+  lift2 :: forall a b c f. (Apply f, Functor f) => (a -> b -> c) -> f a -> f b -> f c
+  lift2 f a b = f <$> a <.> b
+
+  lift3 :: forall a b c d f. (Apply f, Functor f) => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
+  lift3 f a b c = f <$> a <.> b <.> c

src/Control/Bind.purs

@@ -0,0 +1,34 @@
+module Control.Bind where
+
+  -- This should replace most things in Control.Monad.
+  -- Ideally it would be its superclass.
+
+  infixl 1 >>-
+
+  import Control.Apply
+
+  -- This should be a subclass of Apply
+  class Bind m where
+    -- We should be able to provide either one of these and derive the other.
+    (>>-) :: forall a b. (Apply m) => m a -> (a -> m b) -> m b
+    -- (>>-) m f = join (f <$> m)
+    join :: forall a. (Apply m) => m (m a) -> m a
+    -- join m = m >>- id
+
+  instance applyFromBind :: (Bind m) => Apply m where
+    (<.>) f a = f >>- \f' -> f' <$> a
+
+  (-<<) :: forall a b m. (Apply m, Bind m) => (a -> m b) -> m a -> m b
+  (-<<) f m = m >>- f
+
+  (>->) :: forall a b c m. (Apply m, Bind m) => (a -> m b) -> (b -> m c) -> a -> m c
+  (>->) f g a = f a >>- g
+
+  (<-<) :: forall a b c m. (Apply m, Bind m) => (b -> m c) -> (a -> m b) -> a -> m c
+  (<-<) f g a = f -<< g a
+
+  ifM :: forall a m. (Apply m, Bind m) => m Boolean -> m a -> m a -> m a
+  ifM cond t f = cond >>- \cond' -> if cond' then t else f
+
+  forever :: forall a b m. (Apply m, Functor m, Bind m) => m a -> m b
+  forever a = a .> forever a