Merge pull request #89 from lehins/lehins/random-1.3

Adjust for new additions in upcoming random-1.3

.github/workflows/ci.yml

@@ -18,40 +18,43 @@ jobs:
       matrix:
         include:
           ### -- Linux --
-          - { cabal: "3.10", os: ubuntu-latest,  ghc: "8.0.2"  }
-          - { cabal: "3.10", os: ubuntu-latest,  ghc: "8.2.2"  }
-          - { cabal: "3.10", os: ubuntu-latest,  ghc: "8.4.4"  }
-          - { cabal: "3.10", os: ubuntu-latest,  ghc: "8.6.5"  }
-          - { cabal: "3.10", os: ubuntu-latest,  ghc: "8.8.4"  }
-          - { cabal: "3.10", os: ubuntu-latest,  ghc: "8.10.7" }
-          - { cabal: "3.10", os: ubuntu-latest,  ghc: "9.0.2"  }
-          - { cabal: "3.10", os: ubuntu-latest,  ghc: "9.2.8"  }
-          - { cabal: "3.10", os: ubuntu-latest,  ghc: "9.4.8"  }
-          - { cabal: "3.10", os: ubuntu-latest,  ghc: "9.6.5"  }
-          - { cabal: "3.10", os: ubuntu-latest,  ghc: "9.6.5"  }
-          - { cabal: "3.10", os: ubuntu-latest,  ghc: "9.8.2"  }
+          - { cabal: "3.12", os: ubuntu-latest,  ghc: "8.0.2"  }
+          - { cabal: "3.12", os: ubuntu-latest,  ghc: "8.2.2"  }
+          - { cabal: "3.12", os: ubuntu-latest,  ghc: "8.4.4"  }
+          - { cabal: "3.12", os: ubuntu-latest,  ghc: "8.6.5"  }
+          - { cabal: "3.12", os: ubuntu-latest,  ghc: "8.8.4"  }
+          - { cabal: "3.12", os: ubuntu-latest,  ghc: "8.10.7" }
+          - { cabal: "3.12", os: ubuntu-latest,  ghc: "9.0.2"  }
+          - { cabal: "3.12", os: ubuntu-latest,  ghc: "9.2.8"  }
+          - { cabal: "3.12", os: ubuntu-latest,  ghc: "9.4.8"  }
+          - { cabal: "3.12", os: ubuntu-latest,  ghc: "9.6.6"  }
+          - { cabal: "3.12", os: ubuntu-latest,  ghc: "9.8.4"  }
+          - { cabal: "3.12", os: ubuntu-latest,  ghc: "9.10.1" }
+          - { cabal: "3.12", os: ubuntu-latest,  ghc: "9.12.1" }
           ## -- Win --
-          - { cabal: "3.10", os: windows-latest, ghc: "8.4.4"  }
-          - { cabal: "3.10", os: windows-latest, ghc: "8.6.5"  }
-          - { cabal: "3.10", os: windows-latest, ghc: "8.8.4"  }
-          - { cabal: "3.10", os: windows-latest, ghc: "8.10.7" }
-          - { cabal: "3.10", os: windows-latest, ghc: "9.0.2"  }
-          - { cabal: "3.10", os: windows-latest, ghc: "9.2.8"  }
-          - { cabal: "3.10", os: windows-latest, ghc: "9.4.8"  }
-          - { cabal: "3.10", os: windows-latest, ghc: "9.6.5"  }
-          - { cabal: "3.10", os: windows-latest, ghc: "9.6.5"  }
-          - { cabal: "3.10", os: windows-latest, ghc: "9.8.2"  }
+          - { cabal: "3.12", os: windows-latest, ghc: "8.4.4"  }
+          - { cabal: "3.12", os: windows-latest, ghc: "8.6.5"  }
+          - { cabal: "3.12", os: windows-latest, ghc: "8.8.4"  }
+          - { cabal: "3.12", os: windows-latest, ghc: "8.10.7" }
+          - { cabal: "3.12", os: windows-latest, ghc: "9.0.2"  }
+          - { cabal: "3.12", os: windows-latest, ghc: "9.2.8"  }
+          - { cabal: "3.12", os: windows-latest, ghc: "9.4.8"  }
+          - { cabal: "3.12", os: windows-latest, ghc: "9.6.6"  }
+          - { cabal: "3.12", os: windows-latest, ghc: "9.8.4"  }
+          - { cabal: "3.12", os: windows-latest, ghc: "9.10.1" }
+          - { cabal: "3.12", os: windows-latest, ghc: "9.12.1" }
           # MacOS
