Pass root platform along to all necessary stages of the solver.

builder/src/Deps/Solver.hs

@@ -19,6 +19,7 @@ where
 import Control.Monad (foldM)
 import Data.Map ((!))
 import Data.Map qualified as Map
+import Data.NonEmptyList qualified as NE
 import Deps.Package qualified as Package
 import Directories qualified as Dirs
 import File qualified
@@ -65,10 +66,14 @@ data Result a
 data Details
   = Details V.Version (Map.Map Pkg.Name C.Constraint)
 
-verify :: Dirs.PackageCache -> Map.Map Pkg.Name C.Constraint -> IO (Result (Map.Map Pkg.Name Details))
-verify cache constraints =
+verify ::
+  Dirs.PackageCache ->
+  Outline.Platform ->
+  Map.Map Pkg.Name C.Constraint ->
+  IO (Result (Map.Map Pkg.Name Details))
+verify cache rootPlatform constraints =
   Dirs.withRegistryLock cache $
-    case try constraints of
+    case try rootPlatform constraints of
       Solver solver ->
         solver
           (State cache Map.empty)
@@ -90,13 +95,20 @@ data AppSolution = AppSolution
     _app :: Outline.AppOutline
   }
 
-addToApp :: Dirs.PackageCache -> Pkg.Name -> V.Version -> Outline.AppOutline -> IO (Result AppSolution)
-addToApp cache pkg compatibleVsn outline@(Outline.AppOutline _ _ _ direct indirect) =
+addToApp ::
+  Dirs.PackageCache ->
+  Pkg.Name ->
+  V.Version ->
+  Outline.AppOutline ->
+  IO (Result AppSolution)
+addToApp cache pkg compatibleVsn outline@(Outline.AppOutline _ rootPlatform _ direct indirect) =
   Dirs.withRegistryLock cache $
     let allDeps = Map.union direct indirect
 
         attempt toConstraint deps =
