Add load tests for apps

compiler/load/src/file.rs

@@ -12,7 +12,7 @@ use roc_constrain::module::{
 };
 use roc_module::ident::{Ident, Lowercase, ModuleName};
 use roc_module::symbol::{IdentIds, Interns, ModuleId, ModuleIds, Symbol};
-use roc_parse::ast::{self, Attempting, ExposesEntry, ImportsEntry, InterfaceHeader};
+use roc_parse::ast::{self, Attempting, ExposesEntry, ImportsEntry};
 use roc_parse::module::module_defs;
 use roc_parse::parser::{Fail, Parser, State};
 use roc_region::all::{Located, Region};
@@ -108,6 +108,7 @@ pub enum LoadingProblem {
         fail: Fail,
     },
     MsgChannelDied,
+    TriedToImportAppModule,
 }
 
 enum MaybeShared<'a, 'b, A, B> {
@@ -515,13 +516,36 @@ fn load_filename(
             #[allow(clippy::let_and_return)]
             let answer = match roc_parse::module::header().parse(&arena, state) {
                 Ok((ast::Module::Interface { header }, state)) => {
-                    let module_id = send_interface_header(header, state, module_ids, msg_tx);
+                    let module_id = send_header(
+                        header.name,
+                        header.exposes.into_bump_slice(),
+                        header.imports.into_bump_slice(),
+                        state,
+                        module_ids,
+                        msg_tx,
+                    );
 
                     Ok(module_id)
                 }
-                Ok((ast::Module::App { .. }, _)) => {
+                Ok((ast::Module::App { header }, state)) => match module_ids {
-                    panic!("TODO finish loading an App module");
+                    MaybeShared::Shared(_, _) => {
-                }
+                        // If this is Shared, it means we're trying to import
+                        // an app module which is not the root. Not alllowed!
+                        Err(LoadingProblem::TriedToImportAppModule)
+                    }
+                    unique_modules @ MaybeShared::Unique(_, _) => {
+                        let module_id = send_header(
+                            header.name,
+                            header.provides.into_bump_slice(),
+                            header.imports.into_bump_slice(),
+                            state,
+                            unique_modules,
+                            msg_tx,
+                        );
+
+                        Ok(module_id)
+                    }
+                },
                 Err((fail, _)) => Err(LoadingProblem::ParsingFailed { filename, fail }),
             };
 
@@ -534,36 +558,37 @@ fn load_filename(
     }
 }
 
-fn send_interface_header<'a>(
+fn send_header<'a>(
-    header: InterfaceHeader<'a>,
+    name: Located<roc_parse::header::ModuleName<'a>>,
+    exposes: &'a [Located<ExposesEntry<'a>>],
+    imports: &'a [Located<ImportsEntry<'a>>],
     state: State<'a>,
     shared_modules: SharedModules<'_, '_>,
     msg_tx: MsgSender,
 ) -> ModuleId {
     use MaybeShared::*;
 
-    let declared_name: ModuleName = header.name.value.as_str().into();
+    let declared_name: ModuleName = name.value.as_str().into();
 
     // TODO check to see if declared_name is consistent with filename.
     // If it isn't, report a problem!
 
-    let mut imports: Vec<(ModuleName, Vec<Ident>, Region)> =
+    let mut imported: Vec<(ModuleName, Vec<Ident>, Region)> = Vec::with_capacity(imports.len());
-        Vec::with_capacity(header.imports.len());
     let mut imported_modules: MutSet<ModuleId> = MutSet::default();
     let mut scope_size = 0;
 
-    for loc_entry in header.imports {
+    for loc_entry in imports {
         let (module_name, exposed) = exposed_from_import(&loc_entry.value);
 
         scope_size += exposed.len();
 
-        imports.push((module_name, exposed, loc_entry.region));
+        imported.push((module_name, exposed, loc_entry.region));
     }
 
-    let num_exposes = header.exposes.len();
+    let num_exposes = exposes.len();
     let mut deps_by_name: MutMap<ModuleName, ModuleId> =
         HashMap::with_capacity_and_hasher(num_exposes, default_hasher());
-    let mut exposes: Vec<Symbol> = Vec::with_capacity(num_exposes);
+    let mut exposed: Vec<Symbol> = Vec::with_capacity(num_exposes);
 
     // Make sure the module_ids has ModuleIds for all our deps,
     // then record those ModuleIds in can_module_ids for later.
@@ -592,7 +617,7 @@ fn send_interface_header<'a>(
             // For each of our imports, add an entry to deps_by_name
             //
             // e.g. for `imports [ Foo.{ bar } ]`, add `Foo` to deps_by_name
-            for (module_name, exposed, region) in imports.into_iter() {
+            for (module_name, exposed, region) in imported.into_iter() {
                 let cloned_module_name = module_name.clone();
                 let module_id = module_ids.get_or_insert(&module_name.into());
 
@@ -618,7 +643,7 @@ fn send_interface_header<'a>(
             //
             // We must *not* add them to scope yet, or else the Defs will
             // incorrectly think they're shadowing them!
-            for loc_exposed in header.exposes.iter() {
+            for loc_exposed in exposes.iter() {
                 // Use get_or_insert here because the ident_ids may already
                 // created an IdentId for this, when it was imported exposed
                 // in a dependent module.
@@ -629,7 +654,7 @@ fn send_interface_header<'a>(
                 let ident_id = ident_ids.get_or_insert(&loc_exposed.value.as_str().into());
                 let symbol = Symbol::new(home, ident_id);
 
-                exposes.push(symbol);
+                exposed.push(symbol);
             }
 
             if cfg!(debug_assertions) {
@@ -648,7 +673,7 @@ fn send_interface_header<'a>(
             // and also add any exposed values to scope.
             //
             // e.g. for `imports [ Foo.{ bar } ]`, add `Foo` to deps_by_name and `bar` to scope.
-            for (module_name, exposed, region) in imports.into_iter() {
+            for (module_name, exposed, region) in imported.into_iter() {
                 let module_id = module_ids.get_or_insert(&module_name.clone().into());
 
                 deps_by_name.insert(module_name, module_id);
@@ -672,11 +697,11 @@ fn send_interface_header<'a>(
             //
             // We must *not* add them to scope yet, or else the Defs will
             // incorrectly think they're shadowing them!
-            for loc_exposed in header.exposes.iter() {
+            for loc_exposed in exposes.iter() {
                 let ident_id = ident_ids.add(loc_exposed.value.as_str().into());
                 let symbol = Symbol::new(home, ident_id);
 
-                exposes.push(symbol);
+                exposed.push(symbol);
             }
 
             if cfg!(debug_assertions) {
@@ -712,7 +737,7 @@ fn send_interface_header<'a>(
             module_name: declared_name,
             imported_modules,
             deps_by_name,
-            exposes,
+            exposes: exposed,
             src,
             exposed_imports: scope,
         }))

compiler/load/tests/fixtures/build/app_with_deps/AStar.roc

@@ -0,0 +1,111 @@
+interface AStar
+    exposes [ initialModel, reconstructPath, updateCost, cheapestOpen, astar, findPath ]
+    imports []
+
+
+# a port of https://github.com/krisajenkins/elm-astar/blob/2.1.3/src/AStar/Generalised.elm
+
+Model position :
+    { evaluated : Set position
+    , openSet : Set position
+    , costs : Map.Map position Float
+    , cameFrom : Map.Map position position
+    }
+
+
+initialModel : position -> Model position
+initialModel = \start ->
+    { evaluated : Set.empty
+    , openSet : Set.singleton start
+    , costs : Map.singleton start 0.0
+    , cameFrom : Map.empty
+    }
+
+
+cheapestOpen : (position -> Float), Model position -> Result position [ KeyNotFound ]*
+cheapestOpen = \costFunction, model ->
+
+    folder = \position, resSmallestSoFar ->
+            when Map.get model.costs position is
+                Err e ->
+                    Err e
+
+                Ok cost ->
+                    positionCost = costFunction position
+
+                    when resSmallestSoFar is
+                        Err _ -> Ok { position, cost: cost + positionCost }
+                        Ok smallestSoFar ->
+                            if positionCost + cost < smallestSoFar.cost then
+                                Ok { position, cost: cost + positionCost }
+
+                            else
+                                Ok smallestSoFar
+
+    Set.foldl model.openSet folder (Err KeyNotFound)
+        |> Result.map (\x -> x.position)
+
+
+
+reconstructPath : Map position position, position -> List position
+reconstructPath = \cameFrom, goal ->
+    when Map.get cameFrom goal is
+        Err KeyNotFound ->
+            []
+
+        Ok next ->
+            List.push (reconstructPath cameFrom next) goal
+
+updateCost : position, position, Model position -> Model position
+updateCost = \current, neighbour, model ->
+    newCameFrom = Map.insert model.cameFrom neighbour current
+
+    newCosts = Map.insert model.costs neighbour distanceTo
+
+    distanceTo = reconstructPath newCameFrom neighbour
+            |> List.len
+            |> Num.toFloat
+
+    newModel = { model & costs : newCosts , cameFrom : newCameFrom }
+
+    when Map.get model.costs neighbour is
+        Err KeyNotFound ->
+            newModel
+
+        Ok previousDistance ->
+            if distanceTo < previousDistance then
+                newModel
+
+            else
+                model
+
+
+findPath : { costFunction: (position, position -> Float), moveFunction: (position -> Set position), start : position, end : position } -> Result (List position) [ KeyNotFound ]*
+findPath = \{ costFunction, moveFunction, start, end } ->
+    astar costFunction moveFunction end (initialModel start)
+
+
+astar : (position, position -> Float), (position -> Set position), position, Model position -> [ Err [ KeyNotFound ]*, Ok (List position) ]*
+astar = \costFn, moveFn, goal, model ->
+    when cheapestOpen (\position -> costFn goal position) model is
+        Err _ ->
+            Err KeyNotFound
+
+        Ok current ->
+            if current == goal then
+                Ok (reconstructPath model.cameFrom goal)
+
+            else
+
+               modelPopped = { model & openSet : Set.remove model.openSet current, evaluated : Set.insert model.evaluated current }
+
+               neighbours = moveFn current
+
+               newNeighbours = Set.diff neighbours modelPopped.evaluated
+
+               modelWithNeighbours = { modelPopped & openSet : Set.union modelPopped.openSet newNeighbours }
+
+               modelWithCosts = Set.foldl newNeighbours (\nb, md -> updateCost current nb md) modelWithNeighbours
+
+               astar costFn moveFn goal modelWithCosts
+

compiler/load/tests/fixtures/build/app_with_deps/Dep1.roc

@@ -0,0 +1,15 @@
+interface Dep1
+    exposes [ three, str, Unit, Identity, one, two ]
+    imports [ Dep3.Blah.{ foo } ]
+
+one = 1
+
+two = foo
+
+three = 3.0
+
+str = "string!"
+
+Unit : [ Unit ]
+
+Identity a : [ Identity a ]

compiler/load/tests/fixtures/build/app_with_deps/Dep2.roc

@@ -0,0 +1,10 @@
+interface Dep2
+    exposes [ one, two, blah ]
+    imports [ Dep3.Blah.{ foo, bar } ]
+
+one = 1
+
+blah = foo
+
+two = 2.0
+

compiler/load/tests/fixtures/build/app_with_deps/Dep3/Blah.roc

@@ -0,0 +1,10 @@
+interface Dep3.Blah
+    exposes [ one, two, foo, bar ]
+    imports []
+
+one = 1
+
+two = 2
+
+foo = "foo from Dep3"
+bar = "bar from Dep3"

compiler/load/tests/fixtures/build/app_with_deps/ImportAlias.roc

@@ -0,0 +1,7 @@
+interface ImportAlias
+    exposes [ unit ]
+    imports [ Dep1 ]
+
+unit : Dep1.Unit
+unit = Unit
+

compiler/load/tests/fixtures/build/app_with_deps/ManualAttr.roc

@@ -0,0 +1,18 @@
+interface ManualAttr
+    exposes []
+    imports []
+
+# manually replicates the Attr wrapping that uniqueness inference uses, to try and find out why they are different
+# It is very important that there are no signatures here! elm uses an optimization that leads to less copying when 
+# signatures are given.
+
+map =
+    unAttr = \Attr _ foobar -> foobar
+
+    r = Attr unknown "bar"
+
+    s = Attr unknown2 { left : Attr Shared "foo" }
+
+    when True is
+        _ -> { y : r }
+        _ -> { y : (unAttr s).left }

compiler/load/tests/fixtures/build/app_with_deps/OneDep.roc

@@ -0,0 +1,5 @@
+interface OneDep
+    exposes [ str ]
+    imports [ Dep3.Blah.{ foo } ]
+
+str = foo

compiler/load/tests/fixtures/build/app_with_deps/Primary.roc

@@ -0,0 +1,31 @@
+app Primary
+    provides [ blah2, blah3, str, alwaysThree, identity, z, w, succeed, withDefault, yay ]
+    imports [ Dep1, Dep2.{ two, foo }, Dep3.Blah.{ bar }, Res ]
+
+blah2 = Dep2.two
+blah3 = bar
+
+str = Dep1.str
+
+# alwaysThree = \_ -> Dep1.three # TODO FIXME for some reason this infers as a circular type
+alwaysThree = \_ -> "foo"
+
+identity = \a -> a
+
+z = identity (alwaysThree {})
+
+w : Dep1.Identity {}
+w = Identity {}
+
+succeed : a -> Dep1.Identity a
+succeed = \x -> Identity x
+
+withDefault = Res.withDefault
+
+yay : Res.Res {} err
+yay =
+    ok = Ok "foo"
+
+    f = \_ -> {}
+
+    Res.map ok f

compiler/load/tests/fixtures/build/app_with_deps/Quicksort.roc

@@ -0,0 +1,49 @@
+app Quicksort
+    provides [ swap, partition, quicksort ]
+    imports []
+
+quicksort : List (Num a), Int, Int -> List (Num a)
+quicksort = \list, low, high ->
+    when partition low high list is
+        Pair partitionIndex partitioned ->
+            partitioned
+                |> quicksort low (partitionIndex - 1)
+                |> quicksort (partitionIndex + 1) high
+
+
+swap : Int, Int, List a -> List a
+swap = \i, j, list ->
+    when Pair (List.get list i) (List.get list j) is
+        Pair (Ok atI) (Ok atJ) ->
+            list
+                |> List.set i atJ
+                |> List.set j atI
+
+        _ ->
+            []
+
+
+partition : Int, Int, List (Num a) -> [ Pair Int (List (Num a)) ]
+partition = \low, high, initialList ->
+    when List.get initialList high is
+        Ok pivot ->
+            go = \i, j, list ->
+                if j < high then
+                    when List.get list j is
+                        Ok value ->
+                            if value <= pivot then
+                                go (i + 1) (j + 1) (swap (i + 1) j list)
+                            else
+                                go i (j + 1) list
+
+                        Err _ ->
+                            Pair i list
+                else
+                    Pair i list
+
+            when go (low - 1) low initialList is
+                Pair newI newList ->
+                    Pair (newI + 1) (swap (newI + 1) high newList)
+
+        Err _ ->
+            Pair (low - 1) initialList

compiler/load/tests/fixtures/build/app_with_deps/Records.roc

@@ -0,0 +1,8 @@
+interface Records
+    exposes [ intVal ]
+    imports []
+
+intVal =
+    foo = \{ x } -> x
+
+    foo { x: 5 }

compiler/load/tests/fixtures/build/app_with_deps/Res.roc

@@ -0,0 +1,32 @@
+interface Res
+    exposes [ Res, withDefault, map, andThen, ConsList ]
+    imports []
+
+Res ok err : [ Ok ok, Err err ]
+
+ConsList a : [ Cons a (ConsList a), Nil ]
+
+# TODO FIXME for some reason, exposing this causes a stack overflow
+# listMap : ConsList a, (a -> b) -> ConsList b
+# listMap = \list, f ->
+    # when list is
+        # Nil -> Nil
+        # Cons x xs -> Cons (f x) (listMap xs f)
+
+map : Res a err, (a -> b) -> Res b err
+map = \result, transform ->
+    when result is
+        Ok ok -> Ok (transform ok)
+        Err err -> Err err
+
+withDefault : Res a err, a -> a
+withDefault = \result, default ->
+    when result is
+        Ok ok -> ok
+        Err _ -> default
+
+andThen : Res a err, (a -> Res b err) -> Res b err
+andThen = \result, transform ->
+    when result is
+        Ok ok -> transform ok
+        Err err -> Err err

compiler/load/tests/fixtures/build/app_with_deps/WithBuiltins.roc

@@ -0,0 +1,19 @@
+interface WithBuiltins
+    exposes [ floatTest, divisionFn, divisionTest, intTest, constantNum, fromDep2, divDep1ByDep2 ]
+    imports [ Dep1, Dep2.{ two } ]
+
+floatTest = Float.highest
+
+divisionFn = Float.div
+
+x = 5.0
+
+divisionTest = Float.highest / x
+
+intTest = Int.highest
+
+constantNum = 5
+
+fromDep2 = Dep2.two
+
+divDep1ByDep2 = Dep1.three / fromDep2

compiler/load/tests/test_load.rs

@@ -212,7 +212,7 @@ mod test_load {
     }
 
     #[test]
-    fn load_and_typecheck_quicksort() {
+    fn iface_quicksort() {
         test_async(async {
             let subs_by_module = MutMap::default();
             let loaded_module =
@@ -229,6 +229,23 @@ mod test_load {
         });
     }
 
+    #[test]
+    fn app_quicksort() {
+        test_async(async {
+            let subs_by_module = MutMap::default();
+            let loaded_module = load_fixture("app_with_deps", "Quicksort", subs_by_module).await;
+
+            expect_types(
+                loaded_module,
+                hashmap! {
+                    "swap" => "Int, Int, List a -> List a",
+                    "partition" => "Int, Int, List (Num a) -> [ Pair Int (List (Num a)) ]",
+                    "quicksort" => "List (Num a), Int, Int -> List (Num a)",
+                },
+            );
+        });
+    }
+
     #[test]
     fn load_astar() {
         test_async(async {
@@ -266,7 +283,7 @@ mod test_load {
     }
 
     #[test]
-    fn load_dep_types() {
+    fn iface_dep_types() {
         test_async(async {
             let subs_by_module = MutMap::default();
             let loaded_module =
@@ -290,6 +307,30 @@ mod test_load {
         });
     }
 
+    #[test]
+    fn app_dep_types() {
+        test_async(async {
+            let subs_by_module = MutMap::default();
+            let loaded_module = load_fixture("app_with_deps", "Primary", subs_by_module).await;
+
+            expect_types(
+                loaded_module,
+                hashmap! {
+                    "blah2" => "Float",
+                    "blah3" => "Str",
+                    "str" => "Str",
+                    "alwaysThree" => "* -> Str",
+                    "identity" => "a -> a",
+                    "z" => "Str",
+                    "w" => "Dep1.Identity {}",
+                    "succeed" => "a -> Dep1.Identity a",
+                    "yay" => "Res.Res {} err",
+                    "withDefault" => "Res.Res a *, a -> a",
+                },
+            );
+        });
+    }
+
     #[test]
     fn imported_dep_regression() {
         test_async(async {