Merge pull request #269 from gren-lang/breaking-changes

Breaking changes

builder/src/Deps/Solver.hs

@@ -249,15 +249,10 @@ addVersion reportKey (Goals rootPlatform pending solved) name source =
     if C.goodGren gren
       then
         if Platform.compatible rootPlatform platform
-          then
-            if any PossibleFilePath.is deps
-              then
-                solverError $
-                  Exit.SolverTransientLocalDep name
-              else do
-                depsConstraintSources <- Map.traverseWithKey resolveToConstraintSource deps
-                newPending <- foldM (addConstraint name solved) pending (Map.toList depsConstraintSources)
-                return (Goals rootPlatform newPending (Map.insert name source solved))
+          then do
+            depsConstraintSources <- Map.traverseWithKey resolveToConstraintSource deps
+            newPending <- foldM (addConstraint name solved) pending (Map.toList depsConstraintSources)
+            return (Goals rootPlatform newPending (Map.insert name source solved))
           else
             solverError $
               Exit.SolverIncompatiblePlatforms name rootPlatform platform
@@ -268,26 +263,49 @@ addConstraint sourcePkg solved unsolved (name, newConstraintSource) =
   let newConstraint = constraintFromCS newConstraintSource
    in case Map.lookup name solved of
         Just solvedConstraintSource ->
-          let solvedVersion = C.lowerBound $ constraintFromCS solvedConstraintSource
-           in if C.satisfies newConstraint solvedVersion
-                then return unsolved
-                else
-                  solverError $
-                    Exit.SolverIncompatibleSolvedVersion sourcePkg name newConstraint solvedVersion
+          if not $ compatibleConstraintSources solvedConstraintSource newConstraintSource
+            then
+              solverError $
+                Exit.SolverTransientLocalDep sourcePkg name
+            else
+              let solvedVersion = C.lowerBound $ constraintFromCS solvedConstraintSource
+               in if C.satisfies newConstraint solvedVersion
+                    then return unsolved
+                    else
+                      solverError $
+                        Exit.SolverIncompatibleSolvedVersion sourcePkg name newConstraint solvedVersion
         Nothing ->
           case Map.lookup name unsolved of
             Nothing ->
               return $ Map.insert name newConstraintSource unsolved
             Just oldConstraintSource ->
-              let oldConstraint = constraintFromCS oldConstraintSource
-               in case C.intersect oldConstraint newConstraint of
-                    Nothing ->
-                      solverError $
-                        Exit.SolverIncompatibleVersionRanges sourcePkg name oldConstraint newConstraint
-                    Just mergedConstraint ->
-                      if oldConstraint == mergedConstraint
-                        then return unsolved
-                        else return (Map.insert name (setConstraintInCS mergedConstraint newConstraintSource) unsolved)
+              if not $ compatibleConstraintSources oldConstraintSource newConstraintSource
+                then
+                  solverError $
+                    Exit.SolverTransientLocalDep sourcePkg name
+                else
+                  let oldConstraint = constraintFromCS oldConstraintSource
+                   in case C.intersect oldConstraint newConstraint of
+                        Nothing ->
+                          solverError $
+                            Exit.SolverIncompatibleVersionRanges sourcePkg name oldConstraint newConstraint
+                        Just mergedConstraint ->
+                          if oldConstraint == mergedConstraint
+                            then return unsolved
+                            else return (Map.insert name (setConstraintInCS mergedConstraint newConstraintSource) unsolved)
+
+compatibleConstraintSources :: ConstraintSource -> ConstraintSource -> Bool
+compatibleConstraintSources a b =
+  case (a, b) of
+    (Local _ aPath, Local _ bPath) ->
+      aPath == bPath
+    (Remote _, Remote _) ->
+      True
+    (Remote _, Local _ _) ->
+      False
+    (Local _ _, Remote _) ->
+      -- Application is allowed to override
+      True
 
 -- GET CONSTRAINTS
 

builder/src/Generate.hs