-          - { cabal: "3.10", os: macOS-13,       ghc: "8.4.4"  }
-          - { cabal: "3.10", os: macOS-13,       ghc: "8.6.5"  }
-          - { cabal: "3.10", os: macOS-13,       ghc: "8.8.4"  }
-          - { cabal: "3.10", os: macOS-13,       ghc: "8.10.7" }
-          - { cabal: "3.10", os: macOS-13,       ghc: "9.0.2"  }
-          - { cabal: "3.10", os: macOS-latest,   ghc: "9.2.8"  }
-          - { cabal: "3.10", os: macOS-latest,   ghc: "9.4.8"  }
-          - { cabal: "3.10", os: macOS-latest,   ghc: "9.6.5"  }
-          - { cabal: "3.10", os: macOS-latest,   ghc: "9.6.5"  }
-          - { cabal: "3.10", os: macOS-latest,   ghc: "9.8.2"  }
+          - { cabal: "3.12", os: macOS-13,       ghc: "8.4.4"  }
+          - { cabal: "3.12", os: macOS-13,       ghc: "8.6.5"  }
+          - { cabal: "3.12", os: macOS-13,       ghc: "8.8.4"  }
+          - { cabal: "3.12", os: macOS-13,       ghc: "8.10.7" }
+          - { cabal: "3.12", os: macOS-13,       ghc: "9.0.2"  }
+          - { cabal: "3.12", os: macOS-latest,   ghc: "9.2.8"  }
+          - { cabal: "3.12", os: macOS-latest,   ghc: "9.4.8"  }
+          - { cabal: "3.12", os: macOS-latest,   ghc: "9.6.6"  }
+          - { cabal: "3.12", os: macOS-latest,   ghc: "9.8.4"  }
+          - { cabal: "3.12", os: macOS-latest,   ghc: "9.10.1" }
+          - { cabal: "3.12", os: macOS-latest,   ghc: "9.12.1" }
       fail-fast: false
 
     steps:

System/Random/MWC.hs

@@ -158,7 +158,7 @@ module System.Random.MWC
 #include "MachDeps.h"
 #endif
 
-import Control.Monad           (ap, liftM, unless)
+import Control.Monad           (unless)
 import Control.Monad.Primitive (PrimMonad, PrimBase, PrimState, unsafePrimToIO, stToPrim)
 import Control.Monad.ST        (ST,runST)
 import Data.Bits               ((.&.), (.|.), shiftL, shiftR, xor)
