fix: Astrid.Query.andThen compose with map*

Reserve stack slots for andThen values and fill them in later. The old
approach of a strict stack machine was wrong.

examples/sqlite-integration/src/CombinatorsTest.elm

@@ -1,12 +1,13 @@
-module CombinatorsTest exposing (main)
+module CombinatorsTest exposing (testMap3, testAndThen, testDeep)
 
-import Astrid.Query exposing (fetch, execute, errorToString, map3, fetchOne, andThen)
+import Astrid.Query exposing (fetch, execute, errorToString, map3, fetchOne, andThen, map)
 import Json.Decode
 import Html exposing (Html, ul, li, text, code, node, div)
 import Array.Extra
 
-main : Html msg
+
-main =
+testMap3 : Html msg
+testMap3 =
     let
         query =
             map3
@@ -14,33 +15,62 @@ main =
                     one ++ " " ++ two ++ " " ++ three
                 )
                 (fetchOne "select json_quote('a')" [] Json.Decode.string)
-                {-
-                (andThen
-                    (\right ->
-                        map
-                            (\v ->
-                                "andThen( " ++ v ++ ""
-                            )
-                            (andThen
-                                (\left ->
-                                    succeed "andThen"
-                                )
-                            )
-                    )
-                    (fetchOne "select json_quote('b')" [] Json.Decode.string)
-                )
-                -}
                 (fetchOne "select json_quote('b')" [] Json.Decode.string)
                 (fetchOne "select json_quote('c')" [] Json.Decode.string)
     in
-    case execute query of
+    viewResult (execute query)
-        Ok result ->
+
+
+testAndThen : Html msg
+testAndThen =
+    let
+        query =
+            andThen
+                (\_ ->
+                    (fetchOne "select json_quote('d')" [] Json.Decode.string)
+                )
+                (fetchOne "select json_quote('b')" [] Json.Decode.string)
+    in
+    viewResult (execute query)
+
+
+testDeep : Html msg
+testDeep =
+    let
+        query =
+            map3
+                (\one two three ->
+                    one ++ " " ++ two ++ " " ++ three
+                )
+                (map
+                    (\x -> "andThen(" ++ x ++ ")")
+                    ( andThen
+                        (\y ->
+                            map
+                                (\z ->
+                                    y ++ "->" ++ z
+                                )
+                                (fetchOne "select json_quote('d')" [] Json.Decode.string)
+                        )
+                        (fetchOne "select json_quote('a')" [] Json.Decode.string)
+                    )
+                )
+                (fetchOne "select json_quote('b')" [] Json.Decode.string)
+                (fetchOne "select json_quote('c')" [] Json.Decode.string)
+    in
+    viewResult (execute query)
+
+
+viewResult : Result Astrid.Query.Error String -> Html msg
+viewResult result =
+    case result of
+        Ok x ->
             div []
                 [ node "style" []
                     [ text "code { background-color: #f6f7f9; display: block; padding: 1em; border-radius: 4px; border 1px solid #eee; } "
                     ]
                 , code []
-                    [ text result ]
+                    [ text x ]
                 ]
 
         Err error ->

lib/sql/src/Astrid/Query.elm

@@ -1,6 +1,7 @@
 module Astrid.Query
     exposing
