{-# OPTIONS_GHC -fno-warn-orphans #-}

module Data.GenValidity.UUID where

import Data.GenValidity
import Data.UUID
import Data.Validity.UUID ()

instance GenValid UUID where
  genValid :: Gen UUID
genValid =
    Word32 -> Word32 -> Word32 -> Word32 -> UUID
fromWords (Word32 -> Word32 -> Word32 -> Word32 -> UUID)
-> Gen Word32 -> Gen (Word32 -> Word32 -> Word32 -> UUID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word32
forall a. GenValid a => Gen a
genValid Gen (Word32 -> Word32 -> Word32 -> UUID)
-> Gen Word32 -> Gen (Word32 -> Word32 -> UUID)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
forall a. GenValid a => Gen a
genValid Gen (Word32 -> Word32 -> UUID)
-> Gen Word32 -> Gen (Word32 -> UUID)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
forall a. GenValid a => Gen a
genValid
      Gen (Word32 -> UUID) -> Gen Word32 -> Gen UUID
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
forall a. GenValid a => Gen a
genValid
  shrinkValid :: UUID -> [UUID]
shrinkValid UUID
u =
    [ Word32 -> Word32 -> Word32 -> Word32 -> UUID
fromWords Word32
w1 Word32
w2 Word32
w3 Word32
w4
      | (Word32
w1, Word32
w2, Word32
w3, Word32
w4) <- (Word32, Word32, Word32, Word32)
-> [(Word32, Word32, Word32, Word32)]
forall a. GenValid a => a -> [a]
shrinkValid ((Word32, Word32, Word32, Word32)
 -> [(Word32, Word32, Word32, Word32)])
-> (Word32, Word32, Word32, Word32)
-> [(Word32, Word32, Word32, Word32)]
forall a b. (a -> b) -> a -> b
$ UUID -> (Word32, Word32, Word32, Word32)
toWords UUID
u
    ]