-          try (Map.insert pkg (C.untilNextMajor compatibleVsn) (Map.map toConstraint deps))
+          try
+            rootPlatform
+            (Map.insert pkg (C.untilNextMajor compatibleVsn) (Map.map toConstraint deps))
      in case oneOf
           (attempt C.exactly allDeps)
           [ attempt C.exactly direct,
@@ -133,37 +145,38 @@ getTransitive constraints solution unvisited visited =
 
 -- TRY
 
-try :: Map.Map Pkg.Name C.Constraint -> Solver (Map.Map Pkg.Name V.Version)
-try constraints =
-  exploreGoals (Goals constraints Map.empty)
+try :: Outline.Platform -> Map.Map Pkg.Name C.Constraint -> Solver (Map.Map Pkg.Name V.Version)
+try rootPlatform constraints =
+  exploreGoals (Goals (NE.List rootPlatform []) constraints Map.empty)
 
 -- EXPLORE GOALS
 
 data Goals = Goals
-  { _pending :: Map.Map Pkg.Name C.Constraint,
+  { _compatible_platforms :: NE.List Outline.Platform,
+    _pending :: Map.Map Pkg.Name C.Constraint,
     _solved :: Map.Map Pkg.Name V.Version
   }
 
 exploreGoals :: Goals -> Solver (Map.Map Pkg.Name V.Version)
-exploreGoals (Goals pending solved) =
+exploreGoals (Goals compatiblePlatforms pending solved) =
   case Map.minViewWithKey pending of
     Nothing ->
       return solved
     Just ((name, constraint), otherPending) ->
       do
-        let goals1 = Goals otherPending solved
+        let goals1 = Goals compatiblePlatforms otherPending solved
         let lowestVersion = C.lowerBound constraint
         goals2 <- addVersion goals1 name lowestVersion
         exploreGoals goals2
 
 addVersion :: Goals -> Pkg.Name -> V.Version -> Solver Goals
-addVersion (Goals pending solved) name version =
+addVersion (Goals compatiblePlatforms pending solved) name version =
   do
     (Constraints gren deps) <- getConstraints name version
     if C.goodGren gren
       then do
         newPending <- foldM (addConstraint solved) pending (Map.toList deps)
-        return (Goals newPending (Map.insert name version solved))
+        return (Goals compatiblePlatforms newPending (Map.insert name version solved))
       else backtrack
 
 addConstraint :: Map.Map Pkg.Name V.Version -> Map.Map Pkg.Name C.Constraint -> (Pkg.Name, C.Constraint) -> Solver (Map.Map Pkg.Name C.Constraint)

builder/src/Gren/Details.hs

@@ -184,21 +184,21 @@ initEnv key scope root =
 type Task a = Task.Task Exit.Details a
 
 verifyPkg :: Env -> File.Time -> Outline.PkgOutline -> Task Details
-verifyPkg env time (Outline.PkgOutline pkg _ _ _ exposed direct gren _) =
+verifyPkg env time (Outline.PkgOutline pkg _ _ _ exposed direct gren rootPlatform) =
   if Con.goodGren gren
     then do
-      solution <- verifyConstraints env (Map.map (Con.exactly . Con.lowerBound) direct)
+      solution <- verifyConstraints env rootPlatform (Map.map (Con.exactly . Con.lowerBound) direct)
       let exposedList = Outline.flattenExposed exposed
       let exactDeps = Map.map (\(Solver.Details v _) -> v) solution -- for pkg docs in reactor
       verifyDependencies env time (ValidPkg pkg exposedList exactDeps) solution direct
     else Task.throw $ Exit.DetailsBadGrenInPkg gren
 
 verifyApp :: Env -> File.Time -> Outline.AppOutline -> Task Details
-verifyApp env time outline@(Outline.AppOutline grenVersion _ srcDirs direct _) =
+verifyApp env time outline@(Outline.AppOutline grenVersion rootPlatform srcDirs direct _) =
   if grenVersion == V.compiler
     then do
       stated <- checkAppDeps outline
-      actual <- verifyConstraints env (Map.map Con.exactly stated)
+      actual <- verifyConstraints env rootPlatform (Map.map Con.exactly stated)
       if Map.size stated == Map.size actual
         then verifyDependencies env time (ValidApp srcDirs) actual direct
         else Task.throw Exit.DetailsHandEditedDependencies
@@ -210,10 +210,14 @@ checkAppDeps (Outline.AppOutline _ _ _ direct indirect) =
 
 -- VERIFY CONSTRAINTS
 
-verifyConstraints :: Env -> Map.Map Pkg.Name Con.Constraint -> Task (Map.Map Pkg.Name Solver.Details)
-verifyConstraints (Env _ _ _ cache) constraints =
+verifyConstraints ::
+  Env ->
+  Outline.Platform ->
+  Map.Map Pkg.Name Con.Constraint ->
+  Task (Map.Map Pkg.Name Solver.Details)
+verifyConstraints (Env _ _ _ cache) rootPlatform constraints =
   do
-    result <- Task.io $ Solver.verify cache constraints
+    result <- Task.io $ Solver.verify cache rootPlatform constraints
     case result of
       Solver.Ok details -> return details
       Solver.NoSolution -> Task.throw $ Exit.DetailsNoSolution

terminal/src/Init.hs

@@ -84,7 +84,8 @@ init flags =
       Left (DPkg.GitError gitError) ->
         return $ Left $ Exit.InitNoCompatibleDependencies $ Just gitError
       Right deps -> do
-        result <- Solver.verify cache deps
+        -- TODO: Make root platform customizable
+        result <- Solver.verify cache Outline.Browser deps
         case result of
           Solver.Err exit ->
             return (Left (Exit.InitSolverProblem exit))

terminal/src/Install.hs

@@ -213,7 +213,7 @@ makeAppPlan (Solver.Env cache) pkg outline@(Outline.AppOutline _ _ _ direct indi
 -- MAKE PACKAGE PLAN
 
 makePkgPlan :: Solver.Env -> Pkg.Name -> Outline.PkgOutline -> Task (Changes C.Constraint)
-makePkgPlan (Solver.Env cache) pkg outline@(Outline.PkgOutline _ _ _ _ _ deps _ _) =
+makePkgPlan (Solver.Env cache) pkg outline@(Outline.PkgOutline _ _ _ _ _ deps _ rootPlatform) =
   if Map.member pkg deps
     then return AlreadyInstalled
     else do
@@ -231,7 +231,7 @@ makePkgPlan (Solver.Env cache) pkg outline@(Outline.PkgOutline _ _ _ _ _ deps _
         Right compatibleVersion -> do
           let old = deps
           let cons = Map.insert pkg (C.untilNextMajor compatibleVersion) old
-          result <- Task.io $ Solver.verify cache cons
+          result <- Task.io $ Solver.verify cache rootPlatform cons
           case result of
             Solver.Ok solution ->
               let (Solver.Details vsn _) = solution ! pkg