STMonadTrans 0.4.3 → 0.4.4

raw patch · 6 files changed

+161/−91 lines, 6 filesdep +faildep +tastydep +tasty-hunitdep −Cabaldep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: fail, tasty, tasty-hunit, tasty-quickcheck, transformers

Dependencies removed: Cabal

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Control/Monad/ST/Trans.hs +52/−25
• Control/Monad/ST/Trans/Internal.hs +25/−20
• STMonadTrans.cabal +25/−9
• changelog.md +5/−0
• test/Main.hs +54/−0
• test/Test.hs +0/−37

@@ -1,5 +1,4 @@-{-# LANGUAGE CPP, MagicHash, UnboxedTuples, Rank2Types, FlexibleInstances,-    MultiParamTypeClasses, UndecidableInstances, RecursiveDo #-}+{-# LANGUAGE CPP, MagicHash, Rank2Types #-} {- |    Module      :  Control.Monad.ST.Trans    Copyright   :  Josef Svenningsson 2008-2017@@ -53,17 +52,19 @@       )where  import GHC.Base-import GHC.Arr (Ix(..), safeRangeSize, safeIndex, -                Array(..), arrEleBottom)+import GHC.Arr (Ix(..), Array(..)) import qualified GHC.Arr as STArray  import Data.STRef (STRef) import qualified Data.STRef as STRef  import Data.Array.ST hiding (runSTArray)-import qualified Data.Array.ST as STArray+--import qualified Data.Array.ST as STArray +#if __GLASGOW_HASKELL__ <= 708 import Control.Applicative+#endif+ import Control.Monad.ST.Trans.Internal  import Data.IORef@@ -71,24 +72,19 @@ import Unsafe.Coerce import System.IO.Unsafe -#if __GLASGOW_HASKELL__ < 708-isTrue# :: Bool -> Bool-isTrue# x = x-#endif- {-# INLINE newSTRef #-} -- | Create a new reference-newSTRef :: (Applicative m, Monad m) => a -> STT s m (STRef s a)-newSTRef init = liftST (STRef.newSTRef init)+newSTRef :: (Applicative m) => a -> STT s m (STRef s a)+newSTRef i = liftST (STRef.newSTRef i)  {-# INLINE readSTRef #-} -- | Reads the value of a reference-readSTRef :: (Applicative m, Monad m) => STRef s a -> STT s m a+readSTRef :: (Applicative m) => STRef s a -> STT s m a readSTRef ref = liftST (STRef.readSTRef ref)  {-# INLINE writeSTRef #-} -- | Modifies the value of a reference-writeSTRef :: (Applicative m, Monad m) => STRef s a -> a -> STT s m ()+writeSTRef :: (Applicative m) => STRef s a -> a -> STT s m () writeSTRef ref a = liftST (STRef.writeSTRef ref a)  {-# DEPRECATED runST "Use runSTT instead" #-}@@ -111,9 +107,9 @@  {-# INLINE newSTArray #-} -- | Creates a new mutable array-newSTArray :: (Ix i, Applicative m, Monad m) =>+newSTArray :: (Ix i, Applicative m) =>               (i,i) -> e -> STT s m (STArray s i e)-newSTArray bounds init = liftST (newArray bounds init)+newSTArray bnds i = liftST (newArray bnds i)  {-# INLINE boundsSTArray #-} -- | Returns the lowest and highest indices of the array@@ -127,45 +123,69 @@  {-# INLINE readSTArray #-} -- | Retrieves an element from the array-readSTArray :: (Ix i, Applicative m, Monad m) =>+readSTArray :: (Ix i, Applicative m) =>                STArray s i e -> i -> STT s m e readSTArray arr i = liftST (readArray arr i)  {-# INLINE unsafeReadSTArray #-}-unsafeReadSTArray :: (Ix i, Applicative m, Monad m) =>+unsafeReadSTArray :: (+#if __GLASGOW_HASKELL__ <= 710+    Ix i,+#endif+    Applicative m) =>                      STArray s i e -> Int -> STT s m e unsafeReadSTArray arr i = liftST (STArray.unsafeReadSTArray arr i)  {-# INLINE writeSTArray #-} -- | Modifies an element in the array-writeSTArray :: (Ix i, Applicative m, Monad m) =>+writeSTArray :: (Ix i, Applicative m) =>                 STArray s i e -> i -> e -> STT s m () writeSTArray arr i e = liftST (writeArray arr i e)  {-# INLINE unsafeWriteSTArray #-}-unsafeWriteSTArray :: (Ix i, Applicative m, Monad m) =>+unsafeWriteSTArray :: (+#if __GLASGOW_HASKELL__ <= 710+    Ix i,+#endif+  Applicative m) =>                       STArray s i e -> Int -> e -> STT s m () unsafeWriteSTArray arr i e = liftST (STArray.unsafeWriteSTArray arr i e)  {-# INLINE freezeSTArray #-} -- | Copy a mutable array and turn it into an immutable array-freezeSTArray :: (Ix i, Applicative m, Monad m) =>+freezeSTArray :: (+#if __GLASGOW_HASKELL__ <= 710+    Ix i,+#endif+  Applicative m) =>                  STArray s i e -> STT s m (Array i e) freezeSTArray arr = liftST (STArray.freezeSTArray arr)  {-# INLINE unsafeFreezeSTArray #-}-unsafeFreezeSTArray :: (Ix i, Applicative m, Monad m) =>+unsafeFreezeSTArray :: (+#if __GLASGOW_HASKELL__ <= 710+    Ix i,+#endif+  Applicative m) =>                        STArray s i e -> STT s m (Array i e) unsafeFreezeSTArray arr = liftST (STArray.unsafeFreezeSTArray arr)  {-# INLINE thawSTArray #-} -- | Copy an immutable array and turn it into a mutable array-thawSTArray :: (Ix i, Applicative m, Monad m) =>+thawSTArray :: (+#if __GLASGOW_HASKELL__ <= 710+    Ix i,+#endif+  Applicative m) =>                Array i e -> STT s m (STArray s i e) thawSTArray arr = liftST (STArray.thawSTArray arr)  {-# INLINE unsafeThawSTArray #-}-unsafeThawSTArray :: (Ix i, Applicative m, Monad m) =>+unsafeThawSTArray :: (+#if __GLASGOW_HASKELL__ <= 710+    Ix i,+#endif+  Applicative m) =>                      Array i e -> STT s m (STArray s i e) unsafeThawSTArray arr = liftST (STArray.unsafeThawSTArray arr) @@ -173,7 +193,14 @@ -- | A safe way to create and work with a mutable array before returning an -- immutable array for later perusal.  This function avoids copying -- the array before returning it.-runSTArray :: (Ix i, Applicative m, Monad m)+runSTArray :: (+#if __GLASGOW_HASKELL__ <= 710+  Ix i,+#endif+#if __GLASGOW_HASKELL__ <= 708+  Applicative m,+#endif+  Monad m)            => (forall s . STT s m (STArray s i e))            -> m (Array i e) runSTArray st = runSTT (st >>= unsafeFreezeSTArray)

@@ -26,6 +26,7 @@ import GHC.Base import GHC.ST hiding (liftST) +import qualified Control.Monad.Fail as MF import Control.Monad.Fix import Control.Monad.Trans import Control.Monad.Error.Class@@ -33,12 +34,14 @@ import Control.Monad.State.Class import Control.Monad.Writer.Class +#if __GLASGOW_HASKELL__ <= 708 import Control.Applicative+#endif  import Data.Array.ST import Data.Array.Base-import GHC.Int    (Int8,  Int16,  Int32,  Int64)-import GHC.Word   (Word8, Word16, Word32, Word64)+import GHC.Int    (      Int8,  Int16,  Int32,  Int64)+import GHC.Word   (Word, Word8, Word16, Word32, Word64) import GHC.Ptr    (Ptr, FunPtr) import GHC.Stable (StablePtr) @@ -69,6 +72,8 @@        case ret of          STTRet new_st a ->               unSTT (k a) new_st++instance MF.MonadFail m => MF.MonadFail (STT s m) where   fail msg = lift (fail msg)  instance MonadTrans (STT s) where@@ -127,7 +132,7 @@     {-# INLINE getNumElements #-}     getNumElements arr = liftST (getNumElements arr)     {-# INLINE newArray #-}-    newArray bounds e = liftST (newArray bounds e)+    newArray bnds e = liftST (newArray bnds e)     {-# INLINE unsafeRead #-}     unsafeRead arr i = liftST (unsafeRead arr i)     {-# INLINE unsafeWrite #-}@@ -139,7 +144,7 @@     {-# INLINE getNumElements #-}     getNumElements arr = liftST (getNumElements arr)     {-# INLINE newArray #-}-    newArray bounds e = liftST (newArray bounds e)+    newArray bnds e = liftST (newArray bnds e)     {-# INLINE unsafeRead #-}     unsafeRead arr i = liftST (unsafeRead arr i)     {-# INLINE unsafeWrite #-}@@ -151,7 +156,7 @@     {-# INLINE getNumElements #-}     getNumElements arr = liftST (getNumElements arr)     {-# INLINE newArray #-}-    newArray bounds e = liftST (newArray bounds e)+    newArray bnds e = liftST (newArray bnds e)     {-# INLINE unsafeRead #-}     unsafeRead arr i = liftST (unsafeRead arr i)     {-# INLINE unsafeWrite #-}@@ -163,7 +168,7 @@     {-# INLINE getNumElements #-}     getNumElements arr = liftST (getNumElements arr)     {-# INLINE newArray #-}-    newArray bounds e = liftST (newArray bounds e)+    newArray bnds e = liftST (newArray bnds e)     {-# INLINE unsafeRead #-}     unsafeRead arr i = liftST (unsafeRead arr i)     {-# INLINE unsafeWrite #-}@@ -175,7 +180,7 @@     {-# INLINE getNumElements #-}     getNumElements arr = liftST (getNumElements arr)     {-# INLINE newArray #-}-    newArray bounds e = liftST (newArray bounds e)+    newArray bnds e = liftST (newArray bnds e)     {-# INLINE unsafeRead #-}     unsafeRead arr i = liftST (unsafeRead arr i)     {-# INLINE unsafeWrite #-}@@ -187,7 +192,7 @@     {-# INLINE getNumElements #-}     getNumElements arr = liftST (getNumElements arr)     {-# INLINE newArray #-}-    newArray bounds e = liftST (newArray bounds e)+    newArray bnds e = liftST (newArray bnds e)     {-# INLINE unsafeRead #-}     unsafeRead arr i = liftST (unsafeRead arr i)     {-# INLINE unsafeWrite #-}@@ -199,7 +204,7 @@     {-# INLINE getNumElements #-}     getNumElements arr = liftST (getNumElements arr)     {-# INLINE newArray #-}-    newArray bounds e = liftST (newArray bounds e)+    newArray bnds e = liftST (newArray bnds e)     {-# INLINE unsafeRead #-}     unsafeRead arr i = liftST (unsafeRead arr i)     {-# INLINE unsafeWrite #-}@@ -211,7 +216,7 @@     {-# INLINE getNumElements #-}     getNumElements arr = liftST (getNumElements arr)     {-# INLINE newArray #-}-    newArray bounds e = liftST (newArray bounds e)+    newArray bnds e = liftST (newArray bnds e)     {-# INLINE unsafeRead #-}     unsafeRead arr i = liftST (unsafeRead arr i)     {-# INLINE unsafeWrite #-}@@ -223,7 +228,7 @@     {-# INLINE getNumElements #-}     getNumElements arr = liftST (getNumElements arr)     {-# INLINE newArray #-}-    newArray bounds e = liftST (newArray bounds e)+    newArray bnds e = liftST (newArray bnds e)     {-# INLINE unsafeRead #-}     unsafeRead arr i = liftST (unsafeRead arr i)     {-# INLINE unsafeWrite #-}@@ -235,7 +240,7 @@     {-# INLINE getNumElements #-}     getNumElements arr = liftST (getNumElements arr)     {-# INLINE newArray #-}-    newArray bounds e = liftST (newArray bounds e)+    newArray bnds e = liftST (newArray bnds e)     {-# INLINE unsafeRead #-}     unsafeRead arr i = liftST (unsafeRead arr i)     {-# INLINE unsafeWrite #-}@@ -247,7 +252,7 @@     {-# INLINE getNumElements #-}     getNumElements arr = liftST (getNumElements arr)     {-# INLINE newArray #-}-    newArray bounds e = liftST (newArray bounds e)+    newArray bnds e = liftST (newArray bnds e)     {-# INLINE unsafeRead #-}     unsafeRead arr i = liftST (unsafeRead arr i)     {-# INLINE unsafeWrite #-}@@ -259,7 +264,7 @@     {-# INLINE getNumElements #-}     getNumElements arr = liftST (getNumElements arr)     {-# INLINE newArray #-}-    newArray bounds e = liftST (newArray bounds e)+    newArray bnds e = liftST (newArray bnds e)     {-# INLINE unsafeRead #-}     unsafeRead arr i = liftST (unsafeRead arr i)     {-# INLINE unsafeWrite #-}@@ -271,7 +276,7 @@     {-# INLINE getNumElements #-}     getNumElements arr = liftST (getNumElements arr)     {-# INLINE newArray #-}-    newArray bounds e = liftST (newArray bounds e)+    newArray bnds e = liftST (newArray bnds e)     {-# INLINE unsafeRead #-}     unsafeRead arr i = liftST (unsafeRead arr i)     {-# INLINE unsafeWrite #-}@@ -283,7 +288,7 @@     {-# INLINE getNumElements #-}     getNumElements arr = liftST (getNumElements arr)     {-# INLINE newArray #-}-    newArray bounds e = liftST (newArray bounds e)+    newArray bnds e = liftST (newArray bnds e)     {-# INLINE unsafeRead #-}     unsafeRead arr i = liftST (unsafeRead arr i)     {-# INLINE unsafeWrite #-}@@ -295,7 +300,7 @@     {-# INLINE getNumElements #-}     getNumElements arr = liftST (getNumElements arr)     {-# INLINE newArray #-}-    newArray bounds e = liftST (newArray bounds e)+    newArray bnds e = liftST (newArray bnds e)     {-# INLINE unsafeRead #-}     unsafeRead arr i = liftST (unsafeRead arr i)     {-# INLINE unsafeWrite #-}@@ -307,7 +312,7 @@     {-# INLINE getNumElements #-}     getNumElements arr = liftST (getNumElements arr)     {-# INLINE newArray #-}-    newArray bounds e = liftST (newArray bounds e)+    newArray bnds e = liftST (newArray bnds e)     {-# INLINE unsafeRead #-}     unsafeRead arr i = liftST (unsafeRead arr i)     {-# INLINE unsafeWrite #-}@@ -319,7 +324,7 @@     {-# INLINE getNumElements #-}     getNumElements arr = liftST (getNumElements arr)     {-# INLINE newArray #-}-    newArray bounds e = liftST (newArray bounds e)+    newArray bnds e = liftST (newArray bnds e)     {-# INLINE unsafeRead #-}     unsafeRead arr i = liftST (unsafeRead arr i)     {-# INLINE unsafeWrite #-}@@ -331,7 +336,7 @@     {-# INLINE getNumElements #-}     getNumElements arr = liftST (getNumElements arr)     {-# INLINE newArray #-}-    newArray bounds e = liftST (newArray bounds e)+    newArray bnds e = liftST (newArray bnds e)     {-# INLINE unsafeRead #-}     unsafeRead arr i = liftST (unsafeRead arr i)     {-# INLINE unsafeWrite #-}

@@ -1,12 +1,13 @@ name:		STMonadTrans-version:	0.4.3-cabal-version:  >= 1.8+version:	0.4.4+cabal-version:  >= 1.10 license:	BSD3 license-file:	LICENSE author:		Josef Svenningsson maintainer:	josef.svenningsson@gmail.com category:	Monads build-type:	Simple+Tested-With:    GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1 synopsis:	A monad transformer version of the ST monad description:	    A monad transformer version of the ST monad@@ -29,19 +30,34 @@   description: Choose the new smaller, split-up base package.  library+  default-language: Haskell2010+  build-depends: base >= 4.6+           if flag(splitBase)     build-depends: base >= 3, base < 5, mtl, array   else     build-depends: base < 3 +  if impl(ghc < 8.0)+    build-depends: fail+   exposed-modules:	     Control.Monad.ST.Trans,     Control.Monad.ST.Trans.Internal-  extensions:	CPP, MagicHash, UnboxedTuples, Rank2Types, FlexibleInstances,-        MultiParamTypeClasses, UndecidableInstances+  default-extensions: CPP, MagicHash, UnboxedTuples, Rank2Types,+                FlexibleInstances,+                MultiParamTypeClasses, UndecidableInstances -Test-Suite foo-  type: detailed-0.9-  hs-source-dirs: test-  test-module: Test-  build-depends: STMonadTrans, base, mtl, array, Cabal+  ghc-options: -Wall -fwarn-tabs++test-suite test+  default-language: Haskell2010+  type:             exitcode-stdio-1.0+  hs-source-dirs:   test+  main-is:          Main.hs+  build-depends:    base >= 4 && < 5+                  , tasty >= 0.11.0.4 && < 1.3+                  , tasty-quickcheck >= 0.8.4 && < 0.11+                  , tasty-hunit >= 0.9.2 && < 0.11+                  , transformers >= 0.4 && < 0.6+                  , STMonadTrans

@@ -1,3 +1,8 @@+0.4.4++  * Fix compilation for GHC 8.8.1. Thanks to Andrés Sicard-Ramírez.+  * Fix some tests and their dependencies. Thanks to Kirill Zaborsky.+ 0.4.3    * Fix compilation for GHC 7.6.3. Thanks to Andrés Sicard-Ramírez.

@@ -0,0 +1,54 @@+import Test.Tasty+import Test.Tasty.QuickCheck+import Test.Tasty.HUnit++import GHC.STRef (STRef)+import GHC.Arr (Array, listArray, (//))+import Control.Monad.ST.Trans+import Control.Monad.Trans.Class+import Control.Monad (guard)++props :: TestTree+props = testGroup "Properties" [+  testProperty "runSTT respects return" $+    \x -> runSTT (return x) == Just (x :: Int),+  testProperty "STT respects MonadTrans" $+    \m -> runSTT (lift m) == (m :: Maybe Int),+  testProperty "newSTRef . readSTRef == id" $+    \x -> runSTT ((newSTRef x :: STT s Maybe (STRef s Int)) >>= readSTRef) == Just x,+  testProperty "writeSTRef overwrite" $+    \x y -> runSTT (do ref <- newSTRef x+                       writeSTRef ref y+                       readSTRef ref) == Just (y :: Int),+  testProperty "newSTArray makes correct Arrays" $+    \t e -> 0 <= t ==>+      runSTT (newSTArray (0,t) e >>= freezeSTArray) ==+      Just (listArray (0,t) (repeat e) :: Array Int Int),+  testProperty "writeSTArray overwrite" $+    \t e y -> 0 <= t ==>+      runSTT (do arr <- newSTArray (0,t) e+                 mapM_ (\i -> writeSTArray arr i y) [0..t]+                 freezeSTArray arr) ==+      Just (listArray (0,t) (repeat y) :: Array Int Int),+  testProperty "thawSTArray . freezeSTArray == id" $+    \l -> let a = listArray (0,length l - 1) l in+      runSTT (thawSTArray a >>= freezeSTArray) == Just (a :: Array Int Int),+  testProperty "writeSTArray . thawSTArray == update a" $+    \l i e -> let a = listArray (0, length l - 1) l in+      0 <= i && i < length l ==>+        runSTT (do stArr <- thawSTArray a+                   writeSTArray stArr i e+                   freezeSTArray stArr) ==+        Just (a // [(i,e)] :: Array Int Int) ]++unitTests :: TestTree+unitTests = testGroup "Unit Tests" [+  testCase "ST Ref" $ runSTT (do ref <- newSTRef 0+                                 curNum <- readSTRef ref+                                 writeSTRef ref (curNum + 6)+                                 nextNum <- readSTRef ref+                                 lift (guard (nextNum == 6))+                                 return nextNum) @?= Just 6 ]++main :: IO ()+main = defaultMain (testGroup "All Tests" [props,unitTests])

@@ -1,37 +0,0 @@-module Test where--import Control.Monad-import Control.Monad.Trans-import Control.Monad.ST.Trans--import Data.Array--import Distribution.TestSuite--foo :: Int -> Maybe (Array Int Int)-foo i = runSTArray $ do-    arr <- newSTArray (1, 3) 0-    lift $ guard $ i > 0-    writeSTArray arr 2 i-    return arr--ups :: (Maybe (Array Int Int, Array Int Int))-ups = (,) <$> foo 5 <*> foo 6--main :: IO ()-main = print ups--tests :: IO [Test]-tests = return [Test bar]-  where-    bar = TestInstance-        { run = return $ Finished runUps-        , name = "array creation"-        , tags = []-        , options = []-        , setOption = \_ _ -> Right bar-        }-    runUps = case ups of-      Just (a1,a2) | elems a1 /= elems a2 -> Pass-                   | otherwise -> Fail "Only created one array."-      _ -> Error "Got Nothing! Shouldn't happen."