
  0 | ||| Note that the JavaScript library "uuid" on which this Idris library depends, considers a string
  1 | ||| a valid UUID string only if can be generated by a UUID algorithm described in the UUID RFCs.
  2 | module UUID.Driver.JS
  3 | 
  4 | import public UUID
  5 | import UUID.Data.Vect
  6 | 
  7 | %foreign "javascript:lambda: size => new Uint8Array(size)"
  8 | prim__Uint8Array : Int32 -> PrimIO AnyPtr
  9 | 
 10 | %foreign "javascript:lambda: (arr, idx, x) => arr.set([x], idx)"
 11 | prim__Uint8ArraySetByte : GCAnyPtr -> Int32 -> Bits8 -> PrimIO ()
 12 | 
 13 | %foreign "javascript:lambda: (arr, idx) => arr.at(idx)"
 14 | prim__Uint8ArrayAtByte : GCAnyPtr -> Int32 -> Bits8
 15 | 
 16 | %foreign "javascript:lambda: str => require('uuid').parse(str)"
 17 | prim__parse : String -> PrimIO AnyPtr
 18 | 
 19 | %foreign "javascript:lambda: buf => require('uuid').stringify(buf)"
 20 | prim__stringify : GCAnyPtr -> PrimIO String
 21 | 
 22 | %foreign "javascript:lambda: buf => require('uuid').v1(null, buf)"
 23 | prim__v1 : GCAnyPtr -> PrimIO AnyPtr
 24 | 
 25 | %foreign "javascript:lambda: (name, ns, buf) => require('uuid').v3(name, ns, buf)"
 26 | prim__v3 : String -> GCAnyPtr -> GCAnyPtr -> PrimIO AnyPtr
 27 | 
 28 | %foreign "javascript:lambda: buf => require('uuid').v4(null, buf)"
 29 | prim__v4 : GCAnyPtr -> PrimIO AnyPtr
 30 | 
 31 | %foreign "javascript:lambda: (name, ns, buf) => require('uuid').v5(name, ns, buf)"
 32 | prim__v5 : String -> GCAnyPtr -> GCAnyPtr -> PrimIO AnyPtr
 33 | 
 34 | %foreign "javascript:lambda: str => +(require('uuid').validate(str))"
 35 | prim__validate : String -> Int
 36 | 
 37 | assert_gc'ed : AnyPtr -> GCAnyPtr
 38 | assert_gc'ed = believe_me
 39 | 
 40 | allocByteArray : IO GCAnyPtr
 41 | allocByteArray = do
 42 |   ptr <- primIO $ prim__Uint8Array 16
 43 |   pure $ assert_gc'ed ptr
 44 | 
 45 | unparse' : UUID -> String
 46 | unparse' uuid = unsafePerformIO $ primIO $ prim__stringify uuid.ptr
 47 | 
 48 | export Eq UUID where (==) = (==) `on` unparse'
 49 | export Ord UUID where compare = compare `on` unparse'
 50 | 
 51 | toByteArray : Vect 16 Bits8 -> GCAnyPtr
 52 | toByteArray bytes = unsafePerformIO $ do
 53 |   uuid <- allocByteArray
 54 |   traverse_ (\(i, x) => primIO $ prim__Uint8ArraySetByte uuid (cast i) x) $ enumerate bytes
 55 |   pure uuid
 56 | 
 57 | export
 58 | UUIDGen where
 59 |   toBytes uuid = map (prim__Uint8ArrayAtByte uuid.ptr . cast) (range 16)
 60 | 
 61 |   uuid1 = do
 62 |     uuid <- allocByteArray
 63 |     uuid <- primIO $ prim__v1 uuid
 64 |     pure (MkUUID $ assert_gc'ed uuid, True)
 65 | 
 66 |   uuid3 ns name = unsafePerformIO $ do
 67 |     uuid <- allocByteArray
 68 |     uuid <- primIO $ prim__v3 name (toByteArray ns) uuid
 69 |     pure $ MkUUID $ assert_gc'ed uuid
 70 | 
 71 |   uuid4 = do
 72 |     uuid <- allocByteArray
 73 |     uuid <- primIO $ prim__v4 uuid
 74 |     pure $ MkUUID $ assert_gc'ed uuid
 75 | 
 76 |   uuid5 ns name = unsafePerformIO $ do
 77 |     uuid <- allocByteArray
 78 |     uuid <- primIO $ prim__v5 name (toByteArray ns) uuid
 79 |     pure $ MkUUID $ assert_gc'ed uuid
 80 | 
 81 |   parse str =
 82 |     let ok = prim__validate str == 1 in
 83 |     if not ok then Nothing else Just $ unsafePerformIO $ do
 84 |       uuid <- primIO $ prim__parse str
 85 |       pure $ MkUUID $ assert_gc'ed uuid
 86 | 
 87 |   unparse = unparse'
 88 |