{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-|
'Serial' instances are provided for the following types:

* 'Data.Word'
* 'Data.Word8'
* 'Data.Word16'
* 'Data.Word32'
* 'Data.Word64'
* 'Data.Int8'
* 'Data.Int16'
* 'Data.Int32'
* 'Data.Int64'
* 'Data.ByteString.ByteString'
* 'Data.ByteString.Lazy.ByteString'
* 'Data.Text.Text'
* 'Data.Text.Lazy.Text'
* 'Data.Text.Lazy.Text'
* 'Data.Set.Set'
* 'Data.Map.Map'

By default the most exhaustive series are provided which can lead to
combinatorial explosion if you are not careful. In such case, you may want to
use the functions provided in the other modules in this package to create your
own custom series.

Make sure the module where you import these instances will not be imported,
otherwise you might get conflicts between orphan instances defined in different
modules.
-}
module Test.SmallCheck.Series.Instances () where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), pure)
#endif
#if !MIN_VERSION_smallcheck(1,1,4)
import Control.Applicative ((<|>), empty)
import Control.Monad.Logic (interleave)
import Data.Int
import Data.Word
#endif
import Data.Functor.Identity (Identity)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Test.SmallCheck.Series
import Test.SmallCheck.Series.Instances.Internal
#if !MIN_VERSION_smallcheck(1,1,4)

instance Monad m => Serial m Int8 where series = ints
instance Monad m => CoSerial m Int8 where coseries = coInts

instance Monad m => Serial m Int16 where series = ints
instance Monad m => CoSerial m Int16 where coseries = coInts

instance Monad m => Serial m Int32 where series = ints
instance Monad m => CoSerial m Int32 where coseries = coInts

instance Monad m => Serial m Int64 where series = ints
instance Monad m => CoSerial m Int64 where coseries = coInts

ints :: (Monad m, Integral n, Bounded n) => Series m n
ints = generate (\d -> if d >= 0 then pure 0 else empty) <|>
    nats `interleave` (fmap negate nats)
  where
    nats = generate $ \d -> take d [1..maxBound]

coInts :: (Integral n, CoSerial m n) => Series m b -> Series m (n -> b)
coInts rs =
    alts0 rs >>- \z ->
    alts1 rs >>- \f ->
    alts1 rs >>- \g ->
    return $ \i -> if
      | i > 0 -> f (i - 1)
      | i < 0 -> g ((abs i - 1))
      | otherwise -> z

#if !MIN_VERSION_smallcheck(1,1,3)
instance Monad m => Serial m Word where series = nats0
instance Monad m => CoSerial m Word where coseries = conats0
#endif

instance Monad m => Serial m Word8 where series = nats0
instance Monad m => CoSerial m Word8 where coseries = conats0

instance Monad m => Serial m Word16 where series = nats0
instance Monad m => CoSerial m Word16 where coseries = conats0

instance Monad m => Serial m Word32 where series = nats0
instance Monad m => CoSerial m Word32 where coseries = conats0

instance Monad m => Serial m Word64 where series = nats0
instance Monad m => CoSerial m Word64 where coseries = conats0

nats0 :: (Integral n, Bounded n) => Series m n
nats0 = generate $ \d -> take (d+1) [0..maxBound]

conats0 :: (Integral a, CoSerial m a) => Series m b -> Series m (a -> b)
conats0 rs =
    alts0 rs >>- \z ->
    alts1 rs >>- \f ->
    return $ \n ->
    if n > 0
        then f (n-1)
        else z

#endif

instance Monad m => Serial m B.ByteString where
    series :: Series m ByteString
series = ByteString -> Series m ByteString
forall a (m :: * -> *). a -> Series m a
cons0 ByteString
B.empty Series m ByteString -> Series m ByteString -> Series m ByteString
forall (m :: * -> *) a.
Monad m =>
Series m a -> Series m a -> Series m a
\/ (Word8 -> ByteString -> ByteString) -> Series m ByteString
forall (m :: * -> *) a b c.
(Serial m a, Serial m b) =>
(a -> b -> c) -> Series m c
cons2 Word8 -> ByteString -> ByteString
B.cons
instance Monad m => CoSerial m B.ByteString where
    coseries :: Series m b -> Series m (ByteString -> b)
coseries Series m b
rs =
        Series m b -> Series m b
forall (m :: * -> *) a. Series m a -> Series m a
alts0 Series m b
rs Series m b
-> (b -> Series m (ByteString -> b)) -> Series m (ByteString -> b)
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \b
y ->
        Series m b -> Series m (ByteString -> ByteString -> b)
