{-# 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
-- Description : Derived methods for Random.
-- Copyright   : (c) Justin Le 2021
-- License     : BSD-3
-- Maintainer  : justin@jle.im
-- Stability   : unstable
-- Portability : portable
--
-- Derived methods for 'Random', 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 'Random'.
--
-- Also includes a newtype wrapper that imbues any such data type with
-- 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
  -- ** Newtype wrapper
    GRandom(..)
  -- ** Generics-derived methods
  , gRandomR
  , gRandom
  , gRandomRs
  , gRandoms
  , gRandomRIO
  , gRandomIO
  -- * Multiple constructor
  -- ** Newtype wrapper
  , GRandomSum(..)
  -- ** Generics-derived methods
  , gRandomRSum
  , gRandomSum
  , gRandomRSums
  , gRandomSums
  , gRandomRIOSum
  , gRandomIOSum
  ) where

import           Control.Monad
import           Data.Coerce
import           Data.Data
import           Data.Functor.Compose
import           Data.List.NonEmpty   (NonEmpty(..))
import           Data.Maybe
import           GHC.Exts             (build)
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
-- instances of 'Random', then @'GRandom' a@ has a 'Random' 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 'GRandomSum'.
--
-- @since 0.1.2.1
newtype GRandom a = GRandom { GRandom a -> a
getGRandom :: a }
  deriving (GRandom a -> GRandom a -> Bool
(GRandom a -> GRandom a -> Bool)
-> (GRandom a -> GRandom a -> Bool) -> Eq (GRandom a)
forall a. Eq a => GRandom a -> GRandom a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GRandom a -> GRandom a -> Bool
$c/= :: forall a. Eq a => GRandom a -> GRandom a -> Bool
== :: GRandom a -> GRandom a -> Bool
$c== :: forall a. Eq a => GRandom a -> GRandom a -> Bool
Eq, Eq (GRandom a)
Eq (GRandom a)
-> (GRandom a -> GRandom a -> Ordering)
-> (GRandom a -> GRandom a -> Bool)
-> (GRandom a -> GRandom a -> Bool)
-> (GRandom a -> GRandom a -> Bool)
-> (GRandom a -> GRandom a -> Bool)
-> (GRandom a -> GRandom a -> GRandom a)
-> (GRandom a -> GRandom a -> GRandom a)
-> Ord (GRandom a)
GRandom a -> GRandom a -> Bool
GRandom a -> GRandom a -> Ordering
GRandom a -> GRandom a -> GRandom a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (GRandom a)
forall a. Ord a => GRandom a -> GRandom a -> Bool
forall a. Ord a => GRandom a -> GRandom a -> Ordering
forall a. Ord a => GRandom a -> GRandom a -> GRandom a
min :: GRandom a -> GRandom a -> GRandom a
$cmin :: forall a. Ord a => GRandom a -> GRandom a -> GRandom a
max :: GRandom a -> GRandom a -> GRandom a
$cmax :: forall a. Ord a => GRandom a -> GRandom a -> GRandom a
>= :: GRandom a -> GRandom a -> Bool
$c>= :: forall a. Ord a => GRandom a -> GRandom a -> Bool
> :: GRandom a -> GRandom a -> Bool
$c> :: forall a. Ord a => GRandom a -> GRandom a -> Bool
<= :: GRandom a -> GRandom a -> Bool
$c<= :: forall a. Ord a => GRandom a -> GRandom a -> Bool
< :: GRandom a -> GRandom a -> Bool
$c< :: forall a. Ord a => GRandom a -> GRandom a -> Bool
compare :: GRandom a -> GRandom a -> Ordering
$ccompare :: forall a. Ord a => GRandom a -> GRandom a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (GRandom a)
Ord, Int -> GRandom a -> ShowS
[GRandom a] -> ShowS
GRandom a -> String
(Int -> GRandom a -> ShowS)
-> (GRandom a -> String)
-> ([GRandom a] -> ShowS)
-> Show (GRandom a)
forall a. Show a => Int -> GRandom a -> ShowS
forall a. Show a => [GRandom a] -> ShowS
forall a. Show a => GRandom a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GRandom a] -> ShowS
$cshowList :: forall a. Show a => [GRandom a] -> ShowS
show :: GRandom a -> String
$cshow :: forall a. Show a => GRandom a -> String
showsPrec :: Int -> GRandom a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> GRandom a -> ShowS
Show, ReadPrec [GRandom a]
ReadPrec (GRandom a)
Int -> ReadS (GRandom a)
ReadS [GRandom a]
(Int -> ReadS (GRandom a))
-> ReadS [GRandom a]
-> ReadPrec (GRandom a)
-> ReadPrec [GRandom a]
-> Read (GRandom a)
forall a. Read a => ReadPrec [GRandom a]
forall a. Read a => ReadPrec (GRandom a)
forall a. Read a => Int -> ReadS (GRandom a)
forall a. Read a => ReadS [GRandom a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GRandom a]
$creadListPrec :: forall a. Read a => ReadPrec [GRandom a]
readPrec :: ReadPrec (GRandom a)
$creadPrec :: forall a. Read a => ReadPrec (GRandom a)
readList :: ReadS [GRandom a]
$creadList :: forall a. Read a => ReadS [GRandom a]
readsPrec :: Int -> ReadS (GRandom a)
$creadsPrec :: forall a. Read a => Int -> ReadS (GRandom a)
Read, Typeable (GRandom a)
DataType
Constr
Typeable (GRandom a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> GRandom a -> c (GRandom a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (GRandom a))
-> (GRandom a -> Constr)
-> (GRandom a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (GRandom a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (GRandom a)))
-> ((forall b. Data b => b -> b) -> GRandom a -> GRandom a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> GRandom a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> GRandom a -> r)
-> (forall u. (forall d. Data d => d -> u) -> GRandom a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> GRandom a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> GRandom a -> m (GRandom a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GRandom a -> m (GRandom a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GRandom a -> m (GRandom a))
-> Data (GRandom a)
GRandom a -> DataType
GRandom a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (GRandom a))
(forall b. Data b => b -> b) -> GRandom a -> GRandom a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GRandom a -> c (GRandom a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GRandom a)
forall a. Data a => Typeable (GRandom a)
forall a. Data a => GRandom a -> DataType
forall a. Data a => GRandom a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> GRandom a -> GRandom a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> GRandom a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> GRandom a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GRandom a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GRandom a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> GRandom a -> m (GRandom a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> GRandom a -> m (GRandom a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GRandom a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GRandom a -> c (GRandom a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (GRandom a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GRandom a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> GRandom a -> u
forall u. (forall d. Data d => d -> u) -> GRandom a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GRandom a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GRandom a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GRandom a -> m (GRandom a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GRandom a -> m (GRandom a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GRandom a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GRandom a -> c (GRandom a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (GRandom a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GRandom a))
$cGRandom :: Constr
$tGRandom :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> GRandom a -> m (GRandom a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> GRandom a -> m (GRandom a)
gmapMp :: (forall d. Data d => d -> m d) -> GRandom a -> m (GRandom a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> GRandom a -> m (GRandom a)
gmapM :: (forall d. Data d => d -> m d) -> GRandom a -> m (GRandom a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> GRandom a -> m (GRandom a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> GRandom a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> GRandom a -> u
gmapQ :: (forall d. Data d => d -> u) -> GRandom a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> GRandom a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GRandom a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GRandom a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GRandom a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GRandom a -> r
gmapT :: (forall b. Data b => b -> b) -> GRandom a -> GRandom a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> GRandom a -> GRandom a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GRandom a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GRandom a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (GRandom a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (GRandom a))
dataTypeOf :: GRandom a -> DataType
$cdataTypeOf :: forall a. Data a => GRandom a -> DataType
toConstr :: GRandom a -> Constr
$ctoConstr :: forall a. Data a => GRandom a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GRandom a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GRandom a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GRandom a -> c (GRandom a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GRandom a -> c (GRandom a)
$cp1Data :: forall a. Data a => Typeable (GRandom a)
Data, (forall x. GRandom a -> Rep (GRandom a) x)
-> (forall x. Rep (GRandom a) x -> GRandom a)
-> Generic (GRandom a)
forall x. Rep (GRandom a) x -> GRandom a
forall x. GRandom a -> Rep (GRandom a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (GRandom a) x -> GRandom a
forall a x. GRandom a -> Rep (GRandom a) x
$cto :: forall a x. Rep (GRandom a) x -> GRandom a
$cfrom :: forall a x. GRandom a -> Rep (GRandom a) x
Generic, a -> GRandom b -> GRandom a
(a -> b) -> GRandom a -> GRandom b
(forall a b. (a -> b) -> GRandom a -> GRandom b)
-> (forall a b. a -> GRandom b -> GRandom a) -> Functor GRandom
forall a b. a -> GRandom b -> GRandom a
forall a b. (a -> b) -> GRandom a -> GRandom b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GRandom b -> GRandom a
$c<$ :: forall a b. a -> GRandom b -> GRandom a
fmap :: (a -> b) -> GRandom a -> GRandom b
$cfmap :: forall a b. (a -> b) -> GRandom a -> GRandom b
Functor, GRandom a -> Bool
(a -> m) -> GRandom a -> m
(a -> b -> b) -> b -> GRandom a -> b
(forall m. Monoid m => GRandom m -> m)
-> (forall m a. Monoid m => (a -> m) -> GRandom a -> m)
-> (forall m a. Monoid m => (a -> m) -> GRandom a -> m)
-> (forall a b. (a -> b -> b) -> b -> GRandom a -> b)
-> (forall a b. (a -> b -> b) -> b -> GRandom a -> b)
-> (forall b a. (b -> a -> b) -> b -> GRandom a -> b)
-> (forall b a. (b -> a -> b) -> b -> GRandom a -> b)
-> (forall a. (a -> a -> a) -> GRandom a -> a)
-> (forall a. (a -> a -> a) -> GRandom a -> a)
-> (forall a. GRandom a -> [a])
-> (forall a. GRandom a -> Bool)
-> (forall a. GRandom a -> Int)
-> (forall a. Eq a => a -> GRandom a -> Bool)
-> (forall a. Ord a => GRandom a -> a)
-> (forall a. Ord a => GRandom a -> a)
-> (forall a. Num a => GRandom a -> a)
-> (forall a. Num a => GRandom a -> a)
-> Foldable GRandom
forall a. Eq a => a -> GRandom a -> Bool
forall a. Num a => GRandom a -> a
forall a. Ord a => GRandom a -> a
forall m. Monoid m => GRandom m -> m
forall a. GRandom a -> Bool
forall a. GRandom a -> Int
forall a. GRandom a -> [a]
forall a. (a -> a -> a) -> GRandom a -> a
forall m a. Monoid m => (a -> m) -> GRandom a -> m
forall b a. (b -> a -> b) -> b -> GRandom a -> b
forall a b. (a -> b -> b) -> b -> GRandom a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: GRandom a -> a
$cproduct :: forall a. Num a => GRandom a -> a
sum :: GRandom a -> a
$csum :: forall a. Num a => GRandom a -> a
minimum :: GRandom a -> a
$cminimum :: forall a. Ord a => GRandom a -> a
maximum :: GRandom a -> a
$cmaximum :: forall a. Ord a => GRandom a -> a
elem :: a -> GRandom a -> Bool
$celem :: forall a. Eq a => a -> GRandom a -> Bool
length :: GRandom a -> Int
$clength :: forall a. GRandom a -> Int
null :: GRandom a -> Bool
$cnull :: forall a. GRandom a -> Bool
toList :: GRandom a -> [a]
$ctoList :: forall a. GRandom a -> [a]
foldl1 :: (a -> a -> a) -> GRandom a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> GRandom a -> a
foldr1 :: (a -> a -> a) -> GRandom a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> GRandom a -> a
foldl' :: (b -> a -> b) -> b -> GRandom a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> GRandom a -> b
foldl :: (b -> a -> b) -> b -> GRandom a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> GRandom a -> b
foldr' :: (a -> b -> b) -> b -> GRandom a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> GRandom a -> b
foldr :: (a -> b -> b) -> b -> GRandom a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> GRandom a -> b
foldMap' :: (a -> m) -> GRandom a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> GRandom a -> m
foldMap :: (a -> m) -> GRandom a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> GRandom a -> m
fold :: GRandom m -> m
$cfold :: forall m. Monoid m => GRandom m -> m
Foldable, Functor GRandom
Foldable GRandom
Functor GRandom
-> Foldable GRandom
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> GRandom a -> f (GRandom b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    GRandom (f a) -> f (GRandom a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> GRandom a -> m (GRandom b))
-> (forall (m :: * -> *) a.
    Monad m =>
    GRandom (m a) -> m (GRandom a))
-> Traversable GRandom
(a -> f b) -> GRandom a -> f (GRandom b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => GRandom (m a) -> m (GRandom a)
forall (f :: * -> *) a.
Applicative f =>
GRandom (f a) -> f (GRandom a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GRandom a -> m (GRandom b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GRandom a -> f (GRandom b)
sequence :: GRandom (m a) -> m (GRandom a)
$csequence :: forall (m :: * -> *) a. Monad m => GRandom (m a) -> m (GRandom a)
mapM :: (a -> m b) -> GRandom a -> m (GRandom b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GRandom a -> m (GRandom b)
sequenceA :: GRandom (f a) -> f (GRandom a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
GRandom (f a) -> f (GRandom a)
traverse :: (a -> f b) -> GRandom a -> f (GRandom b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GRandom a -> f (GRandom b)
$cp2Traversable :: Foldable GRandom
$cp1Traversable :: Functor GRandom
Traversable)

instance ( ADTRecord a
         , Constraints a Random
         )
      => Random (GRandom a) where
    randomR :: forall g. RandomGen g => (GRandom a, GRandom a) -> g -> (GRandom a, g)
    randomR :: (GRandom a, GRandom a) -> g -> (GRandom a, g)
randomR = ((a, a) -> g -> (a, g))
-> (GRandom a, GRandom a) -> g -> (GRandom a, g)
coerce ((ADTRecord a, Constraints a Random, RandomGen g) =>
(a, a) -> g -> (a, g)
forall a g.
(ADTRecord a, Constraints a Random, RandomGen g) =>
(a, a) -> g -> (a, g)
gRandomR @a @g)
    {-# INLINE randomR #-}
    random :: forall g. RandomGen g => g -> (GRandom a, g)
    random :: g -> (GRandom a, g)
random = (g -> (a, g)) -> g -> (GRandom a, g)
coerce ((ADTRecord a, Constraints a Random, RandomGen g) => g -> (a, g)
forall a g.
(ADTRecord a, Constraints a Random, RandomGen g) =>
g -> (a, g)
gRandom @a @g)
    {-# INLINE random #-}
    randomRs :: forall g. RandomGen g => (GRandom a, GRandom a) -> g -> [GRandom a]
    randomRs :: (GRandom a, GRandom a) -> g -> [GRandom a]
randomRs = ((a, a) -> g -> [a]) -> (GRandom a, GRandom a) -> g -> [GRandom a]
coerce ((ADTRecord a, Constraints a Random, RandomGen g) =>
(a, a) -> g -> [a]
forall a g.
(ADTRecord a, Constraints a Random, RandomGen g) =>
(a, a) -> g -> [a]
gRandomRs @a @g)
    {-# INLINE randomRs #-}
    randoms :: forall g. RandomGen g => g -> [GRandom a]
    randoms :: g -> [GRandom a]
randoms = (g -> [a]) -> g -> [GRandom a]
coerce ((ADTRecord a, Constraints a Random, RandomGen g) => g -> [a]
forall a g.
(ADTRecord a, Constraints a Random, RandomGen g) =>
g -> [a]
gRandoms @a @g)
    {-# INLINE randoms #-}

-- | '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)
gRandomR :: (a, a) -> g -> (a, g)
gRandomR (a
l, a
u) = State g a -> g -> (a, g)
forall s a. State s a -> s -> (a, s)
runState (State g a -> g -> (a, g)) -> State g a -> g -> (a, g)
forall a b. (a -> b) -> a -> b
$
    (forall s. Random s => Pair s -> State g s) -> Pair a -> State g a
forall (c :: * -> Constraint) t (f :: * -> *) (g :: * -> *).
(ADTRecord t, Constraints t c, Functor f, Applicative g) =>
(forall s. c s => f s -> g s) -> f t -> g t
dialgebra @Random
      ((g -> (s, g)) -> State g s
forall s a. (s -> (a, s)) -> State s a
State ((g -> (s, g)) -> State g s)
-> (Pair s -> g -> (s, g)) -> Pair s -> State g s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s, s) -> g -> (s, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR ((s, s) -> g -> (s, g))
-> (Pair s -> (s, s)) -> Pair s -> g -> (s, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pair s -> (s, s)
forall a. Pair a -> (a, a)
dePair)
      (a -> a -> Pair a
forall a. a -> a -> Pair a
Pair a
l a
u)
{-# INLINE gRandomR #-}

-- | '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)
gRandom :: g -> (a, g)
gRandom = State g a -> g -> (a, g)
forall s a. State s a -> s -> (a, s)
runState (State g a -> g -> (a, g)) -> State g a -> g -> (a, g)
forall a b. (a -> b) -> a -> b
$ (forall s. Random s => State g s) -> State g a
forall (c :: * -> Constraint) t (f :: * -> *).
(ADTRecord t, Constraints t c, Applicative f) =>
(forall s. c s => f s) -> f t
createA' @Random ((g -> (s, g)) -> State g s
forall s a. (s -> (a, s)) -> State s a
State g -> (s, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random)
{-# 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]
gRandomRs :: (a, a) -> g -> [a]
gRandomRs (a, a)
ival g
g = (forall b. (a -> b -> b) -> b -> b) -> [a]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\a -> b -> b
cons b
_nil -> (a -> b -> b) -> (g -> (a, g)) -> g -> b
forall g a as.
RandomGen g =>
(a -> as -> as) -> (g -> (a, g)) -> g -> as
buildRandoms a -> b -> b
cons ((a, a) -> g -> (a, g)
forall a g.
(ADTRecord a, Constraints a Random, RandomGen g) =>
(a, a) -> g -> (a, g)
gRandomR (a, a)
ival) g
g)
{-# 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]
gRandoms :: g -> [a]
gRandoms g
g = (forall b. (a -> b -> b) -> b -> b) -> [a]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\a -> b -> b
cons b
_nil -> (a -> b -> b) -> (g -> (a, g)) -> g -> b
forall g a as.
RandomGen g =>
(a -> as -> as) -> (g -> (a, g)) -> g -> as
buildRandoms a -> b -> b
cons g -> (a, g)
forall a g.
(ADTRecord a, Constraints a Random, RandomGen g) =>
g -> (a, g)
gRandom g
g)
{-# 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
gRandomRIO :: (a, a) -> IO a
gRandomRIO (a, a)
range = (StdGen -> (a, StdGen)) -> IO a
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom ((a, a) -> StdGen -> (a, StdGen)
forall a g.
(ADTRecord a, Constraints a Random, RandomGen g) =>
(a, a) -> g -> (a, g)
gRandomR (a, a)
range)
{-# 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
gRandomIO :: IO a
gRandomIO = (StdGen -> (a, StdGen)) -> IO a
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom StdGen -> (a, StdGen)
forall a g.
(ADTRecord a, Constraints a Random, RandomGen g) =>
g -> (a, g)
gRandom
{-# INLINE gRandomIO #-}

-- | If @a@ is a data type whose fields are all instances of 'Random', then
-- @'GRandom' a@ has a 'Random' instance.
--
-- Will one day be able to be used with /DerivingVia/ syntax, to derive
-- instances automatically.
--
-- A version of 'GRandom' that works for data types with multiple
-- constructors.  If your type has only one constructor, it might be more
-- performant to use 'GRandom'.
--
-- 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 { GRandomSum a -> a
getGRandomSum :: a }
  deriving (GRandomSum a -> GRandomSum a -> Bool
(GRandomSum a -> GRandomSum a -> Bool)
-> (GRandomSum a -> GRandomSum a -> Bool) -> Eq (GRandomSum a)
forall a. Eq a => GRandomSum a -> GRandomSum a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GRandomSum a -> GRandomSum a -> Bool
$c/= :: forall a. Eq a => GRandomSum a -> GRandomSum a -> Bool
== :: GRandomSum a -> GRandomSum a -> Bool
$c== :: forall a. Eq a => GRandomSum a -> GRandomSum a -> Bool
Eq, Eq (GRandomSum a)
Eq (GRandomSum a)
-> (GRandomSum a -> GRandomSum a -> Ordering)
-> (GRandomSum a -> GRandomSum a -> Bool)
-> (GRandomSum a -> GRandomSum a -> Bool)
-> (GRandomSum a -> GRandomSum a -> Bool)
-> (GRandomSum a -> GRandomSum a -> Bool)
-> (GRandomSum a -> GRandomSum a -> GRandomSum a)
-> (GRandomSum a -> GRandomSum a -> GRandomSum a)
-> Ord (GRandomSum a)
GRandomSum a -> GRandomSum a -> Bool
GRandomSum a -> GRandomSum a -> Ordering
GRandomSum a -> GRandomSum a -> GRandomSum a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (GRandomSum a)
forall a. Ord a => GRandomSum a -> GRandomSum a -> Bool
forall a. Ord a => GRandomSum a -> GRandomSum a -> Ordering
forall a. Ord a => GRandomSum a -> GRandomSum a -> GRandomSum a
min :: GRandomSum a -> GRandomSum a -> GRandomSum a
$cmin :: forall a. Ord a => GRandomSum a -> GRandomSum a -> GRandomSum a
max :: GRandomSum a -> GRandomSum a -> GRandomSum a
$cmax :: forall a. Ord a => GRandomSum a -> GRandomSum a -> GRandomSum a
>= :: GRandomSum a -> GRandomSum a -> Bool
$c>= :: forall a. Ord a => GRandomSum a -> GRandomSum a -> Bool
> :: GRandomSum a -> GRandomSum a -> Bool
$c> :: forall a. Ord a => GRandomSum a -> GRandomSum a -> Bool
<= :: GRandomSum a -> GRandomSum a -> Bool
$c<= :: forall a. Ord a => GRandomSum a -> GRandomSum a -> Bool
< :: GRandomSum a -> GRandomSum a -> Bool
$c< :: forall a. Ord a => GRandomSum a -> GRandomSum a -> Bool
compare :: GRandomSum a -> GRandomSum a -> Ordering
$ccompare :: forall a. Ord a => GRandomSum a -> GRandomSum a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (GRandomSum a)
Ord, Int -> GRandomSum a -> ShowS
[GRandomSum a] -> ShowS
GRandomSum a -> String
(Int -> GRandomSum a -> ShowS)
-> (GRandomSum a -> String)
-> ([GRandomSum a] -> ShowS)
-> Show (GRandomSum a)
forall a. Show a => Int -> GRandomSum a -> ShowS
forall a. Show a => [GRandomSum a] -> ShowS
forall a. Show a => GRandomSum a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GRandomSum a] -> ShowS
$cshowList :: forall a. Show a => [GRandomSum a] -> ShowS
show :: GRandomSum a -> String
$cshow :: forall a. Show a => GRandomSum a -> String
showsPrec :: Int -> GRandomSum a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> GRandomSum a -> ShowS
Show, ReadPrec [GRandomSum a]
ReadPrec (GRandomSum a)
Int -> ReadS (GRandomSum a)
ReadS [GRandomSum a]
(Int -> ReadS (GRandomSum a))
-> ReadS [GRandomSum a]
-> ReadPrec (GRandomSum a)
-> ReadPrec [GRandomSum a]
-> Read (GRandomSum a)
forall a. Read a => ReadPrec [GRandomSum a]
forall a. Read a => ReadPrec (GRandomSum a)
forall a. Read a => Int -> ReadS (GRandomSum a)
forall a. Read a => ReadS [GRandomSum a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GRandomSum a]
$creadListPrec :: forall a. Read a => ReadPrec [GRandomSum a]
readPrec :: ReadPrec (GRandomSum a)
$creadPrec :: forall a. Read a => ReadPrec (GRandomSum a)
readList :: ReadS [GRandomSum a]
$creadList :: forall a. Read a => ReadS [GRandomSum a]
readsPrec :: Int -> ReadS (GRandomSum a)
$creadsPrec :: forall a. Read a => Int -> ReadS (GRandomSum a)
Read, Typeable (GRandomSum a)
DataType
Constr
Typeable (GRandomSum a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> GRandomSum a -> c (GRandomSum a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (GRandomSum a))
-> (GRandomSum a -> Constr)
-> (GRandomSum a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (GRandomSum a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (GRandomSum a)))
-> ((forall b. Data b => b -> b) -> GRandomSum a -> GRandomSum a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> GRandomSum a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> GRandomSum a -> r)
-> (forall u. (forall d. Data d => d -> u) -> GRandomSum a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> GRandomSum a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> GRandomSum a -> m (GRandomSum a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GRandomSum a -> m (GRandomSum a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GRandomSum a -> m (GRandomSum a))
-> Data (GRandomSum a)
GRandomSum a -> DataType
GRandomSum a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (GRandomSum a))
(forall b. Data b => b -> b) -> GRandomSum a -> GRandomSum a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GRandomSum a -> c (GRandomSum a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GRandomSum a)
forall a. Data a => Typeable (GRandomSum a)
forall a. Data a => GRandomSum a -> DataType
forall a. Data a => GRandomSum a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> GRandomSum a -> GRandomSum a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> GRandomSum a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> GRandomSum a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GRandomSum a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GRandomSum a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> GRandomSum a -> m (GRandomSum a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> GRandomSum a -> m (GRandomSum a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GRandomSum a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GRandomSum a -> c (GRandomSum a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (GRandomSum a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GRandomSum a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> GRandomSum a -> u
forall u. (forall d. Data d => d -> u) -> GRandomSum a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GRandomSum a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GRandomSum a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GRandomSum a -> m (GRandomSum a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GRandomSum a -> m (GRandomSum a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GRandomSum a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GRandomSum a -> c (GRandomSum a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (GRandomSum a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GRandomSum a))
$cGRandomSum :: Constr
$tGRandomSum :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> GRandomSum a -> m (GRandomSum a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> GRandomSum a -> m (GRandomSum a)
gmapMp :: (forall d. Data d => d -> m d) -> GRandomSum a -> m (GRandomSum a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> GRandomSum a -> m (GRandomSum a)
gmapM :: (forall d. Data d => d -> m d) -> GRandomSum a -> m (GRandomSum a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> GRandomSum a -> m (GRandomSum a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> GRandomSum a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> GRandomSum a -> u
gmapQ :: (forall d. Data d => d -> u) -> GRandomSum a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> GRandomSum a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GRandomSum a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GRandomSum a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GRandomSum a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GRandomSum a -> r
gmapT :: (forall b. Data b => b -> b) -> GRandomSum a -> GRandomSum a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> GRandomSum a -> GRandomSum a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GRandomSum a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GRandomSum a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (GRandomSum a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (GRandomSum a))
dataTypeOf :: GRandomSum a -> DataType
$cdataTypeOf :: forall a. Data a => GRandomSum a -> DataType
toConstr :: GRandomSum a -> Constr
$ctoConstr :: forall a. Data a => GRandomSum a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GRandomSum a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GRandomSum a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GRandomSum a -> c (GRandomSum a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GRandomSum a -> c (GRandomSum a)
$cp1Data :: forall a. Data a => Typeable (GRandomSum a)
Data, (forall x. GRandomSum a -> Rep (GRandomSum a) x)
-> (forall x. Rep (GRandomSum a) x -> GRandomSum a)
-> Generic (GRandomSum a)
forall x. Rep (GRandomSum a) x -> GRandomSum a
forall x. GRandomSum a -> Rep (GRandomSum a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (GRandomSum a) x -> GRandomSum a
forall a x. GRandomSum a -> Rep (GRandomSum a) x
$cto :: forall a x. Rep (GRandomSum a) x -> GRandomSum a
$cfrom :: forall a x. GRandomSum a -> Rep (GRandomSum a) x
Generic, a -> GRandomSum b -> GRandomSum a
(a -> b) -> GRandomSum a -> GRandomSum b
(forall a b. (a -> b) -> GRandomSum a -> GRandomSum b)
-> (forall a b. a -> GRandomSum b -> GRandomSum a)
-> Functor GRandomSum
forall a b. a -> GRandomSum b -> GRandomSum a
forall a b. (a -> b) -> GRandomSum a -> GRandomSum b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GRandomSum b -> GRandomSum a
$c<$ :: forall a b. a -> GRandomSum b -> GRandomSum a
fmap :: (a -> b) -> GRandomSum a -> GRandomSum b
$cfmap :: forall a b. (a -> b) -> GRandomSum a -> GRandomSum b
Functor, GRandomSum a -> Bool
(a -> m) -> GRandomSum a -> m
(a -> b -> b) -> b -> GRandomSum a -> b
(forall m. Monoid m => GRandomSum m -> m)
-> (forall m a. Monoid m => (a -> m) -> GRandomSum a -> m)
-> (forall m a. Monoid m => (a -> m) -> GRandomSum a -> m)
-> (forall a b. (a -> b -> b) -> b -> GRandomSum a -> b)
-> (forall a b. (a -> b -> b) -> b -> GRandomSum a -> b)
-> (forall b a. (b -> a -> b) -> b -> GRandomSum a -> b)
-> (forall b a. (b -> a -> b) -> b -> GRandomSum a -> b)
-> (forall a. (a -> a -> a) -> GRandomSum a -> a)
-> (forall a. (a -> a -> a) -> GRandomSum a -> a)
-> (forall a. GRandomSum a -> [a])
-> (forall a. GRandomSum a -> Bool)
-> (forall a. GRandomSum a -> Int)
-> (forall a. Eq a => a -> GRandomSum a -> Bool)
-> (forall a. Ord a => GRandomSum a -> a)
-> (forall a. Ord a => GRandomSum a -> a)
-> (forall a. Num a => GRandomSum a -> a)
-> (forall a. Num a => GRandomSum a -> a)
-> Foldable GRandomSum
forall a. Eq a => a -> GRandomSum a -> Bool
forall a. Num a => GRandomSum a -> a
forall a. Ord a => GRandomSum a -> a
forall m. Monoid m => GRandomSum m -> m
forall a. GRandomSum a -> Bool
forall a. GRandomSum a -> Int
forall a. GRandomSum a -> [a]
forall a. (a -> a -> a) -> GRandomSum a -> a
forall m a. Monoid m => (a -> m) -> GRandomSum a -> m
forall b a. (b -> a -> b) -> b -> GRandomSum a -> b
forall a b. (a -> b -> b) -> b -> GRandomSum a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: GRandomSum a -> a
$cproduct :: forall a. Num a => GRandomSum a -> a
sum :: GRandomSum a -> a
$csum :: forall a. Num a => GRandomSum a -> a
minimum :: GRandomSum a -> a
$cminimum :: forall a. Ord a => GRandomSum a -> a
maximum :: GRandomSum a -> a
$cmaximum :: forall a. Ord a => GRandomSum a -> a
elem :: a -> GRandomSum a -> Bool
$celem :: forall a. Eq a => a -> GRandomSum a -> Bool
length :: GRandomSum a -> Int
$clength :: forall a. GRandomSum a -> Int
null :: GRandomSum a -> Bool
$cnull :: forall a. GRandomSum a -> Bool
toList :: GRandomSum a -> [a]
$ctoList :: forall a. GRandomSum a -> [a]
foldl1 :: (a -> a -> a) -> GRandomSum a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> GRandomSum a -> a
foldr1 :: (a -> a -> a) -> GRandomSum a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> GRandomSum a -> a
foldl' :: (b -> a -> b) -> b -> GRandomSum a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> GRandomSum a -> b
foldl :: (b -> a -> b) -> b -> GRandomSum a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> GRandomSum a -> b
foldr' :: (a -> b -> b) -> b -> GRandomSum a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> GRandomSum a -> b
foldr :: (a -> b -> b) -> b -> GRandomSum a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> GRandomSum a -> b
foldMap' :: (a -> m) -> GRandomSum a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> GRandomSum a -> m
foldMap :: (a -> m) -> GRandomSum a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> GRandomSum a -> m
fold :: GRandomSum m -> m
$cfold :: forall m. Monoid m => GRandomSum m -> m
Foldable, Functor GRandomSum
Foldable GRandomSum
Functor GRandomSum
-> Foldable GRandomSum
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> GRandomSum a -> f (GRandomSum b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    GRandomSum (f a) -> f (GRandomSum a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> GRandomSum a -> m (GRandomSum b))
-> (forall (m :: * -> *) a.
    Monad m =>
    GRandomSum (m a) -> m (GRandomSum a))
-> Traversable GRandomSum
(a -> f b) -> GRandomSum a -> f (GRandomSum b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
GRandomSum (m a) -> m (GRandomSum a)
forall (f :: * -> *) a.
Applicative f =>
GRandomSum (f a) -> f (GRandomSum a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GRandomSum a -> m (GRandomSum b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GRandomSum a -> f (GRandomSum b)
sequence :: GRandomSum (m a) -> m (GRandomSum a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
GRandomSum (m a) -> m (GRandomSum a)
mapM :: (a -> m b) -> GRandomSum a -> m (GRandomSum b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GRandomSum a -> m (GRandomSum b)
sequenceA :: GRandomSum (f a) -> f (GRandomSum a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
GRandomSum (f a) -> f (GRandomSum a)
traverse :: (a -> f b) -> GRandomSum a -> f (GRandomSum b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GRandomSum a -> f (GRandomSum b)
$cp2Traversable :: Foldable GRandomSum
$cp1Traversable :: Functor GRandomSum
Traversable)

instance ( ADT a
         , Constraints a Random
         )
      => Random (GRandomSum a) where
    randomR :: forall g. RandomGen g => (GRandomSum a, GRandomSum a) -> g -> (GRandomSum a, g)
    randomR :: (GRandomSum a, GRandomSum a) -> g -> (GRandomSum a, g)
randomR = ((a, a) -> g -> (a, g))
-> (GRandomSum a, GRandomSum a) -> g -> (GRandomSum a, g)
coerce ((ADT a, Constraints a Random, RandomGen g) => (a, a) -> g -> (a, g)
forall a g.
(ADT a, Constraints a Random, RandomGen g) =>
(a, a) -> g -> (a, g)
gRandomRSum @a @g)
    {-# INLINE randomR #-}
    random :: forall g. RandomGen g => g -> (GRandomSum a, g)
    random :: g -> (GRandomSum a, g)
random = (g -> (a, g)) -> g -> (GRandomSum a, g)
coerce ((ADT a, Constraints a Random, RandomGen g) => g -> (a, g)
forall a g.
(ADT a, Constraints a Random, RandomGen g) =>
g -> (a, g)
gRandomSum @a @g)
    {-# INLINE random #-}
    randomRs :: forall g. RandomGen g => (GRandomSum a, GRandomSum a) -> g -> [GRandomSum a]
    randomRs :: (GRandomSum a, GRandomSum a) -> g -> [GRandomSum a]
randomRs = ((a, a) -> g -> [a])
-> (GRandomSum a, GRandomSum a) -> g -> [GRandomSum a]
coerce ((ADT a, Constraints a Random, RandomGen g) => (a, a) -> g -> [a]
forall a g.
(ADT a, Constraints a Random, RandomGen g) =>
(a, a) -> g -> [a]
gRandomRSums @a @g)
    {-# INLINE randomRs #-}
    randoms :: forall g. RandomGen g => g -> [GRandomSum a]
    randoms :: g -> [GRandomSum a]
randoms = (g -> [a]) -> g -> [GRandomSum a]
coerce ((ADT a, Constraints a Random, RandomGen g) => g -> [a]
forall a g. (ADT a, Constraints a Random, RandomGen g) => g -> [a]
gRandomSums @a @g)
    {-# INLINE randoms #-}

-- | '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)
gRandomRSum :: (a, a) -> g -> (a, g)
gRandomRSum (a
l, a
u) = State g a -> g -> (a, g)
forall s a. State s a -> s -> (a, s)
runState (State g a -> g -> (a, g))
-> (Compose Maybe (State g) a -> State g a)
-> Compose Maybe (State g) a
-> g
-> (a, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State g a -> Maybe (State g a) -> State g a
forall a. a -> Maybe a -> a
fromMaybe (String -> State g a
forall a. HasCallStack => String -> a
error String
badbad) (Maybe (State g a) -> State g a)
-> (Compose Maybe (State g) a -> Maybe (State g a))
-> Compose Maybe (State g) a
-> State g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose Maybe (State g) a -> Maybe (State g a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose Maybe (State g) a -> g -> (a, g))
-> Compose Maybe (State g) a -> g -> (a, g)
forall a b. (a -> b) -> a -> b
$
    (forall s. Random s => s -> s -> Compose Maybe (State g) s)
-> a -> a -> Compose Maybe (State g) a
forall (c :: * -> Constraint) t (f :: * -> *).
(ADT t, Constraints t c, Alternative f) =>
(forall s. c s => s -> s -> f s) -> t -> t -> f t
zipWithA @Random (\s
l' s
u' -> Maybe (State g s) -> Compose Maybe (State g) s
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (State g s -> Maybe (State g s)
forall a. a -> Maybe a
Just ((g -> (s, g)) -> State g s
forall s a. (s -> (a, s)) -> State s a
State ((s, s) -> g -> (s, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (s
l', s
u')))))
      a
l a
u
  where
    badbad :: String
badbad = String
"gRandomRSum: Constructors in range do not match."
{-# INLINE gRandomRSum #-}

-- | '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)
gRandomSum :: g -> (a, g)
gRandomSum = case Maybe (NonEmpty (State g a))
options of
    Maybe (NonEmpty (State g a))
Nothing   -> (String -> a
forall a. HasCallStack => String -> a
error String
"gRandomSum: Uninhabited type",)
    Just NonEmpty (State g a)
opts -> State g a -> g -> (a, g)
forall s a. State s a -> s -> (a, s)
runState (State g (State g a) -> State g a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (NonEmpty (State g a) -> State g (State g a)
forall g a. RandomGen g => NonEmpty a -> State g a
reservoir NonEmpty (State g a)
opts))
  where
    options :: Maybe (NonEmpty (State g a))
options = [State g a] -> Maybe (NonEmpty (State g a))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([State g a] -> Maybe (NonEmpty (State g a)))
-> (Compose [] (State g) a -> [State g a])
-> Compose [] (State g) a
-> Maybe (NonEmpty (State g a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose [] (State g) a -> [State g a]
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose [] (State g) a -> Maybe (NonEmpty (State g a)))
-> Compose [] (State g) a -> Maybe (NonEmpty (State g a))
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
(ADT a, Constraints a Random, Alternative f) =>
(forall s. Random s => f s) -> f a
forall (c :: * -> Constraint) t (f :: * -> *).
(ADT t, Constraints t c, Alternative f) =>
(forall s. c s => f s) -> f t
createA @Random @a ((forall s. Random s => Compose [] (State g) s)
 -> Compose [] (State g) a)
-> (forall s. Random s => Compose [] (State g) s)
-> Compose [] (State g) a
forall a b. (a -> b) -> a -> b
$
        [State g s] -> Compose [] (State g) s
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose [(g -> (s, g)) -> State g s
forall s a. (s -> (a, s)) -> State s a
State g -> (s, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random]
{-# INLINE gRandomSum #-}

-- | 'randomRs' implemented by repeatedly calling 'gRandomRSum'.
--
-- 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]
gRandomRSums :: (a, a) -> g -> [a]
gRandomRSums (a, a)
ival g
g = (forall b. (a -> b -> b) -> b -> b) -> [a]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\a -> b -> b
cons b
_nil -> (a -> b -> b) -> (g -> (a, g)) -> g -> b
forall g a as.
RandomGen g =>
(a -> as -> as) -> (g -> (a, g)) -> g -> as
buildRandoms a -> b -> b
cons ((a, a) -> g -> (a, g)
forall a g.
(ADT a, Constraints a Random, RandomGen g) =>
(a, a) -> g -> (a, g)
gRandomRSum (a, a)
ival) g
g)
{-# 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]
gRandomSums :: g -> [a]
gRandomSums g
g = (forall b. (a -> b -> b) -> b -> b) -> [a]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\a -> b -> b
cons b
_nil -> (a -> b -> b) -> (g -> (a, g)) -> g -> b
forall g a as.
RandomGen g =>
(a -> as -> as) -> (g -> (a, g)) -> g -> as
buildRandoms a -> b -> b
cons g -> (a, g)
forall a g.
(ADT a, Constraints a Random, RandomGen g) =>
g -> (a, g)
gRandomSum g
g)
{-# INLINE gRandomSums #-}

-- | 'randomRIO' implemented by calling 'gRandomRSum' on the global seed.
--
-- 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
gRandomRIOSum :: (a, a) -> IO a
gRandomRIOSum (a, a)
range = (StdGen -> (a, StdGen)) -> IO a
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom ((a, a) -> StdGen -> (a, StdGen)
forall a g.
(ADT a, Constraints a Random, RandomGen g) =>
(a, a) -> g -> (a, g)
gRandomRSum (a, a)
range)
{-# INLINE gRandomRIOSum #-}

-- | 'randomIO' implemented by calling 'gRandom' on the global seed.
gRandomIOSum
    :: forall a. (ADT a, Constraints a Random)
    => IO a
gRandomIOSum :: IO a
gRandomIOSum = (StdGen -> (a, StdGen)) -> IO a
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom StdGen -> (a, StdGen)
forall a g.
(ADT a, Constraints a Random, RandomGen g) =>
g -> (a, g)
gRandomSum
{-# INLINE gRandomIOSum #-}


buildRandoms :: RandomGen g
             => (a -> as -> as)  -- ^ E.g. '(:)' but subject to fusion
             -> (g -> (a,g))     -- ^ E.g. 'random'
             -> g                -- ^ A 'RandomGen' instance
             -> as
buildRandoms :: (a -> as -> as) -> (g -> (a, g)) -> g -> as
buildRandoms a -> as -> as
cons g -> (a, g)
rand = g -> as
go
  where
    -- The seq fixes part of #4218 and also makes fused Core simpler.
    go :: g -> as
go g
g = a
x a -> as -> as
`seq` (a
x a -> as -> as
`cons` g -> as
go g
g') where (a
x,g
g') = g -> (a, g)
rand g
g
{-# INLINE buildRandoms #-}

-- | Select a random item from a non-empty list in constant memory, using
-- only a single traversal, using reservoir sampling.
reservoir :: RandomGen g => NE.NonEmpty a -> State g a
reservoir :: NonEmpty a -> State g a
reservoir (a
x :| [a]
xs) = Int -> a -> [a] -> State g a
forall s t. RandomGen s => Int -> t -> [t] -> State s t
go Int
2 a
x [a]
xs
  where
    go :: Int -> t -> [t] -> State s t
go Int
_  t
y []     = t -> State s t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
y
    go !Int
i t
y (t
z:[t]
zs) = do
      Int
j <- (s -> (Int, s)) -> State s Int
forall s a. (s -> (a, s)) -> State s a
State ((s -> (Int, s)) -> State s Int) -> (s -> (Int, s)) -> State s Int
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> s -> (Int, s)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR @Int (Int
1, Int
i)
      if Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
        then Int -> t -> [t] -> State s t
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) t
z [t]
zs
        else Int -> t -> [t] -> State s t
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) t
y [t]
zs
{-# INLINE reservoir #-}