{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeFamilies       #-}
{-# LANGUAGE ViewPatterns       #-}
#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Unsafe             #-}
#endif
#if __GLASGOW_HASKELL__ >=800
{-# LANGUAGE DeriveLift         #-}
{-# LANGUAGE StandaloneDeriving #-}
#endif

{-# 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

#if MIN_VERSION_random(1,2,0)
import           System.Random (Random (..), uniform)
import           System.Random.Stateful (Uniform (..), uniformWord64)
#else
import           System.Random (Random (..), next)
#endif

#if __GLASGOW_HASKELL__ >=800
import Language.Haskell.TH.Syntax (Lift)
#else
import Language.Haskell.TH (appE, varE)
import Language.Haskell.TH.Syntax (Lift (..), mkNameG_v, Lit (IntegerL), Exp (LitE))
#endif

-- | 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UUID -> UUID -> Bool
$c/= :: UUID -> UUID -> Bool
== :: UUID -> UUID -> Bool
$c== :: UUID -> UUID -> Bool
Eq, Eq 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
min :: UUID -> UUID -> UUID
$cmin :: UUID -> UUID -> UUID
max :: UUID -> UUID -> UUID
$cmax :: UUID -> UUID -> UUID
>= :: UUID -> UUID -> Bool
$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
compare :: UUID -> UUID -> Ordering
$ccompare :: UUID -> UUID -> Ordering
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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w12 forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
32)
    w2 :: Word32
w2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w12
    w3 :: Word32
w3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w34 forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
32)
    w4 :: Word32
w4 = 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]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnpackedUUID]
$creadListPrec :: ReadPrec [UnpackedUUID]
readPrec :: ReadPrec UnpackedUUID
$creadPrec :: ReadPrec UnpackedUUID
readList :: ReadS [UnpackedUUID]
$creadList :: ReadS [UnpackedUUID]
readsPrec :: Int -> ReadS UnpackedUUID
$creadsPrec :: Int -> ReadS UnpackedUUID
Read, Int -> UnpackedUUID -> ShowS
[UnpackedUUID] -> ShowS
UnpackedUUID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnpackedUUID] -> ShowS
$cshowList :: [UnpackedUUID] -> ShowS
show :: UnpackedUUID -> String
$cshow :: UnpackedUUID -> String
showsPrec :: Int -> UnpackedUUID -> ShowS
$cshowsPrec :: Int -> UnpackedUUID -> ShowS
Show, UnpackedUUID -> UnpackedUUID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnpackedUUID -> UnpackedUUID -> Bool
$c/= :: UnpackedUUID -> UnpackedUUID -> Bool
== :: UnpackedUUID -> UnpackedUUID -> Bool
$c== :: UnpackedUUID -> UnpackedUUID -> Bool
Eq, Eq 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
min :: UnpackedUUID -> UnpackedUUID -> UnpackedUUID
$cmin :: UnpackedUUID -> UnpackedUUID -> UnpackedUUID
max :: UnpackedUUID -> UnpackedUUID -> UnpackedUUID
$cmax :: UnpackedUUID -> UnpackedUUID -> UnpackedUUID
>= :: UnpackedUUID -> UnpackedUUID -> Bool
$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
compare :: UnpackedUUID -> UnpackedUUID -> Ordering
$ccompare :: UnpackedUUID -> UnpackedUUID -> Ordering
Ord)

unpack :: UUID -> UnpackedUUID
unpack :: UUID -> UnpackedUUID
unpack (UUID Word64
w0 Word64
w1) = Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Takes8Bytes UnpackedUUID
build forall w g. ByteSource w => ByteSink w g -> w -> g
/-/ Word64
w0 forall w g. ByteSource w => ByteSink w g -> w -> g
/-/ Word64
w1
 where
    build :: Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Takes8Bytes 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 =
  Word8
-> Word8
-> Word8
-> Word8
-> Takes2Bytes
     (Takes2Bytes
        (Takes1Byte
           (Takes1Byte
              (Takes1Byte
                 (Takes1Byte
                    (Takes1Byte (Takes1Byte (Takes1Byte (Takes1Byte UUID)))))))))
makeFromBytes forall w g. ByteSource w => ByteSink w g -> w -> g
/-/ (UnpackedUUID -> Word32
time_low UnpackedUUID
unpacked)
                forall w g. ByteSource w => ByteSink w g -> w -> g
/-/ (UnpackedUUID -> Word16
time_mid UnpackedUUID
unpacked)
                forall w g. ByteSource w => ByteSink w g -> w -> g
/-/ (UnpackedUUID -> Word16
time_hi_and_version UnpackedUUID
unpacked)
                forall w g. ByteSource w => ByteSink w g -> w -> g
/-/ (UnpackedUUID -> Word8
clock_seq_hi_res UnpackedUUID
unpacked)
                forall w g. ByteSource w => ByteSink w g -> w -> g
