Galculator

Blame information for rev 1

Line No.	Rev	Author	Line
1	1	paulosilva
2			{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
3			FlexibleInstances, UndecidableInstances, OverlappingInstances #-}
4			{-# OPTIONS_GHC -Wall #-}
5
6			-------------------------------------------------------------------------------
7
8			{- |
9			Module      :  Control.Monad.Fresh
10			Description :  Monad which provides an infinite set of values.
11			Copyright   :  (c) Paulo Silva
12			License     :  LGPL
13
14			Maintainer  :  paufil@di.uminho.pt
15			Stability   :  experimental
16			Portability :  portable
17
18			-}
19
20			-------------------------------------------------------------------------------
21
22			module Control.Monad.Fresh (
23			MonadFresh,
24			getFresh,
25			FreshT(..),
26			evalFreshT,
27			getFreshLift
28			) where
29
30			-------------------------------------------------------------------------------
31
32			import Control.Monad
33			import Control.Monad.Trans
34			import Data.Stream
35
36			-------------------------------------------------------------------------------
37
38			class (Monad m, Stream s v) => MonadFresh s v m | m -> s where
39			getFresh :: m v
40
41			-------------------------------------------------------------------------------
42
43			newtype FreshT s m a = FreshT {runFreshT :: s -> m (s, a)}
44
45			-------------------------------------------------------------------------------
46
47			instance Monad m => Functor (FreshT s m) where
48			fmap f (FreshT t) = FreshT $ \s -> do
49			(s', v') <- t s
50			return (s',f v')
51
52			-------------------------------------------------------------------------------
53
54			instance Monad m => Monad (FreshT s m) where
55			return v = FreshT $ \s -> return (s,v)
56			v >>= f = FreshT $ \s -> do
57			(s',v') <- runFreshT v s
58			runFreshT (f v') s'
59
60			-------------------------------------------------------------------------------
61
62			instance (Stream s v, Monad m) => MonadFresh s v (FreshT s m) where
63			getFresh = FreshT $ \s -> return (tailStr s, headStr s)
64
65			-------------------------------------------------------------------------------
66
67			instance MonadTrans (FreshT s) where
68			lift m = FreshT $ \s -> do
69			x <- m
70			return (s,x)
71
72			-------------------------------------------------------------------------------
73
74			instance MonadIO m => MonadIO (FreshT s m) where
75			liftIO = lift . liftIO
76
77			-------------------------------------------------------------------------------
78
79			instance (Monad (t m), MonadTrans t, MonadFresh s v m) => MonadFresh s v (t m) where
80			getFresh = lift getFresh
81
82			-------------------------------------------------------------------------------
83
84			evalFreshT :: Monad m => FreshT s m a -> s -> m a
85			evalFreshT m s = do
86			~(_,a) <- runFreshT m s
87			return a
88
89			-------------------------------------------------------------------------------
90
91			getFreshLift :: MonadFresh s v m => (v -> a) -> m a
92			getFreshLift f = liftM f getFresh
93			-------------------------------------------------------------------------------