{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeFamilies       #-}
{-# LANGUAGE ViewPatterns       #-}
{-# LANGUAGE Unsafe             #-}
{-# LANGUAGE DeriveLift         #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_HADDOCK hide #-}

-- |
-- Module      : Data.UUID.Types.Internal
-- Copyright   : (c) 2017-2018 Herbert Valerio Riedel
--               (c) 2008-2009, 2012 Antoine Latter
--               (c) 2009 Mark Lentczner
--
-- License     : BSD-style
--
-- Maintainer  : hvr@gnu.org
-- Portability : portable

module Data.UUID.Types.Internal
    ( UUID(..)
    , null
    , nil
    , fromByteString
    , toByteString
    , fromString
    , toString
    , fromText
    , toText
    , fromWords
    , toWords
    , fromWords64
    , toWords64
    , toList
    , buildFromBytes
    , buildFromWords
    , fromASCIIBytes
    , toASCIIBytes
    , fromLazyASCIIBytes
    , toLazyASCIIBytes
    , UnpackedUUID(..)
    , pack
    , unpack
    ) where

import           Prelude                          hiding (null)

import           Control.Applicative              ((<*>))
import           Control.DeepSeq                  (NFData (..))
import           Control.Monad                    (guard, liftM2)
import           Data.Bits
import           Data.Char
import           Data.Data
import           Data.Functor                     ((<$>))
import           Data.Hashable
import           Data.List                        (elemIndices)
import           Foreign.Ptr                      (Ptr)

import           Foreign.Storable

import           Data.Binary
import           Data.Binary.Get
import           Data.Binary.Put
import qualified Data.ByteString                  as B
import qualified Data.ByteString.Internal         as BI
import qualified Data.ByteString.Lazy             as BL
import qualified Data.ByteString.Unsafe           as BU
import           Data.Text                        (Text)
import qualified Data.Text.Encoding               as T

import           Data.UUID.Types.Internal.Builder

import           System.Random (Random (..), uniform)
import           System.Random.Stateful (Uniform (..), uniformWord64)

import Language.Haskell.TH.Syntax (Lift)

-- | Type representing <https://en.wikipedia.org/wiki/UUID Universally Unique Identifiers (UUID)> as specified in
--  <http://tools.ietf.org/html/rfc4122 RFC 4122>.
data UUID = UUID {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
          deriving (UUID -> UUID -> Bool
(UUID -> UUID -> Bool) -> (UUID -> UUID -> Bool) -> Eq UUID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UUID -> UUID -> Bool
== :: UUID -> UUID -> Bool
$c/= :: UUID -> UUID -> Bool
/= :: UUID -> UUID -> Bool
Eq, Eq UUID
Eq UUID =>
(UUID -> UUID -> Ordering)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> UUID)
-> (UUID -> UUID -> UUID)
-> Ord UUID
UUID -> UUID -> Bool
UUID -> UUID -> Ordering
UUID -> UUID -> UUID
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UUID -> UUID -> Ordering
compare :: UUID -> UUID -> Ordering
$c< :: UUID -> UUID -> Bool
< :: UUID -> UUID -> Bool
$c<= :: UUID -> UUID -> Bool
<= :: UUID -> UUID -> Bool
$c> :: UUID -> UUID -> Bool
> :: UUID -> UUID -> Bool
$c>= :: UUID -> UUID -> Bool
>= :: UUID -> UUID -> Bool
$cmax :: UUID -> UUID -> UUID
max :: UUID -> UUID -> UUID
$cmin :: UUID -> UUID -> UUID
min :: UUID -> UUID -> UUID
Ord, Typeable)
{-
    Prior to uuid-types-1.0.4:
         !Word32 !Word32 !Word32 !Word32
    Other representations that we tried are:
         Mimic V1 structure:     !Word32 !Word16 !Word16 !Word16
                                   !Word8 !Word8 !Word8 !Word8 !Word8 !Word8
         Sixteen bytes:          !Word8 ... (x 16)
         Simple list of bytes:   [Word8]
         ByteString (strict)     ByteString
         Immutable array:        UArray Int Word8
         Vector:                 UArr Word8
    None was as fast, overall, as the representation used here.
-}

-- | Convert a 'UUID' into a sequence of 'Word32' values.
-- Useful for when you need to serialize a UUID and
-- neither 'Storable' nor 'Binary' are appropriate.
--
-- >>> toWords <$> fromString "550e8400-e29b-41d4-a716-446655440000"
-- Just (1427014656,3801825748,2803254374,1430519808)
--
-- See also 'toWords64'.
--
-- /Since: @uuid-1.2.2@/
--
-- @since 1.0.0
toWords :: UUID -> (Word32, Word32, Word32, Word32)
toWords :: UUID -> (Word32, Word32, Word32, Word32)
toWords (UUID Word64
w12 Word64
w34) = (Word32
w1, Word32
w2, Word32
w3, Word32
w4)
  where
    w1 :: Word32
w1 = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w12 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
32)
    w2 :: Word32
w2 = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w12
    w3 :: Word32
w3 = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w34 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
32)
    w4 :: Word32
w4 = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w34

-- | Create a 'UUID' from a sequence of 'Word32'. The
-- inverse of 'toWords'. Useful when you need a total
-- function for constructing 'UUID' values.
--
-- See also 'fromWords64'.
--
-- /Since: @uuid-1.2.2@/
--
-- @since 1.0.0
fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
fromWords Word32
w1 Word32
w2 Word32
w3 Word32
w4 = Word64 -> Word64 -> UUID
UUID (Word32 -> Word32 -> Word64
w32to64 Word32
w1 Word32
w2) (Word32 -> Word32 -> Word64
w32to64 Word32
w3 Word32
w4)

-- | Convert a 'UUID' into a pair of 'Word64's.
--
-- >>> toWords64 <$> fromString "550e8400-e29b-41d4-a716-446655440000"
-- Just (6128981282234515924,12039885860129472512)
--
-- See also 'toWords'.
--
-- @since 1.0.4
toWords64 :: UUID -> (Word64, Word64)
toWords64 :: UUID -> (Word64, Word64)
toWords64 (UUID Word64
w12 Word64
w34) = (Word64
w12,Word64
w34)

-- | Create a 'UUID' from a pair of 'Word64's.
--
-- Inverse of 'toWords64'. See also 'fromWords'.
--
-- @since 1.0.4
fromWords64 :: Word64 -> Word64 -> UUID
fromWords64 :: Word64 -> Word64 -> UUID
fromWords64 = Word64 -> Word64 -> UUID
UUID

data UnpackedUUID =
    UnpackedUUID {
        UnpackedUUID -> Word32
time_low            :: Word32 -- 0-3
      , UnpackedUUID -> Word16
time_mid            :: Word16 -- 4-5
      , UnpackedUUID -> Word16
time_hi_and_version :: Word16 -- 6-7
      , UnpackedUUID -> Word8
clock_seq_hi_res    :: Word8 -- 8
      , UnpackedUUID -> Word8
clock_seq_low       :: Word8 -- 9
      , UnpackedUUID -> Word8
node_0              :: Word8
      , UnpackedUUID -> Word8
node_1              :: Word8
      , UnpackedUUID -> Word8
node_2              :: Word8
      , UnpackedUUID -> Word8
node_3              :: Word8
      , UnpackedUUID -> Word8
node_4              :: Word8
      , UnpackedUUID -> Word8
node_5              :: Word8
      }
    deriving (ReadPrec [UnpackedUUID]
ReadPrec UnpackedUUID
Int -> ReadS UnpackedUUID
ReadS [UnpackedUUID]
(Int -> ReadS UnpackedUUID)
-> ReadS [UnpackedUUID]
-> ReadPrec UnpackedUUID
-> ReadPrec [UnpackedUUID]
-> Read UnpackedUUID
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS UnpackedUUID
readsPrec :: Int -> ReadS UnpackedUUID
$creadList :: ReadS [UnpackedUUID]
readList :: ReadS [UnpackedUUID]
$creadPrec :: ReadPrec UnpackedUUID
readPrec :: ReadPrec UnpackedUUID
$creadListPrec :: ReadPrec [UnpackedUUID]
readListPrec :: ReadPrec [UnpackedUUID]
Read, Int -> UnpackedUUID -> ShowS
[UnpackedUUID] -> ShowS
UnpackedUUID -> String
(Int -> UnpackedUUID -> ShowS)
-> (UnpackedUUID -> String)
-> ([UnpackedUUID] -> ShowS)
-> Show UnpackedUUID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnpackedUUID -> ShowS
showsPrec :: Int -> UnpackedUUID -> ShowS
$cshow :: UnpackedUUID -> String
show :: UnpackedUUID -> String
$cshowList :: [UnpackedUUID] -> ShowS
showList :: [UnpackedUUID] -> ShowS
Show, UnpackedUUID -> UnpackedUUID -> Bool
(UnpackedUUID -> UnpackedUUID -> Bool)
-> (UnpackedUUID -> UnpackedUUID -> Bool) -> Eq UnpackedUUID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnpackedUUID -> UnpackedUUID -> Bool
== :: UnpackedUUID -> UnpackedUUID -> Bool
$c/= :: UnpackedUUID -> UnpackedUUID -> Bool
/= :: UnpackedUUID -> UnpackedUUID -> Bool
Eq, Eq UnpackedUUID
Eq UnpackedUUID =>
(UnpackedUUID -> UnpackedUUID -> Ordering)
-> (UnpackedUUID -> UnpackedUUID -> Bool)
-> (UnpackedUUID -> UnpackedUUID -> Bool)
-> (UnpackedUUID -> UnpackedUUID -> Bool)
-> (UnpackedUUID -> UnpackedUUID -> Bool)
-> (UnpackedUUID -> UnpackedUUID -> UnpackedUUID)
-> (UnpackedUUID -> UnpackedUUID -> UnpackedUUID)
-> Ord UnpackedUUID
UnpackedUUID -> UnpackedUUID -> Bool
UnpackedUUID -> UnpackedUUID -> Ordering
UnpackedUUID -> UnpackedUUID -> UnpackedUUID
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UnpackedUUID -> UnpackedUUID -> Ordering
compare :: UnpackedUUID -> UnpackedUUID -> Ordering
$c< :: UnpackedUUID -> UnpackedUUID -> Bool
< :: UnpackedUUID -> UnpackedUUID -> Bool
$c<= :: UnpackedUUID -> UnpackedUUID -> Bool
<= :: UnpackedUUID -> UnpackedUUID -> Bool
$c> :: UnpackedUUID -> UnpackedUUID -> Bool
> :: UnpackedUUID -> UnpackedUUID -> Bool
$c>= :: UnpackedUUID -> UnpackedUUID -> Bool
>= :: UnpackedUUID -> UnpackedUUID -> Bool
$cmax :: UnpackedUUID -> UnpackedUUID -> UnpackedUUID
max :: UnpackedUUID -> UnpackedUUID -> UnpackedUUID
$cmin :: UnpackedUUID -> UnpackedUUID -> UnpackedUUID
min :: UnpackedUUID -> UnpackedUUID -> UnpackedUUID
Ord)

unpack :: UUID -> UnpackedUUID
unpack :: UUID -> UnpackedUUID
unpack (UUID Word64
w0 Word64
w1) = ByteSink
  Word64
  (Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> UnpackedUUID)
Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> UnpackedUUID
build ByteSink
  Word64
  (Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> UnpackedUUID)
-> Word64
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> UnpackedUUID
forall w g. ByteSource w => ByteSink w g -> w -> g
forall g. ByteSink Word64 g -> Word64 -> g
/-/ Word64
w0 ByteSink Word64 UnpackedUUID -> Word64 -> UnpackedUUID
forall w g. ByteSource w => ByteSink w g -> w -> g
forall g. ByteSink Word64 g -> Word64 -> g
/-/ Word64
w1
 where
    build :: Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> UnpackedUUID
build Word8
x0 Word8
x1 Word8
x2 Word8
x3 Word8
x4 Word8
x5 Word8
x6 Word8
x7 Word8
x8 Word8
x9 Word8
xA Word8
xB Word8
xC Word8
xD Word8
xE Word8
xF =
     UnpackedUUID {
        time_low :: Word32
time_low = Word8 -> Word8 -> Word8 -> Word8 -> Word32
word Word8
x0 Word8
x1 Word8
x2 Word8
x3
      , time_mid :: Word16
time_mid = Word8 -> Word8 -> Word16
w8to16 Word8
x4 Word8
x5
      , time_hi_and_version :: Word16
time_hi_and_version = Word8 -> Word8 -> Word16
w8to16 Word8
x6 Word8
x7
      , clock_seq_hi_res :: Word8
clock_seq_hi_res = Word8
x8
      , clock_seq_low :: Word8
clock_seq_low = Word8
x9
      , node_0 :: Word8
node_0 = Word8
xA
      , node_1 :: Word8
node_1 = Word8
xB
      , node_2 :: Word8
node_2 = Word8
xC
      , node_3 :: Word8
node_3 = Word8
xD
      , node_4 :: Word8
node_4 = Word8
xE
      , node_5 :: Word8
node_5 = Word8
xF
      }

pack :: UnpackedUUID -> UUID
pack :: UnpackedUUID -> UUID
pack UnpackedUUID
unpacked =
  ByteSink
  Word32
  (Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> UUID)
Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> UUID
makeFromBytes ByteSink
  Word32
  (Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> UUID)
-> Word32
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> UUID
forall w g. ByteSource w => ByteSink w g -> w -> g
forall g. ByteSink Word32 g -> Word32 -> g
/-/ (UnpackedUUID -> Word32
time_low UnpackedUUID
unpacked)
                ByteSink
  Word16
  (Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> UUID)
-> Word16
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> UUID
forall w g. ByteSource w => ByteSink w g -> w -> g
forall g. ByteSink Word16 g -> Word16 -> g
/-/ (UnpackedUUID -> Word16
time_mid UnpackedUUID
unpacked)
                ByteSink
  Word16
  (Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> UUID)
-> Word16
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> UUID
forall w g. ByteSource w => ByteSink w g -> w -> g
forall g. ByteSink Word16 g -> Word16 -> g
/-/ (UnpackedUUID -> Word16
time_hi_and_version UnpackedUUID
unpacked)
                ByteSink
  Word8
  (Word8
   -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> UUID)
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> UUID
forall w g. ByteSource w => ByteSink w g -> w -> g
forall g. ByteSink Word8 g -> Word8 -> g
/-/ (UnpackedUUID -> Word8
clock_seq_hi_res UnpackedUUID
unpacked)
                ByteSink
  Word8 (Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> UUID)
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> UUID
forall w g. ByteSource w => ByteSink w g -> w -> g
forall g. ByteSink Word8 g -> Word8 -> g
/-/ (UnpackedUUID -> Word8
clock_seq_low UnpackedUUID
unpacked)
                ByteSink Word8 (Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> UUID)
-> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> UUID
forall w g. ByteSource w => ByteSink w g -> w -> g
forall g. ByteSink Word8 g -> Word8 -> g
/-/ (UnpackedUUID -> Word8
node_0 UnpackedUUID
unpacked) ByteSink Word8 (Word8 -> Word8 -> Word8 -> Word8 -> UUID)
-> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> UUID
forall w g. ByteSource w => ByteSink w g -> w -> g
forall g. ByteSink Word8 g -> Word8 -> g
/-/ (UnpackedUUID -> Word8
node_1 UnpackedUUID
unpacked)
                ByteSink Word8 (Word8 -> Word8 -> Word8 -> UUID)
-> Word8 -> Word8 -> Word8 -> Word8 -> UUID
forall w g. ByteSource w => ByteSink w g -> w -> g
forall g. ByteSink Word8 g -> Word8 -> g
/-/ (UnpackedUUID -> Word8
node_2 UnpackedUUID
unpacked) ByteSink Word8 (Word8 -> Word8 -> UUID)
-> Word8 -> Word8 -> Word8 -> UUID
forall w g. ByteSource w => ByteSink w g -> w -> g
forall g. ByteSink Word8 g -> Word8 -> g
/-/ (UnpackedUUID -> Word8
node_3 UnpackedUUID
unpacked)
                ByteSink Word8 (Word8 -> UUID) -> Word8 -> Word8 -> UUID
forall w g. ByteSource w => ByteSink w g -> w -> g
forall g. ByteSink Word8 g -> Word8 -> g
/-/ (UnpackedUUID -> Word8
node_4 UnpackedUUID
unpacked) ByteSink Word8 UUID -> Word8 -> UUID
forall w g. ByteSource w => ByteSink w g -> w -> g
forall g. ByteSink Word8 g -> Word8 -> g
/-/ (UnpackedUUID -> Word8
node_5 UnpackedUUID
unpacked)


--
-- UTILITIES
--

-- |Build a Word32 from four Word8 values, presented in big-endian order
word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
word Word8
a Word8
b Word8
c Word8
d =  (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
24)
            Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16)
            Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL`  Int
8)
            Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d                  )

-- |Extract a Word8 from a Word64. Bytes, high to low, are numbered from 7 to 0,
byte :: Int -> Word64 -> Word8
byte :: Int -> Word64 -> Word8
byte Int
i Word64
w = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8))

-- |Build a Word16 from two Word8 values, presented in big-endian order.
w8to16 :: Word8 -> Word8 -> Word16
w8to16 :: Word8 -> Word8 -> Word16
w8to16 Word8
w0s Word8
w1s =
    (Word16
w0 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
w1
  where
    w0 :: Word16
w0 = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w0s
    w1 :: Word16
w1 = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w1s

-- | Construct 'Word64' from low/high 'Word32's
w32to64 :: Word32 -> Word32 -> Word64
w32to64 :: Word32 -> Word32 -> Word64
w32to64 Word32
w0 Word32
w1 = (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w0 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
32) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w1)

-- |Make a UUID from sixteen Word8 values
makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8
              -> Word8 -> Word8 -> Word8 -> Word8
              -> Word8 -> Word8 -> Word8 -> Word8
              -> Word8 -> Word8 -> Word8 -> Word8
              -> UUID
makeFromBytes :: Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> UUID
makeFromBytes Word8
b0 Word8
b1 Word8
b2 Word8
b3 Word8
b4 Word8
b5 Word8
b6 Word8
b7 Word8
b8 Word8
b9 Word8
ba Word8
bb Word8
bc Word8
bd Word8
be Word8
bf
        = Word32 -> Word32 -> Word32 -> Word32 -> UUID
fromWords Word32
w0 Word32
w1 Word32
w2 Word32
w3
    where w0 :: Word32
w0 = Word8 -> Word8 -> Word8 -> Word8 -> Word32
word Word8
b0 Word8
b1 Word8
b2 Word8
b3
          w1 :: Word32
w1 = Word8 -> Word8 -> Word8 -> Word8 -> Word32
word Word8
b4 Word8
b5 Word8
b6 Word8
b7
          w2 :: Word32
w2 = Word8 -> Word8 -> Word8 -> Word8 -> Word32
word Word8
b8 Word8
b9 Word8
ba Word8
bb
          w3 :: Word32
w3 = Word8 -> Word8 -> Word8 -> Word8 -> Word32
word Word8
bc Word8
bd Word8
be Word8
bf

-- |A Builder for constructing a UUID of a given version.
buildFromBytes :: Word8
               -> Word8 -> Word8 -> Word8 -> Word8
               -> Word8 -> Word8 -> Word8 -> Word8
               -> Word8 -> Word8 -> Word8 -> Word8
               -> Word8 -> Word8 -> Word8 -> Word8
               -> UUID
buildFromBytes :: Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> UUID
buildFromBytes Word8
v Word8
b0 Word8
b1 Word8
b2 Word8
b3 Word8
b4 Word8
b5 Word8
b6 Word8
b7 Word8
b8 Word8
b9 Word8
ba Word8
bb Word8
bc Word8
bd Word8
be Word8
bf =
    Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> UUID
makeFromBytes Word8
b0 Word8
b1 Word8
b2 Word8
b3 Word8
b4 Word8
b5 Word8
b6' Word8
b7 Word8
b8' Word8
b9 Word8
ba Word8
bb Word8
bc Word8
bd Word8
be Word8
bf
    where b6' :: Word8
b6' = Word8
b6 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0f Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
v Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
4)
          b8' :: Word8
b8' = Word8
b8 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x3f Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x80

-- |Build a UUID of a given version from 'Word32' values.
buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID
buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID
buildFromWords Word8
v Word32
w0 Word32
w1 Word32
w2 Word32
w3 = Word32 -> Word32 -> Word32 -> Word32 -> UUID
fromWords Word32
w0 Word32
w1' Word32
w2' Word32
w3
    where w1' :: Word32
w1' = Word32
w1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xffff0fff Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. ((Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
12)
          w2' :: Word32
w2' = Word32
w2 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x3fffffff Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
0x80000000


-- |Return the bytes that make up the UUID
toList :: UUID -> [Word8]
toList :: UUID -> [Word8]
toList (UUID Word64
w0 Word64
w1) =
    [Int -> Word64 -> Word8
byte Int
7 Word64
w0, Int -> Word64 -> Word8
byte Int
6 Word64
w0, Int -> Word64 -> Word8
byte Int
5 Word64
w0, Int -> Word64 -> Word8
byte Int
4 Word64
w0,
     Int -> Word64 -> Word8
byte Int
3 Word64
w0, Int -> Word64 -> Word8
byte Int
2 Word64
w0, Int -> Word64 -> Word8
byte Int
1 Word64
w0, Int -> Word64 -> Word8
byte Int
0 Word64
w0,
     Int -> Word64 -> Word8
byte Int
7 Word64
w1, Int -> Word64 -> Word8
byte Int
6 Word64
w1, Int -> Word64 -> Word8
byte Int
5 Word64
w1, Int -> Word64 -> Word8
byte Int
4 Word64
w1,
     Int -> Word64 -> Word8
byte Int
3 Word64
w1, Int -> Word64 -> Word8
byte Int
2 Word64
w1, Int -> Word64 -> Word8
byte Int
1 Word64
w1, Int -> Word64 -> Word8
byte Int
0 Word64
w1]

-- |Construct a UUID from a list of Word8. Returns Nothing if the list isn't
-- exactly sixteen bytes long
fromList :: [Word8] -> Maybe UUID
fromList :: [Word8] -> Maybe UUID
fromList [Word8
b0, Word8
b1, Word8
b2, Word8
b3, Word8
b4, Word8
b5, Word8
b6, Word8
b7, Word8
b8, Word8
b9, Word8
ba, Word8
bb, Word8
bc, Word8
bd, Word8
be, Word8
bf] =
    UUID -> Maybe UUID
forall a. a -> Maybe a
Just (UUID -> Maybe UUID) -> UUID -> Maybe UUID
forall a b. (a -> b) -> a -> b
$ Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> UUID
makeFromBytes Word8
b0 Word8
b1 Word8
b2 Word8
b3 Word8
b4 Word8
b5 Word8
b6 Word8
b7 Word8
b8 Word8
b9 Word8
ba Word8
bb Word8
bc Word8
bd Word8
be Word8
bf
fromList [Word8]
_ = Maybe UUID
forall a. Maybe a
Nothing


--
-- UUID API
--

-- |Returns true if the passed-in UUID is the 'nil' UUID.
null :: UUID -> Bool
null :: UUID -> Bool
null = (UUID -> UUID -> Bool
forall a. Eq a => a -> a -> Bool
== UUID
nil)
    -- Note: This actually faster than:
    --      null (UUID 0 0 0 0) = True
    --      null _              = False

-- |The 'nil' UUID, as defined in <http://tools.ietf.org/html/rfc4122 RFC 4122>.
-- It is a UUID of all zeros. @'null' u@ /iff/ @'u' == 'nil'@.
nil :: UUID
nil :: UUID
nil = Word64 -> Word64 -> UUID
UUID Word64
0 Word64
0

-- |Extract a UUID from a 'ByteString' in network byte order.
-- The argument must be 16 bytes long, otherwise 'Nothing' is returned.
fromByteString :: BL.ByteString -> Maybe UUID
fromByteString :: ByteString -> Maybe UUID
fromByteString = [Word8] -> Maybe UUID
fromList ([Word8] -> Maybe UUID)
-> (ByteString -> [Word8]) -> ByteString -> Maybe UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BL.unpack

-- |Encode a UUID into a 'ByteString' in network order.
--
-- This uses the same encoding as the 'Binary' instance.
toByteString :: UUID -> BL.ByteString
toByteString :: UUID -> ByteString
toByteString = [Word8] -> ByteString
BL.pack ([Word8] -> ByteString) -> (UUID -> [Word8]) -> UUID -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> [Word8]
toList

-- |If the passed in 'String' can be parsed as a 'UUID', it will be.
-- The hyphens may not be omitted.
-- Example:
--
-- >>> fromString "c2cc10e1-57d6-4b6f-9899-38d972112d8c"
-- Just c2cc10e1-57d6-4b6f-9899-38d972112d8c
--
-- Hex digits may be upper or lower-case.
fromString :: String -> Maybe UUID
fromString :: String -> Maybe UUID
fromString String
xs | Bool
validFmt  = String -> Maybe UUID
fromString' String
xs
              | Bool
otherwise = Maybe UUID
forall a. Maybe a
Nothing
  where validFmt :: Bool
validFmt = Char -> String -> [Int]
forall a. Eq a => a -> [a] -> [Int]
elemIndices Char
'-' String
xs [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int
8,Int
13,Int
18,Int
23]

fromString' :: String -> Maybe UUID
fromString' :: String -> Maybe UUID
fromString' String
s0 = do
    (Word32
w0, String
s1) <- String -> Maybe (Word32, String)
hexWord String
s0
    (Word32
w1, String
s2) <- String -> Maybe (Word32, String)
hexWord String
s1
    (Word32
w2, String
s3) <- String -> Maybe (Word32, String)
hexWord String
s2
    (Word32
w3, String
s4) <- String -> Maybe (Word32, String)
hexWord String
s3
    if String
s4 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" then Maybe UUID
forall a. Maybe a
Nothing
                else UUID -> Maybe UUID
forall a. a -> Maybe a
Just (UUID -> Maybe UUID) -> UUID -> Maybe UUID
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Word32 -> Word32 -> UUID
fromWords Word32
w0 Word32
w1 Word32
w2 Word32
w3
    where hexWord :: String -> Maybe (Word32, String)
          hexWord :: String -> Maybe (Word32, String)
hexWord String
s = (Word32, String) -> Maybe (Word32, String)
forall a. a -> Maybe a
Just (Word32
0, String
s) Maybe (Word32, String)
-> ((Word32, String) -> Maybe (Word32, String))
-> Maybe (Word32, String)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Word32, String) -> Maybe (Word32, String)
hexByte Maybe (Word32, String)
-> ((Word32, String) -> Maybe (Word32, String))
-> Maybe (Word32, String)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Word32, String) -> Maybe (Word32, String)
hexByte
                                  Maybe (Word32, String)
-> ((Word32, String) -> Maybe (Word32, String))
-> Maybe (Word32, String)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Word32, String) -> Maybe (Word32, String)
hexByte Maybe (Word32, String)
-> ((Word32, String) -> Maybe (Word32, String))
-> Maybe (Word32, String)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Word32, String) -> Maybe (Word32, String)
hexByte

          hexByte :: (Word32, String) -> Maybe (Word32, String)
          hexByte :: (Word32, String) -> Maybe (Word32, String)
hexByte (Word32
w, Char
'-':String
ds) = (Word32, String) -> Maybe (Word32, String)
hexByte (Word32
w, String
ds)
          hexByte (Word32
w, Char
hi:Char
lo:String
ds)
              | Bool
bothHex   = (Word32, String) -> Maybe (Word32, String)
forall a. a -> Maybe a
Just ((Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
octet, String
ds)
              | Bool
otherwise = Maybe (Word32, String)
forall a. Maybe a
Nothing
              where bothHex :: Bool
bothHex = Char -> Bool
isHexDigit Char
hi Bool -> Bool -> Bool
&& Char -> Bool
isHexDigit Char
lo
                    octet :: Word32
octet = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Char -> Int
digitToInt Char
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
lo)
          hexByte (Word32, String)
_ = Maybe (Word32, String)
forall a. Maybe a
Nothing

-- | Convert a UUID into a hypenated string using lower-case letters.
-- Example:
--
-- >>> toString <$> fromString "550e8400-e29b-41d4-a716-446655440000"
-- Just "550e8400-e29b-41d4-a716-446655440000"
--
--
toString :: UUID -> String
toString :: UUID -> String
toString UUID
uuid = Word64 -> ShowS
hexw0 Word64
w0 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Word64 -> ShowS
hexw1 Word64
w1 String
""
    where hexw0 :: Word64 -> String -> String
          hexw0 :: Word64 -> ShowS
hexw0 Word64
w String
s =       Word64 -> Int -> Char
hexn Word64
w Int
60 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
56 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
52 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
48
                          Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
44 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
40 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
36 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
32
                    Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
28 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
24 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
20 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
16
                    Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
12 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w  Int
8 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w  Int
4 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w  Int
0
                          Char -> ShowS
forall a. a -> [a] -> [a]
: String
s

          hexw1 :: Word64 -> String -> String
          hexw1 :: Word64 -> ShowS
hexw1 Word64
w String
s = Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
60 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
56 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
52 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
48
                    Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
44 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
40 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
36 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
32
                          Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
28 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
24 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
20 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
16
                          Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
12 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w  Int
8 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w  Int
4 Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w  Int
0
                          Char -> ShowS
forall a. a -> [a] -> [a]
: String
s

          hexn :: Word64 -> Int -> Char
          hexn :: Word64 -> Int -> Char
hexn Word64
w Int
r = Int -> Char
intToDigit (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
r) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xf)

          (Word64
w0,Word64
w1) = UUID -> (Word64, Word64)
toWords64 UUID
uuid

-- | If the passed in `Text` can be parsed as an ASCII representation of
--   a `UUID`, it will be. The hyphens may not be omitted.
fromText :: Text -> Maybe UUID
fromText :: Text -> Maybe UUID
fromText = ByteString -> Maybe UUID
fromASCIIBytes (ByteString -> Maybe UUID)
-> (Text -> ByteString) -> Text -> Maybe UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

-- | Convert a UUID into a hyphentated string using lower-case letters.
toText :: UUID -> Text
toText :: UUID -> Text
toText = ByteString -> Text
T.decodeLatin1 (ByteString -> Text) -> (UUID -> ByteString) -> UUID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> ByteString
toASCIIBytes

-- | Convert a UUID into a hyphentated string using lower-case letters, packed
--   as ASCII bytes into `B.ByteString`.
--
--   This should be equivalent to `toString` with `Data.ByteString.Char8.pack`.
toASCIIBytes :: UUID -> B.ByteString
toASCIIBytes :: UUID -> ByteString
toASCIIBytes UUID
uuid = Int -> (Ptr Word8 -> IO ()) -> ByteString
BI.unsafeCreate Int
36 (UUID -> Ptr Word8 -> IO ()
pokeASCII UUID
uuid)

-- | Helper function for `toASCIIBytes`
pokeASCII :: UUID -> Ptr Word8 -> IO ()
pokeASCII :: UUID -> Ptr Word8 -> IO ()
pokeASCII UUID
uuid Ptr Word8
ptr = do
    Int -> IO ()
pokeDash Int
8
    Int -> IO ()
pokeDash Int
13
    Int -> IO ()
pokeDash Int
18
    Int -> IO ()
pokeDash Int
23
    Int -> Word32 -> IO ()
pokeSingle Int
0  Word32
w0
    Int -> Word32 -> IO ()
pokeDouble Int
9  Word32
w1
    Int -> Word32 -> IO ()
pokeDouble Int
19 Word32
w2
    Int -> Word32 -> IO ()
pokeSingle Int
28 Word32
w3
  where
    (Word32
w0, Word32
w1, Word32
w2, Word32
w3) = UUID -> (Word32, Word32, Word32, Word32)
toWords UUID
uuid

    -- ord '-' ==> 45
    pokeDash :: Int -> IO ()
pokeDash Int
ix = Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
ptr Int
ix Word8
45

    pokeSingle :: Int -> Word32 -> IO ()
pokeSingle Int
ix Word32
w = do
        Int -> Word32 -> Int -> IO ()
pokeWord Int
ix       Word32
w Int
28
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word32
w Int
24
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word32
w Int
20
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Word32
w Int
16
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Word32
w Int
12
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) Word32
w Int
8
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6) Word32
w Int
4
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Word32
w Int
0

    -- We skip the dash in the middle
    pokeDouble :: Int -> Word32 -> IO ()
pokeDouble Int
ix Word32
w = do
        Int -> Word32 -> Int -> IO ()
pokeWord Int
ix       Word32
w Int
28
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word32
w Int
24
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word32
w Int
20
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Word32
w Int
16
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) Word32
w Int
12
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6) Word32
w Int
8
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Word32
w Int
4
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8) Word32
w Int
0

    pokeWord :: Int -> Word32 -> Int -> IO ()
pokeWord Int
ix Word32
w Int
r =
        Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
ptr Int
ix (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word32
toDigit ((Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
r) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xf)))

    toDigit :: Word32 -> Word32
    toDigit :: Word32 -> Word32
toDigit Word32
w = if Word32
w Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
10 then Word32
48 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
w else Word32
97 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
w Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
10

-- | If the passed in `B.ByteString` can be parsed as an ASCII representation of
--   a `UUID`, it will be. The hyphens may not be omitted.
--
--   This should be equivalent to `fromString` with `Data.ByteString.Char8.unpack`.
fromASCIIBytes :: B.ByteString -> Maybe UUID
fromASCIIBytes :: ByteString -> Maybe UUID
fromASCIIBytes ByteString
bs = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
wellFormed
    Word32 -> Word32 -> Word32 -> Word32 -> UUID
fromWords (Word32 -> Word32 -> Word32 -> Word32 -> UUID)
-> Maybe Word32 -> Maybe (Word32 -> Word32 -> Word32 -> UUID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Word32
single Int
0 Maybe (Word32 -> Word32 -> Word32 -> UUID)
-> Maybe Word32 -> Maybe (Word32 -> Word32 -> UUID)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> Maybe Word32
double Int
9 Int
14 Maybe (Word32 -> Word32 -> UUID)
-> Maybe Word32 -> Maybe (Word32 -> UUID)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> Maybe Word32
double Int
19 Int
24 Maybe (Word32 -> UUID) -> Maybe Word32 -> Maybe UUID
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Maybe Word32
single Int
28
  where
    -- ord '-' ==> 45
    dashIx :: ByteString -> Int -> Bool
dashIx ByteString
bs' Int
ix = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs' Int
ix Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
45

    -- Important: check the length first, given the `unsafeIndex` later.
    wellFormed :: Bool
wellFormed =
        ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
36 Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
dashIx ByteString
bs Int
8 Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
dashIx ByteString
bs Int
13 Bool -> Bool -> Bool
&&
        ByteString -> Int -> Bool
dashIx ByteString
bs Int
18 Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
dashIx ByteString
bs Int
23

    single :: Int -> Maybe Word32
single Int
ix      = Word32 -> Word32 -> Word32 -> Word32 -> Word32
forall {a}. Bits a => a -> a -> a -> a -> a
combine (Word32 -> Word32 -> Word32 -> Word32 -> Word32)
-> Maybe Word32 -> Maybe (Word32 -> Word32 -> Word32 -> Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Word32
octet Int
ix       Maybe (Word32 -> Word32 -> Word32 -> Word32)
-> Maybe Word32 -> Maybe (Word32 -> Word32 -> Word32)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Maybe Word32
octet (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                             Maybe (Word32 -> Word32 -> Word32)
-> Maybe Word32 -> Maybe (Word32 -> Word32)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Maybe Word32
octet (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Maybe (Word32 -> Word32) -> Maybe Word32 -> Maybe Word32
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Maybe Word32
octet (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6)
    double :: Int -> Int -> Maybe Word32
double Int
ix0 Int
ix1 = Word32 -> Word32 -> Word32 -> Word32 -> Word32
forall {a}. Bits a => a -> a -> a -> a -> a
combine (Word32 -> Word32 -> Word32 -> Word32 -> Word32)
-> Maybe Word32 -> Maybe (Word32 -> Word32 -> Word32 -> Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Word32
octet Int
ix0 Maybe (Word32 -> Word32 -> Word32 -> Word32)
-> Maybe Word32 -> Maybe (Word32 -> Word32 -> Word32)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Maybe Word32
octet (Int
ix0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                             Maybe (Word32 -> Word32 -> Word32)
-> Maybe Word32 -> Maybe (Word32 -> Word32)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Maybe Word32
octet Int
ix1 Maybe (Word32 -> Word32) -> Maybe Word32 -> Maybe Word32
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Maybe Word32
octet (Int
ix1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)

    combine :: a -> a -> a -> a -> a
combine a
o0 a
o1 a
o2 a
o3 = a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
o0 Int
24 a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
o1 Int
16 a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
o2 Int
8 a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
o3

    octet :: Int -> Maybe Word32
octet Int
ix = do
        Word32
hi <- Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> Maybe Word8 -> Maybe Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Maybe Word8
toDigit (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
ix)
        Word32
lo <- Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> Maybe Word8 -> Maybe Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Maybe Word8
toDigit (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
        Word32 -> Maybe Word32
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
16 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
hi Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
lo)

    toDigit :: Word8 -> Maybe Word8
    toDigit :: Word8 -> Maybe Word8
toDigit Word8
w
        -- Digit
        | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57  = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
48)
        -- Uppercase
        | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
65 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
70  = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8
10 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
65)
        -- Lowercase
        | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
97 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
102 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8
10 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
97)
        | Bool
otherwise           = Maybe Word8
forall a. Maybe a
Nothing

-- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`.
toLazyASCIIBytes :: UUID -> BL.ByteString
toLazyASCIIBytes :: UUID -> ByteString
toLazyASCIIBytes =
    ByteString -> ByteString
BL.fromStrict
    (ByteString -> ByteString)
-> (UUID -> ByteString) -> UUID -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> ByteString
toASCIIBytes

-- | Similar to `fromASCIIBytes` except parses from a lazy `BL.ByteString`.
fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID
fromLazyASCIIBytes :: ByteString -> Maybe UUID
fromLazyASCIIBytes ByteString
bs =
    if ByteString -> Int64
BL.length ByteString
bs Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
36 then ByteString -> Maybe UUID
fromASCIIBytes (ByteString -> ByteString
BL.toStrict ByteString
bs) else Maybe UUID
forall a. Maybe a
Nothing

--
-- Class Instances
--

-- | This 'Random' instance produces __insecure__ version 4 UUIDs as
-- specified in <http://tools.ietf.org/html/rfc4122 RFC 4122>.
instance Random UUID where
    random :: forall g. RandomGen g => g -> (UUID, g)
random = g -> (UUID, g)
forall g a. (RandomGen g, Uniform a) => g -> (a, g)
uniform
    randomR :: forall g. RandomGen g => (UUID, UUID) -> g -> (UUID, g)
randomR (UUID, UUID)
_ = g -> (UUID, g)
forall g. RandomGen g => g -> (UUID, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random -- range is ignored

-- @since 1.0.4
instance Uniform UUID where
    uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m UUID
uniformM g
gen = do
        Word64
w0 <- g -> m Word64
forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64 g
gen
        Word64
w1 <- g -> m Word64
forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64 g
gen
        UUID -> m UUID
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UUID -> m UUID) -> UUID -> m UUID
forall a b. (a -> b) -> a -> b
$ Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> UUID
buildFromBytes Word8
4 ByteSink
  Word64
  (Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> UUID)
-> Word64
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> UUID
forall w g. ByteSource w => ByteSink w g -> w -> g
forall g. ByteSink Word64 g -> Word64 -> g
/-/ Word64
w0 ByteSink Word64 UUID -> Word64 -> UUID
forall w g. ByteSource w => ByteSink w g -> w -> g
forall g. ByteSink Word64 g -> Word64 -> g
/-/ Word64
w1

-- |A ByteSource to extract only three bytes from an Int, since next on StdGet
-- only returns 31 bits of randomness.
type instance ByteSink ThreeByte g = Takes3Bytes g
newtype ThreeByte = ThreeByte Int
instance ByteSource ThreeByte where
    ByteSink ThreeByte g
f /-/ :: forall g. ByteSink ThreeByte g -> ThreeByte -> g
/-/ (ThreeByte Int
w) = ByteSink ThreeByte g
Takes3Bytes g
f Word8
b1 Word8
b2 Word8
b3
        where b1 :: Word8
b1 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
w Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
16)
              b2 :: Word8
