diff --git a/Data/UUID.hs b/Data/UUID.hs new file mode 100644 --- /dev/null +++ b/Data/UUID.hs @@ -0,0 +1,97 @@ + +{-| The 'UUID' datatype. + -} + +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 + + +{-| A type for Uniform Unique Identifiers. The 'Num' instance allows 'UUID's + to be specified with @0@, @1@, &c. -- testing for the null 'UUID' is + easier that way. The 'Storable' instance is compatible with most (all?) + systems' native representation of 'UUID's. + -} +data UUID = UUID + !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 + !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 + deriving (Eq, Ord) +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/Macros.hs b/Macros.hs --- a/Macros.hs +++ b/Macros.hs @@ -15,7 +15,6 @@ import Language.Haskell.TH.Syntax import Data.List import Control.Applicative -import Text.Regex {-| Just a macro to pull in a file. @@ -28,12 +27,12 @@ version = lift =<< do runIO $ do s <- readFile "system-uuid.cabal" - return $ case regex s of - Just [_, _, c] -> c - _ -> "" + case filter version (lines s) of + v:_ -> return (break_version v) + [ ] -> error "Could not find version :(" where - regex - = ".*\nversion([\t ]*):([\t ]*)([[:digit:].]+)" + version line = "version" == take 7 line + break_version = snd . break (/= ' ') . drop 1 . snd . break (== ':') {-| Extract the usage from the module we're in and put it here. @@ -54,18 +53,12 @@ treating all the text of the comment as the usage statement. -} extractUsage s = - case regex s of - Just [_, b, _, d] -> ('\n':) . normalizeEmptyLines'' $ b ++ d - _ -> "" + case (begins_with_USAGE |--| terminal_comment) (lines s) of + lines -> unlines lines + [ ] -> error "Could not find USAGE :(" where - regex - = ".*\\{-([\t -]*\n)+([ \t]+(SYNOPSIS|USAGE))(.+)\n[-\t ]*-\\}" - - - -- normalizeLeadingEmptyLines -normalizeLeadingEmpties = ('\n':) . dropWhile (`elem` "\n \t") -normalizeEmptyLines'' = reverse . normalizeLeadingEmpties . reverse - + a |--| b = takeWhile (not . b) . dropWhile (not . a) + begins_with_USAGE line = " USAGE: " == take 8 line + terminal_comment line = "-}" == drop (length line - 2) line -r s = matchRegex (mkRegexWithOpts r False True) s diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -1,31 +1,20 @@ {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SYNOPSIS - hooty (-1|-4)? (-n )? - - DESCRIPTION - - The `hooty` program generates any number of UUIDs (one by default), using - either the version 1 (time and MAC) or version 4 (random) algorithm - (version 1 is the default). On all platforms, `hooty` uses the native - implementation. + USAGE: hooty (-1|-4)? (-n )? - OPTIONS + The `hooty` program generates any number of UUIDs (one by default), using + either the version 1 (time and MAC) or version 4 (random) algorithm (version + 1 is the default). On all platforms, `hooty` uses the native implementation. - -n, --number - Create such-and-such many UUIDs in one go. + -n, --number Create many UUIDs in one go. - -1, --sequential - Create UUIDs using the version 1 (time and MAC) algorithm. + -1, --sequential Create version 1 (time and MAC) UUIDs. - -4, --random - Create UUIDs using the version 4 (random) algorithm. + -4, --random Create version 4 (random) UUIDs. - -h, -?, --help - Print this help and exit. + -h, -?, --help Print this help and exit. - --version - Print version and exit. + --version Print version and exit. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} diff --git a/System/UUID/V1.hs b/System/UUID/V1.hs --- a/System/UUID/V1.hs +++ b/System/UUID/V1.hs @@ -12,7 +12,6 @@ import System.UUID.FromForeign -import Data.UUID (UUID) import Foreign.C import Foreign.Ptr @@ -20,7 +19,6 @@ {-| Obtain a Version 1 'UUID' with the native 'UUID' generator. -} -uuid :: IO UUID uuid = runAndRead native diff --git a/System/UUID/V4.hs b/System/UUID/V4.hs --- a/System/UUID/V4.hs +++ b/System/UUID/V4.hs @@ -12,7 +12,6 @@ import System.UUID.FromForeign -import Data.UUID (UUID) import Foreign.C import Foreign.Ptr @@ -20,7 +19,6 @@ {-| Obtain a Version 4 'UUID' with the native 'UUID' generator. -} -uuid :: IO UUID uuid = runAndRead native 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 : 1.2.0 +version : 1.3.0 category : System license : BSD3 license-file : LICENSE @@ -27,13 +27,12 @@ build-depends : base <= 4 , containers , binary - , regex-compat , template-haskell , parsec - , uuid >= 1.0 && < 1.3 exposed-modules : System.UUID.V1 System.UUID.V4 System.UUID.FromForeign + Data.UUID if os(linux) extra-libraries : uuid if os(mingw32)