Clean up a bit

haskell · Jun 27, 2020 · edd8565 · edd8565
1 parent 35ca940
commit edd8565
Show file tree

Hide file tree

Showing 3 changed files with 40 additions and 33 deletions.
diff --git a/src/System/Random/Generic.hs b/src/System/Random/Generic.hs
@@ -5,16 +5,17 @@
 -- Maintainer  :  libraries@haskell.org
 --
 
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE DefaultSignatures    #-}
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE KindSignatures       #-}
+{-# LANGUAGE LambdaCase           #-}
+{-# LANGUAGE MagicHash            #-}
+{-# LANGUAGE PolyKinds            #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeOperators        #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module System.Random.Generic
   ( Enum(..)
@@ -23,12 +24,13 @@ module System.Random.Generic
 
 import qualified Prelude as P
 import Prelude hiding (Enum(..))
-import GHC.Generics
+import Data.Bits
+import Data.Int
 import Data.Proxy
 import Data.Void
-import GHC.Exts
-import Data.Int
 import Data.Word
+import GHC.Exts
+import GHC.Generics
 
 class Enum a where
   cardinality :: proxy a -> Integer
@@ -44,15 +46,6 @@ class Enum a where
   default fromEnum :: (Generic a, GEnum (Rep a)) => a -> Integer
   fromEnum = fromGEnum . from
 
-cardinalityDef :: forall proxy a. (P.Enum a, Bounded a) => proxy a -> Integer
-cardinalityDef _ = toInteger (P.fromEnum (maxBound :: a)) - toInteger (P.fromEnum (minBound :: a)) + 1
-
-toEnumDef :: forall a. (P.Enum a, Bounded a) => Integer -> a
-toEnumDef n = P.toEnum $ fromInteger $ n + toInteger (P.fromEnum (minBound :: a))
-
-fromEnumDef :: forall a. (P.Enum a, Bounded a) => a -> Integer
-fromEnumDef x = toInteger (P.fromEnum x) - toInteger (P.fromEnum (minBound :: a))
-
 class GEnum f where
   gcardinality :: Proxy# f -> Integer
   toGEnum :: Integer -> f a
@@ -103,9 +96,23 @@ instance Enum Bool
 instance Enum Ordering
 
 instance Enum Char where
-  cardinality = cardinalityDef
-  toEnum = toEnumDef
-  fromEnum = fromEnumDef
+  cardinality = const $ toInteger (P.fromEnum (maxBound :: Char)) + 1
+  toEnum = P.toEnum . fromInteger
+  fromEnum = toInteger . P.fromEnum
+
+cardinalityDef :: forall proxy a. (Num a, FiniteBits a) => proxy a -> Integer
+cardinalityDef _ = 1 `shiftL` finiteBitSize (0 :: a)
+
+toEnumDef :: forall a. (Num a, FiniteBits a) => Integer -> a
+toEnumDef n
+    | isSigned (0 :: a) = fromInteger (n - 1 `shiftL` (finiteBitSize (0 :: a) - 1))
+    | otherwise = fromInteger n
+
+fromEnumDef :: (Integral a, FiniteBits a) => a -> Integer
+fromEnumDef x
+    | isSigned x = toInteger x + 1 `shiftL` (finiteBitSize x - 1)
+    | otherwise = toInteger x
+
 instance Enum Word8 where
   cardinality = cardinalityDef
   toEnum = toEnumDef

diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
@@ -382,7 +381,7 @@ data StateGenM g = StateGenM
 --
 -- @since 1.2.0
 newtype StateGen g = StateGen { unStateGen :: g }
-  deriving (Eq, Ord, Show, RandomGen, Storable, NFData, Generic)
+  deriving (Eq, Ord, Show, RandomGen, Storable, NFData)
 
 instance (RandomGen g, MonadState g m) => StatefulGen (StateGenM g) m where
   uniformWord32R r _ = state (genWord32R r)
@@ -474,7 +473,7 @@ runStateGenST g action = runST $ runStateGenT g action
 
 -- | The standard pseudo-random number generator.
 newtype StdGen = StdGen { unStdGen :: SM.SMGen }
-  deriving (Show, RandomGen, NFData, Generic)
+  deriving (Show, RandomGen, NFData)
 
 instance Eq StdGen where
   StdGen x1 == StdGen x2 = SM.unseedSMGen x1 == SM.unseedSMGen x2
@@ -530,6 +529,9 @@ class UniformRange a where
   -- @since 1.2.0
   uniformRM :: StatefulGen g m => (a, a) -> g -> m a
 
+  default uniformRM :: (StatefulGen g m, Generic a, G.GEnum (Rep a)) => (a, a) -> g -> m a
+  uniformRM (l, h) = fmap (to . G.toGEnum) . uniformRM (G.fromGEnum (from l), G.fromGEnum (from h))
+
 instance UniformRange Integer where
   uniformRM = uniformIntegralM
 

diff --git a/src/System/Random/Stateful.hs b/src/System/Random/Stateful.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -101,7 +100,6 @@ import Control.Monad.State.Strict
 import Data.IORef
 import Data.STRef
 import Foreign.Storable
-import GHC.Generics
 import System.Random
 import System.Random.Internal
 
@@ -313,7 +311,7 @@ newtype AtomicGenM g = AtomicGenM { unAtomicGenM :: IORef g}
 --
 -- @since 1.2.0
 newtype AtomicGen g = AtomicGen { unAtomicGen :: g}
-  deriving (Eq, Ord, Show, RandomGen, Storable, NFData, Generic)
+  deriving (Eq, Ord, Show, RandomGen, Storable, NFData)
 
 -- | Creates a new 'AtomicGenM'.
 --
@@ -385,7 +383,7 @@ newtype IOGenM g = IOGenM { unIOGenM :: IORef g }
 --
 -- @since 1.2.0
 newtype IOGen g = IOGen { unIOGen :: g }
-  deriving (Eq, Ord, Show, RandomGen, Storable, NFData, Generic)
+  deriving (Eq, Ord, Show, RandomGen, Storable, NFData)
 
 
 -- | Creates a new 'IOGenM'.
@@ -446,7 +444,7 @@ newtype STGenM g s = STGenM { unSTGenM :: STRef s g }
 --
 -- @since 1.2.0
 newtype STGen g = STGen { unSTGen :: g }
-  deriving (Eq, Ord, Show, RandomGen, Storable, NFData, Generic)
+  deriving (Eq, Ord, Show, RandomGen, Storable, NFData)
 
 -- | Creates a new 'STGenM'.
 --