oss/starmelon
oss/starmelon
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

fix: Astrid.Query.andThen compose with map*

Browse source 
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:
YetAnotherMinion 2022-01-07 23:57:28 +00:00 • committed by nobody
commit 401aec67d0
Signed by: GrocerPublishAgent
GPG key ID: D460CD54A9E3AB86
5 changed files with 271 additions and 85 deletions
Download patch file Download diff file Expand all files Collapse all files

76
examples/sqlite-integration/src/CombinatorsTest.elm
View file

@ -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 ->