mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-30 14:52:51 -06:00
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
This commit is contained in:
30
src-3.0/tools/c/GFCC/ComposOp.hs
Normal file
30
src-3.0/tools/c/GFCC/ComposOp.hs
Normal file
@@ -0,0 +1,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 }
|
||||
Reference in New Issue
Block a user