uuid-bytes (empty) → 0.1.0.0

raw patch · 6 files changed

+263/−0 lines, 6 filesdep +HUnitdep +basedep +byteslicesetup-changed

Dependencies added: HUnit, base, byteslice, bytesmith, natural-arithmetic, primitive, small-bytearray-builder, tasty, tasty-hunit, uuid-bytes, wide-word

Files

CHANGELOG.md +5/−0
LICENSE +7/−0
Setup.hs +2/−0
src/UUID.hs +161/−0
test/Main.hs +29/−0
uuid-bytes.cabal +59/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for uuid-bytes++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

+ LICENSE view

@@ -0,0 +1,7 @@+Copyright 2020 Zachary Churchill++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ src/UUID.hs view

@@ -0,0 +1,161 @@+{-# 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.ByteArray.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++-- | In its canonical textual representation, +-- the 16 octets of a UUID are represented as 32 hexadecimal (base-16) digits, +-- displayed in 5 groups separated by hyphens,+-- in the form 8-4-4-4-12 for a total of 36 characters +-- (32 alphanumeric characters and 4 hyphens)+--+-- UUIDs can also be represented as a base62 encoding of a Word128++encodeHyphenated :: Word128 -> ByteArray+encodeHyphenated uuid = run constant (builderHyphenated uuid)++builderHyphenated :: Word128 -> Builder 36+builderHyphenated uuid = +           word16PaddedLowerHex w1+  `append` word16PaddedLowerHex w2+  `append` ascii '-'+  `append` word16PaddedLowerHex w3+  `append` ascii '-'+  `append` word16PaddedLowerHex w4+  `append` ascii '-'+  `append` word16PaddedLowerHex w5+  `append` ascii '-'+  `append` word16PaddedLowerHex w6+  `append` word16PaddedLowerHex w7+  `append` word16PaddedLowerHex w8+  where+  (w1,w2,w3,w4,w5,w6,w7,w8) = toWord16s uuid++decodeHyphenated :: Bytes -> Maybe Word128+decodeHyphenated uuid = parseBytesMaybe (parserHyphenated ()) uuid++-- | Parser type from @bytesmith@+parserHyphenated :: e -> Parser e s Word128+parserHyphenated err = do+  w1 <- hexFixedWord32 err+  skipChar1 err '-'+  w2 <- hexFixedWord16 err+  skipChar1 err '-'+  w3 <- hexFixedWord16 err+  skipChar1 err '-'+  w4 <- hexFixedWord16 err+  skipChar1 err '-'+  w5 <- hexFixedWord32 err+  w6 <- hexFixedWord16 err+  pure $ Word128+    { word128Hi64 = fromW32W16Word64 w1 w2 w3+    , word128Lo64 = fromW16W32W16Word64 w4 w5 w6+    }++fromWord32sWord64 ::+     Word32 -> Word32+  -> Word64+fromWord32sWord64 x y = +      shiftL (fromIntegral x) 32+  .|. (fromIntegral y)++toWord16s :: Word128 -> (Word16,Word16,Word16,Word16,Word16,Word16,Word16,Word16)+toWord16s (Word128 a b) =+  -- Note: implementing this as 2 Word64 shifts with 'unsafeShiftR'+  -- is up to 40% faster than using 128-bit shifts on a Word128 value.+  ( fromIntegral (unsafeShiftR a 48)+  , fromIntegral (unsafeShiftR a 32)+  , fromIntegral (unsafeShiftR a 16)+  , fromIntegral a+  , fromIntegral (unsafeShiftR b 48)+  , fromIntegral (unsafeShiftR b 32)+  , fromIntegral (unsafeShiftR b 16)+  , fromIntegral b+  )++parserUnhyphenated :: e -> Parser e s Word128+parserUnhyphenated err = do+  w1 <- hexFixedWord32 err+  w2 <- hexFixedWord32 err+  w3 <- hexFixedWord32 err+  w4 <- hexFixedWord32 err+  pure $ Word128+    { word128Hi64 = fromWord32sWord64 w1 w2+    , word128Lo64 = fromWord32sWord64 w3 w4+    }++decodeUnhyphenated :: Bytes -> Maybe Word128+decodeUnhyphenated uuid = parseBytesMaybe (parserUnhyphenated ()) uuid++builderUnhyphenated :: Word128 -> Builder 32+builderUnhyphenated uuid = +           word16PaddedLowerHex w1+  `append` word16PaddedLowerHex w2+  `append` word16PaddedLowerHex w3+  `append` word16PaddedLowerHex w4+  `append` word16PaddedLowerHex w5+  `append` word16PaddedLowerHex w6+  `append` word16PaddedLowerHex w7+  `append` word16PaddedLowerHex w8+  where+  (w1,w2,w3,w4,w5,w6,w7,w8) = toWord16s uuid++encodeUnhyphenated :: Word128 -> ByteArray+encodeUnhyphenated uuid = run constant (builderUnhyphenated uuid)++parserLenient :: e -> Parser e s Word128+parserLenient err = do+  w1 <- hexFixedWord32 err+  skipChar '-'+  w2 <- hexFixedWord16 err+  skipChar '-'+  w3 <- hexFixedWord16 err+  skipChar '-'+  w4 <- hexFixedWord16 err+  skipChar '-'+  w5 <- hexFixedWord32 err+  w6 <- hexFixedWord16 err+  pure $ Word128+    { word128Hi64 = fromW32W16Word64 w1 w2 w3+    , word128Lo64 = fromW16W32W16Word64 w4 w5 w6+    }++-- | decodes uuid with out without hyphens+decodeLenient :: Bytes -> Maybe Word128+decodeLenient uuid = parseBytesMaybe (parserLenient ()) uuid++fromW32W16Word64 :: Word32 -> Word16 -> Word16 -> Word64+fromW32W16Word64 a b c =+      shiftL (fromIntegral a) 32+  .|. shiftL (fromIntegral b) 16+  .|. (fromIntegral c)++fromW16W32W16Word64 :: Word16 -> Word32 -> Word16 -> Word64+fromW16W32W16Word64 a b c = +      shiftL (fromIntegral a) 48+  .|. shiftL (fromIntegral b) 16+  .|. (fromIntegral c)

+ test/Main.hs view

@@ -0,0 +1,29 @@+module Main where++import Data.Bytes+import Data.WideWord.Word128+import Test.Tasty+import Test.Tasty.HUnit+import UUID++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [unitTests]++unitTests :: TestTree+unitTests = testGroup "Unit tests"+  [ testCase "UUID encoding test" $+      fromByteArray (encodeHyphenated uuidW128) @?= uuidBytes +  , testCase "UUID decoding test" $+      decodeHyphenated uuidBytes @?= Just uuidW128+  , testCase "UUID encoding/decoding idempotence test" $+      decodeHyphenated (fromByteArray $ encodeHyphenated uuidW128) @?= Just uuidW128+  ]++uuidBytes :: Bytes+uuidBytes = fromAsciiString "123e4567-e89b-12d3-a456-426655440000"++uuidW128 :: Word128+uuidW128 = 24249434048109030647017182302883282944

+ uuid-bytes.cabal view

@@ -0,0 +1,59 @@+cabal-version: >=1.10+name: uuid-bytes+version: 0.1.0.0+synopsis: UUID parsing using byteverse packages+description: This packages provides `bytesmith` parsers and `byteslice` encoders for 128bit UUIDs in hexadecimal format.+-- bug-reports:+license: MIT+license-file: LICENSE+author: Zachary Churchill+maintainer: zacharyachurchill@gmail.com+-- copyright:+category: Data+build-type: Simple+extra-source-files: CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/goolord/uuid-bytes.git++library+  -- other-modules:+  -- other-extensions:+  ghc-options: -Wall -O2+  exposed-modules:+    UUID+  build-depends: +      base >=4.13 && <4.14+    , wide-word+    , byteslice >=0.2.1 && <0.3+    , bytesmith >=0.3.4 && <0.4+    , primitive+    , small-bytearray-builder+    , natural-arithmetic+  hs-source-dirs: src+  default-language: Haskell2010++test-suite test+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    test+  main-is:+    Main.hs+  build-depends:+      HUnit+    , tasty+    , base+    , tasty-hunit+    , uuid-bytes+    , wide-word+    , byteslice+    , primitive+    , natural-arithmetic+  ghc-options:+    -Wall+    -O2+  default-language:+    Haskell2010+