leancheck-0.9.10: src/Test/LeanCheck/Utils/Types.hs
-- |
-- Module : Test.LeanCheck.Utils.Types
-- Copyright : (c) 2015-2020 Rudy Matela
-- License : 3-Clause BSD (see the file LICENSE)
-- Maintainer : Rudy Matela <rudy@matela.com.br>
--
-- This module is part of LeanCheck,
-- a simple enumerative property-based testing library.
--
-- Types to aid in property-based testing.
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ == 708
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
#endif
module Test.LeanCheck.Utils.Types
(
-- * Integer types
--
-- | Small-width integer types to aid in property-based testing.
-- Sometimes it is useful to limit the possibilities of enumerated values
-- when testing polymorphic functions, these types allow that.
--
-- The signed integer types @IntN@ are of limited bit width @N@
-- bounded by @-2^(N-1)@ to @2^(N-1)-1@.
-- The unsigned integer types @WordN@ are of limited bit width @N@
-- bounded by @0@ to @2^N-1@.
--
-- Operations are closed and modulo @2^N@. e.g.:
--
-- > maxBound + 1 = minBound
-- > read "2" = -2 :: Int2
-- > abs minBound = minBound
-- > negate n = 2^N - n :: WordN
Int1 (..)
, Int2 (..)
, Int3 (..)
, Int4 (..)
, Word1 (..)
, Word2 (..)
, Word3 (..)
, Word4 (..)
, Nat (..)
, Nat1 (..)
, Nat2 (..)
, Nat3 (..)
, Nat4 (..)
, Nat5 (..)
, Nat6 (..)
, Nat7 (..)
, Natural (..)
-- ** Aliases to word types (deprecated)
, UInt1
, UInt2
, UInt3
, UInt4
-- * Extreme Integers
, X (..)
, Xs (..)
-- * List-wrapper types
, NoDup (..)
, Bag (..)
, Set (..)
, Map (..)
-- * Character types
, Space (..)
, Lower (..)
, Upper (..)
, Alpha (..)
, Digit (..)
, AlphaNum (..)
, Letter (..)
-- * String types
, Spaces (..)
, Lowers (..)
, Uppers (..)
, Alphas (..)
, Digits (..)
, AlphaNums (..)
, Letters (..)
-- * Generic types
, A, B, C, D, E, F
)
where
import Test.LeanCheck (Listable(..), listIntegral)
import Test.LeanCheck.Core ((+|),cons1)
import Test.LeanCheck.Tiers (noDupListCons, setCons, bagCons, mapCons)
import Data.Ratio ((%))
import Data.Ix
#if __GLASGOW_HASKELL__ == 708
import Data.Typeable (Typeable)
#endif
narrowU :: Int -> Int -> Int
narrowU w i = i `mod` 2^w
narrowS :: Int -> Int -> Int
narrowS w i = let l = 2^w
i' = i `mod` l
in if i' < 2^(w-1)
then i'
else i' - l
mapTuple :: (a -> b) -> (a,a) -> (b,b)
mapTuple f (x,y) = (f x, f y)
mapFst :: (a -> b) -> (a,c) -> (b,c)
mapFst f (x,y) = (f x,y)
oNewtype :: (a -> b) -> (b -> a) -> (a -> a -> a) -> (b -> b -> b)
oNewtype con des o = \x y -> con $ des x `o` des y
fNewtype :: (a -> b) -> (b -> a) -> (a -> a) -> (b -> b)
fNewtype con des f = con . f . des
otNewtype :: (a -> b) -> (b -> a) -> (a -> a -> (a,a)) -> (b -> b -> (b,b))
otNewtype con des o = \x y -> mapTuple con $ des x `o` des y
readsPrecNewtype :: Read a => (a -> b) -> Int -> String -> [(b,String)]
readsPrecNewtype con n = map (mapFst con) . readsPrec n
boundedEnumFrom :: (Ord a,Bounded a,Enum a) => a -> [a]
boundedEnumFrom x = [x..maxBound]
boundedEnumFromThen :: (Ord a,Bounded a,Enum a) => a -> a -> [a]
boundedEnumFromThen x y | x > y = [x,y..minBound]
| otherwise = [x,y..maxBound]
-- | Single-bit signed integers: -1, 0
newtype Int1 = Int1 { unInt1 :: Int } deriving (Eq, Ord)
-- | Two-bit signed integers: -2, -1, 0, 1
newtype Int2 = Int2 { unInt2 :: Int } deriving (Eq, Ord)
-- | Three-bit signed integers: -4, -3, -2, -1, 0, 1, 2, 3
newtype Int3 = Int3 { unInt3 :: Int } deriving (Eq, Ord)
-- | Four-bit signed integers:
-- -8, -7, -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7
newtype Int4 = Int4 { unInt4 :: Int } deriving (Eq, Ord)
-- | Single-bit unsigned integer: 0, 1
newtype Word1 = Word1 { unWord1 :: Int } deriving (Eq, Ord)
-- | Two-bit unsigned integers: 0, 1, 2, 3
newtype Word2 = Word2 { unWord2 :: Int } deriving (Eq, Ord)
-- | Three-bit unsigned integers: 0, 1, 2, 3, 4, 5, 6, 7
newtype Word3 = Word3 { unWord3 :: Int } deriving (Eq, Ord)
-- | Four-bit unsigned integers:
-- 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15
newtype Word4 = Word4 { unWord4 :: Int } deriving (Eq, Ord)
-- | Natural numbers (including 0): 0, 1, 2, 3, 4, 5, 6, 7, ...
--
-- Internally, this type is represented as an 'Integer'
-- allowing for an infinity of possible values.
--
-- Its 'Enum', 'Listable' and 'Num' instances only produce non-negative values.
-- When @x < y@ then @x - y = 0@.
newtype Natural = Natural { unNatural :: Integer } deriving (Eq, Ord)
-- | Natural numbers (including 0): 0, 1, 2, 3, 4, 5, 6, 7, ...
--
-- Internally, this type is represented as an 'Int'.
-- So, it is limited by the 'maxBound' of 'Int'.
--
-- Its 'Enum', 'Listable' and 'Num' instances only produce non-negative values.
-- When @x < y@ then @x - y = 0@.
newtype Nat = Nat { unNat :: Int } deriving (Eq, Ord)
-- | Natural numbers modulo 1: 0
newtype Nat1 = Nat1 { unNat1 :: Int } deriving (Eq, Ord)
-- | Natural numbers modulo 2: 0, 1
newtype Nat2 = Nat2 { unNat2 :: Int } deriving (Eq, Ord)
-- | Natural numbers modulo 3: 0, 1, 2
newtype Nat3 = Nat3 { unNat3 :: Int } deriving (Eq, Ord)
-- | Natural numbers modulo 4: 0, 1, 2, 3
newtype Nat4 = Nat4 { unNat4 :: Int } deriving (Eq, Ord)
-- | Natural numbers modulo 5: 0, 1, 2, 3, 4
newtype Nat5 = Nat5 { unNat5 :: Int } deriving (Eq, Ord)
-- | Natural numbers modulo 6: 0, 1, 2, 3, 4, 5
newtype Nat6 = Nat6 { unNat6 :: Int } deriving (Eq, Ord)
-- | Natural numbers modulo 7: 0, 1, 2, 3, 4, 5, 6
newtype Nat7 = Nat7 { unNat7 :: Int } deriving (Eq, Ord)
-- | Generic type 'A'.
--
-- Can be used to test polymorphic functions with a type variable
-- such as 'take' or 'sort':
--
-- > take :: Int -> [a] -> [a]
-- > sort :: Ord a => [a] -> [a]
--
-- by binding them to the following types:
--
-- > take :: Int -> [A] -> [A]
-- > sort :: [A] -> [A]
--
-- This type is homomorphic to 'Nat6', 'B', 'C', 'D', 'E' and 'F'.
--
-- It is instance to several typeclasses so that it can be used
-- to test functions with type contexts.
newtype A = A Int deriving (Eq, Ord)
-- | Generic type 'B'.
--
-- Can be used to test polymorphic functions with two type variables
-- such as 'map' or 'foldr':
--
-- > map :: (a -> b) -> [a] -> [b]
-- > foldr :: (a -> b -> b) -> b -> [a] -> b
--
-- by binding them to the following types:
--
-- > map :: (A -> B) -> [A] -> [B]
-- > foldr :: (A -> B -> B) -> B -> [A] -> B
--
-- This type is homomorphic to 'A', 'Nat6', 'C', 'D', 'E' and 'F'.
newtype B = B Int deriving (Eq, Ord)
-- | Generic type 'C'.
--
-- Can be used to test polymorphic functions with three type variables
-- such as 'uncurry' or 'zipWith':
--
-- > uncurry :: (a -> b -> c) -> (a, b) -> c
-- > zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
--
-- by binding them to the following types:
--
-- > uncurry :: (A -> B -> C) -> (A, B) -> C
-- > zipWith :: (A -> B -> C) -> [A] -> [B] -> [C]
--
-- This type is homomorphic to 'A', 'B', 'Nat6', 'D', 'E' and 'F'.
newtype C = C Int deriving (Eq, Ord)
-- | Generic type 'D'.
--
-- Can be used to test polymorphic functions with four type variables.
--
-- This type is homomorphic to 'A', 'B', 'C', 'Nat6', 'E' and 'F'.
newtype D = D Int deriving (Eq, Ord)
-- | Generic type 'E'.
--
-- Can be used to test polymorphic functions with five type variables.
--
-- This type is homomorphic to 'A', 'B', 'C', 'D', 'Nat6' and 'F'.
newtype E = E Int deriving (Eq, Ord)
-- | Generic type 'F'.
--
-- Can be used to test polymorphic functions with five type variables.
--
-- This type is homomorphic to 'A', 'B', 'C', 'D', 'E' and 'Nat6'.
newtype F = F Int deriving (Eq, Ord)
unA :: A -> Int; unA (A n) = n
unB :: B -> Int; unB (B n) = n
unC :: C -> Int; unC (C n) = n
unD :: D -> Int; unD (D n) = n
unE :: E -> Int; unE (E n) = n
unF :: F -> Int; unF (F n) = n
int1 :: Int -> Int1; int1 = Int1 . narrowS 1
int2 :: Int -> Int2; int2 = Int2 . narrowS 2
int3 :: Int -> Int3; int3 = Int3 . narrowS 3
int4 :: Int -> Int4; int4 = Int4 . narrowS 4
word1 :: Int -> Word1; word1 = Word1 . narrowU 1
word2 :: Int -> Word2; word2 = Word2 . narrowU 2
word3 :: Int -> Word3; word3 = Word3 . narrowU 3
word4 :: Int -> Word4; word4 = Word4 . narrowU 4
nat1 :: Int -> Nat1; nat1 = Nat1 . (`mod` 1)
nat2 :: Int -> Nat2; nat2 = Nat2 . (`mod` 2)
nat3 :: Int -> Nat3; nat3 = Nat3 . (`mod` 3)
nat4 :: Int -> Nat4; nat4 = Nat4 . (`mod` 4)
nat5 :: Int -> Nat5; nat5 = Nat5 . (`mod` 5)
nat6 :: Int -> Nat6; nat6 = Nat6 . (`mod` 6)
nat7 :: Int -> Nat7; nat7 = Nat7 . (`mod` 7)
nat :: Int -> Nat; nat = Nat . (\x -> if x < 0 then 0 else x)
natural :: Integer -> Natural; natural = Natural . (\x -> if x < 0 then 0 else x)
mkA :: Int -> A; mkA = A . (`mod` 6)
mkB :: Int -> B; mkB = B . (`mod` 6)
mkC :: Int -> C; mkC = C . (`mod` 6)
mkD :: Int -> D; mkD = D . (`mod` 6)
mkE :: Int -> E; mkE = E . (`mod` 6)
mkF :: Int -> F; mkF = F . (`mod` 6)
oInt1 ::(Int->Int->Int)->(Int1->Int1->Int1) ; oInt1 = oNewtype int1 unInt1
oInt2 ::(Int->Int->Int)->(Int2->Int2->Int2) ; oInt2 = oNewtype int2 unInt2
oInt3 ::(Int->Int->Int)->(Int3->Int3->Int3) ; oInt3 = oNewtype int3 unInt3
oInt4 ::(Int->Int->Int)->(Int4->Int4->Int4) ; oInt4 = oNewtype int4 unInt4
oWord1 ::(Int->Int->Int)->(Word1->Word1->Word1); oWord1 = oNewtype word1 unWord1
oWord2 ::(Int->Int->Int)->(Word2->Word2->Word2); oWord2 = oNewtype word2 unWord2
oWord3 ::(Int->Int->Int)->(Word3->Word3->Word3); oWord3 = oNewtype word3 unWord3
oWord4 ::(Int->Int->Int)->(Word4->Word4->Word4); oWord4 = oNewtype word4 unWord4
oNat ::(Int->Int->Int)->(Nat->Nat->Nat) ; oNat = oNewtype nat unNat
oNat1 ::(Int->Int->Int)->(Nat1->Nat1->Nat1) ; oNat1 = oNewtype nat1 unNat1
oNat2 ::(Int->Int->Int)->(Nat2->Nat2->Nat2) ; oNat2 = oNewtype nat2 unNat2
oNat3 ::(Int->Int->Int)->(Nat3->Nat3->Nat3) ; oNat3 = oNewtype nat3 unNat3
oNat4 ::(Int->Int->Int)->(Nat4->Nat4->Nat4) ; oNat4 = oNewtype nat4 unNat4
oNat5 ::(Int->Int->Int)->(Nat5->Nat5->Nat5) ; oNat5 = oNewtype nat5 unNat5
oNat6 ::(Int->Int->Int)->(Nat6->Nat6->Nat6) ; oNat6 = oNewtype nat6 unNat6
oNat7 ::(Int->Int->Int)->(Nat7->Nat7->Nat7) ; oNat7 = oNewtype nat7 unNat7
oNatural :: (Integer->Integer->Integer) -> (Natural->Natural->Natural)
oNatural = oNewtype natural unNatural
oA :: (Int -> Int -> Int) -> (A -> A -> A); oA = oNewtype mkA unA
oB :: (Int -> Int -> Int) -> (B -> B -> B); oB = oNewtype mkB unB
oC :: (Int -> Int -> Int) -> (C -> C -> C); oC = oNewtype mkC unC
oD :: (Int -> Int -> Int) -> (D -> D -> D); oD = oNewtype mkD unD
oE :: (Int -> Int -> Int) -> (E -> E -> E); oE = oNewtype mkE unE
oF :: (Int -> Int -> Int) -> (F -> F -> F); oF = oNewtype mkF unF
fInt1 :: (Int->Int) -> (Int1->Int1) ; fInt1 = fNewtype int1 unInt1
fInt2 :: (Int->Int) -> (Int2->Int2) ; fInt2 = fNewtype int2 unInt2
fInt3 :: (Int->Int) -> (Int3->Int3) ; fInt3 = fNewtype int3 unInt3
fInt4 :: (Int->Int) -> (Int4->Int4) ; fInt4 = fNewtype int4 unInt4
fWord1 :: (Int->Int) -> (Word1->Word1) ; fWord1 = fNewtype word1 unWord1
fWord2 :: (Int->Int) -> (Word2->Word2) ; fWord2 = fNewtype word2 unWord2
fWord3 :: (Int->Int) -> (Word3->Word3) ; fWord3 = fNewtype word3 unWord3
fWord4 :: (Int->Int) -> (Word4->Word4) ; fWord4 = fNewtype word4 unWord4
fNat :: (Int->Int) -> (Nat->Nat) ; fNat = fNewtype Nat unNat
fNat1 :: (Int->Int) -> (Nat1->Nat1) ; fNat1 = fNewtype nat1 unNat1
fNat2 :: (Int->Int) -> (Nat2->Nat2) ; fNat2 = fNewtype nat2 unNat2
fNat3 :: (Int->Int) -> (Nat3->Nat3) ; fNat3 = fNewtype nat3 unNat3
fNat4 :: (Int->Int) -> (Nat4->Nat4) ; fNat4 = fNewtype nat4 unNat4
fNat5 :: (Int->Int) -> (Nat5->Nat5) ; fNat5 = fNewtype nat5 unNat5
fNat6 :: (Int->Int) -> (Nat6->Nat6) ; fNat6 = fNewtype nat6 unNat6
fNat7 :: (Int->Int) -> (Nat7->Nat7) ; fNat7 = fNewtype nat7 unNat7
fNatural :: (Integer->Integer) -> (Natural->Natural)
fNatural = fNewtype Natural unNatural
fA :: (Int -> Int) -> (A -> A); fA = fNewtype mkA unA
fB :: (Int -> Int) -> (B -> B); fB = fNewtype mkB unB
fC :: (Int -> Int) -> (C -> C); fC = fNewtype mkC unC
fD :: (Int -> Int) -> (D -> D); fD = fNewtype mkD unD
fE :: (Int -> Int) -> (E -> E); fE = fNewtype mkE unE
fF :: (Int -> Int) -> (F -> F); fF = fNewtype mkF unF
instance Show Int1 where show = show . unInt1
instance Show Int2 where show = show . unInt2
instance Show Int3 where show = show . unInt3
instance Show Int4 where show = show . unInt4
instance Show Word1 where show = show . unWord1
instance Show Word2 where show = show . unWord2
instance Show Word3 where show = show . unWord3
instance Show Word4 where show = show . unWord4
instance Show Nat where show (Nat x) = show x
instance Show Nat1 where show = show . unNat1
instance Show Nat2 where show = show . unNat2
instance Show Nat3 where show = show . unNat3
instance Show Nat4 where show = show . unNat4
instance Show Nat5 where show = show . unNat5
instance Show Nat6 where show = show . unNat6
instance Show Nat7 where show = show . unNat7
instance Show Natural where show (Natural x) = show x
instance Show A where show = show . unA
instance Show B where show = show . unB
instance Show C where show = show . unC
instance Show D where show = show . unD
instance Show E where show = show . unE
instance Show F where show = show . unF
instance Read Int1 where readsPrec = readsPrecNewtype int1
instance Read Int2 where readsPrec = readsPrecNewtype int2
instance Read Int3 where readsPrec = readsPrecNewtype int3
instance Read Int4 where readsPrec = readsPrecNewtype int4
instance Read Word1 where readsPrec = readsPrecNewtype word1
instance Read Word2 where readsPrec = readsPrecNewtype word2
instance Read Word3 where readsPrec = readsPrecNewtype word3
instance Read Word4 where readsPrec = readsPrecNewtype word4
instance Read Nat where readsPrec = readsPrecNewtype nat
instance Read Nat1 where readsPrec = readsPrecNewtype nat1
instance Read Nat2 where readsPrec = readsPrecNewtype nat2
instance Read Nat3 where readsPrec = readsPrecNewtype nat3
instance Read Nat4 where readsPrec = readsPrecNewtype nat4
instance Read Nat5 where readsPrec = readsPrecNewtype nat5
instance Read Nat6 where readsPrec = readsPrecNewtype nat6
instance Read Nat7 where readsPrec = readsPrecNewtype nat7
instance Read Natural where readsPrec = readsPrecNewtype natural
instance Read A where readsPrec = readsPrecNewtype mkA
instance Read B where readsPrec = readsPrecNewtype mkB
instance Read C where readsPrec = readsPrecNewtype mkC
instance Read D where readsPrec = readsPrecNewtype mkD
instance Read E where readsPrec = readsPrecNewtype mkE
instance Read F where readsPrec = readsPrecNewtype mkF
instance Num Int1 where (+) = oInt1 (+); abs = fInt1 abs
(-) = oInt1 (-); signum = fInt1 signum
(*) = oInt1 (*); fromInteger = int1 . fromInteger
instance Num Int2 where (+) = oInt2 (+); abs = fInt2 abs
(-) = oInt2 (-); signum = fInt2 signum
(*) = oInt2 (*); fromInteger = int2 . fromInteger
instance Num Int3 where (+) = oInt3 (+); abs = fInt3 abs
(-) = oInt3 (-); signum = fInt3 signum
(*) = oInt3 (*); fromInteger = int3 . fromInteger
instance Num Int4 where (+) = oInt4 (+); abs = fInt4 abs
(-) = oInt4 (-); signum = fInt4 signum
(*) = oInt4 (*); fromInteger = int4 . fromInteger
instance Num Word1 where (+) = oWord1 (+); abs = fWord1 abs
(-) = oWord1 (-); signum = fWord1 signum
(*) = oWord1 (*); fromInteger = word1 . fromInteger
instance Num Word2 where (+) = oWord2 (+); abs = fWord2 abs
(-) = oWord2 (-); signum = fWord2 signum
(*) = oWord2 (*); fromInteger = word2 . fromInteger
instance Num Word3 where (+) = oWord3 (+); abs = fWord3 abs
(-) = oWord3 (-); signum = fWord3 signum
(*) = oWord3 (*); fromInteger = word3 . fromInteger
instance Num Word4 where (+) = oWord4 (+); abs = fWord4 abs
(-) = oWord4 (-); signum = fWord4 signum
(*) = oWord4 (*); fromInteger = word4 . fromInteger
instance Num Nat where (+) = oNat (+); abs = fNat abs
(-) = oNat (-); signum = fNat signum
(*) = oNat (*); fromInteger = nat . fromInteger
instance Num Nat1 where (+) = oNat1 (+); abs = fNat1 abs
(-) = oNat1 (-); signum = fNat1 signum
(*) = oNat1 (*); fromInteger = nat1 . fromInteger
instance Num Nat2 where (+) = oNat2 (+); abs = fNat2 abs
(-) = oNat2 (-); signum = fNat2 signum
(*) = oNat2 (*); fromInteger = nat2 . fromInteger
instance Num Nat3 where (+) = oNat3 (+); abs = fNat3 abs
(-) = oNat3 (-); signum = fNat3 signum
(*) = oNat3 (*); fromInteger = nat3 . fromInteger
instance Num Nat4 where (+) = oNat4 (+); abs = fNat4 abs
(-) = oNat4 (-); signum = fNat4 signum
(*) = oNat4 (*); fromInteger = nat4 . fromInteger
instance Num Nat5 where (+) = oNat5 (+); abs = fNat5 abs
(-) = oNat5 (-); signum = fNat5 signum
(*) = oNat5 (*); fromInteger = nat5 . fromInteger
instance Num Nat6 where (+) = oNat6 (+); abs = fNat6 abs
(-) = oNat6 (-); signum = fNat6 signum
(*) = oNat6 (*); fromInteger = nat6 . fromInteger
instance Num Nat7 where (+) = oNat7 (+); abs = fNat7 abs
(-) = oNat7 (-); signum = fNat7 signum
(*) = oNat7 (*); fromInteger = nat7 . fromInteger
instance Num Natural where
(+) = oNatural (+); abs = fNatural abs
(-) = oNatural (-); signum = fNatural signum
(*) = oNatural (*); fromInteger = natural . fromInteger
instance Num A where (+) = oA (+); abs = fA abs
(-) = oA (-); signum = fA signum
(*) = oA (*); fromInteger = mkA . fromInteger
instance Num B where (+) = oB (+); abs = fB abs
(-) = oB (-); signum = fB signum
(*) = oB (*); fromInteger = mkB . fromInteger
instance Num C where (+) = oC (+); abs = fC abs
(-) = oC (-); signum = fC signum
(*) = oC (*); fromInteger = mkC . fromInteger
instance Num D where (+) = oD (+); abs = fD abs
(-) = oD (-); signum = fD signum
(*) = oD (*); fromInteger = mkD . fromInteger
instance Num E where (+) = oE (+); abs = fE abs
(-) = oE (-); signum = fE signum
(*) = oE (*); fromInteger = mkE . fromInteger
instance Num F where (+) = oF (+); abs = fF abs
(-) = oF (-); signum = fF signum
(*) = oF (*); fromInteger = mkF . fromInteger
instance Real Int1 where toRational (Int1 x) = fromIntegral x % 1
instance Real Int2 where toRational (Int2 x) = fromIntegral x % 1
instance Real Int3 where toRational (Int3 x) = fromIntegral x % 1
instance Real Int4 where toRational (Int4 x) = fromIntegral x % 1
instance Real Word1 where toRational (Word1 x) = fromIntegral x % 1
instance Real Word2 where toRational (Word2 x) = fromIntegral x % 1
instance Real Word3 where toRational (Word3 x) = fromIntegral x % 1
instance Real Word4 where toRational (Word4 x) = fromIntegral x % 1
instance Real Nat where toRational (Nat x) = fromIntegral x % 1
instance Real Nat1 where toRational (Nat1 x) = fromIntegral x % 1
instance Real Nat2 where toRational (Nat2 x) = fromIntegral x % 1
instance Real Nat3 where toRational (Nat3 x) = fromIntegral x % 1
instance Real Nat4 where toRational (Nat4 x) = fromIntegral x % 1
instance Real Nat5 where toRational (Nat5 x) = fromIntegral x % 1
instance Real Nat6 where toRational (Nat6 x) = fromIntegral x % 1
instance Real Nat7 where toRational (Nat7 x) = fromIntegral x % 1
instance Real Natural where toRational (Natural x) = fromIntegral x % 1
instance Real A where toRational (A x) = fromIntegral x % 1
instance Real B where toRational (B x) = fromIntegral x % 1
instance Real C where toRational (C x) = fromIntegral x % 1
instance Real D where toRational (D x) = fromIntegral x % 1
instance Real E where toRational (E x) = fromIntegral x % 1
instance Real F where toRational (F x) = fromIntegral x % 1
instance Integral Int1 where quotRem = otNewtype int1 unInt1 quotRem
toInteger = toInteger . unInt1
instance Integral Int2 where quotRem = otNewtype int2 unInt2 quotRem
toInteger = toInteger . unInt2
instance Integral Int3 where quotRem = otNewtype int3 unInt3 quotRem
toInteger = toInteger . unInt3
instance Integral Int4 where quotRem = otNewtype int4 unInt4 quotRem
toInteger = toInteger . unInt4
instance Integral Word1 where quotRem = otNewtype word1 unWord1 quotRem
toInteger = toInteger . unWord1
instance Integral Word2 where quotRem = otNewtype word2 unWord2 quotRem
toInteger = toInteger . unWord2
instance Integral Word3 where quotRem = otNewtype word3 unWord3 quotRem
toInteger = toInteger . unWord3
instance Integral Word4 where quotRem = otNewtype word4 unWord4 quotRem
toInteger = toInteger . unWord4
instance Integral Nat where quotRem = otNewtype Nat unNat quotRem
toInteger = toInteger . unNat
instance Integral Nat1 where quotRem = otNewtype nat1 unNat1 quotRem
toInteger = toInteger . unNat1
instance Integral Nat2 where quotRem = otNewtype nat2 unNat2 quotRem
toInteger = toInteger . unNat2
instance Integral Nat3 where quotRem = otNewtype nat3 unNat3 quotRem
toInteger = toInteger . unNat3
instance Integral Nat4 where quotRem = otNewtype nat4 unNat4 quotRem
toInteger = toInteger . unNat4
instance Integral Nat5 where quotRem = otNewtype nat5 unNat5 quotRem
toInteger = toInteger . unNat5
instance Integral Nat6 where quotRem = otNewtype nat6 unNat6 quotRem
toInteger = toInteger . unNat6
instance Integral Nat7 where quotRem = otNewtype nat7 unNat7 quotRem
toInteger = toInteger . unNat7
instance Integral Natural where quotRem = otNewtype natural unNatural quotRem
toInteger = toInteger . unNatural
instance Integral A where quotRem = otNewtype mkA unA quotRem
toInteger = toInteger . unA
instance Integral B where quotRem = otNewtype mkB unB quotRem
toInteger = toInteger . unB
instance Integral C where quotRem = otNewtype mkC unC quotRem
toInteger = toInteger . unC
instance Integral D where quotRem = otNewtype mkD unD quotRem
toInteger = toInteger . unD
instance Integral E where quotRem = otNewtype mkE unE quotRem
toInteger = toInteger . unE
instance Integral F where quotRem = otNewtype mkF unF quotRem
toInteger = toInteger . unF
instance Bounded Int1 where maxBound = Int1 0; minBound = Int1 (-1)
instance Bounded Int2 where maxBound = Int2 1; minBound = Int2 (-2)
instance Bounded Int3 where maxBound = Int3 3; minBound = Int3 (-4)
instance Bounded Int4 where maxBound = Int4 7; minBound = Int4 (-8)
instance Bounded Word1 where maxBound = Word1 1; minBound = Word1 0
instance Bounded Word2 where maxBound = Word2 3; minBound = Word2 0
instance Bounded Word3 where maxBound = Word3 7; minBound = Word3 0
instance Bounded Word4 where maxBound = Word4 15; minBound = Word4 0
instance Bounded Nat where maxBound = Nat maxBound; minBound = Nat 0
instance Bounded Nat1 where maxBound = Nat1 0; minBound = Nat1 0
instance Bounded Nat2 where maxBound = Nat2 1; minBound = Nat2 0
instance Bounded Nat3 where maxBound = Nat3 2; minBound = Nat3 0
instance Bounded Nat4 where maxBound = Nat4 3; minBound = Nat4 0
instance Bounded Nat5 where maxBound = Nat5 4; minBound = Nat5 0
instance Bounded Nat6 where maxBound = Nat6 5; minBound = Nat6 0
instance Bounded Nat7 where maxBound = Nat7 6; minBound = Nat7 0
instance Bounded A where maxBound = A 5; minBound = A 0
instance Bounded B where maxBound = B 5; minBound = B 0
instance Bounded C where maxBound = C 5; minBound = C 0
instance Bounded D where maxBound = D 5; minBound = D 0
instance Bounded E where maxBound = E 5; minBound = E 0
instance Bounded F where maxBound = F 5; minBound = F 0
instance Enum Int1 where toEnum = int1; enumFrom = boundedEnumFrom
fromEnum = unInt1; enumFromThen = boundedEnumFromThen
instance Enum Int2 where toEnum = int2; enumFrom = boundedEnumFrom
fromEnum = unInt2; enumFromThen = boundedEnumFromThen
instance Enum Int3 where toEnum = int3; enumFrom = boundedEnumFrom
fromEnum = unInt3; enumFromThen = boundedEnumFromThen
instance Enum Int4 where toEnum = int4; enumFrom = boundedEnumFrom
fromEnum = unInt4; enumFromThen = boundedEnumFromThen
instance Enum Word1 where toEnum = word1; enumFrom = boundedEnumFrom
fromEnum = unWord1; enumFromThen = boundedEnumFromThen
instance Enum Word2 where toEnum = word2; enumFrom = boundedEnumFrom
fromEnum = unWord2; enumFromThen = boundedEnumFromThen
instance Enum Word3 where toEnum = word3; enumFrom = boundedEnumFrom
fromEnum = unWord3; enumFromThen = boundedEnumFromThen
instance Enum Word4 where toEnum = word4; enumFrom = boundedEnumFrom
fromEnum = unWord4; enumFromThen = boundedEnumFromThen
instance Enum Nat where toEnum = nat; enumFrom = boundedEnumFrom
fromEnum = unNat; enumFromThen = boundedEnumFromThen
instance Enum Nat1 where toEnum = nat1; enumFrom = boundedEnumFrom
fromEnum = unNat1; enumFromThen = boundedEnumFromThen
instance Enum Nat2 where toEnum = nat2; enumFrom = boundedEnumFrom
fromEnum = unNat2; enumFromThen = boundedEnumFromThen
instance Enum Nat3 where toEnum = nat3; enumFrom = boundedEnumFrom
fromEnum = unNat3; enumFromThen = boundedEnumFromThen
instance Enum Nat4 where toEnum = nat4; enumFrom = boundedEnumFrom
fromEnum = unNat4; enumFromThen = boundedEnumFromThen
instance Enum Nat5 where toEnum = nat5; enumFrom = boundedEnumFrom
fromEnum = unNat5; enumFromThen = boundedEnumFromThen
instance Enum Nat6 where toEnum = nat6; enumFrom = boundedEnumFrom
fromEnum = unNat6; enumFromThen = boundedEnumFromThen
instance Enum Nat7 where toEnum = nat7; enumFrom = boundedEnumFrom
fromEnum = unNat7; enumFromThen = boundedEnumFromThen
instance Enum Natural where
toEnum = natural . fromIntegral
fromEnum = fromInteger . unNatural;
enumFrom (Natural x) = map Natural [x..]
enumFromThen (Natural x) (Natural s) = map Natural [x,s..]
instance Enum A where toEnum = mkA; enumFrom = boundedEnumFrom
fromEnum = unA; enumFromThen = boundedEnumFromThen
instance Enum B where toEnum = mkB; enumFrom = boundedEnumFrom
fromEnum = unB; enumFromThen = boundedEnumFromThen
instance Enum C where toEnum = mkC; enumFrom = boundedEnumFrom
fromEnum = unC; enumFromThen = boundedEnumFromThen
instance Enum D where toEnum = mkD; enumFrom = boundedEnumFrom
fromEnum = unD; enumFromThen = boundedEnumFromThen
instance Enum E where toEnum = mkE; enumFrom = boundedEnumFrom
fromEnum = unE; enumFromThen = boundedEnumFromThen
instance Enum F where toEnum = mkF; enumFrom = boundedEnumFrom
fromEnum = unF; enumFromThen = boundedEnumFromThen
range' :: Enum a => (a,a) -> [a]
range' (m,n) = [m..n]
index' :: Integral a => (a,a) -> a -> Int
index' b@(m,_) i | inRange' b i = fromIntegral (i - m)
| otherwise = error "Index out of range."
inRange' :: Ord a => (a,a) -> a -> Bool
inRange' (m,n) i = m <= i && i <= m
instance Ix Int1 where range = range'; index = index'; inRange = inRange'
instance Ix Int2 where range = range'; index = index'; inRange = inRange'
instance Ix Int3 where range = range'; index = index'; inRange = inRange'
instance Ix Int4 where range = range'; index = index'; inRange = inRange'
instance Ix Word1 where range = range'; index = index'; inRange = inRange'
instance Ix Word2 where range = range'; index = index'; inRange = inRange'
instance Ix Word3 where range = range'; index = index'; inRange = inRange'
instance Ix Word4 where range = range'; index = index'; inRange = inRange'
instance Ix Nat where range = range'; index = index'; inRange = inRange'
instance Ix Nat1 where range = range'; index = index'; inRange = inRange'
instance Ix Nat2 where range = range'; index = index'; inRange = inRange'
instance Ix Nat3 where range = range'; index = index'; inRange = inRange'
instance Ix Nat4 where range = range'; index = index'; inRange = inRange'
instance Ix Nat5 where range = range'; index = index'; inRange = inRange'
instance Ix Nat6 where range = range'; index = index'; inRange = inRange'
instance Ix Nat7 where range = range'; index = index'; inRange = inRange'
instance Ix Natural where range = range'; index = index'; inRange = inRange'
instance Ix A where range = range'; index = index'; inRange = inRange'
instance Ix B where range = range'; index = index'; inRange = inRange'
instance Ix C where range = range'; index = index'; inRange = inRange'
instance Ix D where range = range'; index = index'; inRange = inRange'
instance Ix E where range = range'; index = index'; inRange = inRange'
instance Ix F where range = range'; index = index'; inRange = inRange'
instance Listable Int1 where list = [0,minBound]
instance Listable Int2 where list = listIntegral
instance Listable Int3 where list = listIntegral
instance Listable Int4 where list = listIntegral
instance Listable Word1 where list = listIntegral
instance Listable Word2 where list = listIntegral
instance Listable Word3 where list = listIntegral
instance Listable Word4 where list = listIntegral
instance Listable Nat where list = listIntegral
instance Listable Nat1 where list = listIntegral
instance Listable Nat2 where list = listIntegral
instance Listable Nat3 where list = listIntegral
instance Listable Nat4 where list = listIntegral
instance Listable Nat5 where list = listIntegral
instance Listable Nat6 where list = listIntegral
instance Listable Nat7 where list = listIntegral
instance Listable Natural where list = listIntegral
instance Listable A where list = listIntegral
instance Listable B where list = listIntegral
instance Listable C where list = listIntegral
instance Listable D where list = listIntegral
instance Listable E where list = listIntegral
instance Listable F where list = listIntegral
-- | Deprecated. Use 'Word1'.
type UInt1 = Word1
-- | Deprecated. Use 'Word2'.
type UInt2 = Word2
-- | Deprecated. Use 'Word3'.
type UInt3 = Word3
-- | Deprecated. Use 'Word4'.
type UInt4 = Word4
-- | Lists without repeated elements.
--
-- > > take 6 $ list :: [NoDup Nat]
-- > [NoDup [],NoDup [0],NoDup [1],NoDup [0,1],NoDup [1,0],NoDup [2]]
--
-- Example, checking the property that @nub@ is an identity:
--
-- > import Data.List (nub)
-- > > check $ \xs -> nub xs == (xs :: [Int])
-- > *** Failed! Falsifiable (after 3 tests):
-- > [0,0]
-- > > check $ \(NoDup xs) -> nub xs == (xs :: [Int])
-- > +++ OK, passed 200 tests.
newtype NoDup a = NoDup [a] deriving (Show, Read, Eq, Ord)
-- | Lists representing bags (multisets).
-- The 'Listable' 'tiers' enumeration will not have repeated bags.
--
-- > > take 6 (list :: [Bag Nat])
-- > [Bag [],Bag [0],Bag [0,0],Bag [1],Bag [0,0,0],Bag [0,1]]
--
-- See also: 'Test.LeanCheck.Tiers.bagsOf' and 'bagCons'.
newtype Bag a = Bag [a] deriving (Show, Read, Eq, Ord)
-- | Lists representing sets.
-- The 'Listable' 'tiers' enumeration will not have repeated sets.
--
-- > > take 6 (list :: [Set Nat])
-- > [Set [],Set [0],Set [1],Set [0,1],Set [2],Set [0,2]]
newtype Set a = Set [a] deriving (Show, Read, Eq, Ord)
-- | Lists of pairs representing maps.
-- The 'Listable' 'tiers' enumeration will not have repeated maps.
--
-- > > take 6 (list :: [Map Nat Nat])
-- > [Map [],Map [(0,0)],Map [(0,1)],Map [(1,0)],Map [(0,2)],Map [(1,1)]]
newtype Map a b = Map [(a,b)] deriving (Show, Read, Eq, Ord)
instance Listable a => Listable (NoDup a) where tiers = noDupListCons NoDup
instance Listable a => Listable (Bag a) where tiers = bagCons Bag
instance Listable a => Listable (Set a) where tiers = setCons Set
instance (Listable a, Listable b)
=> Listable (Map a b) where tiers = mapCons Map
-- | 'X' type to be wrapped around integer types for an e-'X'-treme integer
-- enumeration. See the 'Listable' instance for 'X'. Use 'X' when
-- testing properties about overflows and the like:
--
-- > > check $ \x -> x + 1 > (x :: Int)
-- > +++ OK, passed 200 tests.
--
-- > > check $ \(X x) -> x + 1 > (x :: Int)
-- > +++ Failed! Falsifiable (after 4 tests):
-- > 9223372036854775807
newtype X a = X {unX :: a} deriving (Eq, Ord)
instance Show a => Show (X a) where show (X x) = show x
instance (Integral a, Bounded a) => Listable (X a) where list = map X listXIntegral
-- ^ Extremily large integers are intercalated with small integers.
--
-- > list :: [X Int] = map X
-- > [ 0, 1, -1, maxBound, minBound
-- > , 2, -2, maxBound-1, minBound+1
-- > , 3, -3, maxBound-2, minBound+2
-- > , ... ]
-- FIXME: make this work for Int2 / Word2 types
-- by checking then using normal enumeration
listXIntegral :: (Bounded a, Integral a) => [a]
listXIntegral = l undefined
where
l :: (Bounded a, Integral a) => a -> [a]
l a | count a <= 4 = listIntegral
| min < 0 = listXIntegralN
| otherwise = listXIntegralP
where
min = minBound `asTypeOf` a
-- The type-hackery above is needed so that we don't need to activate
-- ScopedTypeVariables
listXIntegralN :: (Bounded a, Integral a) => [a]
listXIntegralN = 0 : (extremes 1 maxBound) +| (extremes (-1) minBound)
-- listXIntegralN :: Int4 =
-- 0 : (([1,2,3,4] +| [7,6,5]) +| ([-1,-2,-3,-4] +| [-8,-7,-6,-5]))
listXIntegralP :: (Bounded a, Integral a) => [a]
listXIntegralP = 0 : [1..midBound] ++| [maxBound,(maxBound-1)..(midBound+1)]
where
midBound = maxBound `div` 3 * 2
-- how many of this type exist?
-- assumes 0 `elem` [minBound..maxBound]
count :: (Bounded a, Integral a) => a -> Integer
count a = 1 + max + abs min
where
min = fromIntegral $ minBound `asTypeOf` a
max = fromIntegral $ maxBound `asTypeOf` a
extremes :: (Integral a) => a -> a -> [a]
extremes x y
| x > y = [x,x-1..m] +| [y..m-1]
| otherwise = [x..m] +| [y,y-1..m+1]
where m = mid x y
mid :: Integral a => a -> a -> a
mid x y = x `div` 2
+ y `div` 2
+ if odd x && odd y then 1 else 0
-- | Lazily interleaves two lists, switching between elements of the two.
-- This version uses the first list more frequently than the second.
--
-- > [x,y,z,w] +| [a,b] == [x,y, a, z,w, b]
(++|) :: [a] -> [a] -> [a]
[] ++| ys = ys
xs ++| [] = xs
[x] ++| ys = x:ys
(x:x':xs) ++| (y:ys) = x:x':y:(xs ++| ys)
infixr 5 ++|
-- | Wrap around lists of integers for an enumeration containing e-'X'-treme
-- integer values.
--
-- > > check $ \xs -> all (>=0) xs ==> sum (take 1 xs :: [Int]) <= sum xs
-- > +++ OK, passed 200 tests.
--
-- > > check $ \(Xs xs) -> all (>=0) xs ==> sum (take 1 xs :: [Int]) <= sum xs
-- > *** Failed! Falsifiable (after 56 tests):
-- > [1,9223372036854775807]
newtype Xs a = Xs [a] deriving (Eq, Ord, Show, Read)
instance (Integral a, Bounded a) => Listable (Xs a) where
tiers = cons1 (Xs . map unX)
-- ^ Lists with elements of the 'X' type.
-- | Space characters.
--
-- > list :: [Space] = " \t\n\r\f\v"
--
-- > > check $ \(Space c) -> isSpace c
-- > +++ OK, passed 6 tests (exhausted).
data Space = Space {unSpace :: Char}
-- | Lowercase characters.
--
-- > list :: [Lower] = "abcdef..."
--
-- > > check $ \(Lower c) -> isLower c
-- > +++ OK, passed 26 tests (exhausted).
data Lower = Lower {unLower :: Char}
-- | Uppercase characters.
--
-- > list :: [Upper] = "ABCDEF..."
--
-- > > check $ \(Upper c) -> isUpper c
-- > +++ OK, passed 26 tests (exhausted).
data Upper = Upper {unUpper :: Char}
-- | Alphabetic characters.
--
-- > list :: [Alpha] = "aAbBcC..."
--
-- > > check $ \(Alpha c) -> isAlpha c
-- > +++ OK, passed 52 tests (exhausted).
--
-- Equivalent to 'Letter'.
data Alpha = Alpha {unAlpha :: Char}
-- | Digits.
--
-- > list :: [Digit] = "0123456789"
--
-- > > check $ \(Digit c) -> isDigit c
-- > +++ OK, passed 10 tests (exhausted).
data Digit = Digit {unDigit :: Char}
-- | Alphanumeric characters.
--
-- > list :: [AlphaNum] = "0a1A2b3B4c..."
--
-- > > check $ \(AlphaNum c) -> isAlphaNum c
-- > +++ OK, passed 62 tests (exhausted).
data AlphaNum = AlphaNum {unAlphaNum :: Char}
-- | Alphabetic characters.
--
-- > list :: [Letter] = "aAbBcC..."
--
-- > > check $ \(Letter c) -> isLetter c
-- > +++ OK, passed 52 tests (exhausted).
--
-- Equivalent to 'Alpha'.
data Letter = Letter {unLetter :: Char}
instance Show Space where show = show . unSpace
instance Show Lower where show = show . unLower
instance Show Upper where show = show . unUpper
instance Show Alpha where show = show . unAlpha
instance Show Digit where show = show . unDigit
instance Show AlphaNum where show = show . unAlphaNum
instance Show Letter where show = show . unLetter
instance Listable Space where list = map Space [' ', '\t', '\n', '\r', '\f', '\v']
instance Listable Lower where list = map Lower ['a'..'z']
instance Listable Upper where list = map Upper ['A'..'Z']
instance Listable Alpha where list = map Alpha $ ['a'..'z'] +| ['A'..'Z']
instance Listable Digit where list = map Digit ['0'..'9']
instance Listable AlphaNum where list = map AlphaNum $ ['0'..'9'] +| ['a'..'z'] +| ['A'..'Z']
instance Listable Letter where list = map Letter $ ['a'..'z'] +| ['A'..'Z']
-- | Strings of spaces.
data Spaces = Spaces {unSpaces :: String}
-- | Strings of lowercase characters.
data Lowers = Lowers {unLowers :: String}
-- | Strings of uppercase characters
data Uppers = Uppers {unUppers :: String}
-- | Strings of alphabetic characters
data Alphas = Alphas {unAlphas :: String}
-- | Strings of digits.
data Digits = Digits {unDigits :: String}
-- | Strings of alphanumeric characters
data AlphaNums = AlphaNums {unAlphaNums :: String}
-- | Strings of letters
data Letters = Letters {unLetters :: String}
instance Show Spaces where show = show . unSpaces
instance Show Lowers where show = show . unLowers
instance Show Uppers where show = show . unUppers
instance Show Alphas where show = show . unAlphas
instance Show Digits where show = show . unDigits
instance Show AlphaNums where show = show . unAlphaNums
instance Show Letters where show = show . unLetters
instance Listable Spaces where tiers = cons1 (Spaces . map unSpace)
instance Listable Lowers where tiers = cons1 (Lowers . map unLower)
instance Listable Uppers where tiers = cons1 (Uppers . map unUpper)
instance Listable Alphas where tiers = cons1 (Alphas . map unAlpha)
instance Listable Digits where tiers = cons1 (Digits . map unDigit)
instance Listable AlphaNums where tiers = cons1 (AlphaNums . map unAlphaNum)
instance Listable Letters where tiers = cons1 (Letters . map unLetter)
#if __GLASGOW_HASKELL__ == 708
-- there's no need to derive these on GHC >= 7.10
-- as they are automatically derived
deriving instance Typeable Int1
deriving instance Typeable Int2
deriving instance Typeable Int3
deriving instance Typeable Int4
deriving instance Typeable Word1
deriving instance Typeable Word2
deriving instance Typeable Word3
deriving instance Typeable Word4
deriving instance Typeable Nat
deriving instance Typeable Nat1
deriving instance Typeable Nat2
deriving instance Typeable Nat3
deriving instance Typeable Nat4
deriving instance Typeable Nat5
deriving instance Typeable Nat6
deriving instance Typeable Nat7
deriving instance Typeable Natural
deriving instance Typeable X
deriving instance Typeable Xs
deriving instance Typeable NoDup
deriving instance Typeable Bag
deriving instance Typeable Set
deriving instance Typeable Map
deriving instance Typeable Space
deriving instance Typeable Lower
deriving instance Typeable Upper
deriving instance Typeable Alpha
deriving instance Typeable Digit
deriving instance Typeable AlphaNum
deriving instance Typeable Letter
deriving instance Typeable Spaces
deriving instance Typeable Lowers
deriving instance Typeable Uppers
deriving instance Typeable Alphas
deriving instance Typeable Digits
deriving instance Typeable AlphaNums
deriving instance Typeable Letters
deriving instance Typeable A
deriving instance Typeable B
deriving instance Typeable C
deriving instance Typeable D
deriving instance Typeable E
deriving instance Typeable F
#endif