-        ( Query
+        ( Error
+        , Query
         , andThen
         , errorToString
         , execute
@@ -54,7 +55,7 @@ javascript.
 dummyExecute : Result Error a
 dummyExecute =
     let
-        query = Dummy
+        _ = Dummy
         _ = Execute "" ""
         _ = Decode "" 0 (Json.Decode.Failure "" Json.Encode.null)
         _ = Failure ""
@@ -96,5 +97,5 @@ map5 f a b c d e =
     Dummy
 
 andThen : (a -> Query b) -> Query a -> Query b
-andThen f a =
+andThen f q =
     Dummy

src/exec/fixtures/README.md

@@ -0,0 +1,127 @@
+
+# Query batching
+
+Step 1)
+    queries = [ (0, map3 fA (succeed x) (map fB (andThen (\_ -> succeed j) (succeed k))) (succeed y)) ]
+    values = [ Pending ]
+    callbacks = []
+Step 1.A)
+    query = map3 fA (succeed x) (map fB (andThen (\_ -> succeed j) (succeed k))) (succeed y) ]
+
+
+Step 2)
+    queries = [ (1, succeed x), (2, (map fB (andThen (\_ -> succeed j) (succeed k)))), (3, (succeed y)) ]
+    values = [Pending, Pending, Pending, Pending]
+    callbacks = [ (0, fA) ]
+
+Step 2.A)
+    query = (3, succeed y)
+
+Step 3)
+    queries = [ (1, succeed x), (2, (map fB (andThen (\_ -> succeed j) (succeed k)))), ]
+    values = [ Pending, Pending, Pending, Ready y ]
+    callbacks = [ (0, fA) ]
+
+Step 3.A)
+    query = (2, (map fB (andThen (\_ -> succeed j) (succeed k))))
+
+Step 4)
+    queries = [ (1, succeed x), (4, (andThen (\_ -> succeed j) (succeed k))) ]
+    values = [ Pending, Pending, Pending, Ready y, Pending ]
+    callbacks = [ (0, fA), (2, fB) ]
+
+Step 4.A)
+    query = (4, (andThen (\_ -> succeed j) (succeed k)))
+
+Step 5)
+    queries = [ (1, succeed x), (5, succeed k) ]
+    values = [ Pending, Pending, Pending, Ready y, Pending, Pending ]
+    callbacks = [ (0, fA), (2, fB), (4, andThen (\_ -> succeed j)) ]
+
+Step 5.A)
+    query = (5, succeed k)
+    -- insert the value into position 5
+    
+Step 6)
+    queries = [ (1, succeed x) ]
+    values = [ Pending, Pending, Pending, Ready y, Pending, Ready k ]
+    callbacks = [ (0, fA), (2, fB), (4, andThen (\_ -> succeed j)) ]
+
+Step 6.A)
+    query = (1, succeed x)
+    -- insert the value into position 1
+
+Step 6)
+    queries = []
+    values = [ Pending, Ready x, Pending, Ready y, Pending, Ready k ]
+    callbacks = [ (0, fA), (2, fB), (4, andThen (\_ -> succeed j)) ]
+
+> Now go to reduce phase
+
+Reduce Step 1)
+    queries = []
+    values = [ Pending, Ready x, Pending, Ready y, Pending, Ready k ]
+    callbacks = [ (0, fA), (2, fB), (4, andThen (\_ -> succeed j)) ]
+
+Reduce Step 1.A)
+    last = (4, andThen (\_ -> succeed j))
+    value = values.pop() -- It should always be ready
+    -- call the callback to get the new query
+    queries.push(4, succeed j)
+    
+Reduce Step 2)
+    queries = [ (4, succeed j) ]
+    values = [ Pending, Ready x, Pending, Ready y, Pending ]
+    callbacks = [ (0, fA), (2, fB) ]
+
+Reduce Step 2.A)
+    -- check that we have 1 arg ready at end of stack, no, so break the reduce step
+
+
+> Now go back to query phase
+
+Step 7)
+    queries = [ (4, succeed j) ]
+    values = [ Pending, Ready x, Pending, Ready y, Pending ]
+    callbacks = [ (0, fA), (2, fB) ]
+
+Step 7.A)
+    query = (4, succeed j)
+    -- place value in slot 4
+
+Step 8)
+    queries = []
+    values = [ Pending, Ready x, Pending, Ready y, Ready j ]
+    callbacks = [ (0, fA), (2, fB) ]
+
+> Now go to reduce phase
+
+Reduce Step 3)
+    queries = []
+    values = [ Pending, Ready x, Pending, Ready y, Ready j ]
+    callbacks = [ (0, fA), (2, fB) ]
+
+Reduece Step 3.A)
+    last = (2, fB)
+    -- We look at last 1 arg
+    args = [ Ready j ]
+    -- place (fB j) in slot 2
+
+Reduce Step 4)
+    queries = []
+    values = [ Pending, Ready x, Ready (fB j), Ready y ]
+    callbacks = [ (0, fA) ]
+
+Reduece Step 4.A)
+    last = (0, fA)
+    -- We look at last 3 args
+    args = [ Ready x, Ready (fB j), Ready y ]
+    -- They are all ready
+    -- place (fA x (fB j) y) in slot 0
+
+Reduce Step 5)
+    queries = []
+    values = [ Ready (fA x (fB j) y) ]
+    callbacks = []
+
+-- Termination criteria reached, return values[0]

src/exec/mod.rs