b2 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
w Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8)
              b3 :: Word8
b3 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w

instance NFData UUID where
    rnf :: UUID -> ()
rnf = (UUID -> () -> ()) -> () -> UUID -> ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip UUID -> () -> ()
forall a b. a -> b -> b
seq ()

instance Hashable UUID where
    hash :: UUID -> Int
hash (UUID -> (Word32, Word32, Word32, Word32)
toWords -> (Word32
w0,Word32
w1,Word32
w2,Word32
w3)) =
        Word32 -> Int
forall a. Hashable a => a -> Int
hash Word32
w0 Int -> Word32 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word32
w1
                Int -> Word32 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word32
w2
                Int -> Word32 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word32
w3
    hashWithSalt :: Int -> UUID -> Int
hashWithSalt Int
s (UUID -> (Word32, Word32, Word32, Word32)
toWords -> (Word32
w0,Word32
w1,Word32
w2,Word32
w3)) =
        Int
s Int -> Word32 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word32
w0
          Int -> Word32 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word32
w1
          Int -> Word32 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word32
w2
          Int -> Word32 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word32
w3

-- | Pretty prints a 'UUID' (without quotation marks). See also 'toString'.
--
-- >>> show nil
-- "00000000-0000-0000-0000-000000000000"
--
instance Show UUID where
    show :: UUID -> String
