GF/src is now for 2.9, and the new sources are in src-3.0 - keep it this way until the release of GF 3

1 files changed, 37 insertions, 0 deletions

diff --git a/src-3.0/GF/Data/Compos.hs b/src-3.0/GF/Data/Compos.hs
new file mode 100644
index 000000000..7d46fc5a2
--- /dev/null
+++ b/src-3.0/GF/Data/Compos.hs
@@ -0,0 +1,37 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+module GF.Data.Compos (Compos(..),composOp,composM,composM_,composFold) where
+
+import Control.Applicative (Applicative(..), Const(..), WrappedMonad(..))
+import Data.Monoid (Monoid(..))
+
+class Compos t where
+  compos :: Applicative f => (forall a. t a -> f (t a)) -> t c -> f (t c)
+
+composOp :: Compos t => (forall a. t a -> t a) -> t c -> t c
+composOp f = runIdentity . compos (Identity . f)
+
+composFold :: (Monoid o, Compos t) => (forall a. t a -> o) -> t c -> o
+composFold f = getConst . compos (Const . f)
+
+composM :: (Compos t, Monad m) => (forall a. t a -> m (t a)) -> t c -> m (t c)
+composM f = unwrapMonad . compos (WrapMonad . f)
+
+composM_ :: (Compos t, Monad m) => (forall a. t a -> m ()) -> t c -> m ()
+composM_ f = unwrapMonad_ . composFold (WrapMonad_ . f)
+
+
+newtype Identity a = Identity { runIdentity :: a }
+
+instance Functor Identity where
+  fmap f (Identity x) = Identity (f x)
+
+instance Applicative Identity where
+  pure                       = Identity
+  Identity f <*> Identity x  = Identity (f x)
+
+
+newtype WrappedMonad_ m = WrapMonad_ { unwrapMonad_ :: m () }
+
+instance Monad m => Monoid (WrappedMonad_ m) where
+  mempty  = WrapMonad_ (return ())
+  WrapMonad_ x `mappend` WrapMonad_ y = WrapMonad_  (x >> y)