diff --git a/Data/UUID.hs b/Data/UUID.hs --- a/Data/UUID.hs +++ b/Data/UUID.hs @@ -1,6 +1,6 @@ -{-| A 'UUID' and its many instances. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} +{-| The 'UUID' datatype. + -} module Data.UUID ( UUID() @@ -26,6 +26,11 @@ 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 @@ -64,7 +69,7 @@ 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 + | 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] diff --git a/Macros.hs b/Macros.hs --- a/Macros.hs +++ b/Macros.hs @@ -19,12 +19,25 @@ {-| Just a macro to pull in a file. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} + -} pullFile f = lift =<< runIO (readFile f) +{-| Extract the version from the Cabal file and place it here as string. + -} +version = lift =<< do + runIO $ do + s <- readFile "system-uuid.cabal" + return $ case regex s of + Just [_, _, c] -> c + _ -> "" + where + regex + = ".*\nversion([\t ]*):([\t ]*)([[:digit:].]+)" + + {-| Extract the usage from the module we're in and put it here. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} + -} usage = lift =<< do p <- $(presentFile) runIO $ do @@ -37,20 +50,22 @@ {-| Pulls the usage out of the comments in a file, digging through the file - - to find a comment with no text before the @SYNOPSIS@ or @USAGE@, and then - - treating all the text of the comment as the usage statement. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} + to find a comment with no text before the @SYNOPSIS@ or @USAGE@, and then + treating all the text of the comment as the usage statement. + -} extractUsage s = case regex s of - Just [_, a, _, b] -> ('\n':) . normalizeEmptyLines'' $ a ++ b + Just [_, b, _, d] -> ('\n':) . normalizeEmptyLines'' $ b ++ d _ -> "" where - r s = matchRegex (mkRegexWithOpts r False True) s - regex = ".*\\{-([\t -]*\n)+([ \t]+(SYNOPSIS|USAGE))(.+)\n[-\t ]*-\\}" + regex + = ".*\\{-([\t -]*\n)+([ \t]+(SYNOPSIS|USAGE))(.+)\n[-\t ]*-\\}" -- normalizeLeadingEmptyLines normalizeLeadingEmpties = ('\n':) . dropWhile (`elem` "\n \t") normalizeEmptyLines'' = reverse . normalizeLeadingEmpties . reverse + +r s = matchRegex (mkRegexWithOpts r False True) s diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -24,6 +24,9 @@ -h, -?, --help Print this help and exit. + --version + Print version and exit. + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} {-# LANGUAGE TemplateHaskell @@ -50,10 +53,13 @@ when (isJust $ lk "h") $ do stdout << usage exitWith ExitSuccess + when (isJust $ lk "version") $ do + stdout << version + exitWith ExitSuccess when (all (isJust . lk) ["1","4"]) $ do bail "Please specify either version 1 or version 4, not both." let - n :: Word + n :: Word n = fromMaybe 1 $ maybeRead =<< lk "n" gen = if isJust $ lk "4" @@ -71,7 +77,9 @@ usage = $(Macros.usage) +version = "hooty-" ++ $(Macros.version) + opts = do args <- getArgs case runParser options () "command line arguments" args of @@ -102,6 +110,7 @@ , fmap (Map.insert o) anyString ] | otherwise = prb $ "unimplemented option '" ++ o ++ "'" + opt "version" = return $ Map.insert "version" "" opt o = prb $ "unimplemented option '" ++ o ++ "'" prb s = fail $ "Please report a bug -- " ++ s ++ "." opts = map try @@ -109,6 +118,7 @@ , option "1" ["sequential"] , option "4" ["random"] , option "n" ["number"] + , option "" ["version"] ] ++ [ fail "Invalid option." ] diff --git a/System/UUID/FromForeign.hs b/System/UUID/FromForeign.hs --- a/System/UUID/FromForeign.hs +++ b/System/UUID/FromForeign.hs @@ -1,6 +1,6 @@ {-| Utilities for fetching the results from foreign functions. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} + -} {-# LANGUAGE ForeignFunctionInterface #-} @@ -17,9 +17,9 @@ import Foreign -{-| Allocate a pointer to capture the output of a foreign function, run the - - function and interpret the sixteen bytes following the pointer as a UUID. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} +{-| Allocates a pointer to capture the output of a foreign function, runs the + function and interprets the sixteen bytes following the pointer as a UUID. + -} runAndRead :: (Ptr CChar -> IO ()) -> IO UUID runAndRead procedure = do fp <- mallocForeignPtrArray 16 diff --git a/System/UUID/V1.hs b/System/UUID/V1.hs --- a/System/UUID/V1.hs +++ b/System/UUID/V1.hs @@ -1,6 +1,6 @@ -{-| Obtain a Version 1 UUID from the system. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} +{-| Version 1 'UUID' utilities. + -} {-# LANGUAGE ForeignFunctionInterface , CPP @@ -17,6 +17,8 @@ import Foreign.Ptr +{-| Obtain a Version 1 'UUID' with the native 'UUID' generator. + -} 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 @@ -1,6 +1,6 @@ -{-| Obtain a Version 1 UUID from the system. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} +{-| Version 4 'UUID' utilities. + -} {-# LANGUAGE ForeignFunctionInterface , CPP @@ -17,6 +17,8 @@ import Foreign.Ptr +{-| Obtain a Version 4 'UUID' with the native 'UUID' generator. + -} 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.0.2 +version : 1.1.0 category : System license : BSD3 license-file : LICENSE