diff --git a/builder/src/Deps/Solver.hs b/builder/src/Deps/Solver.hs index e26f82562..9931ba060 100644 --- a/builder/src/Deps/Solver.hs +++ b/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.Maybe qualified as Maybe import Deps.Package qualified as Package import Directories qualified as Dirs import File qualified @@ -26,10 +27,13 @@ import Gren.Constraint qualified as C import Gren.Outline qualified as Outline import Gren.Package qualified as Pkg import Gren.Platform qualified as Platform +import Gren.PossibleFilePath (PossibleFilePath) +import Gren.PossibleFilePath qualified as PossibleFilePath import Gren.Version qualified as V import Json.Decode qualified as D import Reporting qualified import Reporting.Exit qualified as Exit +import System.Directory qualified as Dir import System.FilePath (()) -- SOLVER @@ -52,7 +56,7 @@ data State = State data Constraints = Constraints { _gren :: C.Constraint, _platform :: Platform.Platform, - _deps :: Map.Map Pkg.Name C.Constraint + _deps :: Map.Map Pkg.Name (PossibleFilePath C.Constraint) } -- RESULT @@ -65,13 +69,13 @@ data Result a -- VERIFY -- used by Gren.Details data Details - = Details V.Version (Map.Map Pkg.Name C.Constraint) + = Details V.Version (Maybe FilePath) (Map.Map Pkg.Name (PossibleFilePath C.Constraint)) verify :: Reporting.DKey -> Dirs.PackageCache -> Platform.Platform -> - Map.Map Pkg.Name C.Constraint -> + Map.Map Pkg.Name (PossibleFilePath C.Constraint) -> IO (Result (Map.Map Pkg.Name Details)) verify key cache rootPlatform constraints = Dirs.withRegistryLock cache $ @@ -83,17 +87,18 @@ verify key cache rootPlatform constraints = (\_ -> return NoSolution) (\e -> return $ Err e) -addDeps :: State -> Pkg.Name -> V.Version -> Details -addDeps (State _ constraints) name vsn = - case Map.lookup (name, vsn) constraints of - Just (Constraints _ _ deps) -> Details vsn deps - Nothing -> error "compiler bug manifesting in Deps.Solver.addDeps" +addDeps :: State -> Pkg.Name -> ConstraintSource -> Details +addDeps (State _ constraints) name constraintSource = + let vsn = C.lowerBound $ constraintFromCS constraintSource + in case Map.lookup (name, vsn) constraints of + Just (Constraints _ _ deps) -> Details vsn (filePathFromCS constraintSource) deps + Nothing -> error "compiler bug manifesting in Deps.Solver.addDeps" -- ADD TO APP - used in Install data AppSolution = AppSolution - { _old :: Map.Map Pkg.Name V.Version, - _new :: Map.Map Pkg.Name V.Version, + { _old :: Map.Map Pkg.Name (PossibleFilePath V.Version), + _new :: Map.Map Pkg.Name (PossibleFilePath V.Version), _app :: Outline.AppOutline } @@ -108,11 +113,13 @@ addToApp key cache pkg compatibleVsn outline@(Outline.AppOutline _ rootPlatform Dirs.withRegistryLock cache $ let allDeps = Map.union direct indirect + insertableVsn = PossibleFilePath.Other (C.untilNextMajor compatibleVsn) + attempt toConstraint deps = try key rootPlatform - (Map.insert pkg (C.untilNextMajor compatibleVsn) (Map.map toConstraint deps)) + (Map.insert pkg insertableVsn (Map.map (PossibleFilePath.mapWith toConstraint) deps)) in case oneOf (attempt C.exactly allDeps) [ attempt C.exactly direct, @@ -126,95 +133,159 @@ addToApp key cache pkg compatibleVsn outline@(Outline.AppOutline _ rootPlatform (\_ -> return $ NoSolution) (\e -> return $ Err e) -toApp :: State -> Pkg.Name -> Outline.AppOutline -> Map.Map Pkg.Name V.Version -> Map.Map Pkg.Name V.Version -> AppSolution +toApp :: State -> Pkg.Name -> Outline.AppOutline -> Map.Map Pkg.Name (PossibleFilePath V.Version) -> Map.Map Pkg.Name ConstraintSource -> AppSolution toApp (State _ constraints) pkg (Outline.AppOutline gren platform srcDirs direct _) old new = - let d = Map.intersection new (Map.insert pkg V.one direct) - i = Map.difference (getTransitive constraints new (Map.toList d) Map.empty) d - in AppSolution old new (Outline.AppOutline gren platform srcDirs d i) - -getTransitive :: Map.Map (Pkg.Name, V.Version) Constraints -> Map.Map Pkg.Name V.Version -> [(Pkg.Name, V.Version)] -> Map.Map Pkg.Name V.Version -> Map.Map Pkg.Name V.Version + let newAsPFPs = Map.map constraintToFilePath new + d = Map.intersection newAsPFPs (Map.insert pkg (PossibleFilePath.Other V.one) direct) + dCSs = filter (\(pkgName, _) -> Map.member pkgName d) $ Map.toList new + i = Map.map constraintToFilePath $ Map.difference (getTransitive constraints new dCSs Map.empty) d + in AppSolution old newAsPFPs (Outline.AppOutline gren platform srcDirs d i) + +constraintToFilePath :: ConstraintSource -> PossibleFilePath V.Version +constraintToFilePath cs = + case cs of + Local _ fp -> PossibleFilePath.Is fp + Remote con -> PossibleFilePath.Other $ C.lowerBound con + +getTransitive :: Map.Map (Pkg.Name, V.Version) Constraints -> Map.Map Pkg.Name ConstraintSource -> [(Pkg.Name, ConstraintSource)] -> Map.Map Pkg.Name ConstraintSource -> Map.Map Pkg.Name ConstraintSource getTransitive constraints solution unvisited visited = case unvisited of [] -> visited - info@(pkg, vsn) : infos -> + (pkg, cs) : infos -> if Map.member pkg visited then getTransitive constraints solution infos visited else - let newDeps = _deps (constraints ! info) + let vsn = C.lowerBound $ constraintFromCS cs + newDeps = _deps (constraints ! (pkg, vsn)) newUnvisited = Map.toList (Map.intersection solution (Map.difference newDeps visited)) - newVisited = Map.insert pkg vsn visited + newVisited = Map.insert pkg cs visited in getTransitive constraints solution infos $ getTransitive constraints solution newUnvisited newVisited +-- CONSTRAINT SOURCE + +data ConstraintSource + = Remote C.Constraint + | Local C.Constraint FilePath + +-- TODO: Avoid re-reading the gren.json for local dependencies +resolveToConstraintSource :: Pkg.Name -> PossibleFilePath C.Constraint -> Solver ConstraintSource +resolveToConstraintSource pkgName possibleFP = + Solver $ \state ok back err -> + case possibleFP of + PossibleFilePath.Other cons -> + ok state (Remote cons) back + PossibleFilePath.Is fp -> + do + outlineExists <- Dir.doesDirectoryExist fp + if outlineExists + then do + let outlinePath = fp "gren.json" + bytes <- File.readUtf8 outlinePath + case D.fromByteString Outline.decoder bytes of + Right (Outline.Pkg (Outline.PkgOutline _ _ _ version _ _ _ _)) -> + ok state (Local (C.exactly version) fp) back + Right _ -> + err $ Exit.SolverBadLocalDep pkgName fp + Left _ -> + err $ Exit.SolverBadLocalDep pkgName fp + else err $ Exit.SolverBadLocalDep pkgName fp + +constraintFromCS :: ConstraintSource -> C.Constraint +constraintFromCS source = + case source of + Remote c -> c + Local c _ -> c + +setConstraintInCS :: C.Constraint -> ConstraintSource -> ConstraintSource +setConstraintInCS newCons source = + case source of + Remote _ -> Remote newCons + Local _ fp -> Local newCons fp + +filePathFromCS :: ConstraintSource -> Maybe FilePath +filePathFromCS source = + case source of + Remote _ -> Nothing + Local _ fp -> Just fp + -- TRY -try :: Reporting.DKey -> Platform.Platform -> Map.Map Pkg.Name C.Constraint -> Solver (Map.Map Pkg.Name V.Version) +try :: Reporting.DKey -> Platform.Platform -> Map.Map Pkg.Name (PossibleFilePath C.Constraint) -> Solver (Map.Map Pkg.Name ConstraintSource) try key rootPlatform constraints = - exploreGoals key (Goals rootPlatform constraints Map.empty) + do + constraintSources <- Map.traverseWithKey resolveToConstraintSource constraints + exploreGoals key (Goals rootPlatform constraintSources Map.empty) -- EXPLORE GOALS data Goals = Goals { _root_platform :: Platform.Platform, - _pending :: Map.Map Pkg.Name C.Constraint, - _solved :: Map.Map Pkg.Name V.Version + _pending :: Map.Map Pkg.Name ConstraintSource, + _solved :: Map.Map Pkg.Name ConstraintSource } -exploreGoals :: Reporting.DKey -> Goals -> Solver (Map.Map Pkg.Name V.Version) +exploreGoals :: Reporting.DKey -> Goals -> Solver (Map.Map Pkg.Name ConstraintSource) exploreGoals key (Goals rootPlatform pending solved) = case Map.minViewWithKey pending of Nothing -> return solved - Just ((name, constraint), otherPending) -> + Just ((name, constraintSource), otherPending) -> do let goals1 = Goals rootPlatform otherPending solved - let lowestVersion = C.lowerBound constraint - goals2 <- addVersion key goals1 name lowestVersion + goals2 <- addVersion key goals1 name constraintSource exploreGoals key goals2 -addVersion :: Reporting.DKey -> Goals -> Pkg.Name -> V.Version -> Solver Goals -addVersion reportKey (Goals rootPlatform pending solved) name version = +addVersion :: Reporting.DKey -> Goals -> Pkg.Name -> ConstraintSource -> Solver Goals +addVersion reportKey (Goals rootPlatform pending solved) name source = do - (Constraints gren platform deps) <- getConstraints reportKey name version + let constraint = constraintFromCS source + let lowestVersion = C.lowerBound constraint + let maybeFilePath = filePathFromCS source + (Constraints gren platform deps) <- getConstraints reportKey name lowestVersion maybeFilePath if C.goodGren gren then if Platform.compatible rootPlatform platform then do - newPending <- foldM (addConstraint name solved) pending (Map.toList deps) - return (Goals rootPlatform newPending (Map.insert name version solved)) + 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 else backtrack -addConstraint :: Pkg.Name -> Map.Map Pkg.Name V.Version -> Map.Map Pkg.Name C.Constraint -> (Pkg.Name, C.Constraint) -> Solver (Map.Map Pkg.Name C.Constraint) -addConstraint sourcePkg solved unsolved (name, newConstraint) = - case Map.lookup name solved of - Just version -> - if C.satisfies newConstraint version - then return unsolved - else - solverError $ - Exit.SolverIncompatibleSolvedVersion sourcePkg name newConstraint version - Nothing -> - case Map.lookup name unsolved of +addConstraint :: Pkg.Name -> Map.Map Pkg.Name ConstraintSource -> Map.Map Pkg.Name ConstraintSource -> (Pkg.Name, ConstraintSource) -> Solver (Map.Map Pkg.Name ConstraintSource) +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 Nothing -> - return $ Map.insert name newConstraint unsolved - Just oldConstraint -> - case C.intersect oldConstraint newConstraint of + case Map.lookup name unsolved of Nothing -> - solverError $ - Exit.SolverIncompatibleVersionRanges sourcePkg name oldConstraint newConstraint - Just mergedConstraint -> - if oldConstraint == mergedConstraint - then return unsolved - else return (Map.insert name mergedConstraint unsolved) + 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) -- GET CONSTRAINTS -getConstraints :: Reporting.DKey -> Pkg.Name -> V.Version -> Solver Constraints -getConstraints reportKey pkg vsn = +getConstraints :: Reporting.DKey -> Pkg.Name -> V.Version -> Maybe FilePath -> Solver Constraints +getConstraints reportKey pkg vsn maybeFilePath = Solver $ \state@(State cache cDict) ok back err -> do let key = (pkg, vsn) @@ -223,11 +294,13 @@ getConstraints reportKey pkg vsn = ok state cs back Nothing -> do - isPackageInCache <- Package.isPackageInCache cache pkg vsn - if isPackageInCache + let packageCachePath = Dirs.package cache pkg vsn + let path = Maybe.fromMaybe packageCachePath maybeFilePath + isPackageOnDisk <- Dir.doesDirectoryExist path + if isPackageOnDisk then do Reporting.report reportKey Reporting.DCached - constraintsDecodeResult <- getConstraintsHelper cache pkg vsn + constraintsDecodeResult <- getConstraintsHelper path pkg vsn case constraintsDecodeResult of Left exitMsg -> err exitMsg @@ -243,17 +316,17 @@ getConstraints reportKey pkg vsn = err $ Exit.SolverBadGitOperationVersionedPkg pkg vsn gitErr Right () -> do Reporting.report reportKey $ Reporting.DReceived pkg vsn - constraintsDecodeResult <- getConstraintsHelper cache pkg vsn + constraintsDecodeResult <- getConstraintsHelper packageCachePath pkg vsn case constraintsDecodeResult of Left exitMsg -> err exitMsg Right cs -> ok (State cache (Map.insert key cs cDict)) cs back -getConstraintsHelper :: Dirs.PackageCache -> Pkg.Name -> V.Version -> IO (Either Exit.Solver Constraints) -getConstraintsHelper cache pkg vsn = +getConstraintsHelper :: FilePath -> Pkg.Name -> V.Version -> IO (Either Exit.Solver Constraints) +getConstraintsHelper projectRoot pkg vsn = do - let path = Dirs.package cache pkg vsn "gren.json" + let path = projectRoot "gren.json" bytes <- File.readUtf8 path case D.fromByteString constraintsDecoder bytes of Right cs -> diff --git a/builder/src/Directories.hs b/builder/src/Directories.hs index 0192c0bf1..bf21425dd 100644 --- a/builder/src/Directories.hs +++ b/builder/src/Directories.hs @@ -4,10 +4,8 @@ module Directories ( details, interfaces, objects, - prepublishDir, greni, greno, - temp, findRoot, withRootLock, withRegistryLock, @@ -46,10 +44,6 @@ objects :: FilePath -> FilePath objects root = projectCache root "o.dat" -prepublishDir :: FilePath -> FilePath -prepublishDir root = - projectCache root "prepublish" - compilerVersion :: FilePath compilerVersion = V.toChars V.compiler @@ -68,12 +62,6 @@ toArtifactPath :: FilePath -> ModuleName.Raw -> String -> FilePath toArtifactPath root name ext = projectCache root ModuleName.toHyphenPath name <.> ext --- TEMP - -temp :: FilePath -> String -> FilePath -temp root ext = - projectCache root "temp" <.> ext - -- ROOT findRoot :: IO (Maybe FilePath) diff --git a/builder/src/Gren/Details.hs b/builder/src/Gren/Details.hs index bc1132695..226e8b503 100644 --- a/builder/src/Gren/Details.hs +++ b/builder/src/Gren/Details.hs @@ -45,6 +45,8 @@ import Gren.Outline qualified as Outline import Gren.Package qualified as Pkg import Gren.Platform qualified as P import Gren.Platform qualified as Platform +import Gren.PossibleFilePath (PossibleFilePath) +import Gren.PossibleFilePath qualified as PossibleFilePath import Gren.Version qualified as V import Json.Encode qualified as E import Parse.Module qualified as Parse @@ -190,45 +192,45 @@ verifyPkg env@(Env reportKey _ _ _) time (Outline.PkgOutline pkg _ _ _ exposed d if Con.goodGren gren then do _ <- Task.io $ Reporting.report reportKey $ Reporting.DStart $ Map.size direct - solution <- verifyConstraints env rootPlatform (Map.map (Con.exactly . Con.lowerBound) direct) + solution <- + verifyConstraints + env + rootPlatform + (Map.map (PossibleFilePath.mapWith (Con.exactly . Con.lowerBound)) direct) let exposedList = Outline.flattenExposed exposed verifyDependencies env time (ValidPkg rootPlatform pkg exposedList) solution direct else Task.throw $ Exit.DetailsBadGrenInPkg gren verifyApp :: Env -> File.Time -> Outline.AppOutline -> Task Details -verifyApp env@(Env reportKey _ _ _) time outline@(Outline.AppOutline grenVersion rootPlatform srcDirs direct _) = +verifyApp env@(Env reportKey _ _ _) time (Outline.AppOutline grenVersion rootPlatform srcDirs direct indirect) = if grenVersion == V.compiler then do - stated <- checkAppDeps outline + stated <- union noDups direct indirect _ <- Task.io $ Reporting.report reportKey $ Reporting.DStart (Map.size stated) - actual <- verifyConstraints env rootPlatform (Map.map Con.exactly stated) + actual <- verifyConstraints env rootPlatform (Map.map (PossibleFilePath.mapWith Con.exactly) stated) if Map.size stated == Map.size actual then verifyDependencies env time (ValidApp rootPlatform srcDirs) actual direct else - let actualVersions = Map.map (\(Solver.Details vsn _) -> vsn) actual + let actualVersions = Map.map (\(Solver.Details vsn _ _) -> vsn) actual in Task.throw $ Exit.DetailsMissingDeps $ Map.toList $ Map.difference actualVersions stated else Task.throw $ Exit.DetailsBadGrenInAppOutline grenVersion -checkAppDeps :: Outline.AppOutline -> Task (Map.Map Pkg.Name V.Version) -checkAppDeps (Outline.AppOutline _ _ _ direct indirect) = - union noDups direct indirect - -- VERIFY CONSTRAINTS verifyConstraints :: Env -> Platform.Platform -> - Map.Map Pkg.Name Con.Constraint -> + Map.Map Pkg.Name (PossibleFilePath Con.Constraint) -> Task (Map.Map Pkg.Name Solver.Details) verifyConstraints (Env reportKey _ _ cache) rootPlatform constraints = do result <- Task.io $ Solver.verify reportKey cache rootPlatform constraints case result of Solver.Ok details -> return details - Solver.NoSolution -> Task.throw $ Exit.DetailsNoSolution + Solver.NoSolution -> Task.throw Exit.DetailsNoSolution Solver.Err exit -> Task.throw $ Exit.DetailsSolverProblem exit -- UNION @@ -314,9 +316,9 @@ type Dep = Either (Maybe Exit.DetailsBadDep) Artifacts verifyDep :: Env -> MVar (Map.Map Pkg.Name (MVar Dep)) -> Map.Map Pkg.Name Solver.Details -> Pkg.Name -> Solver.Details -> IO Dep -verifyDep (Env key _ _ cache) depsMVar solution pkg details@(Solver.Details vsn directDeps) = +verifyDep (Env key _ _ cache) depsMVar solution pkg details@(Solver.Details vsn _ directDeps) = do - let fingerprint = Map.intersectionWith (\(Solver.Details v _) _ -> v) solution directDeps + let fingerprint = Map.intersectionWith (\(Solver.Details v _ _) _ -> v) solution directDeps maybeCache <- File.readBinary (Dirs.package cache pkg vsn "artifacts.dat") case maybeCache of Nothing -> @@ -339,9 +341,10 @@ type Fingerprint = -- BUILD build :: Reporting.DKey -> Dirs.PackageCache -> MVar (Map.Map Pkg.Name (MVar Dep)) -> Pkg.Name -> Solver.Details -> Fingerprint -> Set.Set Fingerprint -> IO Dep -build key cache depsMVar pkg (Solver.Details vsn _) f fs = +build key cache depsMVar pkg (Solver.Details vsn maybeLocalPath _) f fs = do - eitherOutline <- Outline.read (Dirs.package cache pkg vsn) + let packageDir = Maybe.fromMaybe (Dirs.package cache pkg vsn) maybeLocalPath + eitherOutline <- Outline.read packageDir case eitherOutline of Left _ -> do @@ -359,13 +362,13 @@ build key cache depsMVar pkg (Solver.Details vsn _) f fs = Left _ -> do Reporting.report key Reporting.DBroken - return $ Left $ Nothing + return $ Left Nothing Right directArtifacts -> do - let src = Dirs.package cache pkg vsn "src" + let src = packageDir "src" let foreignDeps = gatherForeignInterfaces directArtifacts - let exposedDict = Map.fromKeys (\_ -> ()) (Outline.flattenExposed exposed) - docsStatus <- getDocsStatus cache pkg vsn + let exposedDict = Map.fromKeys (const ()) (Outline.flattenExposed exposed) + docsStatus <- getDocsStatus packageDir mvar <- newEmptyMVar mvars <- Map.traverseWithKey (const . fork . crawlModule foreignDeps mvar pkg src docsStatus) exposedDict putMVar mvar mvars @@ -388,13 +391,13 @@ build key cache depsMVar pkg (Solver.Details vsn _) f fs = Reporting.report key Reporting.DBroken return $ Left $ Just $ Exit.BD_BadBuild pkg vsn f Just results -> - let path = Dirs.package cache pkg vsn "artifacts.dat" + let path = packageDir "artifacts.dat" ifaces = gatherInterfaces exposedDict results objects = gatherObjects results artifacts = Artifacts ifaces objects fingerprints = Set.insert f fs in do - writeDocs cache pkg vsn docsStatus results + writeDocs packageDir docsStatus results File.writeBinary path (ArtifactCache fingerprints artifacts) Reporting.report key Reporting.DBuilt return (Right artifacts) @@ -579,10 +582,10 @@ data DocsStatus = DocsNeeded | DocsNotNeeded -getDocsStatus :: Dirs.PackageCache -> Pkg.Name -> V.Version -> IO DocsStatus -getDocsStatus cache pkg vsn = +getDocsStatus :: FilePath -> IO DocsStatus +getDocsStatus packageDir = do - exists <- File.exists (Dirs.package cache pkg vsn "docs.json") + exists <- File.exists (packageDir "docs.json") if exists then return DocsNotNeeded else return DocsNeeded @@ -597,11 +600,11 @@ makeDocs status modul = DocsNotNeeded -> Nothing -writeDocs :: Dirs.PackageCache -> Pkg.Name -> V.Version -> DocsStatus -> Map.Map ModuleName.Raw Result -> IO () -writeDocs cache pkg vsn status results = +writeDocs :: FilePath -> DocsStatus -> Map.Map ModuleName.Raw Result -> IO () +writeDocs packageDir status results = case status of DocsNeeded -> - E.writeUgly (Dirs.package cache pkg vsn "docs.json") $ + E.writeUgly (packageDir "docs.json") $ Docs.encode $ Map.mapMaybe toDocs results DocsNotNeeded -> diff --git a/builder/src/Gren/Outline.hs b/builder/src/Gren/Outline.hs index 3ab9fb6dd..9d87ce4d4 100644 --- a/builder/src/Gren/Outline.hs +++ b/builder/src/Gren/Outline.hs @@ -8,6 +8,7 @@ module Gren.Outline PkgOutline (..), Exposed (..), SrcDir (..), + PossibleFilePath (..), read, write, encode, @@ -26,6 +27,7 @@ import AbsoluteSrcDir (AbsoluteSrcDir) import AbsoluteSrcDir qualified import Control.Monad (filterM, liftM) import Data.Binary (Binary, get, getWord8, put, putWord8) +import Data.List qualified as List import Data.Map qualified as Map import Data.NonEmptyList qualified as NE import Data.OneOrMore qualified as OneOrMore @@ -36,12 +38,15 @@ import Gren.Licenses qualified as Licenses import Gren.ModuleName qualified as ModuleName import Gren.Package qualified as Pkg import Gren.Platform qualified as Platform +import Gren.PossibleFilePath (PossibleFilePath) +import Gren.PossibleFilePath qualified as PossibleFilePath import Gren.Version qualified as V import Json.Decode qualified as D import Json.Encode ((==>)) import Json.Encode qualified as E import Json.String qualified as Json import Parse.Primitives qualified as P +import Reporting.Annotation qualified as A import Reporting.Exit qualified as Exit import System.Directory qualified as Dir import System.FilePath (()) @@ -58,8 +63,8 @@ data AppOutline = AppOutline { _app_gren_version :: V.Version, _app_platform :: Platform.Platform, _app_source_dirs :: NE.List SrcDir, - _app_deps_direct :: Map.Map Pkg.Name V.Version, - _app_deps_indirect :: Map.Map Pkg.Name V.Version + _app_deps_direct :: Map.Map Pkg.Name (PossibleFilePath V.Version), + _app_deps_indirect :: Map.Map Pkg.Name (PossibleFilePath V.Version) } data PkgOutline = PkgOutline @@ -68,7 +73,7 @@ data PkgOutline = PkgOutline _pkg_license :: Licenses.License, _pkg_version :: V.Version, _pkg_exposed :: Exposed, - _pkg_deps :: Map.Map Pkg.Name Con.Constraint, + _pkg_deps :: Map.Map Pkg.Name (PossibleFilePath Con.Constraint), _pkg_gren_version :: Con.Constraint, _pkg_platform :: Platform.Platform } @@ -105,14 +110,14 @@ platform outline = Pkg (PkgOutline _ _ _ _ _ _ _ pltform) -> pltform -dependencyConstraints :: Outline -> Map.Map Pkg.Name Con.Constraint +dependencyConstraints :: Outline -> Map.Map Pkg.Name (PossibleFilePath Con.Constraint) dependencyConstraints outline = case outline of App appOutline -> let direct = _app_deps_direct appOutline indirect = _app_deps_indirect appOutline appDeps = Map.union direct indirect - in Map.map (\vsn -> Con.exactly vsn) appDeps + in Map.map (PossibleFilePath.mapWith Con.exactly) appDeps Pkg pkgOutline -> _pkg_deps pkgOutline @@ -164,9 +169,9 @@ encodeModule :: ModuleName.Raw -> E.Value encodeModule name = E.name name -encodeDeps :: (a -> E.Value) -> Map.Map Pkg.Name a -> E.Value +encodeDeps :: (a -> E.Value) -> Map.Map Pkg.Name (PossibleFilePath a) -> E.Value encodeDeps encodeValue deps = - E.dict Pkg.toJsonString encodeValue deps + E.dict Pkg.toJsonString (PossibleFilePath.encodeJson encodeValue) deps encodeSrcDir :: SrcDir -> E.Value encodeSrcDir srcDir = @@ -279,8 +284,8 @@ appDecoder = <$> D.field "gren-version" versionDecoder <*> D.field "platform" (Platform.decoder Exit.OP_BadPlatform) <*> D.field "source-directories" dirsDecoder - <*> D.field "dependencies" (D.field "direct" (depsDecoder versionDecoder)) - <*> D.field "dependencies" (D.field "indirect" (depsDecoder versionDecoder)) + <*> D.field "dependencies" (D.field "direct" (depsDecoder versionOrFilePathDecoder)) + <*> D.field "dependencies" (D.field "indirect" (depsDecoder versionOrFilePathDecoder)) pkgDecoder :: Decoder PkgOutline pkgDecoder = @@ -290,7 +295,7 @@ pkgDecoder = <*> D.field "license" (Licenses.decoder Exit.OP_BadLicense) <*> D.field "version" versionDecoder <*> D.field "exposed-modules" exposedDecoder - <*> D.field "dependencies" (depsDecoder constraintDecoder) + <*> D.field "dependencies" (depsDecoder constraintOrFilePathDecoder) <*> D.field "gren-version" constraintDecoder <*> D.field "platform" (Platform.decoder Exit.OP_BadPlatform) @@ -308,11 +313,43 @@ summaryDecoder = versionDecoder :: Decoder V.Version versionDecoder = - D.mapError (uncurry Exit.OP_BadVersion) V.decoder + D.mapError (Exit.OP_BadVersion . Exit.OP_AttemptedOther) V.decoder + +versionOrFilePathDecoder :: Decoder (PossibleFilePath V.Version) +versionOrFilePathDecoder = + D.oneOf + [ do + vsn <- D.mapError (Exit.OP_BadVersion . Exit.OP_AttemptedOther) V.decoder + D.succeed (PossibleFilePath.Other vsn), + filePathDecoder Exit.OP_BadVersion + ] + +filePathDecoder :: (Exit.PossibleFilePath err -> Exit.OutlineProblem) -> Decoder (PossibleFilePath val) +filePathDecoder errorMapper = + do + jsonStr <- D.string + D.Decoder $ \(A.At errRegion@(A.Region (A.Position row col) _) _) ok err -> + let filePath = Json.toChars jsonStr + in if List.isPrefixOf localDepPrefix filePath + then ok (PossibleFilePath.Is $ List.drop (List.length localDepPrefix) filePath) + else err (D.Failure errRegion $ errorMapper $ Exit.OP_AttemptedFilePath (row, col)) + +localDepPrefix :: String +localDepPrefix = + "local:" constraintDecoder :: Decoder Con.Constraint constraintDecoder = - D.mapError Exit.OP_BadConstraint Con.decoder + D.mapError (Exit.OP_BadConstraint . Exit.OP_AttemptedOther) Con.decoder + +constraintOrFilePathDecoder :: Decoder (PossibleFilePath Con.Constraint) +constraintOrFilePathDecoder = + D.oneOf + [ do + con <- D.mapError (Exit.OP_BadConstraint . Exit.OP_AttemptedOther) Con.decoder + D.succeed (PossibleFilePath.Other con), + filePathDecoder Exit.OP_BadConstraint + ] depsDecoder :: Decoder a -> Decoder (Map.Map Pkg.Name a) depsDecoder valueDecoder = diff --git a/builder/src/Gren/PossibleFilePath.hs b/builder/src/Gren/PossibleFilePath.hs new file mode 100644 index 000000000..854e5e364 --- /dev/null +++ b/builder/src/Gren/PossibleFilePath.hs @@ -0,0 +1,42 @@ +module Gren.PossibleFilePath + ( PossibleFilePath (..), + mapWith, + encodeJson, + other, + toChars, + ) +where + +import Data.Utf8 qualified as Utf8 +import Json.Encode qualified as E + +data PossibleFilePath a + = Is FilePath + | Other a + deriving (Eq) + +mapWith :: (a -> b) -> PossibleFilePath a -> PossibleFilePath b +mapWith fn possibleFP = + case possibleFP of + Is filePath -> Is filePath + Other a -> Other $ fn a + +other :: PossibleFilePath a -> Maybe a +other possibleFP = + case possibleFP of + Is _ -> Nothing + Other a -> Just a + +encodeJson :: (a -> E.Value) -> PossibleFilePath a -> E.Value +encodeJson encoderForNonFP possibleFP = + case possibleFP of + Is filePath -> + E.string $ Utf8.fromChars $ "local:" ++ filePath + Other a -> + encoderForNonFP a + +toChars :: (a -> String) -> PossibleFilePath a -> String +toChars otherToString pfp = + case pfp of + Is fp -> fp + Other a -> otherToString a diff --git a/builder/src/Reporting/Exit.hs b/builder/src/Reporting/Exit.hs index a468a0f4f..dfd31c2ee 100644 --- a/builder/src/Reporting/Exit.hs +++ b/builder/src/Reporting/Exit.hs @@ -28,6 +28,7 @@ module Reporting.Exit Solver (..), Outline (..), OutlineProblem (..), + PossibleFilePath (..), Details (..), DetailsBadDep (..), BuildProblem (..), @@ -987,6 +988,7 @@ outdatedToReport exit = data Solver = SolverBadCacheData Pkg.Name V.Version + | SolverBadLocalDep Pkg.Name String | SolverBadGitOperationUnversionedPkg Pkg.Name Git.Error | SolverBadGitOperationVersionedPkg Pkg.Name V.Version Git.Error | SolverIncompatibleSolvedVersion Pkg.Name Pkg.Name C.Constraint V.Version @@ -1013,6 +1015,20 @@ toSolverReport problem = \ Hopefully that will get you unstuck, but it will not resolve the root\ \ problem if a 3rd party tool is modifing cached files for some reason." ] + SolverBadLocalDep pkg filePath -> + Help.report + "PROBLEM SOLVING PACKAGE CONSTRAINTS" + Nothing + ( "I need the gren.json of " + ++ Pkg.toChars pkg + ++ " (located at " + ++ filePath + ++ ") to help me search for a set of compatible packages. It seems to be a dependency\ + \ that resides on your disk." + ) + [ D.reflow + "Verify that the path is correct, that it is defined as a package and that it compiles." + ] SolverBadGitOperationUnversionedPkg pkg gitError -> toGitErrorReport "PROBLEM SOLVING PACKAGE CONSTRAINTS" gitError $ "I need the gren.json of " @@ -1133,8 +1149,8 @@ data Outline data OutlineProblem = OP_BadType | OP_BadPkgName Row Col - | OP_BadVersion Row Col - | OP_BadConstraint C.Error + | OP_BadVersion (PossibleFilePath (Row, Col)) + | OP_BadConstraint (PossibleFilePath C.Error) | OP_BadModuleName Row Col | OP_BadModuleHeaderTooLong | OP_BadDependencyName Row Col @@ -1143,6 +1159,10 @@ data OutlineProblem | OP_NoSrcDirs | OP_BadPlatform +data PossibleFilePath otherError + = OP_AttemptedFilePath (Row, Col) + | OP_AttemptedOther otherError + toOutlineReport :: Outline -> Help.Report toOutlineReport problem = case problem of @@ -1302,7 +1322,31 @@ toOutlineProblemReport path source _ region problem = \ to change your GitHub name!" ] ) - OP_BadVersion row col -> + OP_BadVersion (OP_AttemptedFilePath (row, col)) -> + toSnippet + "PROBLEM WITH DEPENDENCY FILE PATH" + (toHighlight row col) + ( D.reflow $ + "I got stuck while reading your gren.json file. I was expecting a file path here:", + D.fillSep + [ "I", + "need", + "something", + "like", + D.green "\"local:..\"", + "or", + D.green "\"local:/absolute/path/to/project\"", + "that", + "explicitly", + "states", + "where", + "to", + "find", + "the", + "dependency." + ] + ) + OP_BadVersion (OP_AttemptedOther (row, col)) -> toSnippet "PROBLEM WITH VERSION" (toHighlight row col) @@ -1324,7 +1368,31 @@ toOutlineProblemReport path source _ region problem = "numbers!" ] ) - OP_BadConstraint constraintError -> + OP_BadConstraint (OP_AttemptedFilePath (row, col)) -> + toSnippet + "PROBLEM WITH DEPENDENCY FILE PATH" + (toHighlight row col) + ( D.reflow $ + "I got stuck while reading your gren.json file. I was expecting a file path here:", + D.fillSep + [ "I", + "need", + "something", + "like", + D.green "\"local:..\"", + "or", + D.green "\"local:/absolute/path/to/project\"", + "that", + "explicitly", + "states", + "where", + "to", + "find", + "the", + "dependency." + ] + ) + OP_BadConstraint (OP_AttemptedOther constraintError) -> case constraintError of C.BadFormat row col -> toSnippet diff --git a/compiler/src/Json/Decode.hs b/compiler/src/Json/Decode.hs index 9e5cd5829..ece83926f 100644 --- a/compiler/src/Json/Decode.hs +++ b/compiler/src/Json/Decode.hs @@ -6,7 +6,7 @@ module Json.Decode ( fromByteString, - Decoder, + Decoder (..), string, customString, bool, diff --git a/gren.cabal b/gren.cabal index 36281347f..b4b98884c 100644 --- a/gren.cabal +++ b/gren.cabal @@ -91,6 +91,7 @@ Common gren-common Gren.Outline Gren.Platform Gren.Details + Gren.PossibleFilePath -- Gren.Compiler.Imports Gren.Compiler.Type diff --git a/terminal/src/Init.hs b/terminal/src/Init.hs index e0cfa86ff..04efcfd37 100644 --- a/terminal/src/Init.hs +++ b/terminal/src/Init.hs @@ -16,8 +16,9 @@ import Gren.Licenses qualified as Licenses import Gren.Outline qualified as Outline import Gren.Package qualified as Pkg import Gren.Platform qualified as Platform +import Gren.PossibleFilePath (PossibleFilePath) +import Gren.PossibleFilePath qualified as PossibleFilePath import Gren.Version qualified as V -import Json.String qualified as Json import Reporting qualified import Reporting.Doc qualified as D import Reporting.Exit qualified as Exit @@ -83,7 +84,8 @@ init flags = return $ Left $ Exit.InitNoCompatibleDependencies Nothing Left (DPkg.GitError gitError) -> return $ Left $ Exit.InitNoCompatibleDependencies $ Just gitError - Right deps -> do + Right resolvedDeps -> do + let deps = Map.map PossibleFilePath.Other resolvedDeps result <- Solver.verify Reporting.ignorer cache platform deps case result of Solver.Err exit -> @@ -101,12 +103,12 @@ init flags = putStrLn "Okay, I created it." return (Right ()) -pkgOutline :: Platform.Platform -> Map.Map Pkg.Name Con.Constraint -> Outline.Outline +pkgOutline :: Platform.Platform -> Map.Map Pkg.Name (PossibleFilePath Con.Constraint) -> Outline.Outline pkgOutline platform deps = Outline.Pkg $ Outline.PkgOutline Pkg.dummyName - (Json.fromChars "") + Outline.defaultSummary Licenses.bsd3 V.one (Outline.ExposedList []) @@ -117,10 +119,10 @@ pkgOutline platform deps = appOutlineFromSolverDetails :: Platform.Platform -> [Pkg.Name] -> - (Map.Map Pkg.Name Solver.Details) -> + Map.Map Pkg.Name Solver.Details -> Outline.Outline appOutlineFromSolverDetails platform initialDeps details = - let solution = Map.map (\(Solver.Details vsn _) -> vsn) details + let solution = Map.map (\(Solver.Details vsn _ _) -> vsn) details defaultDeps = Map.fromList $ map (\dep -> (dep, Con.exactly V.one)) initialDeps directs = Map.intersection solution defaultDeps indirects = Map.difference solution defaultDeps @@ -129,8 +131,8 @@ appOutlineFromSolverDetails platform initialDeps details = V.compiler platform (NE.List (Outline.RelativeSrcDir "src") []) - directs - indirects + (Map.map PossibleFilePath.Other directs) + (Map.map PossibleFilePath.Other indirects) selectPlatform :: Flags -> Platform.Platform selectPlatform flags = diff --git a/terminal/src/Package/Install.hs b/terminal/src/Package/Install.hs index 45f1874bb..2a2d9734d 100644 --- a/terminal/src/Package/Install.hs +++ b/terminal/src/Package/Install.hs @@ -18,6 +18,8 @@ import Gren.Constraint qualified as C import Gren.Details qualified as Details import Gren.Outline qualified as Outline import Gren.Package qualified as Pkg +import Gren.PossibleFilePath (PossibleFilePath) +import Gren.PossibleFilePath qualified as PossibleFilePath import Gren.Version qualified as V import Reporting qualified import Reporting.Doc ((<+>)) @@ -55,11 +57,11 @@ run args (Flags _skipPrompts) = Outline.App outline -> do changes <- makeAppPlan env pkg outline - attemptChanges root env _skipPrompts oldOutline V.toChars changes + attemptChanges root env _skipPrompts oldOutline (PossibleFilePath.toChars V.toChars) changes Outline.Pkg outline -> do changes <- makePkgPlan env pkg outline - attemptChanges root env _skipPrompts oldOutline C.toChars changes + attemptChanges root env _skipPrompts oldOutline (PossibleFilePath.toChars C.toChars) changes -- ATTEMPT CHANGES @@ -160,7 +162,7 @@ installDependencies path = -- MAKE APP PLAN -makeAppPlan :: Solver.Env -> Pkg.Name -> Outline.AppOutline -> Task (Changes V.Version) +makeAppPlan :: Solver.Env -> Pkg.Name -> Outline.AppOutline -> Task (Changes (PossibleFilePath V.Version)) makeAppPlan (Solver.Env cache) pkg outline@(Outline.AppOutline _ _ _ direct indirect) = if Map.member pkg direct then return AlreadyInstalled @@ -197,7 +199,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 -> Pkg.Name -> Outline.PkgOutline -> Task (Changes (PossibleFilePath C.Constraint)) makePkgPlan (Solver.Env cache) pkg outline@(Outline.PkgOutline _ _ _ _ _ deps _ rootPlatform) = if Map.member pkg deps then return AlreadyInstalled @@ -215,14 +217,14 @@ makePkgPlan (Solver.Env cache) pkg outline@(Outline.PkgOutline _ _ _ _ _ deps _ Exit.SolverBadGitOperationUnversionedPkg pkg gitError Right compatibleVersion -> do let old = deps - let cons = Map.insert pkg (C.untilNextMajor compatibleVersion) old + let cons = Map.insert pkg (PossibleFilePath.Other (C.untilNextMajor compatibleVersion)) old result <- Task.io $ Solver.verify Reporting.ignorer cache rootPlatform cons case result of Solver.Ok solution -> - let (Solver.Details vsn _) = solution ! pkg + let (Solver.Details vsn _ _) = solution ! pkg con = C.untilNextMajor vsn - new = Map.insert pkg con old + new = Map.insert pkg (PossibleFilePath.Other con) old changes = detectChanges old new news = Map.mapMaybe keepNew changes in return $ @@ -236,7 +238,7 @@ makePkgPlan (Solver.Env cache) pkg outline@(Outline.PkgOutline _ _ _ _ _ deps _ Solver.Err exit -> Task.throw $ Exit.InstallHadSolverTrouble exit -addNews :: Maybe Pkg.Name -> Map.Map Pkg.Name C.Constraint -> Map.Map Pkg.Name C.Constraint -> Map.Map Pkg.Name C.Constraint +addNews :: Maybe Pkg.Name -> Map.Map Pkg.Name (PossibleFilePath C.Constraint) -> Map.Map Pkg.Name (PossibleFilePath C.Constraint) -> Map.Map Pkg.Name (PossibleFilePath C.Constraint) addNews pkg new old = Map.merge Map.preserveMissing diff --git a/terminal/src/Package/Outdated.hs b/terminal/src/Package/Outdated.hs index fa995a8a3..2260caa9a 100644 --- a/terminal/src/Package/Outdated.hs +++ b/terminal/src/Package/Outdated.hs @@ -13,6 +13,8 @@ import Directories qualified as Dirs import Gren.Constraint qualified as C import Gren.Outline qualified as Outline import Gren.Package qualified as Pkg +import Gren.PossibleFilePath (PossibleFilePath) +import Gren.PossibleFilePath qualified as PossibleFilePath import Gren.Version qualified as V import Reporting qualified import Reporting.Exit qualified as Exit @@ -56,15 +58,16 @@ listOutdatedAppDeps appOutline = (Outline._app_deps_direct appOutline) (Outline._app_deps_indirect appOutline) - asConstraints = Map.map C.exactly deps + asConstraints = Map.map (PossibleFilePath.mapWith C.exactly) deps in listOutdatedDeps asConstraints listOutdatedPkgDeps :: Outline.PkgOutline -> Task () listOutdatedPkgDeps pkgOutline = listOutdatedDeps $ Outline._pkg_deps pkgOutline -listOutdatedDeps :: Map.Map Pkg.Name C.Constraint -> Task () -listOutdatedDeps cons = do +listOutdatedDeps :: Map.Map Pkg.Name (PossibleFilePath C.Constraint) -> Task () +listOutdatedDeps filePathsOrConstraints = do + let cons = Map.mapMaybe PossibleFilePath.other filePathsOrConstraints allHigherVersions <- Map.traverseWithKey higherVersions cons let interestingVersions = Map.mapMaybe toDisplayStrings allHigherVersions let report = finalizeReport $ Map.foldrWithKey buildReport [] interestingVersions diff --git a/terminal/src/Package/Uninstall.hs b/terminal/src/Package/Uninstall.hs index 02a0f8994..72cd19e61 100644 --- a/terminal/src/Package/Uninstall.hs +++ b/terminal/src/Package/Uninstall.hs @@ -15,6 +15,8 @@ import Gren.Constraint qualified as C import Gren.Details qualified as Details import Gren.Outline qualified as Outline import Gren.Package qualified as Pkg +import Gren.PossibleFilePath (PossibleFilePath) +import Gren.PossibleFilePath qualified as PossibleFilePath import Gren.Version qualified as V import Reporting qualified import Reporting.Doc ((<+>)) @@ -50,11 +52,11 @@ run args (Flags _skipPrompts) = Outline.App outline -> do changes <- makeAppPlan env pkg outline - attemptChanges root env _skipPrompts oldOutline V.toChars changes + attemptChanges root env _skipPrompts oldOutline (PossibleFilePath.toChars V.toChars) changes Outline.Pkg outline -> do changes <- makePkgPlan env pkg outline - attemptChanges root env _skipPrompts oldOutline C.toChars changes + attemptChanges root env _skipPrompts oldOutline (PossibleFilePath.toChars C.toChars) changes -- ATTEMPT CHANGES @@ -110,9 +112,9 @@ attemptChanges root env skipPrompt oldOutline toChars changes = ] Changes changeDict newOutline -> let widths = Map.foldrWithKey (widen toChars) (Widths 0 0 0) changeDict - changeDocs = Map.foldrWithKey (addChange toChars widths) ([]) changeDict + changeDocs = Map.foldrWithKey (addChange toChars widths) [] changeDict in attemptChangesHelp root env skipPrompt oldOutline newOutline $ - D.vcat $ + D.vcat [ "Here is my plan:", viewChangeDocs changeDocs, "", @@ -147,7 +149,7 @@ attemptChangesHelp root env skipPrompt oldOutline newOutline question = -- MAKE APP PLAN -makeAppPlan :: Solver.Env -> Pkg.Name -> Outline.AppOutline -> Task (Changes V.Version) +makeAppPlan :: Solver.Env -> Pkg.Name -> Outline.AppOutline -> Task (Changes (PossibleFilePath V.Version)) makeAppPlan (Solver.Env cache) pkg outline@(Outline.AppOutline _ rootPlatform _ direct indirect) = case Map.lookup pkg direct of Just vsn -> do @@ -157,7 +159,7 @@ makeAppPlan (Solver.Env cache) pkg outline@(Outline.AppOutline _ rootPlatform _ case result of Solver.Ok solution -> let old = Map.union direct indirect - new = Map.map (\(Solver.Details v _) -> v) solution + new = Map.map (\(Solver.Details v _ _) -> PossibleFilePath.Other v) solution in if Map.member pkg new then return $ @@ -176,7 +178,7 @@ makeAppPlan (Solver.Env cache) pkg outline@(Outline.AppOutline _ rootPlatform _ Outline._app_deps_indirect = Map.intersection indirect new } Solver.NoSolution -> - Task.throw $ Exit.UninstallNoSolverSolution + Task.throw Exit.UninstallNoSolverSolution Solver.Err exit -> Task.throw $ Exit.UninstallHadSolverTrouble exit Nothing -> @@ -188,7 +190,7 @@ makeAppPlan (Solver.Env cache) pkg outline@(Outline.AppOutline _ rootPlatform _ case result of Solver.Ok solution -> let old = Map.union direct indirect - new = Map.map (\(Solver.Details v _) -> v) solution + new = Map.map (\(Solver.Details v _ _) -> PossibleFilePath.Other v) solution in if Map.member pkg new then return $ PackageIsRequired (packagesDependingOn pkg solution) else @@ -200,20 +202,20 @@ makeAppPlan (Solver.Env cache) pkg outline@(Outline.AppOutline _ rootPlatform _ Outline._app_deps_indirect = Map.intersection indirect new } Solver.NoSolution -> - Task.throw $ Exit.UninstallNoSolverSolution + Task.throw Exit.UninstallNoSolverSolution Solver.Err exit -> Task.throw $ Exit.UninstallHadSolverTrouble exit Nothing -> return NoSuchPackage -toConstraints :: Map.Map Pkg.Name V.Version -> Map.Map Pkg.Name V.Version -> Map.Map Pkg.Name C.Constraint +toConstraints :: Map.Map Pkg.Name (PossibleFilePath V.Version) -> Map.Map Pkg.Name (PossibleFilePath V.Version) -> Map.Map Pkg.Name (PossibleFilePath C.Constraint) toConstraints direct indirect = - Map.map C.exactly $ Map.union direct indirect + Map.map (PossibleFilePath.mapWith C.exactly) $ Map.union direct indirect packagesDependingOn :: Pkg.Name -> Map.Map Pkg.Name Solver.Details -> [Pkg.Name] packagesDependingOn targetPkg solution = Map.foldrWithKey - ( \pkg (Solver.Details _ deps) acc -> + ( \pkg (Solver.Details _ _ deps) acc -> if Map.member targetPkg deps then pkg : acc else acc @@ -223,7 +225,7 @@ packagesDependingOn targetPkg solution = -- MAKE PACKAGE PLAN -makePkgPlan :: Solver.Env -> Pkg.Name -> Outline.PkgOutline -> Task (Changes C.Constraint) +makePkgPlan :: Solver.Env -> Pkg.Name -> Outline.PkgOutline -> Task (Changes (PossibleFilePath C.Constraint)) makePkgPlan (Solver.Env cache) pkg outline@(Outline.PkgOutline _ _ _ _ _ deps _ rootPlatform) = if not $ Map.member pkg deps then return NoSuchPackage @@ -240,7 +242,7 @@ makePkgPlan (Solver.Env cache) pkg outline@(Outline.PkgOutline _ _ _ _ _ deps _ { Outline._pkg_deps = withMissingPkg } Solver.NoSolution -> - Task.throw $ Exit.UninstallNoSolverSolution + Task.throw Exit.UninstallNoSolverSolution Solver.Err exit -> Task.throw $ Exit.UninstallHadSolverTrouble exit diff --git a/terminal/src/Repl.hs b/terminal/src/Repl.hs index 51b83b768..14102fab6 100644 --- a/terminal/src/Repl.hs +++ b/terminal/src/Repl.hs @@ -44,6 +44,7 @@ import Gren.ModuleName qualified as ModuleName import Gren.Outline qualified as Outline import Gren.Package qualified as Pkg import Gren.Platform qualified as Platform +import Gren.PossibleFilePath as PossibleFilePath import Gren.Version qualified as V import Parse.Declaration qualified as PD import Parse.Expression qualified as PE @@ -535,7 +536,7 @@ getRoot = Licenses.bsd3 V.one (Outline.ExposedList []) - compatibleDeps + (Map.map PossibleFilePath.Other compatibleDeps) C.defaultGren Platform.Common