{-# OPTIONS_GHC -Wno-orphans #-}

-- | Utilities for arbitrary data generation in property tests.

module Michelson.Test.Gen
  ( minTimestamp
  , maxTimestamp
  , midTimestamp
  ) where

import Data.Time.Calendar (Day, addDays, diffDays)
import Data.Time.Clock (UTCTime(..))
import Data.Time.Format (defaultTimeLocale, parseTimeM)
import Test.QuickCheck (Arbitrary(..), choose)

import Michelson.Typed (T(..), Value'(..))
import Tezos.Core
  (Mutez(..), Timestamp, timestampFromSeconds, timestampFromUTCTime, timestampToSeconds,
  unsafeMkMutez)

instance Arbitrary (Value' instr 'TKeyHash) where
  arbitrary :: Gen (Value' instr 'TKeyHash)
arbitrary = KeyHash -> Value' instr 'TKeyHash
forall (instr :: [T] -> [T] -> *).
KeyHash -> Value' instr 'TKeyHash
VKeyHash (KeyHash -> Value' instr 'TKeyHash)
-> Gen KeyHash -> Gen (Value' instr 'TKeyHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen KeyHash
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary (Value' instr 'TMutez) where
  arbitrary :: Gen (Value' instr 'TMutez)
arbitrary = Mutez -> Value' instr 'TMutez
forall (instr :: [T] -> [T] -> *). Mutez -> Value' instr 'TMutez
VMutez (Mutez -> Value' instr 'TMutez)
-> Gen Mutez -> Gen (Value' instr 'TMutez)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Mutez
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary (Value' instr 'TInt) where
  arbitrary :: Gen (Value' instr 'TInt)
arbitrary = Integer -> Value' instr 'TInt
forall (instr :: [T] -> [T] -> *). Integer -> Value' instr 'TInt
VInt (Integer -> Value' instr 'TInt)
-> Gen Integer -> Gen (Value' instr 'TInt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary (Value' instr a) => Arbitrary (Value' instr ('TList a)) where
  arbitrary :: Gen (Value' instr ('TList a))
arbitrary = [Value' instr a] -> Value' instr ('TList a)
forall (t :: T) (instr :: [T] -> [T] -> *).
[Value' instr t] -> Value' instr ('TList t)
VList ([Value' instr a] -> Value' instr ('TList a))
-> Gen [Value' instr a] -> Gen (Value' instr ('TList a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Value' instr a]
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary (Value' instr 'TUnit) where
  arbitrary :: Gen (Value' instr 'TUnit)
arbitrary = Value' instr 'TUnit -> Gen (Value' instr 'TUnit)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value' instr 'TUnit
forall (instr :: [T] -> [T] -> *). Value' instr 'TUnit
VUnit
instance (Arbitrary (Value' instr a), Arbitrary (Value' instr b))
    => Arbitrary (Value' instr ('TPair a b)) where
  arbitrary :: Gen (Value' instr ('TPair a b))
arbitrary = (Value' instr a, Value' instr b) -> Value' instr ('TPair a b)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair ((Value' instr a, Value' instr b) -> Value' instr ('TPair a b))
-> (Value' instr a
    -> Value' instr b -> (Value' instr a, Value' instr b))
-> Value' instr a
-> Value' instr b
-> Value' instr ('TPair a b)
forall a b c. SuperComposition a b c => a -> b -> c
... (,) (Value' instr a -> Value' instr b -> Value' instr ('TPair a b))
-> Gen (Value' instr a)
-> Gen (Value' instr b -> Value' instr ('TPair a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Value' instr a)
forall a. Arbitrary a => Gen a
arbitrary Gen (Value' instr b -> Value' instr ('TPair a b))
-> Gen (Value' instr b) -> Gen (Value' instr ('TPair a b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Value' instr b)
forall a. Arbitrary a => Gen a
arbitrary

minDay :: Day
minDay :: Day
minDay = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe (Text -> Day
forall a. HasCallStack => Text -> a
error "failed to parse day 2008-11-01") (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$
            Bool -> TimeLocale -> String -> String -> Maybe Day
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale "%Y-%-m-%-d" "2008-11-01"

maxDay :: Day
maxDay :: Day
maxDay = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe (Text -> Day
forall a. HasCallStack => Text -> a
error "failed to parse day 2024-11-01") (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$
            Bool -> TimeLocale -> String -> String -> Maybe Day
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale "%Y-%-m-%-d" "2024-11-01"

minSec :: Integer
minSec :: Integer
minSec = 0

maxSec :: Integer
maxSec :: Integer
maxSec = 86399

-- | Minimal (earliest) timestamp used for @Arbitrary (CValue 'CTimestamp)@
minTimestamp :: Timestamp
minTimestamp :: Timestamp
minTimestamp = UTCTime -> Timestamp
timestampFromUTCTime (UTCTime -> Timestamp) -> UTCTime -> Timestamp
forall a b. (a -> b) -> a -> b
$ Day -> DiffTime -> UTCTime
UTCTime Day
minDay (Integer -> DiffTime
forall a. Num a => Integer -> a
fromInteger Integer
minSec)

-- | Maximal (latest) timestamp used for @Arbitrary (CValue 'CTimestamp)@
maxTimestamp :: Timestamp
maxTimestamp :: Timestamp
maxTimestamp = UTCTime -> Timestamp
timestampFromUTCTime (UTCTime -> Timestamp) -> UTCTime -> Timestamp
forall a b. (a -> b) -> a -> b
$ Day -> DiffTime -> UTCTime
UTCTime Day
maxDay (Integer -> DiffTime
forall a. Num a => Integer -> a
fromInteger Integer
maxSec)

-- | Median of 'minTimestamp' and 'maxTimestamp'.
-- Useful for testing (exactly half of generated dates will be before and after
-- this date).
midTimestamp :: Timestamp
midTimestamp :: Timestamp
midTimestamp = UTCTime -> Timestamp
timestampFromUTCTime (UTCTime -> Timestamp) -> UTCTime -> Timestamp
forall a b. (a -> b) -> a -> b
$
  Day -> DiffTime -> UTCTime
UTCTime ( ((Day
maxDay Day -> Day -> Integer
`diffDays` Day
minDay) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` 2) Integer -> Day -> Day
`addDays` Day
minDay)
          (Integer -> DiffTime
forall a. Num a => Integer -> a
fromInteger (Integer -> DiffTime) -> Integer -> DiffTime
forall a b. (a -> b) -> a -> b
$ (Integer
maxSec Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
minSec) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` 2)

instance Arbitrary (Value' instr 'TTimestamp) where
  arbitrary :: Gen (Value' instr 'TTimestamp)
arbitrary = Timestamp -> Value' instr 'TTimestamp
forall (instr :: [T] -> [T] -> *).
Timestamp -> Value' instr 'TTimestamp
VTimestamp (Timestamp -> Value' instr 'TTimestamp)
-> Gen Timestamp -> Gen (Value' instr 'TTimestamp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Timestamp
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary Mutez where
  arbitrary :: Gen Mutez
arbitrary = HasCallStack => Word64 -> Mutez
Word64 -> Mutez
unsafeMkMutez (Word64 -> Mutez) -> Gen Word64 -> Gen Mutez
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Mutez -> Word64
unMutez Mutez
forall a. Bounded a => a
minBound, Mutez -> Word64
unMutez Mutez
forall a. Bounded a => a
maxBound)

instance Arbitrary Timestamp where
  arbitrary :: Gen Timestamp
arbitrary =
    Integer -> Timestamp
timestampFromSeconds (Integer -> Timestamp) -> Gen Integer -> Gen Timestamp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Timestamp -> Integer
forall a. Integral a => Timestamp -> a
timestampToSeconds Timestamp
minTimestamp, Timestamp -> Integer
forall a. Integral a => Timestamp -> a
timestampToSeconds Timestamp
maxTimestamp)