pandoc/src/Text/Pandoc/UUID.hs
John MacFarlane f3080c0c22 Remove license boilerplate.
The haddock module header contains essentially the
same information, so the boilerplate is redundant and
just one more thing to get out of sync.
2019-03-01 10:27:06 -08:00

62 lines
1.7 KiB
Haskell

{-# LANGUAGE NoImplicitPrelude #-}
{- |
Module : Text.Pandoc.UUID
Copyright : Copyright (C) 2010-2019 John MacFarlane
License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <jgm@berkeley.edu>
Stability : alpha
Portability : portable
UUID generation using Version 4 (random method) described
in RFC4122. See http://tools.ietf.org/html/rfc4122
-}
module Text.Pandoc.UUID ( UUID(..), getRandomUUID, getUUID ) where
import Prelude
import Data.Bits (clearBit, setBit)
import Data.Word
import System.Random (RandomGen, getStdGen, randoms)
import Text.Printf (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 a b c d e f g h i j k l m n o p) =
"urn:uuid:" ++
printf "%02x" a ++
printf "%02x" b ++
printf "%02x" c ++
printf "%02x" d ++
"-" ++
printf "%02x" e ++
printf "%02x" f ++
"-" ++
printf "%02x" g ++
printf "%02x" h ++
"-" ++
printf "%02x" i ++
printf "%02x" j ++
"-" ++
printf "%02x" k ++
printf "%02x" l ++
printf "%02x" m ++
printf "%02x" n ++
printf "%02x" o ++
printf "%02x" p
getUUID :: RandomGen g => g -> UUID
getUUID gen =
case take 16 (randoms gen :: [Word8]) of
[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p] ->
-- set variant
let i' = i `setBit` 7 `clearBit` 6
-- set version (0100 for random)
g' = g `clearBit` 7 `setBit` 6 `clearBit` 5 `clearBit` 4
in UUID a b c d e f g' h i' j k l m n o p
_ -> error "not enough random numbers for UUID" -- should not happen
getRandomUUID :: IO UUID
getRandomUUID = getUUID <$> getStdGen