forall (m :: * -> *) a b c.
(CoSerial m a, CoSerial m b) =>
Series m c -> Series m (a -> b -> c)
alts2 Series m b
rs Series m (ByteString -> ByteString -> b)
-> ((ByteString -> ByteString -> b) -> Series m (ByteString -> b))
-> Series m (ByteString -> b)
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \ByteString -> ByteString -> b
f ->
            (ByteString -> b) -> Series m (ByteString -> b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ByteString -> b) -> Series m (ByteString -> b))
-> (ByteString -> b) -> Series m (ByteString -> b)
forall a b. (a -> b) -> a -> b
$ \ByteString
bs -> case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
bs of
                Maybe (Word8, ByteString)
Nothing -> b
y
                Just (Word8
b,ByteString
bs') -> ByteString -> ByteString -> b
f (Word8 -> ByteString
B.singleton Word8
b) ByteString
bs'

instance Monad m => Serial m BL.ByteString where
    series :: Series m ByteString
series = ByteString -> Series m ByteString
forall a (m :: * -> *). a -> Series m a
cons0 ByteString
BL.empty Series m ByteString -> Series m ByteString -> Series m ByteString
forall (m :: * -> *) a.
Monad m =>
Series m a -> Series m a -> Series m a
\/ (Word8 -> ByteString -> ByteString) -> Series m ByteString
forall (m :: * -> *) a b c.
(Serial m a, Serial m b) =>
(a -> b -> c) -> Series m c
cons2 Word8 -> ByteString -> ByteString
BL.cons
instance Monad m => CoSerial m BL.ByteString where
    coseries :: Series m b -> Series m (ByteString -> b)
coseries Series m b
rs =
        Series m b -> Series m b
forall (m :: * -> *) a. Series m a -> Series m a
alts0 Series m b
rs Series m b
-> (b -> Series m (ByteString -> b)) -> Series m (ByteString -> b)
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \b
y ->
        Series m b -> Series m (ByteString -> ByteString -> b)
forall (m :: * -> *) a b c.
(CoSerial m a, CoSerial m b) =>
Series m c -> Series m (a -> b -> c)
alts2 Series m b
rs Series m (ByteString -> ByteString -> b)
-> ((ByteString -> ByteString -> b) -> Series m (ByteString -> b))
-> Series m (ByteString -> b)
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \ByteString -> ByteString -> b
f ->
            (ByteString -> b) -> Series m (ByteString -> b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ByteString -> b) -> Series m (ByteString -> b))
-> (ByteString -> b) -> Series m (ByteString -> b)
forall a b. (a -> b) -> a -> b
$ \ByteString
bs -> case ByteString -> Maybe (Word8, ByteString)
BL.uncons ByteString
bs of
                Maybe (Word8, ByteString)
Nothing -> b
y
                Just (Word8
b,ByteString
bs') -> ByteString -> ByteString -> b
f (Word8 -> ByteString
BL.singleton Word8
b) ByteString
bs'

instance Monad m => Serial m T.Text where
    series :: Series m Text
series = Text -> Series m Text
forall a (m :: * -> *). a -> Series m a
cons0 Text
T.empty Series m Text -> Series m Text -> Series m Text
forall (m :: * -> *) a.
Monad m =>
Series m a -> Series m a -> Series m a
\/ (Char -> Text -> Text) -> Series m Text
forall (m :: * -> *) a b c.
(Serial m a, Serial m b) =>
(a -> b -> c) -> Series m c
cons2 Char -> Text -> Text
T.cons
instance Monad m => CoSerial m T.Text where
    coseries :: Series m b -> Series m (Text -> b)
coseries Series m b
rs =
        Series m b -> Series m b
forall (m :: * -> *) a. Series m a -> Series m a
alts0 Series m b
rs Series m b -> (b -> Series m (Text -> b)) -> Series m (Text -> b)
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \b
y ->
        Series m b -> Series m (Text -> Text -> b)
forall (m :: * -> *) a b c.
(CoSerial m a, CoSerial m b) =>
Series m c -> Series m (a -> b -> c)
alts2 Series m b
rs Series m (Text -> Text -> b)
-> ((Text -> Text -> b) -> Series m (Text -> b))
-> Series m (Text -> b)
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Text -> Text -> b
f ->
            (Text -> b) -> Series m (Text -> b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text -> b) -> Series m (Text -> b))
-> (Text -> b) -> Series m (Text -> b)
forall a b. (a -> b) -> a -> b
$ \Text
bs -> case Text -> Maybe (Char, Text)
T.uncons Text
bs of
                Maybe (Char, Text)