@@ -210,11 +210,15 @@ pub(crate) fn exec(
                 )
                 .replace(
                     "var $author$project$Astrid$Query$map2 = F3(\n\tfunction (f, a, b) {\n\t\treturn $author$project$Astrid$Query$Dummy;\n\t});",
-                    r#"var $author$project$Astrid$Query$map3 = _Query_map2;"#,
+                    r#"var $author$project$Astrid$Query$map2 = _Query_map2;"#,
                 )
                 .replace(
                     "var $author$project$Astrid$Query$map = F2(\n\tfunction (f, a) {\n\t\treturn $author$project$Astrid$Query$Dummy;\n\t});",
-                    r#"var $author$project$Astrid$Query$map3 = _Query_map1;"#,
+                    r#"var $author$project$Astrid$Query$map = _Query_map1;"#,
+                )
+                .replace(
+                    "var $author$project$Astrid$Query$andThen = F2(\n\tfunction (f, q) {\n\t\treturn $author$project$Astrid$Query$Dummy;\n\t});",
+                    r#"var $author$project$Astrid$Query$andThen = _Query_andThen;"#,
                 );
 
             // final_script.replace("var $author$project$Astrid$Query$run = ", "JSON.stringify(x)");

src/fixture/query.js

@@ -1,8 +1,21 @@
 // CORE QUERIES
 
 function __Debug_print(object) {
-    //Deno.core.print(JSON.stringify(object));
+    Deno.core.print(JSON.stringify(object));
-    //Deno.core.print("\n");
+    Deno.core.print("\n");
+}
+
+function __Debug_print_slots(values) {
+    var len = values.length;
+    for (var i = 0; i < len; i++) {
+        Deno.core.print(["  ", i, ": ", JSON.stringify(values[i]), "\n"].join(""));
+    }
+}
+
+function __Debug_assert(expr) {
+    if (!expr) {
+        throw new Error("debug assert");
+    }
 }
 
 function _Query_succeed(value)
@@ -11,7 +24,7 @@ function _Query_succeed(value)
 		$: 0,
 		a: value
 	};
-}
+};
 
 
 var _Query_fetchOptional = F3(function(sql, args, decoder)
@@ -53,14 +66,14 @@ function _Query_mapMany(f, queries)
     };
 }
 
