    {- |
       Module      : Text.Pandoc.UUID
       Copyright   : Copyright (C) 2010-2024 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 ) where

    import Data.Bits (clearBit, setBit)
    import Data.Word
    import System.Random (RandomGen, randoms)
    import Text.Printf (printf)
    import Text.Pandoc.Class.PandocMonad

    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 -> String
    show (UUID Word8
    a Word8
    b Word8
    c Word8
    d Word8
    e Word8
    f Word8
    g Word8
    h Word8
    i Word8
    j Word8
    k Word8
    l Word8
    m Word8
    n Word8
    o Word8
    p) =
       String
    "urn:uuid:" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       String -> Word8 -> String
    forall r. PrintfType r => String -> r
    printf String
    "%02x" Word8
    a String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       String -> Word8 -> String
    forall r. PrintfType r => String -> r
    printf String
    "%02x" Word8
    b String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       String -> Word8 -> String
    forall r. PrintfType r => String -> r
    printf String
    "%02x" Word8
    c String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       String -> Word8 -> String
    forall r. PrintfType r => String -> r
    printf String
    "%02x" Word8
    d String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       String
    "-" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       String -> Word8 -> String
    forall r. PrintfType r => String -> r
    printf String
    "%02x" Word8
    e String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       String -> Word8 -> String
    forall r. PrintfType r => String -> r
    printf String
    "%02x" Word8
    f String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       String
    "-" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       String -> Word8 -> String
    forall r. PrintfType r => String -> r
    printf String
    "%02x" Word8
    g String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       String -> Word8 -> String
    forall r. PrintfType r => String -> r
    printf String
    "%02x" Word8
    h String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       String
    "-" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       String -> Word8 -> String
    forall r. PrintfType r => String -> r
    printf String
    "%02x" Word8
    i String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       String -> Word8 -> String
    forall r. PrintfType r => String -> r
    printf String
    "%02x" Word8
    j String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       String
    "-" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       String -> Word8 -> String
    forall r. PrintfType r => String -> r
    printf String
    "%02x" Word8
    k String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       String -> Word8 -> String
    forall r. PrintfType r => String -> r
    printf String
    "%02x" Word8
    l String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       String -> Word8 -> String
    forall r. PrintfType r => String -> r
    printf String
    "%02x" Word8
    m String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       String -> Word8 -> String
    forall r. PrintfType r => String -> r
    printf String
    "%02x" Word8
    n String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       String -> Word8 -> String
    forall r. PrintfType r => String -> r
    printf String
    "%02x" Word8
    o String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       String -> Word8 -> String
    forall r. PrintfType r => String -> r
    printf String
    "%02x" Word8
    p

    getUUID :: RandomGen g => g -> UUID
    getUUID :: forall g. RandomGen g => g -> UUID
    getUUID g
    gen =
      case Int -> [Word8] -> [Word8]
    forall a. Int -> [a] -> [a]
    take Int
    16 (g -> [Word8]
    forall g. RandomGen g => g -> [Word8]
    forall a g. (Random a, RandomGen g) => g -> [a]
    randoms g
    gen :: [Word8]) of
           [Word8
    a,Word8
    b,Word8
    c,Word8
    d,Word8
    e,Word8
    f,Word8
    g,Word8
    h,Word8
    i,Word8
    j,Word8
    k,Word8
    l,Word8
    m,Word8
    n,Word8
    o,Word8
    p] ->
             -- set variant
             let i' :: Word8
    i' = Word8
    i Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `setBit` Int
    7 Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `clearBit` Int
    6
             -- set version (0100 for random)
                 g' :: Word8
    g' = Word8
    g Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `clearBit` Int
    7 Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `setBit` Int
    6 Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `clearBit` Int
    5 Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `clearBit` Int
    4
             in  Word8
    -> Word8
    -> Word8
    -> Word8
    -> Word8
    -> Word8
    -> Word8
    -> Word8
    -> Word8
    -> Word8
    -> Word8
    -> Word8
    -> Word8
    -> Word8
    -> Word8
    -> Word8
    -> UUID
    UUID Word8
    a Word8
    b Word8
    c Word8
    d Word8
    e Word8
    f Word8
    g' Word8
    h Word8
    i' Word8
    j Word8
    k Word8
    l Word8
    m Word8
    n Word8
    o Word8
    p
           [Word8]
    _ -> String -> UUID
    forall a. HasCallStack => String -> a
    error String
    "not enough random numbers for UUID" -- should not happen

    getRandomUUID :: PandocMonad m => m UUID
    getRandomUUID :: forall (m :: * -> *). PandocMonad m => m UUID
    getRandomUUID = StdGen -> UUID
    forall g. RandomGen g => g -> UUID
    getUUID (StdGen -> UUID) -> m StdGen -> m UUID
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m StdGen
    forall (m :: * -> *). PandocMonad m => m StdGen
    newStdGen