Nothing -> b
y
                Just (Char
b,Text
bs') -> Text -> Text -> b
f (Char -> Text
T.singleton Char
b) Text
bs'

instance Monad m => Serial m TL.Text where
    series :: Series m Text
series = Text -> Series m Text
forall a (m :: * -> *). a -> Series m a
cons0 Text
TL.empty Series m Text -> Series m Text -> Series m Text
forall (m :: * -> *) a.
Monad m =>
Series m a -> Series m a -> Series m a
\/ (Char -> Text -> Text) -> Series m Text
forall (m :: * -> *) a b c.
(Serial m a, Serial m b) =>
(a -> b -> c) -> Series m c
cons2 Char -> Text -> Text
TL.cons
instance Monad m => CoSerial m TL.Text where
    coseries :: Series m b -> Series m (Text -> b)
coseries Series m b
rs =
        Series m b -> Series m b
forall (m :: * -> *) a. Series m a -> Series m a
alts0 Series m b
rs Series m b -> (b -> Series m (Text -> b)) -> Series m (Text -> b)
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \b
y ->
        Series m b -> Series m (Text -> Text -> b)
forall (m :: * -> *) a b c.
(CoSerial m a, CoSerial m b) =>
Series m c -> Series m (a -> b -> c)
alts2 Series m b
rs Series m (Text -> Text -> b)
-> ((Text -> Text -> b) -> Series m (Text -> b))
-> Series m (Text -> b)
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Text -> Text -> b
f ->
            (Text -> b) -> Series m (Text -> b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text -> b) -> Series m (Text -> b))
-> (Text -> b) -> Series m (Text -> b)
forall a b. (a -> b) -> a -> b
$ \Text
bs -> case Text -> Maybe (Char, Text)
TL.uncons Text
bs of
                Maybe (Char, Text)
Nothing -> b
y
                Just (Char
b,Text
bs') -> Text -> Text -> b
f (Char -> Text
TL.singleton Char
b) Text
bs'

instance (Num a, Ord a, Serial m a, Serial Identity a) => Serial m (Set a) where
  series :: Series m (Set a)
series = ([a] -> Set a) -> Series m [a] -> Series m (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList Series m [a]
forall a (m :: * -> *).
(Ord a, Serial m a, Serial Identity a) =>
Series m [a]
sets

instance (Serial m k, Serial m v) => Serial m (Map k v) where
    series :: Series m (Map k v)
series = k -> v -> Map k v
forall k a. k -> a -> Map k a
Map.singleton (k -> v -> Map k v) -> Series m k -> Series m (v -> Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m k
forall (m :: * -> *) a. Serial m a => Series m a
series Series m (v -> Map k v) -> Series m v -> Series m (Map k v)
forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m v
forall (m :: * -> *) a. Serial m a => Series m a
series
instance (Ord k, CoSerial m k, CoSerial m v) => CoSerial m (Map k v) where
    coseries :: Series m b -> Series m (Map k v -> b)
coseries Series m b
rs =
        Series m b -> Series m b
forall (m :: * -> *) a. Series m a -> Series m a
alts0 Series m b
rs Series m b
-> (b -> Series m (Map k v -> b)) -> Series m (Map k v -> b)
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \b
y ->
        Series m b -> Series m (Map k v -> Map k v -> b)
forall (m :: * -> *) a b c.
(CoSerial m a, CoSerial m b) =>
Series m c -> Series m (a -> b -> c)
alts2 Series m b
rs Series m (Map k v -> Map k v -> b)
-> ((Map k v -> Map k v -> b) -> Series m (Map k v -> b))
-> Series m (Map k v -> b)
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Map k v -> Map k v -> b
f ->
            (Map k v -> b) -> Series m (Map k v -> b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Map k v -> b) -> Series m (Map k v -> b))
-> (Map k v -> b) -> Series m (Map k v -> b)
forall a b. (a -> b) -> a -> b
$ \Map k v
m -> case Map k v -> Maybe ((k, v), Map k v)
forall k a. Ord k => Map k a -> Maybe ((k, a), Map k a)
pop Map k v
m of
                Maybe ((k, v), Map k v)
Nothing -> b
y
                Just ((k
k,v
v), Map k v
m') -> Map k v -> Map k v -> b
f (k -> v -> Map k v
forall k a. k -> a -> Map k a
Map.singleton k
k v
v) Map k v
m'
      where
        pop :: Map k a -> Maybe ((k, a), Map k a)
pop Map k a
m = case Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k a
m of
                     [] -> Maybe ((k, a), Map k a)
forall a. Maybe a
Nothing
                     ((k, a)
kv:[(k, a)]
its) -> ((k, a), Map k a) -> Maybe ((k, a), Map k a)
forall a. a -> Maybe a
Just ((k, a)
kv, [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(k, a)]
its)