Make tokenTypeOf more precise (#325)

* Make `tokenTypeOf` more precise Now `tokenTypeOf` distinguishes between: - Unsigned 64 bit integers `(0 <= n < 2^64)`: `TypeUInt64` - Negative 64 bit integers `(-2^64 < n < 0 )`: `TypeNInt64` - Integers outside the ranges above : `TypeInteger` Fixes #324
well-typed · Sep 8, 2023 · c8013b3 · c8013b3
1 parent 4149849
commit c8013b3
Showing 1 changed file with 22 additions and 19 deletions.
diff --git a/cborg/src/Codec/CBOR/FlatTerm.hs b/cborg/src/Codec/CBOR/FlatTerm.hs
@@ -562,25 +562,28 @@ fromFlatTerm decoder ft =
 -- | Map a 'TermToken' to the underlying CBOR 'TokenType'
 tokenTypeOf :: TermToken -> TokenType
 tokenTypeOf (TkInt n)
-    | n >= 0                = TypeUInt
-    | otherwise             = TypeNInt
-tokenTypeOf TkInteger{}     = TypeInteger
-tokenTypeOf TkBytes{}       = TypeBytes
-tokenTypeOf TkBytesBegin{}  = TypeBytesIndef
-tokenTypeOf TkString{}      = TypeString
-tokenTypeOf TkStringBegin{} = TypeStringIndef
-tokenTypeOf TkListLen{}     = TypeListLen
-tokenTypeOf TkListBegin{}   = TypeListLenIndef
-tokenTypeOf TkMapLen{}      = TypeMapLen
-tokenTypeOf TkMapBegin{}    = TypeMapLenIndef
-tokenTypeOf TkTag{}         = TypeTag
-tokenTypeOf TkBool{}        = TypeBool
-tokenTypeOf TkNull          = TypeNull
-tokenTypeOf TkBreak         = TypeBreak
-tokenTypeOf TkSimple{}      = TypeSimple
-tokenTypeOf TkFloat16{}     = TypeFloat16
-tokenTypeOf TkFloat32{}     = TypeFloat32
-tokenTypeOf TkFloat64{}     = TypeFloat64
+    | n >= 0                          = TypeUInt
+    | otherwise                       = TypeNInt
+tokenTypeOf (TkInteger n)   -- See https://github.com/well-typed/cborg/issues/324
+  | 0 <= n && n <= 0xffffffffffffffff = TypeUInt64 -- 0xffffffffffffffff == 2^64 - 1
+  | -0xffffffffffffffff <= n && n < 0 = TypeNInt64
+  | otherwise                         = TypeInteger
+tokenTypeOf TkBytes{}                 = TypeBytes
+tokenTypeOf TkBytesBegin{}            = TypeBytesIndef
+tokenTypeOf TkString{}                = TypeString
+tokenTypeOf TkStringBegin{}           = TypeStringIndef
+tokenTypeOf TkListLen{}               = TypeListLen
+tokenTypeOf TkListBegin{}             = TypeListLenIndef
+tokenTypeOf TkMapLen{}                = TypeMapLen
+tokenTypeOf TkMapBegin{}              = TypeMapLenIndef
+tokenTypeOf TkTag{}                   = TypeTag
+tokenTypeOf TkBool{}                  = TypeBool
+tokenTypeOf TkNull                    = TypeNull
+tokenTypeOf TkBreak                   = TypeBreak
+tokenTypeOf TkSimple{}                = TypeSimple
+tokenTypeOf TkFloat16{}               = TypeFloat16
+tokenTypeOf TkFloat32{}               = TypeFloat32
+tokenTypeOf TkFloat64{}               = TypeFloat64
 
 --------------------------------------------------------------------------------