@@ -1,8 +1,7 @@
 {-# LANGUAGE BangPatterns #-}
 
 module Generate
-  ( debug,
-    dev,
+  ( dev,
     prod,
     repl,
   )
@@ -22,9 +21,7 @@ import Directories qualified as Dirs
 import File qualified
 import Generate.JavaScript qualified as JS
 import Generate.Mode qualified as Mode
-import Gren.Compiler.Type.Extract qualified as Extract
 import Gren.Details qualified as Details
-import Gren.Interface qualified as I
 import Gren.ModuleName qualified as ModuleName
 import Gren.Package qualified as Pkg
 import Nitpick.Debug qualified as Nitpick
@@ -37,22 +34,11 @@ import Prelude hiding (cycle, print)
 type Task a =
   Task.Task Exit.Generate a
 
-debug :: FilePath -> Details.Details -> Build.Artifacts -> Task JS.GeneratedResult
-debug root details (Build.Artifacts pkg ifaces roots modules) =
-  do
-    loading <- loadObjects root details modules
-    types <- loadTypes root ifaces modules
-    objects <- finalizeObjects loading
-    let mode = Mode.Dev (Just types)
-    let graph = objectsToGlobalGraph objects
-    let mains = gatherMains pkg objects roots
-    return $ JS.generate mode graph mains
-
 dev :: FilePath -> Details.Details -> Build.Artifacts -> Task JS.GeneratedResult
 dev root details (Build.Artifacts pkg _ roots modules) =
   do
     objects <- finalizeObjects =<< loadObjects root details modules
-    let mode = Mode.Dev Nothing
+    let mode = Mode.Dev
     let graph = objectsToGlobalGraph objects
     let mains = gatherMains pkg objects roots
     return $ JS.generate mode graph mains
@@ -144,38 +130,3 @@ finalizeObjects (LoadingObjects mvar mvars) =
 objectsToGlobalGraph :: Objects -> Opt.GlobalGraph
 objectsToGlobalGraph (Objects globals locals) =
   foldr Opt.addLocalGraph globals locals
-
--- LOAD TYPES
-
-loadTypes :: FilePath -> Map.Map ModuleName.Canonical I.DependencyInterface -> [Build.Module] -> Task Extract.Types
-loadTypes root ifaces modules =
-  Task.eio id $
-    do
-      mvars <- traverse (loadTypesHelp root) modules
-      let !foreigns = Extract.mergeMany (Map.elems (Map.mapWithKey Extract.fromDependencyInterface ifaces))
-      results <- traverse readMVar mvars
-      case sequence results of
-        Just ts -> return (Right (Extract.merge foreigns (Extract.mergeMany ts)))
-        Nothing -> return (Left Exit.GenerateCannotLoadArtifacts)
-
-loadTypesHelp :: FilePath -> Build.Module -> IO (MVar (Maybe Extract.Types))
-loadTypesHelp root modul =
-  case modul of
-    Build.Fresh name iface _ ->
-      newMVar (Just (Extract.fromInterface name iface))
-    Build.Cached name _ ciMVar ->
-      do
-        cachedInterface <- readMVar ciMVar
-        case cachedInterface of
-          Build.Unneeded ->
-            do
-              mvar <- newEmptyMVar
-              _ <- forkIO $
-                do
-                  maybeIface <- File.readBinary (Dirs.greni root name)
-                  putMVar mvar (Extract.fromInterface name <$> maybeIface)
-              return mvar
-          Build.Loaded iface ->
-            newMVar (Just (Extract.fromInterface name iface))
-          Build.Corrupted ->
-            newMVar Nothing

builder/src/Reporting/Exit.hs

@@ -1088,7 +1088,7 @@ data Solver
   | SolverBadLocalDepExpectedPkg FilePath Pkg.Name
   | SolverBadLocalDepInvalidGrenJson FilePath Pkg.Name
   | SolverLocalDepNotFound FilePath Pkg.Name
-  | SolverTransientLocalDep Pkg.Name
+  | SolverTransientLocalDep Pkg.Name Pkg.Name
   | SolverBadGitOperationUnversionedPkg Pkg.Name Git.Error
   | SolverBadGitOperationVersionedPkg Pkg.Name V.Version Git.Error
   | SolverIncompatibleSolvedVersion Pkg.Name Pkg.Name C.Constraint V.Version
@@ -1170,16 +1170,23 @@ toSolverReport problem =
         [ D.reflow
             "Verify that the path is correct."
         ]
-    SolverTransientLocalDep pkgName ->
+    SolverTransientLocalDep pkgName depName ->
       Help.report
         "PROBLEM SOLVING PACKAGE CONSTRAINTS"
         Nothing
         ( Pkg.toChars pkgName
-            ++ " has defined one or more local dependencies."
+            ++ " has defined a dependency on "
+            ++ Pkg.toChars depName
+            ++ " with an incompatible source."
         )
-        [ D.reflow
-            "Dependencies are not allowed to define their own local dependencies. Contact the package \
-            \author to resolve this issue."
+        [ D.reflow $
+            "This could mean that your application has specified "
+              ++ Pkg.toChars depName
+              ++ " as a versioned dependency while "
+              ++ Pkg.toChars pkgName
+              ++ " has defined it as a local dependency. It could also mean that "
+              ++ " the package has been defined as a local dependency in both places, but"
+              ++ " with different paths."
         ]
     SolverBadGitOperationUnversionedPkg pkg gitError ->
       toGitErrorReport "PROBLEM SOLVING PACKAGE CONSTRAINTS" gitError $
@@ -2023,8 +2030,8 @@ toDetailsReport details =
                 "I ran into a compilation error when trying to build the following package:"
                 [ D.indent 4 $ D.red $ D.fromChars $ Pkg.toChars pkg ++ " " ++ V.toChars vsn,
                   D.reflow
-                    "This package contains kernel code which has not been signed by the lead\
-                    \ developer of Gren. Kernel code can violate all the guarantees that Gren\
+                    "This package contains kernel code which has not been signed by Gren's core\
+                    \ team. Kernel code can violate all the guarantees that Gren\
                     \ provide, and is therefore carefully managed.",
                   D.toSimpleNote $
                     "To help with the root problem, please report this to the package author."
@@ -2102,7 +2109,6 @@ toGitErrorReport title err context =
 
 data Make
   = MakeNoOutline
-  | MakeCannotOptimizeAndDebug
   | MakeCannotOutputForPackage
   | MakeCannotOutputMainForPackage ModuleName.Raw [ModuleName.Raw]
   | MakeBadDetails Details
@@ -2128,29 +2134,6 @@ makeToReport make =
           D.reflow $
             "It will help you get set up. It is really simple!"
         ]
-    MakeCannotOptimizeAndDebug ->
-      Help.docReport
-        "CLASHING FLAGS"
-        Nothing
-        ( D.fillSep
-            [ "I",
-              "cannot",
-              "compile",
-              "with",
-              D.red "--optimize",
-              "and",
-              D.red "--debug",
-              "at",
-              "the",
-              "same",
-              "time."
-            ]
-        )
-        [ D.reflow
-            "I need to take away information to optimize things, and I need to\
-            \ add information to add the debugger. It is impossible to do both\
-            \ at once though! Pick just one of those flags and it should work!"
-        ]
     MakeCannotOutputForPackage ->
       Help.docReport
         "IMPOSSIBLE TO PRODUCE OUTPUT FOR A PACKAGE"

compiler/src/Canonicalize/Environment/Local.hs

@@ -250,11 +250,14 @@ canonicalizeUnion env@(Env.Env home _ _ _ _ _ _ _) (A.At _ (Src.Union (A.At _ na
 
 canonicalizeCtor :: Env.Env -> Index.ZeroBased -> Src.UnionVariant -> Result i w (A.Located Can.Ctor)
 canonicalizeCtor env index (_, A.At region ctor, tipes, _) =
-  do
-    ctipes <- traverse (Type.canonicalize env) (fmap snd tipes)
-    Result.ok $
-      A.At region $
-        Can.Ctor ctor index (length ctipes) ctipes
+  let argLength = length tipes
+   in if argLength > 1
+        then Result.throw (Error.CustomTypeTooManyParams region ctor argLength)
+        else do
+          ctipes <- traverse (Type.canonicalize env) (fmap snd tipes)
+          Result.ok $
+            A.At region $
+              Can.Ctor ctor index (length ctipes) ctipes
 
 toOpts :: [Src.UnionVariant] -> Can.CtorOpts
 toOpts ctors =

compiler/src/Generate/JavaScript.hs

@@ -102,7 +102,7 @@ addMain mode graph home _ state =
 
 generateForRepl :: Bool -> L.Localizer -> Opt.GlobalGraph -> ModuleName.Canonical -> Name.Name -> Can.Annotation -> B.Builder
 generateForRepl ansi localizer (Opt.GlobalGraph graph _) home name (Can.Forall _ tipe) =
-  let mode = Mode.Dev Nothing
+  let mode = Mode.Dev
       debugState = addGlobal mode graph (emptyState 0) (Opt.Global ModuleName.debug "toString")
       evalState = addGlobal mode graph debugState (Opt.Global home name)
    in "process.on('uncaughtException', function(err) { process.stderr.write(err.toString() + '\\n'); process.exit(1); });"
@@ -209,9 +209,7 @@ addGlobalHelp mode graph global@(Opt.Global home _) state =
         Opt.Manager effectsType ->
           generateManager mode graph global effectsType state
         Opt.Kernel chunks deps ->
-          if isDebugger global && not (Mode.isDebug mode)
-            then state
-            else addDeps deps (addKernel state (generateKernel mode chunks))
+          addDeps deps (addKernel state (generateKernel mode chunks))
         Opt.Enum index ->
           addStmt
             state
@@ -267,10 +265,6 @@ ctor (Opt.Global home name) arity code =
           JS.Var (JsName.fromGlobal home name) $ Expr.codeToExpr (Expr.generateCurriedFunctionRef argNames directFnName)
         ]
 
-isDebugger :: Opt.Global -> Bool
-isDebugger (Opt.Global (ModuleName.Canonical _ home) _) =
-  home == Name.debugger
-
 -- GENERATE CYCLES
 
 generateCycle :: Mode.Mode -> FnArgLookup -> Opt.Global -> [Name.Name] -> [(Name.Name, Opt.Expr)] -> [Opt.Def] -> JS.Stmt
@@ -285,7 +279,7 @@ generateCycle mode argLookup (Opt.Global home _) names values functions =
           case mode of
             Mode.Prod _ ->
               JS.Block realBlock
-            Mode.Dev _ ->
+            Mode.Dev ->
               JS.Try (JS.Block realBlock) JsName.dollar $
                 JS.Throw $
                   JS.String $
@@ -364,13 +358,13 @@ addChunk mode chunk builder =
       B.intDec int <> builder
     K.Debug ->
       case mode of
-        Mode.Dev _ ->
+        Mode.Dev ->
           builder
         Mode.Prod _ ->
           "_UNUSED" <> builder
     K.Prod ->
       case mode of
-        Mode.Dev _ ->
+        Mode.Dev ->
           "_UNUSED" <> builder
         Mode.Prod _ ->
           builder
@@ -381,7 +375,7 @@ generateEnum :: Mode.Mode -> Opt.Global -> Index.ZeroBased -> JS.Stmt
 generateEnum mode global@(Opt.Global home name) index =
   JS.Var (JsName.fromGlobal home name) $
     case mode of
-      Mode.Dev _ ->
+      Mode.Dev ->
         Expr.codeToExpr (Expr.generateCtor mode global index 0)
       Mode.Prod _ ->
         JS.Int (Index.toMachine index)
@@ -392,7 +386,7 @@ generateBox :: Mode.Mode -> Opt.Global -> JS.Stmt
 generateBox mode global@(Opt.Global home name) =
   JS.Var (JsName.fromGlobal home name) $
     case mode of
-      Mode.Dev _ ->
+      Mode.Dev ->
         Expr.codeToExpr (Expr.generateCtor mode global Index.first 1)
       Mode.Prod _ ->
         JS.Ref (JsName.fromGlobal ModuleName.basics Name.identity)