Merge pull request #5799 from unisonweb/runarorama/avroMagic

Add Avro-decoder builtin and replacement function

Author: aryairani

parser-typechecker/src/Unison/Builtin/Decls.hs

@@ -53,6 +53,7 @@ library:
     - asn1-encoding
     - asn1-types
     - atomic-primops
+    - avro
     - base
     - binary
     - bytes

unison-runtime/package.yaml

@@ -1302,6 +1302,7 @@ declareForeigns = do
   declareForeign Untracked 1 Json_toText
   declareForeign Untracked 1 Json_unconsText
   declareForeign Untracked 1 Json_tryUnconsText
+  declareForeign Untracked 3 Avro_decodeBinary
 
 foreignDeclResults :: (Map ForeignFunc (Sandbox, SuperNormal Symbol))
 foreignDeclResults =

unison-runtime/src/Unison/Runtime/Builtin.hs

@@ -279,6 +279,7 @@ data ForeignFunc
   | Json_toText
   | Json_unconsText
   | Json_tryUnconsText
+  | Avro_decodeBinary
   deriving (Show, Eq, Ord, Enum, Bounded)
 
 foreignFuncBuiltinName :: ForeignFunc -> Text
@@ -554,3 +555,4 @@ foreignFuncBuiltinName = \case
   Json_toText -> "Json.toText"
   Json_unconsText -> "Json.unconsText"
   Json_tryUnconsText -> "Json.tryUnconsText"
+  Avro_decodeBinary -> "avro.Value.tryDecodeBytes"

unison-runtime/src/Unison/Runtime/Foreign/Function.hs

@@ -152,6 +152,7 @@ module Unison.Runtime.Stack
     asize,
     useg,
     bseg,
+    segFromList,
 
     -- * Unboxed type tags
     natTypeTag,

unison-runtime/src/Unison/Runtime/Foreign/Function/Type.hs

@@ -50,6 +50,102 @@ module Unison.Runtime.TypeTags
     jsonTextTag,
     jsonArrTag,
     jsonParseErrorTag,
+    avroNullTag,
+    avroRecordTag,
+    avroBytesTag,
+    avroFixedTag,
+    avroArrayTag,
+    avroMapTag,
+    avroUnionTag,
+    avroEnumTag,
+    avroStringTag,
+    avroIntTag,
+    avroLongTag,
+    avroFloatTag,
+    avroDoubleTag,
+    avroBooleanTag,
+    avroReadSchemaNullTag,
+    avroReadSchemaBooleanTag,
+    avroReadSchemaIntTag,
+    avroReadSchemaLongTag,
+    avroReadSchemaFloatTag,
+    avroReadSchemaDoubleTag,
+    avroReadSchemaBytesTag,
+    avroReadSchemaStringTag,
+    avroReadSchemaArrayTag,
+    avroReadSchemaMapTag,
+    avroReadSchemaRecordTag,
+    avroReadSchemaEnumTag,
+    avroReadSchemaUnionTag,
+    avroReadSchemaFixedTag,
+    avroReadSchemaFreeUnionTag,
+    avroReadSchemaNamedTypeTag,
+    avroTypeNameTag,
+    avroLogicalIntDateTag,
+    avroLogicalIntTimeTag,
+    avroLogicalIntDecimalTag,
+    avroReadFloatFromInt32Tag,
+    avroReadFloatFromInt64Tag,
+    avroReadFloatTag,
+    avroLogicalLongTimeMicrosTag,
+    avroLogicalLongTimestampMillisTag,
+    avroLogicalLongTimestampMicrosTag,
+    avroLogicalLongLocalTimestampMillisTag,
+    avroLogicalLongLocalTimestampMicrosTag,
+    avroLogicalLongDecimalTag,
+    avroLogicalFixedDurationTag,
+    avroLogicalFixedDecimalTag,
+    avroLogicalStringUUIDTag,
+    avroReadDoubleFromInt32Tag,
+    avroReadDoubleFromInt64Tag,
+    avroReadDoubleFromFloatTag,
+    avroReadDoubleTag,
+    avroDecimalTag,
+    avroReadLongInt32Tag,
+    avroReadLongTag,
+    avroLogicalBytesDecimalTag,
+    avroLogicalStringUuidTag,
+    avroReadFieldTag,
+    avroFieldTag,
+    avroFieldStatusAsIsTag,
+    avroFieldStatusDefaultedTag,
+    avroFieldStatusIgnoredTag,
+    avroOrderAscendingTag,
+    avroOrderDescendingTag,
+    avroOrderIgnoreTag,
+    avroDefaultValueIntTag,
+    avroDefaultValueLongTag,
+    avroDefaultValueFloatTag,
+    avroDefaultValueDoubleTag,
+    avroDefaultValueBytesTag,
+    avroDefaultValueStringTag,
+    avroDefaultValueArrayTag,
+    avroDefaultValueMapTag,
+    avroDefaultValueRecordTag,
+    avroDefaultValueUnionTag,
+    avroDefaultValueFixedTag,
+    avroDefaultValueEnumTag,
+    avroDefaultValueNullTag,
+    avroDefaultValueBooleanTag,
+    avroSchemaNullTag,
+    avroSchemaBooleanTag,
+    avroSchemaIntTag,
+    avroSchemaLongTag,
+    avroSchemaFloatTag,
+    avroSchemaDoubleTag,
+    avroSchemaBytesTag,
+    avroSchemaStringTag,
+    avroSchemaArrayTag,
+    avroSchemaMapTag,
+    avroSchemaNamedTypeTag,
+    avroSchemaRecordTag,
+    avroSchemaEnumTag,
+    avroSchemaUnionTag,
+    avroSchemaFixedTag,
+    avroReadRecordTag,
+    avroFixedTypeTag,
+    avroRecordTypeTag,
+    avroEnumTypeTag,
   )
 where
 