show = UUID -> String
toString

instance Read UUID where
    readsPrec :: Int -> ReadS UUID
readsPrec Int
_ String
str =
        let noSpaces :: String
noSpaces = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
str
        in case String -> Maybe UUID
fromString (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
36 String
noSpaces) of
          Maybe UUID
Nothing -> []
          Just UUID
u  -> [(UUID
u,Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
36 String
noSpaces)]

-- | This 'Storable' instance uses the memory layout as described in <http://tools.ietf.org/html/rfc4122 RFC 4122>, but in contrast to the 'Binary' instance, __the fields are stored in host byte order__.
instance Storable UUID where
    sizeOf :: UUID -> Int
sizeOf UUID
_ = Int
16
    alignment :: UUID -> Int
alignment UUID
_ = Int
4

    peekByteOff :: forall b. Ptr b -> Int -> IO UUID
peekByteOff Ptr b
p Int
off =
      UnpackedUUID -> UUID
pack (UnpackedUUID -> UUID) -> IO UnpackedUUID -> IO UUID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
       (Word32
-> Word16
-> Word16
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> UnpackedUUID
UnpackedUUID
             (Word32
 -> Word16
 -> Word16
 -> Word8
 -> Word8
 -> Word8
 -> Word8
 -> Word8
 -> Word8
 -> Word8
 -> Word8
 -> UnpackedUUID)
-> IO Word32
-> IO
     (Word16
      -> Word16
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> UnpackedUUID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr b -> Int -> IO Word32
forall b. Ptr b -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p Int
off -- Word32
             IO
  (Word16
   -> Word16
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> UnpackedUUID)
-> IO Word16
-> IO
     (Word16
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> UnpackedUUID)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr b -> Int -> IO Word16
forall b. Ptr b -> Int -> IO Word16
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4) -- Word16
             IO
  (Word16
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> UnpackedUUID)
-> IO Word16
-> IO
     (Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> UnpackedUUID)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr b -> Int -> IO Word16
forall b. Ptr b -> Int -> IO Word16
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
6) -- Word16
             IO
  (Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> UnpackedUUID)
