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.
This commit is contained in:
parent
b6182376b6
commit
401aec67d0
5 changed files with 271 additions and 85 deletions
|
|
@ -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
|
||||
Ok result ->
|
||||
viewResult (execute query)
|
||||
|
||||
|
||||
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 ->
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
127
src/exec/fixtures/README.md
Normal file
127
src/exec/fixtures/README.md
Normal file
|
|
@ -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]
|
||||
|
|
@ -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)");
|
||||
|
|
|
|||
|
|
@ -1,8 +1,21 @@
|
|||
// CORE QUERIES
|
||||
|
||||
function __Debug_print(object) {
|
||||
//Deno.core.print(JSON.stringify(object));
|
||||
//Deno.core.print("\n");
|
||||
Deno.core.print(JSON.stringify(object));
|
||||
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,8 +66,8 @@ function _Query_mapMany(f, queries)
|
|||
};
|
||||
}
|
||||
|
||||
var _Query_andThen = F2(function(callback, query)
|
||||
{
|
||||
var _Query_andThen = F2(
|
||||
function(callback, query) {
|
||||
return {
|
||||
$: 5,
|
||||
e: query,
|
||||
|
|
@ -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;
|
||||
while(q = queries.pop()) {
|
||||
__Debug_print("query =");
|
||||
__Debug_print(q);
|
||||
var x;
|
||||
while(x = queries.pop()) {
|
||||
var slot = x.slot;
|
||||
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");
|
||||
__Debug_print(q)
|
||||
callbacks.push({ $:'Map', a: q.f })
|
||||
// We know that the list of queries is limited to length 8,
|
||||
// which is much less then browser's stack overflow limits that
|
||||
// start around 100,000 elements.
|
||||
Array.prototype.push.apply(queries, q.g);
|
||||
callbacks.push({ $:'Map', a: q.f, slot: slot })
|
||||
// Array.prototype.push.apply(queries, q.g);
|
||||
var len = q.g.length;
|
||||
for (var i = 0; i < len; i++) {
|
||||
queries.push({slot: values.length, query: q.g[i]})
|
||||
values.push($elm$core$Maybe$Nothing);
|
||||
}
|
||||
break;
|
||||
|
||||
case 5:
|
||||
callbacks.push({ $:'AndThen', a: q.h })
|
||||
queries.push(q.e)
|
||||
callbacks.push({ $:'AndThen', a: q.h, slot: slot })
|
||||
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(callbacks);
|
||||
__Debug_print("=====");
|
||||
__Debug_print({"processing callbacks stack": callbacks});
|
||||
|
||||
reduce:
|
||||
while(callbacks.length > 0) {
|
||||
var last = callbacks[callbacks.length - 1];
|
||||
switch (last.$) {
|
||||
case 'Map':
|
||||
__Debug_print(last);
|
||||
__Debug_print(values);
|
||||
var arity = last.a.a;
|
||||
if (values.length < arity) {
|
||||
var arity = last.a.a ? last.a.a : 1;
|
||||
var slot = last.slot;
|
||||
var len = values.length;
|
||||
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;
|
||||
__Debug_print(typeof fun);
|
||||
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));
|
||||
var fun = last.a.f ? last.a.f : last.a;
|
||||
values.length = values.length - arity;
|
||||
values[slot] = $elm$core$Maybe$Just(fun.apply(null, args));
|
||||
break;
|
||||
|
||||
case 'AndThen':
|
||||
callbacks.pop();
|
||||
var fun = last.a.f;
|
||||
// I think that if we have an AndThen then we will always have at least one value
|
||||
queries.push(fun(values.pop()));
|
||||
break;
|
||||
var fun = last.a;
|
||||
var slot = last.slot;
|
||||
__Debug_assert(values.length > 0);
|
||||
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_print(values);
|
||||
// values must have one element in it.
|
||||
return $elm$core$Result$Ok(values.pop())
|
||||
__Debug_assert(values.length === 1);
|
||||
__Debug_assert(values[0].$ === 'Just');
|
||||
|
||||
return $elm$core$Result$Ok(values.pop().a)
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
var $author$project$Astrid$Query$execute = _Query_execute;
|
||||
var $author$project$Astrid$Query$andThen = _Query_andThen;
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue