one-liner-instances 0.1.2.1 → 0.1.3.0

raw patch · 9 files changed

+329/−55 lines, 9 filesdep ~randomPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: random

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• one-liner-instances.cabal +10/−8
• src/Data/Bounded/OneLiner.hs +1/−3
• src/Data/Monoid/OneLiner.hs +6/−2
• src/Data/Ord/OneLiner.hs +1/−1
• src/Numeric/OneLiner.hs +1/−1
• src/System/Random/OneLiner.hs +30/−40
• src/System/Random/OneLiner/Internal.hs +47/−0
• src/System/Random/Stateful/OneLiner.hs +222/−0

@@ -1,6 +1,17 @@ Changelog ========= +Version 0.1.3.0+---------------++*Nov 20, 2021*++<https://github.com/mstksg/one-liner-instances/releases/tag/v0.1.3.0>++*   Fixed builds for *random-1.2*+*   Fixed warnings for *base-4.11*+*   Added support for new *System.Random.Stateful* instances for *random* library+ Version 0.1.2.1 --------------- 

@@ -1,11 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.21.2.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack------ hash: 6acb459b36dc35bbc749809acb02ea8b942833b8ae0a465908c8ddfc21ac7dca  name:           one-liner-instances-version:        0.1.2.1+version:        0.1.3.0 synopsis:       Generics-based implementations for common typeclasses description:    Provides generics-based implementations for common typeclasses using                 Generics.@@ -20,11 +20,11 @@ license:        BSD3 license-file:   LICENSE build-type:     Simple-cabal-version:  >= 1.10-+tested-with:+    GHC >= 8.0 extra-source-files:-    CHANGELOG.md     README.md+    CHANGELOG.md  source-repository head   type: git@@ -37,13 +37,15 @@       Data.Ord.OneLiner       Numeric.OneLiner       System.Random.OneLiner+      System.Random.Stateful.OneLiner   other-modules:       Paths_one_liner_instances+      System.Random.OneLiner.Internal   hs-source-dirs:       src   ghc-options: -Wall   build-depends:       base >=4.7 && <5     , one-liner >=0.9-    , random+    , random >=1.2   default-language: Haskell2010

