{-# LANGUAGE CPP              #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Test.QuickCheck.Instances.UUID () where

import Prelude ()
import Test.QuickCheck.Instances.CustomPrelude

import Data.Word (Word32)

import Test.QuickCheck

import qualified Data.UUID.Types as UUID

-------------------------------------------------------------------------------
-- uuid
-------------------------------------------------------------------------------

uuidFromWords :: (Word32, Word32, Word32, Word32) -> UUID.UUID
uuidFromWords :: (Word32, Word32, Word32, Word32) -> UUID
uuidFromWords (Word32
a,Word32
b,Word32
c,Word32
d) = Word32 -> Word32 -> Word32 -> Word32 -> UUID
UUID.fromWords Word32
a Word32
b Word32
c Word32
d

-- | Uniform distribution.
instance Arbitrary UUID.UUID where
    arbitrary :: Gen UUID
arbitrary = (Word32, Word32, Word32, Word32) -> UUID
uuidFromWords ((Word32, Word32, Word32, Word32) -> UUID)
-> Gen (Word32, Word32, Word32, Word32) -> Gen UUID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Word32, Word32, Word32, Word32)
forall a. Arbitrary a => Gen a
arbitrary
    shrink :: UUID -> [UUID]
shrink = ((Word32, Word32, Word32, Word32) -> UUID)
-> [(Word32, Word32, Word32, Word32)] -> [UUID]
forall a b. (a -> b) -> [a] -> [b]
map (Word32, Word32, Word32, Word32) -> UUID
uuidFromWords ([(Word32, Word32, Word32, Word32)] -> [UUID])
-> (UUID -> [(Word32, Word32, Word32, Word32)]) -> UUID -> [UUID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32, Word32, Word32, Word32)
-> [(Word32, Word32, Word32, Word32)]
forall a. Arbitrary a => a -> [a]
shrink ((Word32, Word32, Word32, Word32)
 -> [(Word32, Word32, Word32, Word32)])
-> (UUID -> (Word32, Word32, Word32, Word32))
-> UUID
-> [(Word32, Word32, Word32, Word32)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> (Word32, Word32, Word32, Word32)
UUID.toWords

instance CoArbitrary UUID.UUID where
    coarbitrary :: UUID -> Gen b -> Gen b
coarbitrary = (Word32, Word32, Word32, Word32) -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary ((Word32, Word32, Word32, Word32) -> Gen b -> Gen b)
-> (UUID -> (Word32, Word32, Word32, Word32))
-> UUID
-> Gen b
-> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> (Word32, Word32, Word32, Word32)
UUID.toWords

instance Function UUID.UUID where
    function :: (UUID -> b) -> UUID :-> b
function = (UUID -> (Word32, Word32, Word32, Word32))
-> ((Word32, Word32, Word32, Word32) -> UUID)
-> (UUID -> b)
-> UUID :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap UUID -> (Word32, Word32, Word32, Word32)
UUID.toWords (Word32, Word32, Word32, Word32) -> UUID
uuidFromWords