{-# LANGUAGE
OverloadedStrings
, GeneralizedNewtypeDeriving
, DataKinds
, ApplicativeDo
#-}
module UUID
( encodeHyphenated
, builderHyphenated
, decodeHyphenated
, parserHyphenated
, encodeUnhyphenated
, builderUnhyphenated
, parserUnhyphenated
, decodeUnhyphenated
, decodeLenient
) where
import Arithmetic.Nat
import Data.Bits
import Data.Bytes.Builder.Bounded
import Data.Bytes
import Data.Bytes.Parser
import Data.Bytes.Parser.Latin
import Data.Primitive.ByteArray
import Data.WideWord.Word128
import Data.Word
encodeHyphenated :: Word128 -> ByteArray
encodeHyphenated :: Word128 -> ByteArray
encodeHyphenated Word128
uuid = Nat 36 -> Builder 36 -> ByteArray
forall (n :: Nat). Nat n -> Builder n -> ByteArray
run Nat 36
forall (n :: Nat). KnownNat n => Nat n
constant (Word128 -> Builder 36
builderHyphenated Word128
uuid)
builderHyphenated :: Word128 -> Builder 36
builderHyphenated :: Word128 -> Builder 36
builderHyphenated Word128
uuid =
Word32 -> Builder 8
word32PaddedLowerHex Word32
w1
Builder 8 -> Builder 28 -> Builder (8 + 28)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`append` Char -> Builder 1
ascii Char
'-'
Builder 1 -> Builder 27 -> Builder (1 + 27)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`append` Word16 -> Builder 4
word16PaddedLowerHex Word16
w2
Builder 4 -> Builder 23 -> Builder (4 + 23)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`append` Char -> Builder 1
ascii Char
'-'
Builder 1 -> Builder 22 -> Builder (1 + 22)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`append` Word16 -> Builder 4
word16PaddedLowerHex Word16
w3
Builder 4 -> Builder 18 -> Builder (4 + 18)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`append` Char -> Builder 1
ascii Char
'-'
Builder 1 -> Builder 17 -> Builder (1 + 17)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`append` Word16 -> Builder 4
word16PaddedLowerHex Word16
w4
Builder 4 -> Builder 13 -> Builder (4 + 13)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`append` Char -> Builder 1
ascii Char
'-'
Builder 1 -> Builder 12 -> Builder (1 + 12)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`append` Word32 -> Builder 8
word32PaddedLowerHex Word32
w5
Builder 8 -> Builder 4 -> Builder (8 + 4)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`append` Word16 -> Builder 4
word16PaddedLowerHex Word16
w6
where
(Word32
w1,Word16
w2,Word16
w3,Word16
w4,Word32
w5,Word16
w6) = Word128 -> (Word32, Word16, Word16, Word16, Word32, Word16)
toWords Word128
uuid
decodeHyphenated :: Bytes -> Maybe Word128
decodeHyphenated :: Bytes -> Maybe Word128
decodeHyphenated Bytes
uuid = (forall s. Parser () s Word128) -> Bytes -> Maybe Word128
forall e a. (forall s. Parser e s a) -> Bytes -> Maybe a
parseBytesMaybe (() -> Parser () s Word128
forall e s. e -> Parser e s Word128
parserHyphenated ()) Bytes
uuid
parserHyphenated :: e -> Parser e s Word128
parserHyphenated :: e -> Parser e s Word128
parserHyphenated e
err = do
Word32
w1 <- e -> Parser e s Word32
forall e s. e -> Parser e s Word32
hexFixedWord32 e
err
e -> Char -> Parser e s ()
forall e s. e -> Char -> Parser e s ()
skipChar1 e
err Char
'-'
Word16
w2 <- e -> Parser e s Word16
forall e s. e -> Parser e s Word16
hexFixedWord16 e
err
e -> Char -> Parser e s ()
forall e s. e -> Char -> Parser e s ()
skipChar1 e
err Char
'-'
Word16
w3 <- e -> Parser e s Word16
forall e s. e -> Parser e s Word16
hexFixedWord16 e
err
e -> Char -> Parser e s ()
forall e s. e -> Char -> Parser e s ()
skipChar1 e
err Char
'-'
Word16
w4 <- e -> Parser e s Word16
forall e s. e -> Parser e s Word16
hexFixedWord16 e
err
e -> Char -> Parser e s ()
forall e s. e -> Char -> Parser e s ()
skipChar1 e
err Char
'-'
Word32
w5 <- e -> Parser e s Word32
forall e s. e -> Parser e s Word32
hexFixedWord32 e
err
Word16
w6 <- e -> Parser e s Word16
forall e s. e -> Parser e s Word16
hexFixedWord16 e
err
pure $ Word128 :: Word64 -> Word64 -> Word128
Word128
{ word128Hi64 :: Word64
word128Hi64 = Word32 -> Word16 -> Word16 -> Word64
fromW32W16Word64 Word32
w1 Word16
w2 Word16
w3
, word128Lo64 :: Word64
word128Lo64 = Word16 -> Word32 -> Word16 -> Word64
fromW16W32W16Word64 Word16
w4 Word32
w5 Word16
w6
}
toWords :: Word128 -> (Word32,Word16,Word16,Word16,Word32,Word16)
toWords :: Word128 -> (Word32, Word16, Word16, Word16, Word32, Word16)
toWords (Word128 Word64
a Word64
b) =
( Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
a Int
32)
, Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
a Int
16)
, Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
a
, Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
b Int
48)
, Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
b Int
16)
, Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
b
)
parserUnhyphenated :: e -> Parser e s Word128
parserUnhyphenated :: e -> Parser e s Word128
parserUnhyphenated e
err =
Word64 -> Word64 -> Word128
Word128
(Word64 -> Word64 -> Word128)
-> Parser e s Word64 -> Parser e s (Word64 -> Word128)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> Parser e s Word64
forall e s. e -> Parser e s Word64
hexFixedWord64 e
err
Parser e s (Word64 -> Word128)
-> Parser e s Word64 -> Parser e s Word128
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e -> Parser e s Word64
forall e s. e -> Parser e s Word64
hexFixedWord64 e
err
decodeUnhyphenated :: Bytes -> Maybe Word128
decodeUnhyphenated :: Bytes -> Maybe Word128
decodeUnhyphenated Bytes
uuid = (forall s. Parser () s Word128) -> Bytes -> Maybe Word128
forall e a. (forall s. Parser e s a) -> Bytes -> Maybe a
parseBytesMaybe (() -> Parser () s Word128
forall e s. e -> Parser e s Word128
parserUnhyphenated ()) Bytes
uuid
builderUnhyphenated :: Word128 -> Builder 32
builderUnhyphenated :: Word128 -> Builder 32
builderUnhyphenated = Word128 -> Builder 32
word128PaddedLowerHex
encodeUnhyphenated :: Word128 -> ByteArray
encodeUnhyphenated :: Word128 -> ByteArray
encodeUnhyphenated Word128
uuid = Nat 32 -> Builder 32 -> ByteArray
forall (n :: Nat). Nat n -> Builder n -> ByteArray
run Nat 32
forall (n :: Nat). KnownNat n => Nat n
constant (Word128 -> Builder 32
builderUnhyphenated Word128
uuid)
parserLenient :: e -> Parser e s Word128
parserLenient :: e -> Parser e s Word128
parserLenient e
err = do
Word32
w1 <- e -> Parser e s Word32
forall e s. e -> Parser e s Word32
hexFixedWord32 e
err
Char -> Parser e s ()
forall e s. Char -> Parser e s ()
skipChar Char
'-'
Word16
w2 <- e -> Parser e s Word16
forall e s. e -> Parser e s Word16
hexFixedWord16 e
err
Char -> Parser e s ()
forall e s. Char -> Parser e s ()
skipChar Char
'-'
Word16
w3 <- e -> Parser e s Word16
forall e s. e -> Parser e s Word16
hexFixedWord16 e
err
Char -> Parser e s ()
forall e s. Char -> Parser e s ()
skipChar Char
'-'
Word16
w4 <- e -> Parser e s Word16
forall e s. e -> Parser e s Word16
hexFixedWord16 e
err
Char -> Parser e s ()
forall e s. Char -> Parser e s ()
skipChar Char
'-'
Word32
w5 <- e -> Parser e s Word32
forall e s. e -> Parser e s Word32
hexFixedWord32 e
err
Word16
w6 <- e -> Parser e s Word16
forall e s. e -> Parser e s Word16
hexFixedWord16 e
err
pure $ Word128 :: Word64 -> Word64 -> Word128
Word128
{ word128Hi64 :: Word64
word128Hi64 = Word32 -> Word16 -> Word16 -> Word64
fromW32W16Word64 Word32
w1 Word16
w2 Word16
w3
, word128Lo64 :: Word64
word128Lo64 = Word16 -> Word32 -> Word16 -> Word64
fromW16W32W16Word64 Word16
w4 Word32
w5 Word16
w6
}
decodeLenient :: Bytes -> Maybe Word128
decodeLenient :: Bytes -> Maybe Word128
decodeLenient Bytes
uuid = (forall s. Parser () s Word128) -> Bytes -> Maybe Word128
forall e a. (forall s. Parser e s a) -> Bytes -> Maybe a
parseBytesMaybe (() -> Parser () s Word128
forall e s. e -> Parser e s Word128
parserLenient ()) Bytes
uuid
fromW32W16Word64 :: Word32 -> Word16 -> Word16 -> Word64
fromW32W16Word64 :: Word32 -> Word16 -> Word16 -> Word64
fromW32W16Word64 Word32
a Word16
b Word16
c =
Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
a) Int
32
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
b) Int
16
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
c)
fromW16W32W16Word64 :: Word16 -> Word32 -> Word16 -> Word64
fromW16W32W16Word64 :: Word16 -> Word32 -> Word16 -> Word64
fromW16W32W16Word64 Word16
a Word32
b Word16
c =
Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
a) Int
48
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
b) Int
16
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
c)