@@ -11,7 +11,7 @@ -- | -- Module      : Data.Bounded.OneLiner -- Description : Derived methods for Semigroup.--- Copyright   : (c) Justin Le 2018+-- Copyright   : (c) Justin Le 2021 -- License     : BSD-3 -- Maintainer  : justin@jle.im -- Stability   : unstable@@ -67,7 +67,6 @@ gMinBound = case create @Bounded [minBound] of               []  -> error "minBound: uninhabited"               x:_ -> x-{-# INLINE gMinBound #-}  -- | 'maxBound' implemented by using 'maxBound' for all of the components -- for the last constructor@@ -77,4 +76,3 @@ gMaxBound = case reverse (create @Bounded [maxBound]) of               []  -> error "maxBound: uninhabited"               x:_ -> x-{-# INLINE gMaxBound #-}

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP                  #-} {-# LANGUAGE DeriveDataTypeable   #-} {-# LANGUAGE DeriveFoldable       #-} {-# LANGUAGE DeriveFunctor        #-}@@ -11,7 +12,7 @@ -- | -- Module      : Data.Monoid.OneLiner -- Description : Derived methods for Semigroup and Monoid.--- Copyright   : (c) Justin Le 2018+-- Copyright   : (c) Justin Le 2021 -- License     : BSD-3 -- Maintainer  : justin@jle.im -- Stability   : unstable@@ -42,9 +43,12 @@  import           Data.Coerce import           Data.Data-import           Data.Semigroup import           GHC.Generics import           Generics.OneLiner++#if !MIN_VERSION_base(4,11,0)+import           Data.Semigroup+#endif  -- | If @a@ is a data type with a single constructor whose fields are all -- instances of 'Semigroup', then @'GMonoid' a@ has a 'Semigroup' instance.

@@ -11,7 +11,7 @@ -- | -- Module      : Data.Ord.OneLiner -- Description : Derived methods for Semigroup.--- Copyright   : (c) Justin Le 2018+-- Copyright   : (c) Justin Le 2021 -- License     : BSD-3 -- Maintainer  : justin@jle.im -- Stability   : unstable

@@ -11,7 +11,7 @@ -- | -- Module      : Numeric.OneLiner -- Description : Derived methods for numeric typeclasses--- Copyright   : (c) Justin Le 2018+-- Copyright   : (c) Justin Le 2021 -- License     : BSD-3 -- Maintainer  : justin@jle.im -- Stability   : unstable

@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns         #-}+{-# LANGUAGE CPP                  #-} {-# LANGUAGE DeriveDataTypeable   #-} {-# LANGUAGE DeriveFoldable       #-} {-# LANGUAGE DeriveFunctor        #-}@@ -14,7 +15,7 @@ -- | -- Module      : System.Random.OneLiner -- Description : Derived methods for Random.--- Copyright   : (c) Justin Le 2018+-- Copyright   : (c) Justin Le 2021 -- License     : BSD-3 -- Maintainer  : justin@jle.im -- Stability   : unstable@@ -30,6 +31,7 @@ -- instant 'Random' instances, which can one day be used with /DerivingVia/ -- syntax to derive instances automatically. --+-- @since 0.1.2.1  module System.Random.OneLiner (   -- * Single constructor@@ -64,6 +66,7 @@ import           GHC.Generics import           Generics.OneLiner import           System.Random+import           System.Random.OneLiner.Internal (Pair(..), dePair, State(..)) import qualified Data.List.NonEmpty   as NE  -- | If @a@ is a data type with a single constructor whose fields are all@@ -74,6 +77,8 @@ -- -- Only works with data types with single constructors.  If you need it to -- work with types of multiple constructors, consider 'GRandomSum'.+--+-- @since 0.1.2.1 newtype GRandom a = GRandom { getGRandom :: a }   deriving (Eq, Ord, Show, Read, Data, Generic, Functor, Foldable, Traversable) @@ -93,16 +98,12 @@     randoms :: forall g. RandomGen g => g -> [GRandom a]     randoms = coerce (gRandoms @a @g)     {-# INLINE randoms #-}-    randomRIO :: (GRandom a, GRandom a) -> IO (GRandom a)-    randomRIO = coerce (gRandomRIO @a)-    {-# INLINE randomRIO #-}-    randomIO :: IO (GRandom a)-    randomIO = coerce (gRandomIO @a)-    {-# INLINE randomIO #-}  -- | 'randomR' implemented by sequencing 'randomR' between all components -- -- Requires the type to have only a single constructor.+--+-- @since 0.1.2.1 gRandomR     :: forall a g. (ADTRecord a, Constraints a Random, RandomGen g)     => (a, a) -> g -> (a, g)@@ -115,6 +116,8 @@ -- | 'random' implemented by sequencing 'random' for all components. -- -- Requires the type to have only a single constructor.+--+-- @since 0.1.2.1 gRandom     :: forall a g. (ADTRecord a, Constraints a Random, RandomGen g)     => g -> (a, g)@@ -122,6 +125,8 @@ {-# INLINE gRandom #-}  -- | 'randomRs' implemented by repeatedly calling 'gRandomR'.+--+-- @since 0.1.2.1 gRandomRs     :: forall a g. (ADTRecord a, Constraints a Random, RandomGen g)     => (a, a) -> g -> [a]@@ -129,6 +134,8 @@ {-# INLINE gRandomRs #-}  -- | 'randoms' implemented by repeatedly calling 'gRandom'.+--+-- @since 0.1.2.1 gRandoms     :: forall a g. (ADTRecord a, Constraints a Random, RandomGen g)     => g -> [a]@@ -136,6 +143,8 @@ {-# INLINE gRandoms #-}  -- | 'randomRIO' implemented by calling 'gRandomR' on the global seed.+--+-- @since 0.1.2.1 gRandomRIO     :: forall a. (ADTRecord a, Constraints a Random)     => (a, a) -> IO a@@ -143,6 +152,8 @@ {-# INLINE gRandomRIO #-}  -- | 'randomIO' implemented by calling 'gRandom' on the global seed.+--+-- @since 0.1.2.1 gRandomIO     :: forall a. (ADTRecord a, Constraints a Random)     => IO a@@ -161,6 +172,8 @@ -- -- Note that the "ranged" variants are partial: if given a range of items -- made with different constructors, will be 'error'!+--+-- @since 0.1.2.1 newtype GRandomSum a = GRandomSum { getGRandomSum :: a }   deriving (Eq, Ord, Show, Read, Data, Generic, Functor, Foldable, Traversable) @@ -180,17 +193,13 @@     randoms :: forall g. RandomGen g => g -> [GRandomSum a]     randoms = coerce (gRandomSums @a @g)     {-# INLINE randoms #-}-    randomRIO :: (GRandomSum a, GRandomSum a) -> IO (GRandomSum a)-    randomRIO = coerce (gRandomRIOSum @a)-    {-# INLINE randomRIO #-}-    randomIO :: IO (GRandomSum a)-    randomIO = coerce (gRandomIOSum @a)-    {-# INLINE randomIO #-}  -- | 'randomR' implemented by sequencing 'randomR' between all components. -- -- If given a range of items made with different constructors, will be -- 'error'!+--+-- @since 0.1.2.1 gRandomRSum     :: forall a g. (ADT a, Constraints a Random, RandomGen g)     => (a, a) -> g -> (a, g)@@ -203,6 +212,8 @@  -- | 'random' implemented by selecting a random constructor and sequencing -- 'random' for all components.+--+-- @since 0.1.2.1 gRandomSum     :: forall a g. (ADT a, Constraints a Random, RandomGen g)     => g -> (a, g)@@ -218,6 +229,8 @@ -- -- If given a range of items made with different constructors, will be -- 'error'!+--+-- @since 0.1.2.1 gRandomRSums     :: forall a g. (ADT a, Constraints a Random, RandomGen g)     => (a, a) -> g -> [a]@@ -225,6 +238,8 @@ {-# INLINE gRandomRSums #-}  -- | 'randoms' implemented by repeatedly calling 'gRandomSum'.+--+-- @since 0.1.2.1 gRandomSums     :: forall a g. (ADT a, Constraints a Random, RandomGen g)     => g -> [a]@@ -235,6 +250,8 @@ -- -- If given a range of items made with different constructors, will be -- 'error'!+--+-- @since 0.1.2.1 gRandomRIOSum     :: forall a. (ADT a, Constraints a Random)     => (a, a) -> IO a@@ -248,33 +265,6 @@ gRandomIOSum = getStdRandom gRandomSum {-# INLINE gRandomIOSum #-} --data Pair a = Pair !a !a-    deriving Functor--dePair :: Pair a -> (a, a)-dePair (Pair x y) = (x, y)-{-# INLINE dePair #-}--newtype State s a = State { runState :: s -> (a, s) }-    deriving Functor--instance Applicative (State s) where-    pure x = State (x,)-    {-# INLINE pure #-}-    sf <*> sx = State $ \s0 ->-        let (f, !s1) = runState sf s0-            (x, !s2) = runState sx s1-        in  (f x, s2)-    {-# INLINE (<*>) #-}--instance Monad (State s) where-    return x = State (x,)-    {-# INLINE return #-}-    sx >>= f = State $ \s0 ->-      let (x, !s1) = runState sx s0-      in  runState (f x) s1-    {-# INLINE (>>=) #-}  buildRandoms :: RandomGen g              => (a -> as -> as)  -- ^ E.g. '(:)' but subject to fusion

@@ -0,0 +1,47 @@+{-# LANGUAGE BangPatterns         #-}+{-# LANGUAGE CPP                  #-}+{-# LANGUAGE DeriveDataTypeable   #-}+{-# LANGUAGE DeriveFoldable       #-}+{-# LANGUAGE DeriveFunctor        #-}+{-# LANGUAGE DeriveGeneric        #-}+{-# LANGUAGE DeriveTraversable    #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE InstanceSigs         #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TupleSections        #-}+{-# LANGUAGE TypeApplications     #-}+{-# LANGUAGE UndecidableInstances #-}++module System.Random.OneLiner.Internal (+    Pair(..)+  , dePair+  , State(..)+  ) where++data Pair a = Pair !a !a+    deriving Functor++dePair :: Pair a -> (a, a)+dePair (Pair x y) = (x, y)+{-# INLINE dePair #-}++newtype State s a = State { runState :: s -> (a, s) }+    deriving Functor++instance Applicative (State s) where+    pure x = State (x,)+    {-# INLINE pure #-}+    sf <*> sx = State $ \s0 ->+        let (f, !s1) = runState sf s0+            (x, !s2) = runState sx s1+        in  (f x, s2)+    {-# INLINE (<*>) #-}++instance Monad (State s) where+    return x = State (x,)+    {-# INLINE return #-}+    sx >>= f = State $ \s0 ->+      let (x, !s1) = runState sx s0+      in  runState (f x) s1+    {-# INLINE (>>=) #-}+

@@ -0,0 +1,222 @@+{-# LANGUAGE BangPatterns         #-}+{-# LANGUAGE CPP                  #-}+{-# LANGUAGE DeriveDataTypeable   #-}+{-# LANGUAGE DeriveFoldable       #-}+{-# LANGUAGE DeriveFunctor        #-}+{-# LANGUAGE DeriveGeneric        #-}+{-# LANGUAGE DeriveTraversable    #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE InstanceSigs         #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TupleSections        #-}+{-# LANGUAGE TypeApplications     #-}+{-# LANGUAGE UndecidableInstances #-}++-- |+-- Module      : System.Random.Stateful.OneLiner+-- Description : Derived methods for Random.+-- Copyright   : (c) Justin Le 2021+-- License     : BSD-3+-- Maintainer  : justin@jle.im+-- Stability   : unstable+-- Portability : portable+--+-- Derived methods for 'Uniform', using "Generics.OneLiner" and+-- "GHC.Generics".+--+-- Can be used for any types (deriving 'Generic') made with a single+-- constructor, where every field is an instance of 'Uniform'.+--+-- Also includes a newtype wrapper that imbues any such data type with+-- instant 'Uniform' instances, which can one day be used with /DerivingVia/+-- syntax to derive instances automatically.+--+-- @since 0.1.3.0+module System.Random.Stateful.OneLiner (+  -- * Single constructor+  -- ** Newtype wrapper+    GUniform(..)+  -- ** Generics-derived methods+  , gUniformM+  , gUniformRM+  , gUniformListM+  , gRandomM+  , gRandomRM+  -- * Multiple constructor+  -- ** Newtype wrapper+  , GUniformSum(..)+  -- ** Generics-derived methods+  , gUniformSumM+  , gUniformRSumM+  , gUniformSumListM+  , gRandomSumM+  , gRandomRSumM+  ) where++import           Control.Monad+import           Data.Data+import           Data.Functor.Compose+import           Data.List.NonEmpty              (NonEmpty(..))+import           Data.Maybe+import           GHC.Generics+import           Generics.OneLiner+import           System.Random+import           System.Random.OneLiner+import           System.Random.OneLiner.Internal (Pair(..), dePair)+import           System.Random.Stateful+import qualified Data.List.NonEmpty              as NE++-- | If @a@ is a data type with a single constructor whose fields are all+-- instances of 'Uniform', then @'GUniform' a@ has a 'Uniform' instance.+--+-- Will one day be able to be used with /DerivingVia/ syntax, to derive+-- instances automatically.+--+-- Only works with data types with single constructors.  If you need it to+-- work with types of multiple constructors, consider 'GUniformSum'.+newtype GUniform a = GUniform { getGUniform :: a }+  deriving (Eq, Ord, Show, Read, Data, Generic, Functor, Foldable, Traversable)++instance ( ADTRecord a+         , Constraints a Uniform+         )+      => Uniform (GUniform a) where+    uniformM :: forall g m. StatefulGen g m => g -> m (GUniform a)+    uniformM g = GUniform <$> gUniformM g+    {-# INLINE uniformM #-}++instance ( ADTRecord a+         , Constraints a UniformRange+         )+      => UniformRange (GUniform a) where+    uniformRM :: forall g m. StatefulGen g m => (GUniform a, GUniform a) -> g -> m (GUniform a)+    uniformRM (GUniform l, GUniform r) g = GUniform <$> gUniformRM (l, r) g+    {-# INLINE uniformRM #-}++gUniformM+   :: forall a g m. (ADTRecord a, Constraints a Uniform, StatefulGen g m)+   => g+   -> m a+gUniformM g = createA' @Uniform (uniformM g)+{-# INLINE gUniformM #-}++gUniformRM+    :: forall a g m. (ADTRecord a, Constraints a UniformRange, StatefulGen g m)+    => (a, a) -> g -> m a+gUniformRM (l, u) g = dialgebra @UniformRange+    ((`uniformRM` g) . dePair)+    (Pair l u)+{-# INLINE gUniformRM #-}++-- | Uses the 'Random' instance instead of the 'Uniform' instance.+gRandomM+    :: forall a g m r. (ADTRecord a, Constraints a Random, RandomGenM g r m)+    => g -> m a+gRandomM = applyRandomGenM gRandom++-- | Uses the 'Random' instance instead of the 'Uniform' instance.+gRandomRM+    :: forall a g m r. (ADTRecord a, Constraints a Random, RandomGenM g r m)+    => (a, a) -> g -> m a+gRandomRM r = applyRandomGenM (gRandomR r)++gUniformListM+   :: forall a g m. (ADTRecord a, Constraints a Uniform, StatefulGen g m)+   => Int+   -> g+   -> m [a]+gUniformListM n g = replicateM n (gUniformM g)++-- | If @a@ is a data type whose fields are all instances of 'Uniform', then+-- @'GUniform' a@ has a 'Uniform' instance.+--+-- Will one day be able to be used with /DerivingVia/ syntax, to derive+-- instances automatically.+--+-- A version of 'GUniform' that works for data types with multiple+-- constructors.  If your type has only one constructor, it might be more+-- performant to use 'GUniform'.+--+-- Note that the "ranged" variants are partial: if given a range of items+-- made with different constructors, will be 'error'!+newtype GUniformSum a = GUniformSum { getGUniformSum :: a }+  deriving (Eq, Ord, Show, Read, Data, Generic, Functor, Foldable, Traversable)++instance ( ADT a+         , Constraints a Uniform+         )+      => Uniform (GUniformSum a) where+    uniformM :: forall g m. StatefulGen g m => g -> m (GUniformSum a)+    uniformM g = GUniformSum <$> gUniformSumM g+    {-# INLINE uniformM #-}++-- | Note that this is partial: the range limits must have the same+-- constructors.+instance ( ADT a+         , Constraints a UniformRange+         )+      => UniformRange (GUniformSum a) where+    uniformRM :: forall g m. StatefulGen g m => (GUniformSum a, GUniformSum a) -> g -> m (GUniformSum a)+    uniformRM (GUniformSum l, GUniformSum u) g = GUniformSum <$> gUniformRSumM (l, u) g+    {-# INLINE uniformRM #-}++-- | 'randomR' implemented by sequencing 'randomR' between all components.+--+-- If given a range of items made with different constructors, will be+-- 'error'!+gUniformRSumM+    :: forall a g m. (ADT a, Constraints a UniformRange, StatefulGen g m)+    => (a, a) -> g -> m a+gUniformRSumM (l, u) g = fromMaybe (error badbad) . getCompose $+    zipWithA @UniformRange+      (\l' u' -> Compose (Just (uniformRM (l', u') g)))+      l u+  where+    badbad = "gUniformRSum: Constructors in range do not match."+{-# INLINE gUniformRSumM #-}++-- | 'random' implemented by selecting a random constructor and sequencing+-- 'random' for all components.+gUniformSumM+    :: forall a g m. (ADT a, Constraints a Uniform, StatefulGen g m)+    => g -> m a+gUniformSumM g = case options of+    Nothing   -> pure (error "gUniformSumM: Uninhabited type")+    Just opts -> join $ reservoir opts g+  where+    options = NE.nonEmpty . getCompose $ createA @Uniform @a $+        Compose [uniformM g]+{-# INLINE gUniformSumM #-}++-- | Uses the 'Random' instance instead of the 'Uniform' instance.+gRandomSumM+    :: forall a g m r. (ADT a, Constraints a Random, RandomGenM g r m)+    => g -> m a+gRandomSumM = applyRandomGenM gRandomSum++-- | Uses the 'Random' instance instead of the 'Uniform' instance.+gRandomRSumM+    :: forall a g m r. (ADT a, Constraints a Random, RandomGenM g r m)+    => (a, a) -> g -> m a+gRandomRSumM r = applyRandomGenM (gRandomRSum r)++gUniformSumListM+   :: forall a g m. (ADT a, Constraints a Uniform, StatefulGen g m)+   => Int+   -> g+   -> m [a]+gUniformSumListM n g = replicateM n (gUniformSumM g)++-- | Select a random item from a non-empty list in constant memory, using+-- only a single traversal, using reservoir sampling.+reservoir :: StatefulGen g m => NE.NonEmpty a -> g -> m a+reservoir (x :| xs) g = go 1 x xs+  where+    go _  y []     = pure y+    go !i y (z:zs) = do+      j <- uniformWord64R i g+      if j <= 0+        then go (i + 1) z zs+        else go (i + 1) y zs+{-# INLINE reservoir #-}+