src/Text/Pandoc/UUID.hs · typeable/pandoc

git.iko.soy/typeable/pandoc

on 34412cf help sign in

typeable/pandoc/src/Text/Pandoc/UUID.hs

78 lines 2.3 kB history raw

1{-

4This program is free software; you can redistribute it and/or modify

5it under the terms of the GNU General Public License as published by

6the Free Software Foundation; either version 2 of the License, or

7(at your option) any later version.

9This program is distributed in the hope that it will be useful,

10but WITHOUT ANY WARRANTY; without even the implied warranty of

11MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

12GNU General Public License for more details.

14You should have received a copy of the GNU General Public License

15along with this program; if not, write to the Free Software

16Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

17-}

19{- |

20 Module : Text.Pandoc.UUID

22 License : GNU GPL, version 2 or above

24 Maintainer : John MacFarlane <jgm@berkeley.edu>

25 Stability : alpha

26 Portability : portable

28UUID generation using Version 4 (random method) described

29in RFC4122. See http://tools.ietf.org/html/rfc4122

30-}

32module Text.Pandoc.UUID ( UUID(..), getRandomUUID, getUUID ) where

34import Data.Bits (clearBit, setBit)

35import Data.Word

36import System.Random (RandomGen, getStdGen, randoms)

37import Text.Printf (printf)

39data UUID = UUID Word8 Word8 Word8 Word8 Word8 Word8 Word8 Word8

40 Word8 Word8 Word8 Word8 Word8 Word8 Word8 Word8

42instance Show UUID where

43 show (UUID a b c d e f g h i j k l m n o p) =

44 "urn:uuid:" ++

45 printf "%02x" a ++

46 printf "%02x" b ++

47 printf "%02x" c ++

48 printf "%02x" d ++

49 "-" ++

50 printf "%02x" e ++

51 printf "%02x" f ++

52 "-" ++

53 printf "%02x" g ++

54 printf "%02x" h ++

55 "-" ++

56 printf "%02x" i ++

57 printf "%02x" j ++

58 "-" ++

59 printf "%02x" k ++

60 printf "%02x" l ++

61 printf "%02x" m ++

62 printf "%02x" n ++

63 printf "%02x" o ++

64 printf "%02x" p

66getUUID :: RandomGen g => g -> UUID

67getUUID gen =

68 let [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p] = take 16 $ randoms gen :: [Word8]

69 -- set variant

70 i' = i `setBit` 7 `clearBit` 6

71 -- set version (0100 for random)

72 g' = g `clearBit` 7 `setBit` 6 `clearBit` 5 `clearBit` 4

73 in

74 UUID a b c d e f g' h i' j k l m n o p

76getRandomUUID :: IO UUID

77getRandomUUID = getUUID <$> getStdGen