-> IO Word8
-> IO
     (Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> UnpackedUUID)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
8) -- Word8
             IO
  (Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> UnpackedUUID)
-> IO Word8
-> IO
     (Word8
      -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> UnpackedUUID)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
9) -- Word8
             IO
  (Word8
   -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> UnpackedUUID)
-> IO Word8
-> IO (Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> UnpackedUUID)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
10) -- Word8
             IO (Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> UnpackedUUID)
-> IO Word8
-> IO (Word8 -> Word8 -> Word8 -> Word8 -> UnpackedUUID)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
11) -- Word8
             IO (Word8 -> Word8 -> Word8 -> Word8 -> UnpackedUUID)
-> IO Word8 -> IO (Word8 -> Word8 -> Word8 -> UnpackedUUID)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
12) -- Word8
             IO (Word8 -> Word8 -> Word8 -> UnpackedUUID)
-> IO Word8 -> IO (Word8 -> Word8 -> UnpackedUUID)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
13) -- Word8
             IO (Word8 -> Word8 -> UnpackedUUID)
-> IO Word8 -> IO (Word8 -> UnpackedUUID)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
14) -- Word8
             IO (Word8 -> UnpackedUUID) -> IO Word8 -> IO UnpackedUUID
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
15) -- Word8
        )

    pokeByteOff :: forall b. Ptr b -> Int -> UUID -> IO ()