-var _Query_andThen = F2(function(callback, query)
+var _Query_andThen = F2(
-{
+    function(callback, query) {
-    return {
+        return {
-        $: 5,
+            $: 5,
-        e: query,
+            e: query,
-        h: callback
+            h: callback
-    };
+        };
-});
+    });
 
 var _Query_map1 = F2(function(f, q1)
 {
@@ -194,22 +207,29 @@ function _Query_runDecoder(decoder, sql, xs)
 
 var _Query_execute = function(query)
 {
+    // queries: Array (Int, Query a)
+    // values: Array (Maybe a)
+    // callbacks: Array (Int, Fn: * -> a)
     var queries = new Array;
-    var statements = new Array;
-    var decoders = new Array;
     var values = new Array;
     var callbacks = new Array;
+    var statements = new Array;
+    var decoders = new Array;
 
-    queries.push(query);
+    queries.push({slot: 0, query: query});
+    values.push($elm$core$Maybe$Nothing);
 
     while (true) {
-        var q;
+        var x;
-        while(q = queries.pop()) {
+        while(x = queries.pop()) {
-            __Debug_print("query =");
+            var slot = x.slot;
-            __Debug_print(q);
+            var q = x.query;
+            //__Debug_print({"the result of this query goes in slot": slot});
+            //__Debug_print({"query": q ? q : "missing" });
+            //__Debug_print_slots(values);
             switch (q.$) {
                 case 0:
-                    values.push(q.a);
+                    values[slot] = $elm$core$Maybe$Just(q.a);
                     break;
 
                 case 1:
@@ -220,34 +240,33 @@ var _Query_execute = function(query)
                     var bindParameters = _List_toArray(q.c);
                     var decoder = q.d;
                     statements.push([moreThanOneRow, sql, bindParameters]);
-                    decoders.push(decoder);
+                    decoders.push({slot: slot, decoder: decoder});
                     break;
 
                 case 4:
-                    __Debug_print("got a map");
+                    callbacks.push({ $:'Map', a: q.f, slot: slot })
-                    __Debug_print(q)
+                    // Array.prototype.push.apply(queries, q.g);
-                    callbacks.push({ $:'Map', a: q.f })
+                    var len = q.g.length;
-                    // We know that the list of queries is limited to length 8,
+                    for (var i = 0; i < len; i++) {
-                    // which is much less then browser's stack overflow limits that
+                        queries.push({slot: values.length, query: q.g[i]})
-                    // start around 100,000 elements.
+                        values.push($elm$core$Maybe$Nothing);
-                    Array.prototype.push.apply(queries, q.g);
+                    }
                     break;
 
                 case 5:
-                    callbacks.push({ $:'AndThen', a: q.h })
+                    callbacks.push({ $:'AndThen', a: q.h, slot: slot })
-                    queries.push(q.e)
+                    queries.push({slot: values.length, query: q.e})
+                    values.push($elm$core$Maybe$Nothing);
                     break;
             }
         }
+        __Debug_print("-----------------------");
 
         if (statements.length > 0) {
-            __Debug_print("statements = ");
-            __Debug_print(statements);
             var queryResult = Deno.core.opSync(
                 'op_starmelon_batch_queries',
                 statements,
             );
-            __Debug_print(queryResult);
             // I am assuming here that the Rust code is serializing the same
             // structure that the Elm compiler thinks we have.
             if (!$elm$core$Result$isOk(queryResult)) {
@@ -257,64 +276,69 @@ var _Query_execute = function(query)
             
             var len = results.length;
             for (var i = 0; i < len; i++) {
-                var result = _Query_runDecoder(decoders[i], statements[i][1], results[i])
+                var { decoder, slot } = decoders[i];
+                var result = _Query_runDecoder(decoder, statements[i][1], results[i])
                 if (!$elm$core$Result$isOk(result))
                 {
                     return result
                 }
-                values.push(result.a);
+                values[slot] = $elm$core$Maybe$Just(result.a);
             }
             statements.length = 0;
             decoders.length = 0;
         }
 
-        __Debug_print("processing callbacks stack");
+        __Debug_print({"processing callbacks stack": callbacks});
-        __Debug_print(callbacks);
-        __Debug_print("=====");
 
         reduce:
         while(callbacks.length > 0) {
             var last = callbacks[callbacks.length - 1];
             switch (last.$) {
                 case 'Map':
-                    __Debug_print(last);
+                    var arity = last.a.a ? last.a.a : 1;
-                    __Debug_print(values);
+                    var slot = last.slot;
-                    var arity = last.a.a;
+                    var len = values.length;
-                    if (values.length < arity) {
+                    if (len < arity + 1) {
                         // This implies that queries.length > 0 because we must
                         // have a way to generate the missing value(s) to call
                         // this function.
                         break reduce;
                     }
+                    // Check if all the values are ready
+                    var args = new Array;
+                    for(var i = len - arity; i < len; i++) {
+                        if (values[i].$ === 'Nothing') {
+                            break reduce;
+                        }
+                        args.push(values[i].a);
+                    }
                     callbacks.pop();
                     // Directly call the wrapped Elm function since we know all
                     // the arguments
-                    __Debug_print("ready to call function");
+                    var fun = last.a.f ? last.a.f : last.a;
-                    var fun = last.a.f;
+                    values.length = values.length - arity;
-                    __Debug_print(typeof fun);
+                    values[slot] = $elm$core$Maybe$Just(fun.apply(null, args));
-                    var args = values.slice(-arity);
-                    values.length = values.length - args.length;
-                    args.reverse();
-                    __Debug_print({ args: args, values: values});
-                    values.push(fun.apply(null, args));
                     break;
 
                 case 'AndThen':
                     callbacks.pop();
-                    var fun = last.a.f;
+                    var fun = last.a;
-                    // I think that if we have an AndThen then we will always have at least one value
+                    var slot = last.slot;
-                    queries.push(fun(values.pop()));
+                    __Debug_assert(values.length > 0);
-                    break;
+                    var maybeValue = values.pop();
+                    __Debug_assert(maybeValue.$ === 'Just');
+                    queries.push({slot: slot, query: fun(maybeValue.a)})
             }
         }   
 
         if (queries.length == 0 && callbacks.length == 0) {
-            __Debug_print("final result");
+            __Debug_assert(values.length === 1);
-            __Debug_print(values);
+            __Debug_assert(values[0].$ === 'Just');
-            // values must have one element in it.
+        
-            return $elm$core$Result$Ok(values.pop())
+            return $elm$core$Result$Ok(values.pop().a)
         }
     }
 };
 
 var $author$project$Astrid$Query$execute = _Query_execute;
+var $author$project$Astrid$Query$andThen = _Query_andThen;