Enabling Byte over ports in the compiler.

Injecting _Json_encodeBytes and _Json_decodeBytes kernel functions directly, not through a customized Json package.

Author: rupertlssmith

scripts/replacements.js

@@ -94,6 +94,32 @@ var string = '';
 \t\t);
 \t}
 \treturn _Utils_Tuple2(offset, string.join(''));
-});`);
+});`)
+
+    /* Add Bytes encoder/decoder for ports support.
+       Allows Bytes.Bytes to be sent through ports, mapping to Uint8Array on the JS side.
+     */
+    .replace(
+        `var _Json_encodeNull = _Json_wrap(null);`,
+        `var _Json_encodeNull = _Json_wrap(null);
+
+// BYTES FOR PORTS
+var _Json_decodeBytes = _Json_decodePrim(function(value) {
+\tif (value instanceof Uint8Array) {
+\t\treturn $elm$core$Result$Ok(new DataView(value.buffer, value.byteOffset, value.byteLength));
+\t}
+\tif (value instanceof ArrayBuffer) {
+\t\treturn $elm$core$Result$Ok(new DataView(value));
+\t}
+\tif (value instanceof DataView) {
+\t\treturn $elm$core$Result$Ok(value);
+\t}
+\treturn _Json_expecting('a BYTES value (Uint8Array, ArrayBuffer, or DataView)', value);
+});
+
+var _Json_encodeBytes = function(bytes) {
+\treturn _Json_wrap(new Uint8Array(bytes.buffer, bytes.byteOffset, bytes.byteLength));
+};`
+    );
 
 fs.writeFileSync(path, data, { encoding: 'utf8', flag: 'w' });

src/Compiler/Canonicalize/Effects.elm

@@ -207,7 +207,7 @@ checkPayload tipe =
         Can.TType home name args ->
             case args of
                 [] ->
-                    if isJson home name || isString home name || isIntFloatBool home name then
+                    if isJson home name || isString home name || isIntFloatBool home name || isBytes home name then
                         Ok ()
 
                     else
@@ -306,3 +306,11 @@ isArray home name =
         == ModuleName.array
         && name
         == Name.array
+
+
+isBytes : IO.Canonical -> Name.Name -> Bool
+isBytes home name =
+    home
+        == ModuleName.bytes
+        && name
+        == Name.bytes

src/Compiler/Data/Name.elm

@@ -4,6 +4,7 @@ module Compiler.Data.Name exposing
     , basics
     , bitwise
     , bool
+    , bytes
     , char
     , cmd
     , debug
@@ -356,6 +357,11 @@ dict =
     "Dict"
 
 
+bytes : Name
+bytes =
+    "Bytes"
+
+
 tuple : Name
 tuple =
     "Tuple"

src/Compiler/Generate/JavaScript.elm

@@ -267,7 +267,30 @@ emptyState startingLine =
 
 stateToBuilder : State -> String
 stateToBuilder (State (JS.Builder revKernels code _ _ _) _) =
-    prependBuilders revKernels code
+    prependBuilders revKernels (bytesForPorts ++ code)
+
+
+bytesForPorts : String
+bytesForPorts =
+    """
+// BYTES FOR PORTS
+var _Json_decodeBytes = _Json_decodePrim(function(value) {
+    if (value instanceof Uint8Array) {
+        return $elm$core$Result$Ok(new DataView(value.buffer, value.byteOffset, value.byteLength));
+    }
+    if (value instanceof ArrayBuffer) {
+        return $elm$core$Result$Ok(new DataView(value));
+    }
+    if (value instanceof DataView) {
+        return $elm$core$Result$Ok(value);
+    }
+    return _Json_expecting('a BYTES value (Uint8Array, ArrayBuffer, or DataView)', value);
+});
+
+var _Json_encodeBytes = function(bytes) {
+    return _Json_wrap(new Uint8Array(bytes.buffer, bytes.byteOffset, bytes.byteLength));
+};
+"""
 
 
 prependBuilders : List String -> String -> String

src/Compiler/Guida/ModuleName.elm

@@ -2,6 +2,7 @@ module Compiler.Guida.ModuleName exposing
     ( Raw
     , array
     , basics
+    , bytes
     , canonicalDecoder
     , canonicalEncoder
     , char
@@ -283,6 +284,15 @@ jsonEncode =
 
 
 
+-- BYTES
+
+
+bytes : Canonical
+bytes =
+    Canonical Pkg.bytes "Bytes"
+
+
+
 -- WEBGL
 
 

src/Compiler/Guida/Package.elm

@@ -3,6 +3,7 @@ module Compiler.Guida.Package exposing
     , Name
     , Project
     , browser
+    , bytes
     , compareName
     , core
     , decoder
@@ -144,6 +145,11 @@ json =
     toName elm "json"
 
 
+bytes : Name
+bytes =
+    toName elm "bytes"
+
+
 http : Name
 http =
     toName elm "http"

src/Compiler/Optimize/Port.elm

@@ -58,6 +58,12 @@ toEncoder tipe =
                     else if name == Name.value then
                         Names.registerGlobal A.zero ModuleName.basics Name.identity_
 
+                    else if name == Name.bytes then
+                        encode "bytes"
+
+                    else if name == Name.bytes then
+                        encodeBytes
+
                     else
                         crash "toEncoder: bad custom type"
 
@@ -271,6 +277,12 @@ toDecoder tipe =
                 ( "Value", [] ) ->
                     decode "value"
 
+                ( "Bytes", [] ) ->
+                    decode "bytes"
+
+                ( "Bytes", [] ) ->
+                    decodeBytes
+
                 ( "Maybe", [ arg ] ) ->
                     decodeMaybe arg
 
@@ -478,3 +490,17 @@ encode name =
 decode : Name -> Names.Tracker Opt.Expr
 decode name =
     Names.registerGlobal A.zero ModuleName.jsonDecode name
+
+
+
+-- BYTES HELPERS
+
+
+encodeBytes : Names.Tracker Opt.Expr
+encodeBytes =
+    Names.registerKernel Name.json (Opt.VarKernel A.zero Name.json "encodeBytes")
+
+
+decodeBytes : Names.Tracker Opt.Expr
+decodeBytes =
+    Names.registerKernel Name.json (Opt.VarKernel A.zero Name.json "decodeBytes")

src/Compiler/Reporting/Error/Canonicalize.elm

@@ -704,7 +704,7 @@ toReport source err =
                             [ D.reflow "I cannot handle that. The types that CAN flow in and out of Guida include:"
                             , D.indent 4 <|
                                 D.reflow
-                                    "Ints, Floats, Bools, Strings, Maybes, Lists, Arrays, tuples, records, and JSON values."
+                                    "Ints, Floats, Bools, Strings, Maybes, Lists, Arrays, tuples, records, JSON values, and Bytes."
                             , D.reflow
                                 "Since JSON values can flow through, you can use JSON encoders and decoders to allow other types through as well. More advanced users often just do everything with encoders and decoders for more control and better errors."
                             ]