-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

module Hedgehog.Gen.Tezos.Core
  ( genChainId
  , genMutez
  , genMutez'
  , genTimestamp
  , minTimestamp
  , maxTimestamp
  , midTimestamp
  ) where

import Data.Time.Calendar (Day, addDays, diffDays)
import Data.Time.Clock (UTCTime(..))
import Data.Time.Format (defaultTimeLocale, parseTimeM)
import Hedgehog (MonadGen, Range)
import Hedgehog.Gen qualified as Gen
import Hedgehog.Range qualified as Range

import Morley.Tezos.Core
  (ChainId(..), Mutez(..), Timestamp, mkMutez, timestampFromSeconds, timestampFromUTCTime,
  timestampToSeconds)

import Test.Cleveland.Instances ()

genChainId :: MonadGen m => m ChainId
genChainId :: m ChainId
genChainId  = ByteString -> ChainId
UnsafeChainId (ByteString -> ChainId) -> m ByteString -> m ChainId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> m ByteString
forall (m :: * -> *). MonadGen m => Range Int -> m ByteString
Gen.bytes (Int -> Range Int
forall a. a -> Range a
Range.singleton Int
4)

-- | Generates an arbitrary `Mutez` value using the data type's full range.
genMutez :: MonadGen m => m Mutez
genMutez :: m Mutez
genMutez = Range Mutez -> m Mutez
forall (m :: * -> *). MonadGen m => Range Mutez -> m Mutez
genMutez' Range Mutez
forall a. (Bounded a, Integral a) => Range a
Range.linearBounded

-- | Generates an arbitrary `Mutez` value constrained to the given range.
genMutez' :: MonadGen m => Range Mutez -> m Mutez
genMutez' :: Range Mutez -> m Mutez
genMutez' Range Mutez
range = Either Text Mutez -> Mutez
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text Mutez -> Mutez)
-> (Word64 -> Either Text Mutez) -> Word64 -> Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Either Text Mutez
forall i. Integral i => i -> Either Text Mutez
mkMutez (Word64 -> Mutez) -> m Word64 -> m Mutez
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Word64 -> m Word64
forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 (Word63 -> Word64
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral (Word63 -> Word64) -> (Mutez -> Word63) -> Mutez -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mutez -> Word63
unMutez (Mutez -> Word64) -> Range Mutez -> Range Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Mutez
range)

genTimestamp :: MonadGen m => m Timestamp
genTimestamp :: m Timestamp
genTimestamp =
  Integer -> Timestamp
timestampFromSeconds (Integer -> Timestamp) -> m Integer -> m Timestamp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Integer -> m Integer
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral
    (Integer -> Integer -> Range Integer
forall a. Integral a => a -> a -> Range a
Range.linear (Timestamp -> Integer
forall a. Integral a => Timestamp -> a
timestampToSeconds Timestamp
minTimestamp) (Timestamp -> Integer
forall a. Integral a => Timestamp -> a
timestampToSeconds Timestamp
maxTimestamp))

-- | 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 b.
(Integral a, RealFrac b, CheckIntSubType a Integer) =>
a -> b
fromIntegralToRealFrac 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 b.
(Integral a, RealFrac b, CheckIntSubType a Integer) =>
a -> b
fromIntegralToRealFrac 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` Integer
2) Integer -> Day -> Day
`addDays` Day
minDay)
          (Integer -> DiffTime
forall a b.
(Integral a, RealFrac b, CheckIntSubType a Integer) =>
a -> b
fromIntegralToRealFrac (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` Integer
2)

minDay :: Day
minDay :: Day
minDay = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe (Text -> Day
forall a. HasCallStack => Text -> a
error Text
"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 String
"%Y-%-m-%-d" String
"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 Text
"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 String
"%Y-%-m-%-d" String
"2024-11-01"

minSec :: Integer
minSec :: Integer
minSec = Integer
0

maxSec :: Integer
maxSec :: Integer
maxSec = Integer
86399