@@ -337,6 +433,159 @@ jsonParseErrorTag
       pet
   | otherwise = error "internal error: json parse error tag"
 
+avroNullTag, avroRecordTag, avroBytesTag, avroFixedTag, avroArrayTag, avroMapTag, avroUnionTag, avroEnumTag, avroStringTag, avroIntTag, avroLongTag, avroFloatTag, avroDoubleTag, avroBooleanTag :: PackedTag
+(avroNullTag, avroRecordTag, avroBytesTag, avroFixedTag, avroArrayTag, avroMapTag, avroUnionTag, avroEnumTag, avroStringTag, avroIntTag, avroLongTag, avroFloatTag, avroDoubleTag, avroBooleanTag)
+  | [nlt, rct, bct, fct, act, mct, ut, et, st, it, lt, ft, dt, bt] <-
+      mkTags
+        "avro tags"
+        Ty.avroRef
+        [Ty.avroNull, Ty.avroRecord, Ty.avroBytes, Ty.avroFixed, Ty.avroArray, Ty.avroMap, Ty.avroUnion, Ty.avroEnum, Ty.avroString, Ty.avroInt, Ty.avroLong, Ty.avroFloat, Ty.avroDouble, Ty.avroBoolean] =
+      (nlt, rct, bct, fct, act, mct, ut, et, st, it, lt, ft, dt, bt)
+  | otherwise = error "internal error: avro tags"
+
+avroFixedTypeTag :: PackedTag
+avroFixedTypeTag = mkSimpleTag "avroFixedTypeTag" Ty.avroFixedRef
+
+avroRecordTypeTag :: PackedTag
+avroRecordTypeTag = mkSimpleTag "avroRecordTypeTag" Ty.avroRecordRef
+
+avroEnumTypeTag :: PackedTag
+avroEnumTypeTag = mkSimpleTag "avroEnumTypeTag" Ty.avroEnumRef
+
+avroDefaultValueIntTag, avroDefaultValueLongTag, avroDefaultValueFloatTag, avroDefaultValueDoubleTag, avroDefaultValueBytesTag, avroDefaultValueStringTag, avroDefaultValueArrayTag, avroDefaultValueMapTag, avroDefaultValueRecordTag, avroDefaultValueUnionTag, avroDefaultValueFixedTag, avroDefaultValueEnumTag, avroDefaultValueNullTag, avroDefaultValueBooleanTag :: PackedTag
+(avroDefaultValueIntTag, avroDefaultValueLongTag, avroDefaultValueFloatTag, avroDefaultValueDoubleTag, avroDefaultValueBytesTag, avroDefaultValueStringTag, avroDefaultValueArrayTag, avroDefaultValueMapTag, avroDefaultValueRecordTag, avroDefaultValueUnionTag, avroDefaultValueFixedTag, avroDefaultValueEnumTag, avroDefaultValueNullTag, avroDefaultValueBooleanTag)
+  | [it, lt, ft, dt, bct, st, art, mct, rct, ut, fct, ent, nct, bot] <-
+      mkTags
+        "avro default value tags"
+        Ty.avroDefaultValueRef
+        [Ty.avroDefaultValueInt32, Ty.avroDefaultValueInt64, Ty.avroDefaultValueFloat, Ty.avroDefaultValueDouble, Ty.avroDefaultValueBytes, Ty.avroDefaultValueString, Ty.avroDefaultValueArray, Ty.avroDefaultValueMap, Ty.avroDefaultValueRecord, Ty.avroDefaultValueUnion, Ty.avroDefaultValueFixed, Ty.avroDefaultValueEnum, Ty.avroDefaultValueNull, Ty.avroDefaultValueBoolean] =
+      (it, lt, ft, dt, bct, st, art, mct, rct, ut, fct, ent, nct, bot)
+  | otherwise = error "internal error: avro default value tags"
+
+avroReadSchemaNullTag, avroReadSchemaBooleanTag, avroReadSchemaStringTag, avroReadSchemaFloatTag, avroReadSchemaFixedTag, avroReadSchemaDoubleTag, avroReadSchemaBytesTag, avroReadSchemaNamedTypeTag, avroReadSchemaIntTag, avroReadSchemaLongTag, avroReadSchemaMapTag, avroReadSchemaRecordTag, avroReadSchemaFreeUnionTag, avroReadSchemaEnumTag, avroReadSchemaUnionTag, avroReadSchemaArrayTag :: PackedTag
+(avroReadSchemaNullTag, avroReadSchemaBooleanTag, avroReadSchemaStringTag, avroReadSchemaFloatTag, avroReadSchemaFixedTag, avroReadSchemaDoubleTag, avroReadSchemaBytesTag, avroReadSchemaNamedTypeTag, avroReadSchemaIntTag, avroReadSchemaLongTag, avroReadSchemaMapTag, avroReadSchemaRecordTag, avroReadSchemaFreeUnionTag, avroReadSchemaEnumTag, avroReadSchemaUnionTag, avroReadSchemaArrayTag)
+  | [nullTag, booleanTag, stringTag, floatTag, fixedTag, doubleTag, bytesTag, namedTypeTag, intTag, longTag, mapTag, recordTag, freeUnionTag, enumTag, unionTag, arrayTag] <-
+      mkTags
+        "avro read schema tags"
+        Ty.avroReadSchemaRef
+        [Ty.avroReadSchemaNull, Ty.avroReadSchemaBoolean, Ty.avroReadSchemaString, Ty.avroReadSchemaFloat, Ty.avroReadSchemaFixed, Ty.avroReadSchemaDouble, Ty.avroReadSchemaBytes, Ty.avroReadSchemaNamedType, Ty.avroReadSchemaInt, Ty.avroReadSchemaLong, Ty.avroReadSchemaMap, Ty.avroReadSchemaRecord, Ty.avroReadSchemaFreeUnion, Ty.avroReadSchemaEnum, Ty.avroReadSchemaUnion, Ty.avroReadSchemaArray] =
+      (nullTag, booleanTag, stringTag, floatTag, fixedTag, doubleTag, bytesTag, namedTypeTag, intTag, longTag, mapTag, recordTag, freeUnionTag, enumTag, unionTag, arrayTag)
+  | otherwise = error "internal error: avro readschema tags"
+
+avroSchemaNullTag, avroSchemaBooleanTag, avroSchemaIntTag, avroSchemaLongTag, avroSchemaFloatTag, avroSchemaDoubleTag, avroSchemaBytesTag, avroSchemaStringTag, avroSchemaArrayTag, avroSchemaMapTag, avroSchemaNamedTypeTag, avroSchemaRecordTag, avroSchemaEnumTag, avroSchemaUnionTag, avroSchemaFixedTag :: PackedTag
+(avroSchemaNullTag, avroSchemaBooleanTag, avroSchemaIntTag, avroSchemaLongTag, avroSchemaFloatTag, avroSchemaDoubleTag, avroSchemaBytesTag, avroSchemaStringTag, avroSchemaArrayTag, avroSchemaMapTag, avroSchemaNamedTypeTag, avroSchemaRecordTag, avroSchemaEnumTag, avroSchemaUnionTag, avroSchemaFixedTag)
+  | [nlt, bot, it, lt, ft, dt, bst, st, at, mt, ntt, rct, ent, ut, fxt] <-
+      mkTags
+        "avro schema tags"
+        Ty.avroSchemaRef
+        [Ty.avroSchemaNull, Ty.avroSchemaBoolean, Ty.avroSchemaInt, Ty.avroSchemaLong, Ty.avroSchemaFloat, Ty.avroSchemaDouble, Ty.avroSchemaBytes, Ty.avroSchemaString, Ty.avroSchemaArray, Ty.avroSchemaMap, Ty.avroSchemaNamedType, Ty.avroSchemaRecord, Ty.avroSchemaEnum, Ty.avroSchemaUnion, Ty.avroSchemaFixed] =
+      (nlt, bot, it, lt, ft, dt, bst, st, at, mt, ntt, rct, ent, ut, fxt)
+  | otherwise = error "internal error: avro schema tags"
+
+avroLogicalIntDateTag, avroLogicalIntTimeTag, avroLogicalIntDecimalTag :: PackedTag
+(avroLogicalIntDateTag, avroLogicalIntTimeTag, avroLogicalIntDecimalTag)
+  | [dt, tt, dect] <-
+      mkTags
+        "avro logical int tags"
+        Ty.avroLogicalIntRef
+        [Ty.avroLogicalIntDate, Ty.avroLogicalIntTime, Ty.avroLogicalIntDecimal] =
+      (dt, tt, dect)
+  | otherwise = error "internal error: avro logical int tags"
+
+avroReadFieldTag :: PackedTag
+avroReadFieldTag = mkSimpleTag "avroReadFieldTag" Ty.avroReadFieldRef
+
+avroFieldTag :: PackedTag
+avroFieldTag = mkSimpleTag "avroFieldTag" Ty.avroFieldRef
+
+avroReadRecordTag :: PackedTag
+avroReadRecordTag = mkSimpleTag "avroReadRecordTag" Ty.avroReadRecordRef
+
+avroLogicalStringUuidTag :: PackedTag
+avroLogicalStringUuidTag = mkSimpleTag "avroLogicalStringUuidTag" Ty.avroLogicalStringRef
+
+avroLogicalBytesDecimalTag :: PackedTag
+avroLogicalBytesDecimalTag = mkSimpleTag "avroLogicalBytesDecimalTag" Ty.avroLogicalBytesRef
+
+avroLogicalLongTimeMicrosTag, avroLogicalLongTimestampMillisTag, avroLogicalLongTimestampMicrosTag, avroLogicalLongLocalTimestampMillisTag, avroLogicalLongLocalTimestampMicrosTag, avroLogicalLongDecimalTag :: PackedTag
+(avroLogicalLongTimeMicrosTag, avroLogicalLongTimestampMillisTag, avroLogicalLongTimestampMicrosTag, avroLogicalLongLocalTimestampMillisTag, avroLogicalLongLocalTimestampMicrosTag, avroLogicalLongDecimalTag)
+  | [tmct, tsmst, tsmcst, ltsmst, ltsmcst, decct] <-
+      mkTags
+        "avro logical long tags"
+        Ty.avroLogicalLongRef
+        [Ty.avroLogicalLongTimeMicros, Ty.avroLogicalLongTimestampMillis, Ty.avroLogicalLongTimestampMicros, Ty.avroLogicalLongLocalTimestampMillis, Ty.avroLogicalLongLocalTimestampMicros, Ty.avroLogicalLongDecimal] =
+      (tmct, tsmst, tsmcst, ltsmst, ltsmcst, decct)
+  | otherwise = error "internal error: avro logical long tags"
+
+avroLogicalFixedDurationTag, avroLogicalFixedDecimalTag :: PackedTag
+(avroLogicalFixedDurationTag, avroLogicalFixedDecimalTag)
+  | [durt, decct] <-
+      mkTags
+        "avro logical fixed tags"
+        Ty.avroLogicalFixedRef
+        [Ty.avroLogicalFixedDuration, Ty.avroLogicalFixedDecimal] =
+      (durt, decct)
+  | otherwise = error "internal error: avro logical fixed tags"
+
+avroLogicalStringUUIDTag :: PackedTag
+avroLogicalStringUUIDTag = mkSimpleTag "avroLogicalStringUUIDTag" Ty.avroLogicalStringRef
+
+avroReadFloatFromInt32Tag, avroReadFloatFromInt64Tag, avroReadFloatTag :: PackedTag
+(avroReadFloatFromInt32Tag, avroReadFloatFromInt64Tag, avroReadFloatTag)
+  | [i32t, i64t, ft] <-
+      mkTags
+        "avro read float tags"
+        Ty.avroReadFloatRef
+        [Ty.avroReadFloatInt32, Ty.avroReadFloatInt64, Ty.avroReadFloat] =
+      (i32t, i64t, ft)
+  | otherwise = error "internal error: avro read float tags"
+
+avroReadDoubleFromInt32Tag, avroReadDoubleFromInt64Tag, avroReadDoubleFromFloatTag, avroReadDoubleTag :: PackedTag
+(avroReadDoubleFromInt32Tag, avroReadDoubleFromInt64Tag, avroReadDoubleFromFloatTag, avroReadDoubleTag)
+  | [i32t, i64t, ft, dt] <-
+      mkTags
+        "avro read double tags"
+        Ty.avroReadDoubleRef
+        [Ty.avroReadDoubleInt32, Ty.avroReadDoubleInt64, Ty.avroReadDoubleFromFloat, Ty.avroReadDouble] =
+      (i32t, i64t, ft, dt)
+  | otherwise = error "internal error: avro read double tags"
+
+avroReadLongInt32Tag, avroReadLongTag :: PackedTag
+(avroReadLongInt32Tag, avroReadLongTag)
+  | [i32t, lt] <-
+      mkTags
+        "avro read long tags"
+        Ty.avroReadLongRef
+        [Ty.avroReadLongInt32, Ty.avroReadLong] =
+      (i32t, lt)
+  | otherwise = error "internal error: avro read long tags"
+
+avroTypeNameTag :: PackedTag
+avroTypeNameTag = mkSimpleTag "avroTypeNameTag" Ty.avroTypeNameRef
+
+avroDecimalTag :: PackedTag
+avroDecimalTag = mkSimpleTag "avroDecimalTag" Ty.avroDecimalRef
+
+avroFieldStatusAsIsTag, avroFieldStatusDefaultedTag, avroFieldStatusIgnoredTag :: PackedTag
+(avroFieldStatusAsIsTag, avroFieldStatusDefaultedTag, avroFieldStatusIgnoredTag)
+  | [ast, dct, igt] <-
+      mkTags
+        "avro field status tags"
+        Ty.avroFieldStatusRef
+        [Ty.avroFieldStatusAsIs, Ty.avroFieldStatusDefaulted, Ty.avroFieldStatusIgnored] =
+      (ast, dct, igt)
+  | otherwise = error "internal error: avro field status tags"
+
+avroOrderAscendingTag, avroOrderDescendingTag, avroOrderIgnoreTag :: PackedTag
+(avroOrderAscendingTag, avroOrderDescendingTag, avroOrderIgnoreTag)
+  | [ast, dct, igt] <-
+      mkTags
+        "avro order tags"
+        Ty.avroOrderRef
+        [Ty.avroOrderAscending, Ty.avroOrderDescending, Ty.avroOrderIgnore] =
+      (ast, dct, igt)
+  | otherwise = error "internal error: avro order tags"
+
 -- | A tag we use to represent the 'pure' effect case.
 pureEffectTag :: PackedTag
 pureEffectTag = PackedTag 0