@@ -310,24 +310,24 @@ instance Variate Word where
     {-# INLINE uniformR #-}
 
 instance (Variate a, Variate b) => Variate (a,b) where
-    uniform g = (,) `liftM` uniform g `ap` uniform g
-    uniformR ((x1,y1),(x2,y2)) g = (,) `liftM` uniformR (x1,x2) g `ap` uniformR (y1,y2) g
+    uniform g = (,) <$> uniform g <*> uniform g
+    uniformR ((x1,y1),(x2,y2)) g = (,) <$> uniformR (x1,x2) g <*> uniformR (y1,y2) g
     {-# INLINE uniform  #-}
     {-# INLINE uniformR #-}
 
 instance (Variate a, Variate b, Variate c) => Variate (a,b,c) where
-    uniform g = (,,) `liftM` uniform g `ap` uniform g `ap` uniform g
+    uniform g = (,,) <$> uniform g <*> uniform g <*> uniform g
     uniformR ((x1,y1,z1),(x2,y2,z2)) g =
-      (,,) `liftM` uniformR (x1,x2) g `ap` uniformR (y1,y2) g `ap` uniformR (z1,z2) g
+      (,,) <$> uniformR (x1,x2) g <*> uniformR (y1,y2) g <*> uniformR (z1,z2) g
     {-# INLINE uniform  #-}
     {-# INLINE uniformR #-}
 
 instance (Variate a, Variate b, Variate c, Variate d) => Variate (a,b,c,d) where
-    uniform g = (,,,) `liftM` uniform g `ap` uniform g `ap` uniform g
-                `ap` uniform g
+    uniform g = (,,,) <$> uniform g <*> uniform g <*> uniform g
+                <*> uniform g
     uniformR ((x1,y1,z1,t1),(x2,y2,z2,t2)) g =
-      (,,,) `liftM` uniformR (x1,x2) g `ap` uniformR (y1,y2) g `ap`
-                    uniformR (z1,z2) g `ap` uniformR (t1,t2) g
+      (,,,) <$> uniformR (x1,x2) g <*> uniformR (y1,y2) g <*>
+                    uniformR (z1,z2) g <*> uniformR (t1,t2) g
     {-# INLINE uniform  #-}
     {-# INLINE uniformR #-}
 
@@ -463,14 +463,28 @@ instance (s ~ PrimState m, PrimMonad m) => Random.StatefulGen (Gen s) m where
   {-# INLINE uniformWord32 #-}
   uniformWord64 = uniform
   {-# INLINE uniformWord64 #-}
+#if MIN_VERSION_random(1,3,0)
+  uniformByteArrayM isPinned n g = stToPrim (Random.fillByteArrayST isPinned n (uniform g))
+  {-# INLINE uniformByteArrayM #-}
+#else
   uniformShortByteString n g = stToPrim (Random.genShortByteStringST n (uniform g))
   {-# INLINE uniformShortByteString #-}
+#endif
 
 -- | @since 0.15.0.0
 instance PrimMonad m => Random.FrozenGen Seed m where
   type MutableGen Seed m = Gen (PrimState m)
-  thawGen = restore
   freezeGen = save
+#if MIN_VERSION_random(1,3,0)
+  modifyGen gen@(Gen mv) f = do
+    seed <- save gen
+    case f seed of
+      (a, Seed v) -> a <$ G.copy mv v
+  overwriteGen (Gen mv) (Seed v) = G.copy mv v
+
+instance PrimMonad m => Random.ThawedGen Seed m where
+#endif
+  thawGen = restore
 
 -- | Convert vector to 'Seed'. It acts similarly to 'initialize' and
 -- will accept any vector. If you want to pass seed immediately to
@@ -482,12 +496,12 @@ toSeed v = Seed $ I.create $ do { Gen q <- initialize v; return q }
 
 -- | Save the state of a 'Gen', for later use by 'restore'.
 save :: PrimMonad m => Gen (PrimState m) -> m Seed
-save (Gen q) = Seed `liftM` G.freeze q
+save (Gen q) = Seed <$> G.freeze q
 {-# INLINE save #-}
 
 -- | Create a new 'Gen' that mirrors the state of a saved 'Seed'.
 restore :: PrimMonad m => Seed -> m (Gen (PrimState m))
-restore (Seed s) = Gen `liftM` G.thaw s
+restore (Seed s) = Gen <$> G.thaw s
 {-# INLINE restore #-}
 
 
@@ -577,9 +591,9 @@ aa = 1540315826
 uniformWord32 :: PrimMonad m => Gen (PrimState m) -> m Word32
 -- NOTE [Carry value]
 uniformWord32 (Gen q) = do
-  i  <- nextIndex `liftM` M.unsafeRead q ioff
-  c  <- fromIntegral `liftM` M.unsafeRead q coff
-  qi <- fromIntegral `liftM` M.unsafeRead q i
+  i  <- nextIndex <$> M.unsafeRead q ioff
+  c  <- fromIntegral <$> M.unsafeRead q coff
+  qi <- fromIntegral <$> M.unsafeRead q i
   let t  = aa * qi + c
       c' = fromIntegral (t `shiftR` 32)
       x  = fromIntegral t + c'
@@ -599,11 +613,11 @@ uniform1 f gen = do
 
 uniform2 :: PrimMonad m => (Word32 -> Word32 -> a) -> Gen (PrimState m) -> m a
 uniform2 f (Gen q) = do
-  i  <- nextIndex `liftM` M.unsafeRead q ioff
+  i  <- nextIndex <$> M.unsafeRead q ioff
   let j = nextIndex i
-  c  <- fromIntegral `liftM` M.unsafeRead q coff
-  qi <- fromIntegral `liftM` M.unsafeRead q i
-  qj <- fromIntegral `liftM` M.unsafeRead q j
+  c  <- fromIntegral <$> M.unsafeRead q coff
+  qi <- fromIntegral <$> M.unsafeRead q i
+  qj <- fromIntegral <$> M.unsafeRead q j
   let t   = aa * qi + c
       c'  = fromIntegral (t `shiftR` 32)
       x   = fromIntegral t + c'

System/Random/MWC/Distributions.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE BangPatterns, CPP, GADTs, FlexibleContexts, ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns, GADTs, FlexibleContexts, ScopedTypeVariables #-}
 -- |
 -- Module    : System.Random.MWC.Distributions
 -- Copyright : (c) 2012 Bryan O'Sullivan
@@ -40,13 +40,9 @@ module System.Random.MWC.Distributions
     ) where
 
 import Prelude hiding (mapM)
-import Control.Monad (liftM)
 import Control.Monad.Primitive (PrimMonad, PrimState)
 import Data.Bits ((.&.))
 import Data.Foldable (foldl')
-#if !MIN_VERSION_base(4,8,0)
-import Data.Traversable (Traversable)
-#endif
 import Data.Traversable (mapM)
 import Data.Word (Word32)
 import System.Random.Stateful (StatefulGen(..),Uniform(..),UniformRange(..),uniformDoublePositive01M)
@@ -83,7 +79,7 @@ standard :: StatefulGen g m => g -> m Double
 standard gen = loop
   where
     loop = do
-      u  <- (subtract 1 . (*2)) `liftM` uniformDoublePositive01M gen
+      u  <- subtract 1 . (*2) <$> uniformDoublePositive01M gen
       ri <- uniformM gen
       let i  = fromIntegral ((ri :: Word32) .&. 127)
           bi = I.unsafeIndex blocks i
@@ -102,8 +98,8 @@ standard gen = loop
                else loop
     normalTail neg  = tailing
       where tailing  = do
-              x <- ((/rNorm) . log) `liftM` uniformDoublePositive01M gen
-              y <- log              `liftM` uniformDoublePositive01M gen
+              x <- (/ rNorm) . log <$> uniformDoublePositive01M gen
+              y <- log             <$> uniformDoublePositive01M gen
               if y * (-2) < x * x
                 then tailing
                 else return $! if neg then x - rNorm else rNorm - x
@@ -257,7 +253,7 @@ bernoulli :: StatefulGen g m
           -> g                 -- ^ Generator
           -> m Bool
 {-# INLINE bernoulli #-}
-bernoulli p gen = (<p) `liftM` uniformDoublePositive01M gen
+bernoulli p gen = (< p) <$> uniformDoublePositive01M gen
 
 -- | Random variate generator for categorical distribution.
 --
@@ -274,7 +270,7 @@ categorical v gen
     | G.null v = pkgError "categorical" "empty weights!"
     | otherwise = do
         let cv  = G.scanl1' (+) v
-        p <- (G.last cv *) `liftM` uniformDoublePositive01M gen
+        p <- (G.last cv *) <$> uniformDoublePositive01M gen
         return $! case G.findIndex (>=p) cv of
                     Just i  -> i
                     Nothing -> pkgError "categorical" "bad weights!"

System/Random/MWC/SeedSource.hs

@@ -10,7 +10,6 @@ module System.Random.MWC.SeedSource (
   , randomSourceName
   ) where
 
-import Control.Monad           (liftM)
 import Data.Word               (Word32,Word64)
 import Data.Bits               (shiftR)
 import Data.Ratio              ((%), numerator)
@@ -31,8 +30,8 @@ import System.CPUTime   (cpuTimePrecision, getCPUTime)
 -- Windows system.
 acquireSeedTime :: IO [Word32]
 acquireSeedTime = do
-  c <- (numerator . (% cpuTimePrecision)) `liftM` getCPUTime
-  t <- toRational `liftM` getPOSIXTime
+  c <- numerator . (% cpuTimePrecision) <$> getCPUTime
+  t <- toRational <$> getPOSIXTime
   let n    = fromIntegral (numerator t) :: Word64
   return [fromIntegral c, fromIntegral n, fromIntegral (n `shiftR` 32)]
 

changelog.md

@@ -1,3 +1,8 @@
+## Changes in 0.15.2.0
+
+  * Support for `random-1.3`.
+
+
 ## Changes in 0.15.1.0
 
   * Additon of binomial sampler using the rejection sampling method in

mwc-random.cabal

@@ -1,7 +1,7 @@
 cabal-version:  3.0
 build-type:     Simple
 name:           mwc-random
-version:        0.15.1.0
+version:        0.15.2.0
 license:        BSD-2-Clause
 license-file:   LICENSE
 copyright:      2009, 2010, 2011 Bryan O'Sullivan
@@ -45,9 +45,10 @@ tested-with:
    || ==9.0.2
    || ==9.2.8
    || ==9.4.8
-   || ==9.6.5
-   || ==9.6.5
-   || ==9.8.2
+   || ==9.6.6
+   || ==9.8.4
+   || ==9.10.1
+   || ==9.12.1
 
 
 source-repository head
@@ -120,9 +121,9 @@ test-suite mwc-prop-tests
                , QuickCheck                 >=2.2
                , vector                     >=0.12.1
                , tasty                      >=1.3.1
-               , tasty-quickcheck
+               , tasty-quickcheck           >=0.10.2
                , tasty-hunit
-               , random     >=1.2
+               , random                     >=1.2
                , mtl
                , math-functions             >=0.3.4
 
@@ -141,7 +142,7 @@ test-suite mwc-doctests
   build-depends:
             base       -any
           , mwc-random -any
-          , doctest    >=0.15 && <0.23
+          , doctest    >=0.15 && <0.24
             --
           , bytestring
           , primitive

stack.yaml

@@ -1,8 +1,5 @@
-resolver: lts-15.2
+resolver: lts-22.43
 packages:
   - '.'
-
 extra-deps:
-- github: idontgetoutmuch/random
-  commit: 86e06b8902d4d5c32b14b6a5ef44b964280bcc32
-- splitmix-0.1@sha256:d50c4d0801a35be7875a040470c09863342514930c82a7d25780a6c2efc4fda9,5249
+- random-1.3.0@sha256:e5b7016e43a8f4822ebcf8cacaaa737beb62d370b988b5c69e95105d9f0fd582,6004