system-uuid 1.2.0 → 1.3.0
raw patch · 6 files changed
+119/−45 lines, 6 filesdep −regex-compatdep −uuid
Dependencies removed: regex-compat, uuid
Files
- Data/UUID.hs +97/−0
- Macros.hs +11/−18
- Main.hs +9/−20
- System/UUID/V1.hs +0/−2
- System/UUID/V4.hs +0/−2
- system-uuid.cabal +2/−3
+ Data/UUID.hs view
@@ -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)+
Macros.hs view
@@ -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
Main.hs view
@@ -1,31 +1,20 @@ {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SYNOPSIS- hooty (-1|-4)? (-n <number to make>)?-- 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 <number to make>)? - 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 <number>- Create such-and-such many UUIDs in one go.+ -n, --number <number> Create <number> 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. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
System/UUID/V1.hs view
@@ -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
System/UUID/V4.hs view
@@ -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
system-uuid.cabal view
@@ -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)