From 173d0ae876371a2156a34d30b781c43a54f121ae Mon Sep 17 00:00:00 2001 From: bringert Date: Sat, 20 Oct 2007 18:42:16 +0000 Subject: Added Compos instance generation to the haskell_gadt printer. Added GF.Data.Compos module which is imported by the code generated by haskell_gadt. --- src/GF/Data/Compos.hs | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) create mode 100644 src/GF/Data/Compos.hs (limited to 'src/GF/Data') diff --git a/src/GF/Data/Compos.hs b/src/GF/Data/Compos.hs new file mode 100644 index 000000000..f8e592bc1 --- /dev/null +++ b/src/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) \ No newline at end of file -- cgit v1.2.3