module Main.Gens where
import Main.Prelude hiding (assert, isRight, isLeft, choose)
import Test.QuickCheck hiding (vector)
import Test.QuickCheck.Instances
import qualified Main.PTI as PTI
import qualified Data.Scientific as Scientific
import qualified Data.UUID as UUID
import qualified Data.Vector as Vector
import qualified Data.HashMap.Strict as HashMap
import qualified PostgreSQL.Binary.Encoding as Encoder
import qualified Data.Text as Text
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.KeyMap as AesonKeyMap
import qualified Data.Aeson.Key as AesonKey
import qualified Network.IP.Addr as IPAddr
-- * Generators
-------------------------
auto :: Arbitrary a => Gen a
auto =
arbitrary
vector :: Gen a -> Gen (Vector a)
vector element =
join $ Vector.replicateM <$> arbitrary <*> pure element
hashMap :: (Eq a, Hashable a) => Gen a -> Gen b -> Gen (HashMap a b)
hashMap key value =
fmap HashMap.fromList $ join $ replicateM <$> arbitrary <*> pure row
where
row =
(,) <$> key <*> value
aeson :: Gen Aeson.Value
aeson =
byDepth 0
where
byDepth depth =
frequency (primitives <> composites)
where
primitives =
map (freq,) [null, bool, number, string]
where
freq =
maxFreq
composites =
map (freq,) [array, object]
where
freq =
maxFreq - depth
maxFreq =
4
null =
pure Aeson.Null
bool =
fmap Aeson.Bool arbitrary
number =
fmap Aeson.Number arbitrary
string =
fmap Aeson.String text
array =
fmap Aeson.Array (vector (byDepth (succ depth)))
object =
Aeson.Object . AesonKeyMap.fromList <$> listOf pair
where
pair =
(,) <$> key <*> value
where
key =
AesonKey.fromText <$> text
value =
byDepth (succ depth)
postgresInt :: (Bounded a, Ord a, Integral a, Arbitrary a) => Gen a
postgresInt =
arbitrary >>= \x -> if x > halfMaxBound then postgresInt else pure x
where
halfMaxBound =
div maxBound 2
text :: Gen Text
text =
arbitrary >>= \x -> if Text.find (== '\NUL') x == Nothing then return x else text
char :: Gen Char
char =
arbitrary >>= \x -> if x /= '\NUL' then return x else char
scientific :: Gen Scientific
scientific =
Scientific.scientific <$> arbitrary <*> arbitrary
microsTimeOfDay :: Gen TimeOfDay
microsTimeOfDay =
fmap timeToTimeOfDay $ fmap picosecondsToDiffTime $ fmap (* (10^6)) $
choose (0, (10^6)*24*60*60)
microsLocalTime :: Gen LocalTime
microsLocalTime =
LocalTime <$> arbitrary <*> microsTimeOfDay
microsUTCTime :: Gen UTCTime
microsUTCTime =
localTimeToUTC <$> timeZone <*> microsLocalTime
intervalDiffTime :: Gen DiffTime
intervalDiffTime = do
unsafeCoerce ((* (10^6)) <$> choose (uMin, uMax) :: Gen Integer)
where
uMin = unsafeCoerce minInterval `div` 10^6
uMax = unsafeCoerce maxInterval `div` 10^6
timeZone :: Gen TimeZone
timeZone =
minutesToTimeZone <$> choose (- 60 * 12 + 1, 60 * 12)
timetz :: Gen (TimeOfDay, TimeZone)
timetz =
(,) <$> microsTimeOfDay <*> timeZone
uuid :: Gen UUID.UUID
uuid =
UUID.fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
inet :: Gen (IPAddr.NetAddr IPAddr.IP)
inet = do
ipv6 <- choose (True, False)
if ipv6
then IPAddr.netAddr <$> (IPAddr.IPv6 <$> (IPAddr.ip6FromWords <$>
arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary)) <*> choose (0, 128)
else IPAddr.netAddr <$> (IPAddr.IPv4 <$> (IPAddr.ip4FromOctets <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary)) <*> choose (0, 32)
array3 :: Gen a -> Gen [[[a]]]
array3 gen =
do
width1 <- choose (1, 10)
width2 <- choose (1, 10)
width3 <- choose (1, 10)
replicateM width1 (replicateM width2 (replicateM width3 gen))
-- * Constants
-------------------------
maxInterval :: DiffTime =
unsafeCoerce $
(truncate (1780000 * 365.2425 * 24 * 60 * 60 * 10 ^ 12 :: Rational) :: Integer)
minInterval :: DiffTime =
negate maxInterval