{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-} module Foundation.UUID ( UUID(..) , newUUID , nil , fromBinary , uuidParser ) where import Data.Maybe (fromMaybe) import Basement.Compat.Base import Foundation.Collection (Element, Sequential, foldl') import Foundation.Class.Storable import Foundation.Hashing.Hashable import Foundation.Bits import Foundation.Parser import Foundation.Numerical import Foundation.Primitive import Basement.Base16 import Basement.IntegralConv import Basement.Types.OffsetSize import qualified Basement.UArray as UA import Foundation.Random (MonadRandom, getRandomBytes) 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 /= :: UUID -> UUID -> Bool $c/= :: UUID -> UUID -> Bool == :: UUID -> UUID -> Bool $c== :: 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 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 $cp1Ord :: Eq UUID Ord,Typeable) instance Show UUID where show :: UUID -> String show = UUID -> String toLString instance NormalForm UUID where toNormalForm :: UUID -> () toNormalForm !UUID _ = () instance Hashable UUID where hashMix :: UUID -> st -> st hashMix (UUID Word64 a Word64 b) = Word64 -> st -> st forall a st. (Hashable a, Hasher st) => a -> st -> st hashMix Word64 a (st -> st) -> (st -> st) -> st -> st forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . Word64 -> st -> st forall a st. (Hashable a, Hasher st) => a -> st -> st hashMix Word64 b instance Storable UUID where peek :: Ptr UUID -> IO UUID peek Ptr UUID p = Word64 -> Word64 -> UUID UUID (Word64 -> Word64 -> UUID) -> IO Word64 -> IO (Word64 -> UUID) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (BE Word64 -> Word64 forall a. ByteSwap a => BE a -> a fromBE (BE Word64 -> Word64) -> IO (BE Word64) -> IO Word64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Ptr (BE Word64) -> Offset (BE Word64) -> IO (BE Word64) forall a. StorableFixed a => Ptr a -> Offset a -> IO a peekOff Ptr (BE Word64) ptr Offset (BE Word64) 0) IO (Word64 -> UUID) -> IO Word64 -> IO UUID forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (BE Word64 -> Word64 forall a. ByteSwap a => BE a -> a fromBE (BE Word64 -> Word64) -> IO (BE Word64) -> IO Word64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Ptr (BE Word64) -> Offset (BE Word64) -> IO (BE Word64) forall a. StorableFixed a => Ptr a -> Offset a -> IO a peekOff Ptr (BE Word64) ptr Offset (BE Word64) 1) where ptr :: Ptr (BE Word64) ptr = Ptr UUID -> Ptr (BE Word64) forall a b. Ptr a -> Ptr b castPtr Ptr UUID p :: Ptr (BE Word64) poke :: Ptr UUID -> UUID -> IO () poke Ptr UUID p (UUID Word64 a Word64 b) = do Ptr (BE Word64) -> Offset (BE Word64) -> BE Word64 -> IO () forall a. StorableFixed a => Ptr a -> Offset a -> a -> IO () pokeOff Ptr (BE Word64) ptr Offset (BE Word64) 0 (Word64 -> BE Word64 forall a. ByteSwap a => a -> BE a toBE Word64 a) Ptr (BE Word64) -> Offset (BE Word64) -> BE Word64 -> IO () forall a. StorableFixed a => Ptr a -> Offset a -> a -> IO () pokeOff Ptr (BE Word64) ptr Offset (BE Word64) 1 (Word64 -> BE Word64 forall a. ByteSwap a => a -> BE a toBE Word64 b) where ptr :: Ptr (BE Word64) ptr = Ptr UUID -> Ptr (BE Word64) forall a b. Ptr a -> Ptr b castPtr Ptr UUID p :: Ptr (BE Word64) instance StorableFixed UUID where size :: proxy UUID -> CountOf Word8 size proxy UUID _ = CountOf Word8 16 alignment :: proxy UUID -> CountOf Word8 alignment proxy UUID _ = CountOf Word8 8 withComponent :: UUID -> (Word32 -> Word16 -> Word16 -> Word16 -> Word64 -> a) -> a withComponent :: UUID -> (Word32 -> Word16 -> Word16 -> Word16 -> Word64 -> a) -> a withComponent (UUID Word64 a Word64 b) Word32 -> Word16 -> Word16 -> Word16 -> Word64 -> a f = Word32 -> Word16 -> Word16 -> Word16 -> Word64 -> a f Word32 x1 Word16 x2 Word16 x3 Word16 x4 Word64 x5 where !x1 :: Word32 x1 = Word64 -> Word32 forall a b. IntegralDownsize a b => a -> b integralDownsize (Word64 a Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a .>>. Int 32) !x2 :: Word16 x2 = Word64 -> Word16 forall a b. IntegralDownsize a b => a -> b integralDownsize ((Word64 a Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a .>>. Int 16) Word64 -> Word64 -> Word64 forall a. Bits a => a -> a -> a .&. Word64 0xffff) !x3 :: Word16 x3 = Word64 -> Word16 forall a b. IntegralDownsize a b => a -> b integralDownsize (Word64 a Word64 -> Word64 -> Word64 forall a. Bits a => a -> a -> a .&. Word64 0xffff) !x4 :: Word16 x4 = Word64 -> Word16 forall a b. IntegralDownsize a b => a -> b integralDownsize (Word64 b Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a .>>. Int 48) !x5 :: Word64 x5 = (Word64 b Word64 -> Word64 -> Word64 forall a. Bits a => a -> a -> a .&. Word64 0x0000ffffffffffff) {-# INLINE withComponent #-} toLString :: UUID -> [Char] toLString :: UUID -> String toLString UUID uuid = UUID -> (Word32 -> Word16 -> Word16 -> Word16 -> Word64 -> String) -> String forall a. UUID -> (Word32 -> Word16 -> Word16 -> Word16 -> Word64 -> a) -> a withComponent UUID uuid ((Word32 -> Word16 -> Word16 -> Word16 -> Word64 -> String) -> String) -> (Word32 -> Word16 -> Word16 -> Word16 -> Word64 -> String) -> String forall a b. (a -> b) -> a -> b $ \Word32 x1 Word16 x2 Word16 x3 Word16 x4 Word64 x5 -> Word32 -> ShowS hexWord_4 Word32 x1 ShowS -> ShowS forall a b. (a -> b) -> a -> b $ ShowS addDash ShowS -> ShowS forall a b. (a -> b) -> a -> b $ Word16 -> ShowS hexWord_2 Word16 x2 ShowS -> ShowS forall a b. (a -> b) -> a -> b $ ShowS addDash ShowS -> ShowS forall a b. (a -> b) -> a -> b $ Word16 -> ShowS hexWord_2 Word16 x3 ShowS -> ShowS forall a b. (a -> b) -> a -> b $ ShowS addDash ShowS -> ShowS forall a b. (a -> b) -> a -> b $ Word16 -> ShowS hexWord_2 Word16 x4 ShowS -> ShowS forall a b. (a -> b) -> a -> b $ ShowS addDash ShowS -> ShowS forall a b. (a -> b) -> a -> b $ Word64 -> ShowS hexWord64_6 Word64 x5 [] where addDash :: ShowS addDash = (:) Char '-' hexWord_2 :: Word16 -> ShowS hexWord_2 Word16 w String l = case Word16 -> (Char, Char, Char, Char) hexWord16 Word16 w of (Char c1,Char c2,Char c3,Char c4) -> Char c1Char -> ShowS forall a. a -> [a] -> [a] :Char c2Char -> ShowS forall a. a -> [a] -> [a] :Char c3Char -> ShowS forall a. a -> [a] -> [a] :Char c4Char -> ShowS forall a. a -> [a] -> [a] :String l hexWord_4 :: Word32 -> ShowS hexWord_4 Word32 w String l = case Word32 -> (Char, Char, Char, Char, Char, Char, Char, Char) hexWord32 Word32 w of (Char c1,Char c2,Char c3,Char c4,Char c5,Char c6,Char c7,Char c8) -> Char c1Char -> ShowS forall a. a -> [a] -> [a] :Char c2Char -> ShowS forall a. a -> [a] -> [a] :Char c3Char -> ShowS forall a. a -> [a] -> [a] :Char c4Char -> ShowS forall a. a -> [a] -> [a] :Char c5Char -> ShowS forall a. a -> [a] -> [a] :Char c6Char -> ShowS forall a. a -> [a] -> [a] :Char c7Char -> ShowS forall a. a -> [a] -> [a] :Char c8Char -> ShowS forall a. a -> [a] -> [a] :String l hexWord64_6 :: Word64 -> ShowS hexWord64_6 Word64 w String l = case Word64 -> Word32x2 word64ToWord32s Word64 w of Word32x2 Word32 wHigh Word32 wLow -> Word16 -> ShowS hexWord_2 (Word32 -> Word16 forall a b. IntegralDownsize a b => a -> b integralDownsize Word32 wHigh) ShowS -> ShowS forall a b. (a -> b) -> a -> b $ Word32 -> ShowS hexWord_4 Word32 wLow String l nil :: UUID nil :: UUID nil = Word64 -> Word64 -> UUID UUID Word64 0 Word64 0 newUUID :: MonadRandom randomly => randomly UUID newUUID :: randomly UUID newUUID = UUID -> Maybe UUID -> UUID forall a. a -> Maybe a -> a fromMaybe (String -> UUID forall a. HasCallStack => String -> a error String "Foundation.UUID.newUUID: the impossible happned") (Maybe UUID -> UUID) -> (UArray Word8 -> Maybe UUID) -> UArray Word8 -> UUID forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . UArray Word8 -> Maybe UUID fromBinary (UArray Word8 -> UUID) -> randomly (UArray Word8) -> randomly UUID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> CountOf Word8 -> randomly (UArray Word8) forall (m :: * -> *). MonadRandom m => CountOf Word8 -> m (UArray Word8) getRandomBytes CountOf Word8 16 fromBinary :: UA.UArray Word8 -> Maybe UUID fromBinary :: UArray Word8 -> Maybe UUID fromBinary UArray Word8 ba | UArray Word8 -> CountOf Word8 forall ty. UArray ty -> CountOf ty UA.length UArray Word8 ba CountOf Word8 -> CountOf Word8 -> Bool forall a. Eq a => a -> a -> Bool /= CountOf Word8 16 = Maybe UUID forall a. Maybe a Nothing | Bool otherwise = UUID -> Maybe UUID forall a. a -> Maybe a Just (UUID -> Maybe UUID) -> UUID -> Maybe UUID forall a b. (a -> b) -> a -> b $ Word64 -> Word64 -> UUID UUID Word64 w0 Word64 w1 where w0 :: Word64 w0 = (Word64 b15 Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a .<<. Int 56) Word64 -> Word64 -> Word64 forall a. Bits a => a -> a -> a .|. (Word64 b14 Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a .<<. Int 48) Word64 -> Word64 -> Word64 forall a. Bits a => a -> a -> a .|. (Word64 b13 Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a .<<. Int 40) Word64 -> Word64 -> Word64 forall a. Bits a => a -> a -> a .|. (Word64 b12 Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a .<<. Int 32) Word64 -> Word64 -> Word64 forall a. Bits a => a -> a -> a .|. (Word64 b11 Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a .<<. Int 24) Word64 -> Word64 -> Word64 forall a. Bits a => a -> a -> a .|. (Word64 b10 Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a .<<. Int 16) Word64 -> Word64 -> Word64 forall a. Bits a => a -> a -> a .|. (Word64 b9 Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a .<<. Int 8) Word64 -> Word64 -> Word64 forall a. Bits a => a -> a -> a .|. Word64 b8 w1 :: Word64 w1 = (Word64 b7 Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a .<<. Int 56) Word64 -> Word64 -> Word64 forall a. Bits a => a -> a -> a .|. (Word64 b6 Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a .<<. Int 48) Word64 -> Word64 -> Word64 forall a. Bits a => a -> a -> a .|. (Word64 b5 Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a .<<. Int 40) Word64 -> Word64 -> Word64 forall a. Bits a => a -> a -> a .|. (Word64 b4 Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a .<<. Int 32) Word64 -> Word64 -> Word64 forall a. Bits a => a -> a -> a .|. (Word64 b3 Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a .<<. Int 24) Word64 -> Word64 -> Word64 forall a. Bits a => a -> a -> a .|. (Word64 b2 Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a .<<. Int 16) Word64 -> Word64 -> Word64 forall a. Bits a => a -> a -> a .|. (Word64 b1 Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a .<<. Int 8) Word64 -> Word64 -> Word64 forall a. Bits a => a -> a -> a .|. Word64 b0 b0 :: Word64 b0 = Word8 -> Word64 forall a b. IntegralUpsize a b => a -> b integralUpsize (UArray Word8 -> Offset Word8 -> Word8 forall ty. PrimType ty => UArray ty -> Offset ty -> ty UA.unsafeIndex UArray Word8 ba Offset Word8 0) b1 :: Word64 b1 = Word8 -> Word64 forall a b. IntegralUpsize a b => a -> b integralUpsize (UArray Word8 -> Offset Word8 -> Word8 forall ty. PrimType ty => UArray ty -> Offset ty -> ty UA.unsafeIndex UArray Word8 ba Offset Word8 1) b2 :: Word64 b2 = Word8 -> Word64 forall a b. IntegralUpsize a b => a -> b integralUpsize (UArray Word8 -> Offset Word8 -> Word8 forall ty. PrimType ty => UArray ty -> Offset ty -> ty UA.unsafeIndex UArray Word8 ba Offset Word8 2) b3 :: Word64 b3 = Word8 -> Word64 forall a b. IntegralUpsize a b => a -> b integralUpsize (UArray Word8 -> Offset Word8 -> Word8 forall ty. PrimType ty => UArray ty -> Offset ty -> ty UA.unsafeIndex UArray Word8 ba Offset Word8 3) b4 :: Word64 b4 = Word8 -> Word64 forall a b. IntegralUpsize a b => a -> b integralUpsize (UArray Word8 -> Offset Word8 -> Word8 forall ty. PrimType ty => UArray ty -> Offset ty -> ty UA.unsafeIndex UArray Word8 ba Offset Word8 4) b5 :: Word64 b5 = Word8 -> Word64 forall a b. IntegralUpsize a b => a -> b integralUpsize (UArray Word8 -> Offset Word8 -> Word8 forall ty. PrimType ty => UArray ty -> Offset ty -> ty UA.unsafeIndex UArray Word8 ba Offset Word8 5) b6 :: Word64 b6 = Word8 -> Word64 forall a b. IntegralUpsize a b => a -> b integralUpsize (UArray Word8 -> Offset Word8 -> Word8 forall ty. PrimType ty => UArray ty -> Offset ty -> ty UA.unsafeIndex UArray Word8 ba Offset Word8 6) b7 :: Word64 b7 = Word8 -> Word64 forall a b. IntegralUpsize a b => a -> b integralUpsize (UArray Word8 -> Offset Word8 -> Word8 forall ty. PrimType ty => UArray ty -> Offset ty -> ty UA.unsafeIndex UArray Word8 ba Offset Word8 7) b8 :: Word64 b8 = Word8 -> Word64 forall a b. IntegralUpsize a b => a -> b integralUpsize (UArray Word8 -> Offset Word8 -> Word8 forall ty. PrimType ty => UArray ty -> Offset ty -> ty UA.unsafeIndex UArray Word8 ba Offset Word8 8) b9 :: Word64 b9 = Word8 -> Word64 forall a b. IntegralUpsize a b => a -> b integralUpsize (UArray Word8 -> Offset Word8 -> Word8 forall ty. PrimType ty => UArray ty -> Offset ty -> ty UA.unsafeIndex UArray Word8 ba Offset Word8 9) b10 :: Word64 b10 = Word8 -> Word64 forall a b. IntegralUpsize a b => a -> b integralUpsize (UArray Word8 -> Offset Word8 -> Word8 forall ty. PrimType ty => UArray ty -> Offset ty -> ty UA.unsafeIndex UArray Word8 ba Offset Word8 10) b11 :: Word64 b11 = Word8 -> Word64 forall a b. IntegralUpsize a b => a -> b integralUpsize (UArray Word8 -> Offset Word8 -> Word8 forall ty. PrimType ty => UArray ty -> Offset ty -> ty UA.unsafeIndex UArray Word8 ba Offset Word8 11) b12 :: Word64 b12 = Word8 -> Word64 forall a b. IntegralUpsize a b => a -> b integralUpsize (UArray Word8 -> Offset Word8 -> Word8 forall ty. PrimType ty => UArray ty -> Offset ty -> ty UA.unsafeIndex UArray Word8 ba Offset Word8 12) b13 :: Word64 b13 = Word8 -> Word64 forall a b. IntegralUpsize a b => a -> b integralUpsize (UArray Word8 -> Offset Word8 -> Word8 forall ty. PrimType ty => UArray ty -> Offset ty -> ty UA.unsafeIndex UArray Word8 ba Offset Word8 13) b14 :: Word64 b14 = Word8 -> Word64 forall a b. IntegralUpsize a b => a -> b integralUpsize (UArray Word8 -> Offset Word8 -> Word8 forall ty. PrimType ty => UArray ty -> Offset ty -> ty UA.unsafeIndex UArray Word8 ba Offset Word8 14) b15 :: Word64 b15 = Word8 -> Word64 forall a b. IntegralUpsize a b => a -> b integralUpsize (UArray Word8 -> Offset Word8 -> Word8 forall ty. PrimType ty => UArray ty -> Offset ty -> ty UA.unsafeIndex UArray Word8 ba Offset Word8 15) uuidParser :: ( ParserSource input, Element input ~ Char , Sequential (Chunk input), Element input ~ Element (Chunk input) ) => Parser input UUID uuidParser :: Parser input UUID uuidParser = do Word64 hex1 <- CountOf Char -> Parser input Word64 forall input. (ParserSource input, Element input ~ Char, Sequential (Chunk input), Element input ~ Element (Chunk input)) => CountOf Char -> Parser input Word64 parseHex (Int -> CountOf Char forall ty. Int -> CountOf ty CountOf Int 8) Parser input Word64 -> Parser input () -> Parser input Word64 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Element input -> Parser input () forall input. (ParserSource input, Eq (Element input), Element input ~ Element (Chunk input)) => Element input -> Parser input () element Char Element input '-' Word64 hex2 <- CountOf Char -> Parser input Word64 forall input. (ParserSource input, Element input ~ Char, Sequential (Chunk input), Element input ~ Element (Chunk input)) => CountOf Char -> Parser input Word64 parseHex (Int -> CountOf Char forall ty. Int -> CountOf ty CountOf Int 4) Parser input Word64 -> Parser input () -> Parser input Word64 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Element input -> Parser input () forall input. (ParserSource input, Eq (Element input), Element input ~ Element (Chunk input)) => Element input -> Parser input () element Char Element input '-' Word64 hex3 <- CountOf Char -> Parser input Word64 forall input. (ParserSource input, Element input ~ Char, Sequential (Chunk input), Element input ~ Element (Chunk input)) => CountOf Char -> Parser input Word64 parseHex (Int -> CountOf Char forall ty. Int -> CountOf ty CountOf Int 4) Parser input Word64 -> Parser input () -> Parser input Word64 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Element input -> Parser input () forall input. (ParserSource input, Eq (Element input), Element input ~ Element (Chunk input)) => Element input -> Parser input () element Char Element input '-' Word64 hex4 <- CountOf Char -> Parser input Word64 forall input. (ParserSource input, Element input ~ Char, Sequential (Chunk input), Element input ~ Element (Chunk input)) => CountOf Char -> Parser input Word64 parseHex (Int -> CountOf Char forall ty. Int -> CountOf ty CountOf Int 4) Parser input Word64 -> Parser input () -> Parser input Word64 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Element input -> Parser input () forall input. (ParserSource input, Eq (Element input), Element input ~ Element (Chunk input)) => Element input -> Parser input () element Char Element input '-' Word64 hex5 <- CountOf Char -> Parser input Word64 forall input. (ParserSource input, Element input ~ Char, Sequential (Chunk input), Element input ~ Element (Chunk input)) => CountOf Char -> Parser input Word64 parseHex (Int -> CountOf Char forall ty. Int -> CountOf ty CountOf Int 12) UUID -> Parser input UUID forall (m :: * -> *) a. Monad m => a -> m a return (UUID -> Parser input UUID) -> UUID -> Parser input UUID forall a b. (a -> b) -> a -> b $ Word64 -> Word64 -> UUID UUID (Word64 hex1 Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a .<<. Int 32 Word64 -> Word64 -> Word64 forall a. Bits a => a -> a -> a .|. Word64 hex2 Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a .<<. Int 16 Word64 -> Word64 -> Word64 forall a. Bits a => a -> a -> a .|. Word64 hex3) (Word64 hex4 Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a .<<. Int 48 Word64 -> Word64 -> Word64 forall a. Bits a => a -> a -> a .|. Word64 hex5) parseHex :: ( ParserSource input, Element input ~ Char , Sequential (Chunk input), Element input ~ Element (Chunk input) ) => CountOf Char -> Parser input Word64 parseHex :: CountOf Char -> Parser input Word64 parseHex CountOf Char count = do String r <- Chunk input -> String forall l. IsList l => l -> [Item l] toList (Chunk input -> String) -> Parser input (Chunk input) -> Parser input String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> CountOf (Element (Chunk input)) -> Parser input (Chunk input) forall input. (ParserSource input, Sequential (Chunk input), Element input ~ Element (Chunk input)) => CountOf (Element (Chunk input)) -> Parser input (Chunk input) take CountOf Char CountOf (Element (Chunk input)) count Bool -> Parser input () -> Parser input () forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless ([Bool] -> Bool forall (t :: * -> *). Foldable t => t Bool -> Bool and ([Bool] -> Bool) -> [Bool] -> Bool forall a b. (a -> b) -> a -> b $ Char -> Bool isValidHexa (Char -> Bool) -> String -> [Bool] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> String r) (Parser input () -> Parser input ()) -> Parser input () -> Parser input () forall a b. (a -> b) -> a -> b $ ParseError input -> Parser input () forall input a. ParseError input -> Parser input a reportError (ParseError input -> Parser input ()) -> ParseError input -> Parser input () forall a b. (a -> b) -> a -> b $ Maybe String -> ParseError input forall input. Maybe String -> ParseError input Satisfy (Maybe String -> ParseError input) -> Maybe String -> ParseError input forall a b. (a -> b) -> a -> b $ String -> Maybe String forall a. a -> Maybe a Just (String -> Maybe String) -> String -> Maybe String forall a b. (a -> b) -> a -> b $ String "expecting hexadecimal character only: " String -> String -> String forall a. Semigroup a => a -> a -> a <> [Item String] -> String forall l. IsList l => [Item l] -> l fromList (ShowS forall a. Show a => a -> String show String r) Word64 -> Parser input Word64 forall (m :: * -> *) a. Monad m => a -> m a return (Word64 -> Parser input Word64) -> Word64 -> Parser input Word64 forall a b. (a -> b) -> a -> b $ Word64 -> String -> Word64 listToHex Word64 0 String r where listToHex :: Word64 -> String -> Word64 listToHex = (Word64 -> Element String -> Word64) -> Word64 -> String -> Word64 forall collection a. Foldable collection => (a -> Element collection -> a) -> a -> collection -> a foldl' (\Word64 acc' Element String x -> Word64 acc' Word64 -> Word64 -> Word64 forall a. Multiplicative a => a -> a -> a * Word64 16 Word64 -> Word64 -> Word64 forall a. Additive a => a -> a -> a + Char -> Word64 forall p. Integral p => Char -> p fromHex Char Element String x) isValidHexa :: Char -> Bool isValidHexa :: Char -> Bool isValidHexa Char c = (Char '0' Char -> Char -> Bool forall a. Ord a => a -> a -> Bool <= Char c Bool -> Bool -> Bool && Char c Char -> Char -> Bool forall a. Ord a => a -> a -> Bool <= Char '9') Bool -> Bool -> Bool || (Char 'a' Char -> Char -> Bool forall a. Ord a => a -> a -> Bool <= Char c Bool -> Bool -> Bool && Char c Char -> Char -> Bool forall a. Ord a => a -> a -> Bool <= Char 'f') Bool -> Bool -> Bool || (Char 'A' Char -> Char -> Bool forall a. Ord a => a -> a -> Bool <= Char c Bool -> Bool -> Bool && Char c Char -> Char -> Bool forall a. Ord a => a -> a -> Bool <= Char 'F') fromHex :: Char -> p fromHex Char '0' = p 0 fromHex Char '1' = p 1 fromHex Char '2' = p 2 fromHex Char '3' = p 3 fromHex Char '4' = p 4 fromHex Char '5' = p 5 fromHex Char '6' = p 6 fromHex Char '7' = p 7 fromHex Char '8' = p 8 fromHex Char '9' = p 9 fromHex Char 'a' = p 10 fromHex Char 'b' = p 11 fromHex Char 'c' = p 12 fromHex Char 'd' = p 13 fromHex Char 'e' = p 14 fromHex Char 'f' = p 15 fromHex Char 'A' = p 10 fromHex Char 'B' = p 11 fromHex Char 'C' = p 12 fromHex Char 'D' = p 13 fromHex Char 'E' = p 14 fromHex Char 'F' = p 15 fromHex Char _ = String -> p forall a. HasCallStack => String -> a error String "Foundation.UUID.parseUUID: the impossible happened"