blob: 401c1d7784435b44720ef6fc606d10d7700896ee (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
|
{-# OPTIONS_GHC -fglasgow-exts #-}
module GFCC.ComposOp (Compos(..),composOp,composOpM,composOpM_,composOpMonoid,
composOpMPlus,composOpFold) where
import Control.Monad.Identity
import Data.Monoid
class Compos t where
compos :: (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b)
-> (forall a. t a -> m (t a)) -> t c -> m (t c)
composOp :: Compos t => (forall a. t a -> t a) -> t c -> t c
composOp f = runIdentity . composOpM (Identity . f)
composOpM :: (Compos t, Monad m) => (forall a. t a -> m (t a)) -> t c -> m (t c)
composOpM = compos return ap
composOpM_ :: (Compos t, Monad m) => (forall a. t a -> m ()) -> t c -> m ()
composOpM_ = composOpFold (return ()) (>>)
composOpMonoid :: (Compos t, Monoid m) => (forall a. t a -> m) -> t c -> m
composOpMonoid = composOpFold mempty mappend
composOpMPlus :: (Compos t, MonadPlus m) => (forall a. t a -> m b) -> t c -> m b
composOpMPlus = composOpFold mzero mplus
composOpFold :: Compos t => b -> (b -> b -> b) -> (forall a. t a -> b) -> t c -> b
composOpFold z c f = unC . compos (\_ -> C z) (\(C x) (C y) -> C (c x y)) (C . f)
newtype C b a = C { unC :: b }
|
