89 lines
3 KiB
Diff
89 lines
3 KiB
Diff
diff -ru3 IOSpec-0.2.5-old/src/Test/IOSpec/STM.hs IOSpec-0.2.5/src/Test/IOSpec/STM.hs
|
|
--- IOSpec-0.2.5-old/src/Test/IOSpec/STM.hs 2015-04-17 21:32:51.062498481 +0300
|
|
+++ IOSpec-0.2.5/src/Test/IOSpec/STM.hs 2015-04-17 21:39:50.451032159 +0300
|
|
@@ -23,6 +23,7 @@
|
|
import Data.Dynamic
|
|
import Data.Maybe (fromJust)
|
|
import Control.Monad.State
|
|
+import Control.Monad (ap)
|
|
|
|
-- The 'STMS' data type and its instances.
|
|
--
|
|
@@ -67,14 +68,18 @@
|
|
fmap _ Retry = Retry
|
|
fmap f (OrElse io1 io2) = OrElse (fmap f io1) (fmap f io2)
|
|
|
|
+instance Applicative STM where
|
|
+ pure = STMReturn
|
|
+ (<*>) = ap
|
|
+
|
|
instance Monad STM where
|
|
- return = STMReturn
|
|
- STMReturn a >>= f = f a
|
|
- NewTVar d g >>= f = NewTVar d (\l -> g l >>= f)
|
|
- ReadTVar l g >>= f = ReadTVar l (\d -> g d >>= f)
|
|
- WriteTVar l d p >>= f = WriteTVar l d (p >>= f)
|
|
- Retry >>= _ = Retry
|
|
- OrElse p q >>= f = OrElse (p >>= f) (q >>= f)
|
|
+ return = STMReturn
|
|
+ STMReturn a >>= f = f a
|
|
+ NewTVar d g >>= f = NewTVar d (\l -> g l >>= f)
|
|
+ ReadTVar l g >>= f = ReadTVar l (\d -> g d >>= f)
|
|
+ WriteTVar l d p >>= f = WriteTVar l d (p >>= f)
|
|
+ Retry >>= _ = Retry
|
|
+ OrElse p q >>= f = OrElse (p >>= f) (q >>= f)
|
|
|
|
-- | A 'TVar' is a shared, mutable variable used by STM.
|
|
newtype TVar a = TVar Loc
|
|
diff -ru3 IOSpec-0.2.5-old/src/Test/IOSpec/Types.hs IOSpec-0.2.5/src/Test/IOSpec/Types.hs
|
|
--- IOSpec-0.2.5-old/src/Test/IOSpec/Types.hs 2015-04-17 21:32:51.062498481 +0300
|
|
+++ IOSpec-0.2.5/src/Test/IOSpec/Types.hs 2015-04-17 21:37:02.306575081 +0300
|
|
@@ -15,6 +15,8 @@
|
|
, inject
|
|
) where
|
|
|
|
+import Control.Monad (ap)
|
|
+
|
|
-- | A value of type 'IOSpec' @f@ @a@ is either a pure value of type @a@
|
|
-- or some effect, determined by @f@. Crucially, 'IOSpec' @f@ is a
|
|
-- monad, provided @f@ is a functor.
|
|
@@ -26,6 +28,10 @@
|
|
fmap f (Pure x) = Pure (f x)
|
|
fmap f (Impure t) = Impure (fmap (fmap f) t)
|
|
|
|
+instance (Functor f) => Applicative (IOSpec f) where
|
|
+ pure = Pure
|
|
+ (<*>) = ap
|
|
+
|
|
instance (Functor f) => Monad (IOSpec f) where
|
|
return = Pure
|
|
(Pure x) >>= f = f x
|
|
@@ -61,4 +67,4 @@
|
|
inj = Inr . inj
|
|
|
|
inject :: (g :<: f) => g (IOSpec f a) -> IOSpec f a
|
|
-inject = Impure . inj
|
|
\ No newline at end of file
|
|
+inject = Impure . inj
|
|
diff -ru3 IOSpec-0.2.5-old/src/Test/IOSpec/VirtualMachine.hs IOSpec-0.2.5/src/Test/IOSpec/VirtualMachine.hs
|
|
--- IOSpec-0.2.5-old/src/Test/IOSpec/VirtualMachine.hs 2015-04-17 21:32:51.062498481 +0300
|
|
+++ IOSpec-0.2.5/src/Test/IOSpec/VirtualMachine.hs 2015-04-17 21:39:47.222044580 +0300
|
|
@@ -43,6 +43,7 @@
|
|
import qualified Data.Stream as Stream
|
|
import Test.IOSpec.Types
|
|
import Test.QuickCheck
|
|
+import Control.Monad (ap)
|
|
|
|
type Data = Dynamic
|
|
type Loc = Int
|
|
@@ -211,6 +212,10 @@
|
|
fmap f (Print c t) = Print c (fmap f t)
|
|
fmap _ (Fail msg) = Fail msg
|
|
|
|
+instance Applicative Effect where
|
|
+ pure = Done
|
|
+ (<*>) = ap
|
|
+
|
|
instance Monad Effect where
|
|
return = Done
|
|
(Done x) >>= f = f x
|