type 4 uuids

guid.hs

unique type Guid = Guid Nat Nat Nat Nat

Guid.data1 = cases
  Guid data1 _ _ _ -> data1

Guid.data2 = cases
  Guid _ data2 _ _ -> data2

Guid.data3 = cases
  Guid _ _ data3 _ -> data3

Guid.data4 = cases
  Guid _ _ _ data4 -> data4

Guid.type4 : '{Random} Guid
Guid.type4 _ =
  use Nat or and maxNat

  a = nat!
  b = nat!

  {{ upper 32 bits set, lower unset }}
  data1Mask = (shiftLeft Nat.maxNat 32)
  data2Mask = (shiftRight (shiftLeft Nat.maxNat 48) 32)
  data3Mask = (shiftRight (shiftLeft Nat.maxNat 48) 48)

  versionAndMask = shiftRight Nat.maxNat 52
  versionOrMask = shiftLeft 1 14

  variantAndMask = shiftRight Nat.maxNat 2
  variantOrMask = shiftLeft 1 63

  data1 = Nat.shiftRight (Nat.and (data1Mask) a) 32
  data2 = Nat.shiftRight (Nat.and (data2Mask) a) 16
  data3 = Nat.or versionOrMask (Nat.and versionAndMask (Nat.and (data3Mask) a))
  data4 = Nat.or variantOrMask (Nat.and variantAndMask b)

  !(watch ("data1: " ++ (hexPrint 32 data1)))
  !(watch ("data2: " ++ (hexPrint 16 data2)))
  !(watch ("data3: " ++ (hexPrint 16 data3)))
  !(watch ("data4: " ++ (hexPrint 64 data4)))

  Guid.Guid data1 data2 data3 data4

hexPrint: Nat -> Nat -> Text
hexPrint howMany n = 
  hexDigit: Nat -> Text
  hexDigit = cases
    0 -> "0"
    1 -> "1"
    2 -> "2"
    3 -> "3"
    4 -> "4"
    5 -> "5"
    6 -> "6"
    7 -> "7"
    8 -> "8"
    9 -> "9"
    10 -> "a"
    11 -> "b"
    12 -> "c"
    13 -> "d"
    14 -> "e"
    15 -> "f"
    x  -> Nat.toText x

  go: Nat -> Text -> Text
  go shift acc =
    digit = Nat.and (shiftRight n shift) 15
    next = acc ++ (hexDigit digit)
    if shift Nat.> 0 then
      go (truncate0 (shift - 4)) next
    else
      next

  start = truncate0 (howMany - 4)
  go start ""


Guid.toText : Guid -> Text
Guid.toText = cases
  Guid a b c d ->
     section1 = hexPrint 32 a
     section2 = hexPrint 16 b
     section3 = hexPrint 16 c
     section4 = hexPrint 16 (Nat.shiftRight (Nat.and d (shiftLeft maxNat 48)) 48)
     section5 = hexPrint 48 (Nat.and d (shiftRight maxNat 16))

     section1 ++ "-" ++ section2 ++ "-" ++ section3 ++ "-" ++ section4 ++ "-" ++ section5