module Data.Vhd.UniqueId
( UniqueId
, uniqueId
, randomUniqueId
) where
import Control.Exception
import Control.Monad
import Data.Char
import Data.List
import Data.Byteable
import System.Random
import qualified Data.ByteString as B
import Text.Printf
newtype UniqueId = UniqueId B.ByteString deriving (Eq)
uniqueId :: B.ByteString -> UniqueId
uniqueId i = assert (B.length i == 16) $ UniqueId i
instance Byteable UniqueId where
toBytes (UniqueId b) = b
instance Show UniqueId where
show (UniqueId b) = intercalate "-" $ map disp [[0 .. 3], [4, 5], [6, 7], [8, 9], [10 .. 15]]
where disp = concatMap (printf "%02x" . B.index b)
instance Read UniqueId where
readsPrec _ r = let (t,d) = splitAt 36 r
in case ofString t of
Nothing -> []
Just uid -> [(uid, d)]
ofString :: String -> Maybe UniqueId
ofString s
| length s /= 36 = Nothing
| head r0 /= '-' = Nothing
| head r1 /= '-' = Nothing
| head r2 /= '-' = Nothing
| head r3 /= '-' = Nothing
| otherwise = Just $ UniqueId $ B.pack (unhex a8 ++ unhex b4 ++ unhex c4 ++ unhex d4 ++ unhex (drop 1 r3))
where (a8, r0) = splitAt 8 s
(b4, r1) = splitAt 4 $ drop 1 r0
(c4, r2) = splitAt 4 $ drop 1 r1
(d4, r3) = splitAt 4 $ drop 1 r2
unhex [] = []
unhex (v1:v2:xs) = fromIntegral (digitToInt v1 * 16 + digitToInt v2) : unhex xs
unhex _ = error "internal error in unhex"
randomUniqueId :: IO UniqueId
randomUniqueId
= liftM (uniqueId . B.pack)
$ replicateM 16
$ liftM fromIntegral
$ randomRIO (0 :: Int, 255)