module HaskellWorks.Polysemy.Hedgehog.Ulid (
    genUlid,
    genUlidRandom,
    genUlidTimeStamp,
) where

import           Data.Binary                         (decodeOrFail)
import qualified Data.ByteString.Lazy                as LBS
import           Data.ULID                           (ULID (..))
import           Data.ULID.Random                    (ULIDRandom)
import           Data.ULID.TimeStamp                 (ULIDTimeStamp,
                                                      mkULIDTimeStamp)
import           HaskellWorks.Polysemy.Hedgehog.Time

import           Hedgehog
import qualified Hedgehog.Gen                        as Gen
import qualified Hedgehog.Range                      as Range

import           HaskellWorks.Prelude

genUlidRandom :: Gen ULIDRandom
genUlidRandom :: Gen ULIDRandom
genUlidRandom = do
    ByteString
bytes <- Range Int -> GenT Identity ByteString
forall (m :: * -> *). MonadGen m => Range Int -> m ByteString
Gen.bytes (Int -> Range Int
forall a. a -> Range a
Range.singleton Int
10) -- 80 bits
    let lazyBytes :: ByteString
lazyBytes = ByteString -> ByteString
LBS.fromStrict ByteString
bytes
    case ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, ULIDRandom)
forall a.
Binary a =>
ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
decodeOrFail ByteString
lazyBytes of
        Left (ByteString
_, ByteOffset
_, String
err)   -> String -> Gen ULIDRandom
forall a. String -> GenT Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Gen ULIDRandom) -> String -> Gen ULIDRandom
forall a b. (a -> b) -> a -> b
$ String
"Failed to decode ULIDRandom: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err -- This shouldn't happen.
        Right (ByteString
_, ByteOffset
_, ULIDRandom
ulid) -> ULIDRandom -> Gen ULIDRandom
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ULIDRandom
ulid

genUlidTimeStamp :: Gen ULIDTimeStamp
genUlidTimeStamp :: Gen ULIDTimeStamp
genUlidTimeStamp =
    POSIXTime -> ULIDTimeStamp
mkULIDTimeStamp (POSIXTime -> ULIDTimeStamp)
-> GenT Identity POSIXTime -> Gen ULIDTimeStamp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity POSIXTime
genPOSIXTime

genUlid :: Gen ULID
genUlid :: Gen ULID
genUlid =
    ULIDTimeStamp -> ULIDRandom -> ULID
ULID (ULIDTimeStamp -> ULIDRandom -> ULID)
-> Gen ULIDTimeStamp -> GenT Identity (ULIDRandom -> ULID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ULIDTimeStamp
genUlidTimeStamp GenT Identity (ULIDRandom -> ULID) -> Gen ULIDRandom -> Gen ULID
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ULIDRandom
genUlidRandom