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

git.iko.soy/typeable/pandoc

on bfbc5ee help sign in

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

79 lines 2.4 kB history raw

1{-# LANGUAGE NoImplicitPrelude #-}

2{-

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

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

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

8(at your option) any later version.

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

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

12MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

13GNU General Public License for more details.

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

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

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

18-}

20{- |

21 Module : Text.Pandoc.UUID

23 License : GNU GPL, version 2 or above

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

26 Stability : alpha

27 Portability : portable

29UUID generation using Version 4 (random method) described

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

31-}

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

35import Prelude

36import Data.Bits (clearBit, setBit)

37import Data.Word

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

39import Text.Printf (printf)

41data UUID = UUID Word8 Word8 Word8 Word8 Word8 Word8 Word8 Word8

42 Word8 Word8 Word8 Word8 Word8 Word8 Word8 Word8

44instance Show UUID where

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

46 "urn:uuid:" ++

47 printf "%02x" a ++

48 printf "%02x" b ++

49 printf "%02x" c ++

50 printf "%02x" d ++

51 "-" ++

52 printf "%02x" e ++

53 printf "%02x" f ++

54 "-" ++

55 printf "%02x" g ++

56 printf "%02x" h ++

57 "-" ++

58 printf "%02x" i ++

59 printf "%02x" j ++

60 "-" ++

61 printf "%02x" k ++

62 printf "%02x" l ++

63 printf "%02x" m ++

64 printf "%02x" n ++

65 printf "%02x" o ++

66 printf "%02x" p

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

69getUUID gen =

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

71 -- set variant

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

73 -- set version (0100 for random)

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

75 in

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

78getRandomUUID :: IO UUID

79getRandomUUID = getUUID <$> getStdGen