/-/ (UnpackedUUID -> Word8
clock_seq_low UnpackedUUID
unpacked)
                forall w g. ByteSource w => ByteSink w g -> w -> g
/-/ (UnpackedUUID -> Word8
node_0 UnpackedUUID
unpacked) forall w g. ByteSource w => ByteSink w g -> w -> g
/-/ (UnpackedUUID -> Word8
node_1 UnpackedUUID
unpacked)
                forall w g. ByteSource w => ByteSink w g -> w -> g
/-/ (UnpackedUUID -> Word8
node_2 UnpackedUUID
unpacked) forall w g. ByteSource w => ByteSink w g -> w -> g
/-/ (UnpackedUUID -> Word8
node_3 UnpackedUUID
unpacked)
                forall w g. ByteSource w => ByteSink w g -> w -> g
/-/ (UnpackedUUID -> Word8
node_4 UnpackedUUID
unpacked) forall w g. ByteSource w => ByteSink w g -> w -> 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 =  (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
24)
            forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16)
            forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c forall a. Bits a => a -> Int -> a
`unsafeShiftL`  Int
8)
            forall a. Bits a => a -> a -> a
.|. (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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w forall a. Bits a => a -> Int -> a
`shiftR` (Int
i 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 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8) forall a. Bits a => a -> a -> a
.|. Word16
w1
  where
    w0 :: Word16
w0 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w0s
    w1 :: Word16
w1 = 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 = (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w0 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
32) forall a. Bits a => a -> a -> a
.|. (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
-> Takes2Bytes
     (Takes2Bytes
        (Takes1Byte
           (Takes1Byte
              (Takes1Byte
                 (Takes1Byte
                    (Takes1Byte (Takes1Byte (Takes1Byte (Takes1Byte 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
-> Takes2Bytes
     (Takes2Bytes
        (Takes1Byte
           (Takes1Byte
              (Takes1Byte
                 (Takes1Byte
                    (Takes1Byte (Takes1Byte (Takes1Byte (Takes1Byte 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
-> Takes2Bytes
     (Takes2Bytes
        (Takes1Byte
           (Takes1Byte
              (Takes1Byte
                 (Takes1Byte
                    (Takes1Byte (Takes1Byte (Takes1Byte (Takes1Byte 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 forall a. Bits a => a -> a -> a
.&. Word8
0x0f forall a. Bits a => a -> a -> a
.|. (Word8
v forall a. Bits a => a -> Int -> a
`shiftL` Int
4)
          b8' :: Word8
b8' = Word8
b8 forall a. Bits a => a -> a -> a
.&. Word8
0x3f 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 forall a. Bits a => a -> a -> a
.&. Word32
0xffff0fff forall a. Bits a => a -> a -> a
.|. ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v) forall a. Bits a => a -> Int -> a
`shiftL` Int
12)
          w2' :: Word32
w2' = Word32
w2 forall a. Bits a => a -> a -> a
.&. Word32
0x3fffffff 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] =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Word8
-> Word8
-> Word8
-> Word8
-> Takes2Bytes
     (Takes2Bytes
        (Takes1Byte
           (Takes1Byte
              (Takes1Byte
                 (Takes1Byte
                    (Takes1Byte (Takes1Byte (Takes1Byte (Takes1Byte 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]
_ = 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 = (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 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 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 = forall a. Maybe a
Nothing
  where validFmt :: Bool
validFmt = forall a. Eq a => a -> [a] -> [Int]
elemIndices Char
'-' String
xs 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 forall a. Eq a => a -> a -> Bool
/= String
"" then forall a. Maybe a
Nothing
                else forall a. a -> Maybe a
Just 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 = forall a. a -> Maybe a
Just (Word32
0, String
s) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Word32, String) -> Maybe (Word32, String)
hexByte forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Word32, String) -> Maybe (Word32, String)
hexByte
                                  forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Word32, String) -> Maybe (Word32, String)
hexByte 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   = forall a. a -> Maybe a
Just ((Word32
w forall a. Bits a => a -> Int -> a
`shiftL` Int
8) forall a. Bits a => a -> a -> a
.|. Word32
octet, String
ds)
              | Bool
otherwise = 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
16 forall a. Num a => a -> a -> a
* Char -> Int
digitToInt Char
hi forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
lo)
          hexByte (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 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 forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
56 forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
52 forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
48
                          forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
44 forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
40 forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
36 forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
32
                    forall a. a -> [a] -> [a]
: Char
'-' forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
28 forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
24 forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
20 forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
16
                    forall a. a -> [a] -> [a]
: Char
'-' forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w Int
12 forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w  Int
8 forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w  Int
4 forall a. a -> [a] -> [a]
: Word64 -> Int -> Char
hexn Word64
w  Int
0
                          forall a. a -> [a] -> [a]
: String
s

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

          hexn :: Word64 -> Int -> Char
          hexn :: Word64 -> Int -> Char
hexn Word64
w Int
r = Int -> Char
intToDigit forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
r) 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 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 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 = 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 forall a. Num a => a -> a -> a
+ Int
1) Word32
w Int
24
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix forall a. Num a => a -> a -> a
+ Int
2) Word32
w Int
20
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix forall a. Num a => a -> a -> a
+ Int
3) Word32
w Int
16
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix forall a. Num a => a -> a -> a
+ Int
4) Word32
w Int
12
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix forall a. Num a => a -> a -> a
+ Int
5) Word32
w Int
8
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix forall a. Num a => a -> a -> a
+ Int
6) Word32
w Int
4
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix 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 forall a. Num a => a -> a -> a
+ Int
1) Word32
w Int
24
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix forall a. Num a => a -> a -> a
+ Int
2) Word32
w Int
20
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix forall a. Num a => a -> a -> a
+ Int
3) Word32
w Int
16
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix forall a. Num a => a -> a -> a
+ Int
5) Word32
w Int
12
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix forall a. Num a => a -> a -> a
+ Int
6) Word32
w Int
8
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix forall a. Num a => a -> a -> a
+ Int
7) Word32
w Int
4
        Int -> Word32 -> Int -> IO ()
pokeWord (Int
ix 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 =
        forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
ptr Int
ix (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word32
toDigit ((Word32
w forall a. Bits a => a -> Int -> a
`shiftR` Int
r) forall a. Bits a => a -> a -> a
.&. Word32
0xf)))

    toDigit :: Word32 -> Word32
    toDigit :: Word32 -> Word32
toDigit Word32
w = if Word32
w forall a. Ord a => a -> a -> Bool
< Word32
10 then Word32
48 forall a. Num a => a -> a -> a
+ Word32
w else Word32
97 forall a. Num a => a -> a -> a
+ Word32
w 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
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
wellFormed
    Word32 -> Word32 -> Word32 -> Word32 -> UUID
fromWords forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Word32
single Int
0 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> Maybe Word32
double Int
9 Int
14 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> Maybe Word32
double Int
19 Int
24 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 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 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      = forall {a}. Bits a => a -> a -> a -> a -> a
combine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Word32
octet Int
ix       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Maybe Word32
octet (Int
ix forall a. Num a => a -> a -> a
+ Int
2)
                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Maybe Word32
octet (Int
ix forall a. Num a => a -> a -> a
+ Int
4) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Maybe Word32
octet (Int
ix forall a. Num a => a -> a -> a
+ Int
6)
    double :: Int -> Int -> Maybe Word32
double Int
ix0 Int
ix1 = forall {a}. Bits a => a -> a -> a -> a -> a
combine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Word32
octet Int
ix0 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Maybe Word32
octet (Int
ix0 forall a. Num a => a -> a -> a
+ Int
2)
                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Maybe Word32
octet Int
ix1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Maybe Word32
octet (Int
ix1 forall a. Num a => a -> a -> a
+ Int
2)

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

    octet :: Int -> Maybe Word32
octet Int
ix = do
        Word32
hi <- forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 forall a. Num a => a -> a -> a
+ Int
1))
        forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
16 forall a. Num a => a -> a -> a
* Word32
hi forall a. Num a => a -> a -> a
+ Word32
lo)

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

-- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`.
toLazyASCIIBytes :: UUID -> BL.ByteString
toLazyASCIIBytes :: UUID -> ByteString
toLazyASCIIBytes =
#if MIN_VERSION_bytestring(0,10,0)
    ByteString -> ByteString
BL.fromStrict
#else
    BL.fromChunks . return
#endif
    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 forall a. Eq a => a -> a -> Bool
== Int64
36 then ByteString -> Maybe UUID
fromASCIIBytes (
#if MIN_VERSION_bytestring(0,10,0)
        ByteString -> ByteString
BL.toStrict ByteString
bs
#else
        B.concat $ BL.toChunks bs
#endif
        ) else 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>.
#if MIN_VERSION_random(1,2,0)
instance Random UUID where
    random :: forall g. RandomGen g => g -> (UUID, g)
random = forall g a. (RandomGen g, Uniform a) => g -> (a, g)
uniform
    randomR :: forall g. RandomGen g => (UUID, UUID) -> g -> (UUID, g)
randomR (UUID, UUID)
_ = 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 <- forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64 g
gen
        Word64
w1 <- forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64 g
gen
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Takes2Bytes
     (Takes2Bytes
        (Takes1Byte
           (Takes1Byte
              (Takes1Byte
                 (Takes1Byte
                    (Takes1Byte (Takes1Byte (Takes1Byte (Takes1Byte UUID)))))))))
buildFromBytes Word8
4 forall w g. ByteSource w => ByteSink w g -> w -> g
/-/ Word64
w0 forall w g. ByteSource w => ByteSink w g -> w -> g
/-/ Word64
w1
#else
instance Random UUID where
    random g = (fromGenNext w0 w1 w2 w3 w4, g4)
        where (w0, g0) = next g
              (w1, g1) = next g0
              (w2, g2) = next g1
              (w3, g3) = next g2
              (w4, g4) = next g3
    randomR _ = random -- range is ignored

-- |Build a UUID from the results of five calls to next on a StdGen.
-- While next on StdGet returns an Int, it doesn't provide 32 bits of
-- randomness. This code relies on at last 28 bits of randomness in the
-- and optimizes its use so as to make only five random values, not six.
fromGenNext :: Int -> Int -> Int -> Int -> Int -> UUID
fromGenNext w0 w1 w2 w3 w4 =
    buildFromBytes 4 /-/ (ThreeByte w0)
                     /-/ (ThreeByte w1)
                     /-/ w2    -- use all 4 bytes because we know the version
                               -- field will "cover" the upper, non-random bits
                     /-/ (ThreeByte w3)
                     /-/ (ThreeByte w4)
#endif

-- |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
f Word8
b1 Word8
b2 Word8
b3
        where b1 :: Word8
b1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
w forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
16)
              b2 :: Word8
b2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
w forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8)
              b3 :: Word8
b3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w

instance NFData UUID where
    rnf :: UUID -> ()
rnf = forall a b c. (a -> b -> c) -> b -> a -> c
flip seq :: 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)) =
        forall a. Hashable a => a -> Int
hash Word32
w0 forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word32
w1
                forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word32
w2
                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 forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word32
w0
          forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word32
w1
          forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word32
w2
          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 = forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
str
        in case String -> Maybe UUID
fromString (forall a. Int -> [a] -> [a]
take Int
36 String
noSpaces) of
          Maybe UUID
Nothing -> []
          Just UUID
u  -> [(UUID
u,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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
       (Word32 -> Word16 -> Word16 -> Takes8Bytes UnpackedUUID
UnpackedUUID
             forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p Int
off -- Word32
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
offforall a. Num a => a -> a -> a
+Int
4) -- Word16
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
offforall a. Num a => a -> a -> a
+Int
6) -- Word16
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
offforall a. Num a => a -> a -> a
+Int
8) -- Word8
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
offforall a. Num a => a -> a -> a
+Int
9) -- Word8
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
offforall a. Num a => a -> a -> a
+Int
10) -- Word8
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
offforall a. Num a => a -> a -> a
+Int
11) -- Word8
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
offforall a. Num a => a -> a -> a
+Int
12) -- Word8
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
offforall a. Num a => a -> a -> a
+Int
13) -- Word8
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
offforall a. Num a => a -> a -> a
+Int
14) -- Word8
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
offforall 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
                forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p Int
off Word32
x0
                forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
offforall a. Num a => a -> a -> a
+Int
4) Word16
x1
                forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
offforall a. Num a => a -> a -> a
+Int
6) Word16
x2
                forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
offforall a. Num a => a -> a -> a
+Int
8) Word8
x3
                forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
offforall a. Num a => a -> a -> a
+Int
9) Word8
x4
                forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
offforall a. Num a => a -> a -> a
+Int
10) Word8
x5
                forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
offforall a. Num a => a -> a -> a
+Int
11) Word8
x6
                forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
offforall a. Num a => a -> a -> a
+Int
12) Word8
x7
                forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
offforall a. Num a => a -> a -> a
+Int
13) Word8
x8
                forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
offforall a. Num a => a -> a -> a
+Int
14) Word8
x9
                forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
offforall 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putWord64be Word64
w1
    get :: Get UUID
get = 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 (forall a. Show a => a -> String
show UUID
uu) [] (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
_  = 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"

#if !MIN_VERSION_base(4,5,0)
unsafeShiftR, unsafeShiftL :: Bits w => w -> Int -> w
{-# INLINE unsafeShiftR #-}
unsafeShiftR = shiftR
{-# INLINE unsafeShiftL #-}
unsafeShiftL = shiftL
#endif

#if __GLASGOW_HASKELL__ >=800
deriving instance Lift UUID
#else
instance Lift UUID where
    lift (UUID w1 w2) = varE fromWords64Name `appE` liftW64 w1 `appE` liftW64 w2
      where
        fromWords64Name = mkNameG_v currentPackageKey "Data.UUID.Types.Internal" "fromWords64"
        liftW64 x = return (LitE (IntegerL (fromIntegral x)))

currentPackageKey :: String
#ifdef CURRENT_PACKAGE_KEY
currentPackageKey = CURRENT_PACKAGE_KEY
#else
currentPackageKey = "uuid-types-1.0.5"
#endif
#endif