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)
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
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