system-uuid 0.0.1 → 1.0.0
raw patch · 6 files changed
+103/−64 lines, 6 filesdep +binary
Dependencies added: binary
Files
- ACKNOWLDEGMENTS +3/−0
- Data/UUID.hs +93/−0
- Data/UUID/Bytes.hs +0/−55
- Main.hs +1/−1
- System/UUID/FromForeign.hs +2/−6
- system-uuid.cabal +4/−2
+ ACKNOWLDEGMENTS view
@@ -0,0 +1,3 @@+ Thanks to Antoine S. Latter, whose original UUID package provided+ inspiration for this one.+
+ Data/UUID.hs view
@@ -0,0 +1,93 @@++{-| A 'UUID' and its many instances. + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}++module Data.UUID+ ( UUID()+ ) where+++import Data.Word+import Data.Char+import Data.Binary+import Data.Binary.Put+import Data.Binary.Get+import Data.Bits+import Foreign.C+import Foreign.ForeignPtr+import Foreign+import Control.Monad+import Control.Applicative+import Numeric+import Text.ParserCombinators.ReadPrec (lift)+import Text.ParserCombinators.ReadP+import Text.Read hiding (pfail)+import Data.List+import Text.Printf+++data UUID = UUID+ !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8+ !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8+instance Eq UUID+instance Ord UUID+instance Show UUID where+ show (UUID x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF)+ = printf formatUUID x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF+ where+ formatUUID = intercalate "-" $ map b [ 2, 1, 1, 1, 3 ]+ b = concat . (`replicate` "%02.2x%02.2x")+instance Read UUID where+ readPrec = lift $ do+ [x0,x1,x2,x3] <- count 4 byte+ char '-'+ [x4,x5] <- count 2 byte+ char '-'+ [x6,x7] <- count 2 byte+ char '-'+ [x8,x9] <- count 2 byte+ char '-'+ [xA,xB,xC,xD,xE,xF] <- count 6 byte+ return $ UUID x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF+ where+ byte = do+ s <- sequence $ replicate 2 $ satisfy isHexDigit+ case readHex s of+ [(b, _)] -> return b+ _ -> pfail+instance Storable UUID where+ sizeOf _ = 16+ alignment _ = 4+ peek p = do+ bytes <- peekArray 16 $ castPtr p+ return $ fromList bytes+ poke p uuid = pokeArray (castPtr p) $ listOfBytes uuid +instance Num UUID where+ fromInteger i -- This really should be in a different class.+ | i <= 0 = UUID 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0+ | i > 2^128 = UUID 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0+ | otherwise = fromList bytes + where+ bytes = map shifter $ reverse [0,8..15*8]+ where+ shifter n = fromInteger $ i `shiftR` (8 * n)+ (+) = undefined+ (-) = undefined+ (*) = undefined+ negate = undefined+ abs = undefined+ signum = undefined+instance Bounded UUID where+ minBound = 0+ maxBound = 2^128+instance Binary UUID where+ put = mapM_ putWord8 . listOfBytes + get = fromList <$> sequence (replicate 16 getWord8) +++listOfBytes (UUID x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF)+ = [ x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, xA, xB, xC, xD, xE, xF ]++fromList [ x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, xA, xB, xC, xD, xE, xF ]+ = (UUID x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF)+
− Data/UUID/Bytes.hs
@@ -1,55 +0,0 @@--{-| A 'UUID' as plain old bytes.- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}--module Data.UUID.Bytes- ( UUID(..)- , listOfBytes- ) where---import Data.Word-import Data.Char-import Control.Monad-import Numeric-import Text.ParserCombinators.ReadPrec (lift)-import Text.ParserCombinators.ReadP-import Text.Read hiding (pfail)-import Data.List-import Text.Printf---data UUID = UUID- !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8- !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8-instance Show UUID where- show (UUID x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF)- = printf formatUUID x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF- where- formatUUID = intercalate "-" $ map b [ 2, 1, 1, 1, 3 ]- b = concat . (`replicate` "%02.2x%02.2x")-instance Read UUID where- readPrec = lift $ do- [x0,x1,x2,x3] <- count 4 byte- char '-'- [x4,x5] <- count 2 byte- char '-'- [x6,x7] <- count 2 byte- char '-'- [x8,x9] <- count 2 byte- char '-'- [xA,xB,xC,xD,xE,xF] <- count 6 byte- return $ UUID x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF- where- byte = do- s <- sequence $ replicate 2 $ satisfy isHexDigit- case readHex s of- [(b, _)] -> return b- _ -> pfail-instance Eq UUID-instance Ord UUID---listOfBytes (UUID x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF)- = [ x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, xA, xB, xC, xD, xE, xF ]-
Main.hs view
@@ -51,7 +51,7 @@ stdout << usage exitWith ExitSuccess when (all (isJust . lk) ["1","4"]) $ do- bail "Please specify either version 1 or version 4."+ bail "Please specify either version 1 or version 4, not both." let n :: Word n = fromMaybe 1 $ maybeRead =<< lk "n"
System/UUID/FromForeign.hs view
@@ -10,7 +10,7 @@ ) where -import Data.UUID.Bytes+import Data.UUID import Foreign.C import Foreign.ForeignPtr@@ -24,9 +24,5 @@ runAndRead procedure = do fp <- mallocForeignPtrArray 16 withForeignPtr fp procedure - bytes <- withForeignPtr fp $ peekArray 16 . castPtr- let- [x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, xA, xB, xC, xD, xE, xF]- = bytes- return $ UUID x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF+ withForeignPtr fp $ peek . castPtr
system-uuid.cabal view
@@ -1,5 +1,5 @@ name : system-uuid-version : 0.0.1+version : 1.0.0 category : System license : BSD3 license-file : LICENSE@@ -15,6 +15,7 @@ cabal-version : >= 1.2 build-type : Simple extra-source-files : README+ ACKNOWLDEGMENTS CONTRIBUTORS Options.hs Macros.hs@@ -25,13 +26,14 @@ library build-depends : base , containers+ , binary , regex-compat , template-haskell , parsec exposed-modules : System.UUID.V1 System.UUID.V4 System.UUID.FromForeign- Data.UUID.Bytes+ Data.UUID if os(linux) extra-libraries : uuid if os(mingw32)