git.iko.soy/typeable/uuid
on master help sign in
add functions to/from lazy/strict ByteString
3fd3cf5Francesco Mazzoli
Data/UUID.hs+4
compare with master
unifiedsplit
@@ -33,6 +33,10 @@ module Data.UUID(UUID
33 ,fromWords
33 ,fromWords
34 ,null
34 ,null
35 ,nil
35 ,nil
36+ ,fromASCIIBytes
37+ ,toASCIIBytes
38+ ,fromLazyASCIIBytes
39+ ,toLazyASCIIBytes
36 ) where
40 ) where
37
41
38import Prelude () -- we need to hide Prelude.null
42import Prelude () -- we need to hide Prelude.null
Data/UUID/Internal.hs+107−6
@@ -24,16 +24,24 @@ module Data.UUID.Internal
24 ,toList
24 ,toList
25 ,buildFromBytes
25 ,buildFromBytes
26 ,buildFromWords
26 ,buildFromWords
27+ ,fromASCIIBytes
28+ ,toASCIIBytes
29+ ,fromLazyASCIIBytes
30+ ,toLazyASCIIBytes
27 ) where
31 ) where
28
32
29import Prelude hiding (null)
33import Prelude hiding (null)
30
34
31−import Control.Monad (liftM4)
35+import Control.Applicative ((<*>))
36+import Control.DeepSeq (NFData(..))
37+import Control.Monad (liftM4, guard)
38+import Data.Functor ((<$>))
32import Data.Char
39import Data.Char
33import Data.Bits
40import Data.Bits
34import Data.Hashable
41import Data.Hashable
35import Data.Maybe
42import Data.Maybe
36import Data.List (elemIndices)
43import Data.List (elemIndices)
44+import Foreign.Ptr (Ptr)
37
45
38#if MIN_VERSION_base(4,0,0)
46#if MIN_VERSION_base(4,0,0)
39import Data.Data
47import Data.Data
@@ -46,7 +54,10 @@ import Foreign.Storable
46import Data.Binary
54import Data.Binary
47import Data.Binary.Put
55import Data.Binary.Put
48import Data.Binary.Get
56import Data.Binary.Get
49−import qualified Data.ByteString.Lazy as Lazy
57+import qualified Data.ByteString as B
58+import qualified Data.ByteString.Internal as BI
59+import qualified Data.ByteString.Lazy as BL
60+import qualified Data.ByteString.Unsafe as BU
50
61
51import Data.UUID.Builder
62import Data.UUID.Builder
52
63
@@ -176,12 +187,12 @@ nil = UUID 0 0 0 0
176
187
177-- |Extract a UUID from a 'ByteString' in network byte order.
188-- |Extract a UUID from a 'ByteString' in network byte order.
178-- The argument must be 16 bytes long, otherwise 'Nothing' is returned.
189-- The argument must be 16 bytes long, otherwise 'Nothing' is returned.
179−fromByteString :: Lazy.ByteString -> Maybe UUID
190+fromByteString :: BL.ByteString -> Maybe UUID
180−fromByteString = fromList . Lazy.unpack
191+fromByteString = fromList . BL.unpack
181
192
182-- |Encode a UUID into a 'ByteString' in network order.
193-- |Encode a UUID into a 'ByteString' in network order.
183−toByteString :: UUID -> Lazy.ByteString
194+toByteString :: UUID -> BL.ByteString
184−toByteString = Lazy.pack . toList
195+toByteString = BL.pack . toList
185
196
186-- |If the passed in 'String' can be parsed as a 'UUID', it will be.
197-- |If the passed in 'String' can be parsed as a 'UUID', it will be.
187-- The hyphens may not be omitted.
198-- The hyphens may not be omitted.
@@ -328,3 +339,93 @@ mkNoRepType :: String -> DataType
328mkNoRepType = mkNorepType
339mkNoRepType = mkNorepType
329#endif
340#endif
330
341
342+fromASCIIBytes :: B.ByteString -> Maybe UUID
343+fromASCIIBytes bs = do
344+ guard wellFormed
345+ fromWords <$> single 0 <*> double 9 14 <*> double 19 24 <*> single 28
346+ where
347+ -- ord '-' ==> 45
348+ dashIx bs' ix = BU.unsafeIndex bs' ix == 45
349+
350+ -- Important: check the length first, given the `unsafeIndex` later.
351+ wellFormed =
352+ B.length bs == 36 && dashIx bs 8 && dashIx bs 13 &&
353+ dashIx bs 18 && dashIx bs 23
354+
355+ single ix = combine <$> octet ix <*> octet (ix + 2)
356+ <*> octet (ix + 4) <*> octet (ix + 6)
357+ double ix0 ix1 = combine <$> octet ix0 <*> octet (ix0 + 2)
358+ <*> octet ix1 <*> octet (ix1 + 2)
359+
360+ combine o0 o1 o2 o3 = shiftL o0 24 .|. shiftL o1 16 .|. shiftL o2 8 .|. o3
361+
362+ octet ix = do
363+ hi <- fromIntegral <$> toDigit (BU.unsafeIndex bs ix)
364+ lo <- fromIntegral <$> toDigit (BU.unsafeIndex bs (ix + 1))
365+ return (16 * hi + lo)
366+
367+ toDigit :: Word8 -> Maybe Word8
368+ toDigit w
369+ -- Digit
370+ | w >= 48 && w <= 57 = Just (w - 48)
371+ -- Uppercase
372+ | w >= 65 && w <= 70 = Just (10 + w - 65)
373+ -- Lowercase
374+ | w >= 97 && w <= 102 = Just (10 + w - 97)
375+ | otherwise = Nothing
376+
377+toASCIIBytes :: UUID -> B.ByteString
378+toASCIIBytes uuid = BI.unsafeCreate 36 (pokeASCII uuid)
379+
380+pokeASCII :: UUID -> Ptr Word8 -> IO ()
381+pokeASCII uuid ptr = do
382+ pokeDash 8
383+ pokeDash 13
384+ pokeDash 18
385+ pokeDash 23
386+ pokeSingle 0 w0
387+ pokeDouble 9 w1
388+ pokeDouble 19 w2
389+ pokeSingle 28 w3
390+ where
391+ (w0, w1, w2, w3) = toWords uuid
392+
393+ -- ord '-' ==> 45
394+ pokeDash ix = pokeElemOff ptr ix 45
395+
396+ pokeSingle ix w = do
397+ pokeWord ix w 28
398+ pokeWord (ix + 1) w 24
399+ pokeWord (ix + 2) w 20
400+ pokeWord (ix + 3) w 16
401+ pokeWord (ix + 4) w 12
402+ pokeWord (ix + 5) w 8
403+ pokeWord (ix + 6) w 4
404+ pokeWord (ix + 7) w 0
405+
406+ -- We skip the dash in the middle
407+ pokeDouble ix w = do
408+ pokeWord ix w 28
409+ pokeWord (ix + 1) w 24
410+ pokeWord (ix + 2) w 20
411+ pokeWord (ix + 3) w 16
412+ pokeWord (ix + 5) w 12
413+ pokeWord (ix + 6) w 8
414+ pokeWord (ix + 7) w 4
415+ pokeWord (ix + 8) w 0
416+
417+ pokeWord ix w r =
418+ pokeElemOff ptr ix (fromIntegral (toDigit ((w `shiftR` r) .&. 0xf)))
419+
420+ toDigit :: Word32 -> Word32
421+ toDigit w = if w < 10 then 48 + w else 97 + w - 10
422+
423+fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID
424+fromLazyASCIIBytes bs =
425+ if BL.length bs == 36 then fromASCIIBytes (BL.toStrict bs) else Nothing
426+
427+toLazyASCIIBytes :: UUID -> BL.ByteString
428+toLazyASCIIBytes = BL.fromStrict . toASCIIBytes
429+
430+instance NFData UUID where
431+ rnf = rnf . toWords
tests/BenchUUID.hs−3
@@ -22,9 +22,6 @@ instance NFData BL.ByteString where
22 rnf (BL.Chunk _ ts) = rnf ts
22 rnf (BL.Chunk _ ts) = rnf ts
23#endif
23#endif
24
24
25−instance NFData U.UUID where
26−
27−
28main :: IO ()
25main :: IO ()
29main = do
26main = do
30 u1 <- randomIO
27 u1 <- randomIO
uuid.cabal+2−1
@@ -33,7 +33,8 @@ Library
33 hashable == 1.2.*,
33 hashable == 1.2.*,
34 network-info == 0.2.*,
34 network-info == 0.2.*,
35 random >= 1.0.1 && < 1.1,
35 random >= 1.0.1 && < 1.1,
36− time >= 1.1 && < 1.5
36+ time >= 1.1 && < 1.5,
37+ deepseq >= 1.3 && < 1.4
37
38
38 Exposed-Modules:
39 Exposed-Modules:
39 Data.UUID
40 Data.UUID