random-class 0.1.1.0 → 0.1.2.0

raw patch · 3 files changed

+20/−22 lines, 3 filesdep +utilPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: util

API changes (from Hackage documentation)

+ Random: instance Random.Uniform a ()

- Random: class Gen g where type Mut s g = m | m -> s g type Native g type Mut s g = MutVar s g uniformNativeM = ReaderT $ flip atomicModifyMutVar $ swap . runState uniformNative skip n = appEndo . stimes n . Endo $ execState uniformNative skipM = flip replicateA_ (() <$ uniformNativeM) where {

+ Random: class Gen g where type Mut s g = m | m -> s g type Native g type Mut s g = MutVar s g uniformNativeM = ReaderT $ flip atomicModifyMutVar $ swap . runState uniformNative skip n = appEndo . stimes n . Endo $ execState uniformNative skipM = flip mtimesA (() <$ uniformNativeM) where {

Files

Random.hs +12/−3
Util.hs +5/−18
random-class.cabal +3/−1

Random.hs view

@@ -30,7 +30,7 @@      default skipM :: (Mut (PrimState m) g ~ MutVar (PrimState m) g,                       PrimMonad m) => Natural -> ReaderT (Mut (PrimState m) g) m ()-    skipM = flip replicateA_ (() <$ uniformNativeM)+    skipM = flip mtimesA (() <$ uniformNativeM)  class Split g where     split :: g -> (g, g)@@ -47,8 +47,17 @@ uniformM = liftUniform uniformNativeM  instance {-# OVERLAPPABLE #-} (Bounded a, Enum a, Bounded b, Enum b) => Uniform b a where-    liftUniform = fmap (toEnum' . foldr (\ m n -> card @b * n + fromEnum' m) 0)-                . replicateA ((card @a + card @b - 1) `div` card @b)+    liftUniform = untilJust+                . fmap (toEnumMayWrap' . foldr (\ m n -> card @b * n + fromEnum' m) 0)+                . replicateA @_ @[] r+      where toEnumMayWrap' :: Natural -> Maybe a+            toEnumMayWrap' n | n > r * card @b `div` card @a * card @a = Nothing+                             | otherwise = toEnumMay' (n `div` card @a) +            r = (card @a + card @b - 1) `div` card @b+ instance Uniform Void a where     liftUniform = fmap $ \ case++instance Uniform a () where+    liftUniform = (() <$)

Util.hs view

@@ -1,30 +1,17 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE AllowAmbiguousTypes #-} -module Util where+module Util (card, fromEnum', toEnumMay', module U) where -import Control.Applicative import qualified Data.List as L-import Data.Semigroup import Numeric.Natural--replicateA :: Applicative p => Natural -> p a -> p [a]-replicateA n = sequenceA . L.genericReplicate n--replicateA_ :: Applicative p => Natural -> p () -> p ()-replicateA_ n = unAp . stimes n . Ap--newtype Ap p a = Ap { unAp :: p a } deriving (Functor, Applicative)-instance (Applicative p, Semigroup a) => Semigroup (Ap p a) where (<>) = liftA2 (<>)-instance (Applicative p, Semigroup a, Monoid a) => Monoid (Ap p a) where-    mempty = pure mempty-    mappend = (<>)+import "util" Util as U  card :: ∀ a . (Bounded a, Enum a) => Natural card = L.genericLength [minBound @a..]-            + fromEnum' :: (Bounded a, Enum a) => a -> Natural fromEnum' a = L.genericLength [minBound..a] - 1 -toEnum' :: (Bounded a, Enum a) => Natural -> a-toEnum' = L.genericIndex [minBound..]+toEnumMay' :: (Bounded a, Enum a) => Natural -> Maybe a+toEnumMay' = (!!?) [minBound..]

random-class.cabal view

@@ -1,5 +1,5 @@ name:                random-class-version:             0.1.1.0+version:             0.1.2.0 synopsis:            Class of random value generation -- description:          license:             BSD3@@ -18,6 +18,7 @@   build-depends:       base >=4.9 && <5                      , primitive                      , transformers+                     , util >=0.1.2 && <0.2   -- hs-source-dirs:         default-language:    Haskell2010   default-extensions:  UnicodeSyntax@@ -31,4 +32,5 @@                      , MultiParamTypeClasses                      , FlexibleContexts                      , FlexibleInstances+                     , PackageImports   ghc-options:         -Wall -Wno-name-shadowing