pokeByteOff Ptr b
p Int
off UUID
u =
        case UUID -> UnpackedUUID
unpack UUID
u of
          (UnpackedUUID Word32
x0 Word16
x1 Word16
x2 Word8
x3 Word8
x4 Word8
x5 Word8
x6 Word8
x7 Word8
x8 Word8
x9 Word8
x10) ->
              do
                Ptr b -> Int -> Word32 -> IO ()
forall b. Ptr b -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p Int
off Word32
x0
                Ptr b -> Int -> Word16 -> IO ()
forall b. Ptr b -> Int -> Word16 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4) Word16
x1
                Ptr b -> Int -> Word16 -> IO ()
forall b. Ptr b -> Int -> Word16 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
6) Word16
x2
                Ptr b -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
8) Word8
x3
                Ptr b -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
9) Word8
x4
                Ptr b -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
10) Word8
x5
                Ptr b -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
11) Word8
x6
                Ptr b -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
12) Word8
x7
                Ptr b -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
13) Word8
x8
                Ptr b -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
14) Word8
x9
                Ptr b -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
15) Word8
x10

-- | This 'Binary' instance is compatible with <http://tools.ietf.org/html/rfc4122 RFC 4122>, storing the fields in network order as 16 bytes.
instance Binary UUID where
    put :: UUID -> Put
put (UUID Word64
w0 Word64
w1) = Word64 -> Put
putWord64be Word64
w0 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putWord64be Word64
w1
    get :: Get UUID
get = (Word64 -> Word64 -> UUID) -> Get Word64 -> Get Word64 -> Get UUID
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Word64 -> Word64 -> UUID
UUID Get Word64
getWord64be Get Word64
getWord64be


-- My goal with this instance was to make it work just enough to do what
-- I want when used with the HStringTemplate library.
instance Data UUID where
    toConstr :: UUID -> Constr
toConstr UUID
uu  = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
uuidType (UUID -> String
forall a. Show a => a -> String
show UUID
uu) [] (String -> Fixity
forall a. HasCallStack => String -> a
error String
"fixity")
    gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UUID
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c UUID
forall a. HasCallStack => String -> a
error String
"gunfold"
    dataTypeOf :: UUID -> DataType
dataTypeOf UUID
_ = DataType
uuidType

uuidType :: DataType
uuidType :: DataType
uuidType =  String -> DataType
mkNoRepType String
"Data.UUID.Types.UUID"

deriving instance Lift UUID