unison-runtime/src/Unison/Runtime/Stack.hs

@@ -109,6 +109,7 @@ library
       asn1-encoding
     , asn1-types
     , atomic-primops
+    , avro
     , base
     , binary
     , bytes

unison-runtime/src/Unison/Runtime/TypeTags.hs

@@ -80,7 +80,7 @@ structural type SomethingUnusuallyLong
   = SomethingUnusuallyLong Text Text Text
 
 structural type UUID
-  = UUID Nat (Nat, Nat)
+  = UUUID Nat (Nat, Nat)
 
 structural ability Zoink where
   nay : Text -> (Nat, Nat) ->{Zoink} Nat
@@ -816,11 +816,11 @@ use_clauses_example2 oo =
   bar.quaffle + bar.quaffle + bar.quaffle + 1
 
 UUID.random : 'UUID
-UUID.random = do UUID 0 (0, 0)
+UUID.random = do UUUID 0 (0, 0)
 
 UUID.randomUUIDBytes : 'Bytes
 UUID.randomUUIDBytes = do
-  (UUID a (b, _)) = random()
+  (UUUID a (b, _)) = random()
   encodeNat64be a Bytes.++ encodeNat64be b
 
 (|>) : a -> (a ->{e} b) ->{e} b

unison-runtime/unison-runtime.cabal

@@ -217,14 +217,14 @@ ex3a =
 -- Make sure use clauses don't show up before a soft hang
 -- Regression test for https://github.com/unisonweb/unison/issues/3883
 
-structural type UUID = UUID Nat (Nat, Nat)
+structural type UUID = UUUID Nat (Nat, Nat)
 
 UUID.random : 'UUID
-UUID.random = do UUID 0 (0,0)
+UUID.random = do UUID.UUUID 0 (0,0)
 
 UUID.randomUUIDBytes : 'Bytes
 UUID.randomUUIDBytes = do
-  (UUID a (b,_)) = !UUID.random
+  (UUID.UUUID a (b,_)) = !UUID.random
   (encodeNat64be a) ++ (encodeNat64be b)
 
 -- Raw string round trip