diff --git a/ACKNOWLDEGMENTS b/ACKNOWLDEGMENTS new file mode 100644 --- /dev/null +++ b/ACKNOWLDEGMENTS @@ -0,0 +1,3 @@ + Thanks to Antoine S. Latter, whose original UUID package provided + inspiration for this one. + diff --git a/Data/UUID.hs b/Data/UUID.hs new file mode 100644 --- /dev/null +++ b/Data/UUID.hs @@ -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) + diff --git a/Data/UUID/Bytes.hs b/Data/UUID/Bytes.hs deleted file mode 100644 --- a/Data/UUID/Bytes.hs +++ /dev/null @@ -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 ] - diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -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" diff --git a/System/UUID/FromForeign.hs b/System/UUID/FromForeign.hs --- a/System/UUID/FromForeign.hs +++ b/System/UUID/FromForeign.hs @@ -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 diff --git a/system-uuid.cabal b/system-uuid.cabal --- a/system-uuid.cabal +++ b/system-uuid.cabal @@ -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)