gren-lang/compiler
1
1
Fork 0
mirror of https://github.com/gren-lang/compiler.git synced 2024-09-11 08:45:42 +03:00
Code Issues Actions Packages Projects Releases Wiki Activity

Merge pull request #169 from gren-lang/local-disk-dependencies

Browse Source 
Local disk dependencies
This commit is contained in:
Robin Heggelund Hansen 2023-01-13 17:07:42 +01:00 committed by GitHub
commit 8a58879429
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
13 changed files with 374 additions and 152 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

197
builder/src/Deps/Solver.hs
View File

@ -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)
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)
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
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
Nothing ->
return $ Map.insert name newConstraint unsolved
Just oldConstraint ->
case C.intersect oldConstraint newConstraint of
Nothing ->
solverError $
Exit.SolverIncompatibleVersionRanges sourcePkg name oldConstraint newConstraint
Just mergedConstraint ->
if oldConstraint == mergedConstraint
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 return (Map.insert name mergedConstraint 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)
-- 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 ->

12
builder/src/Directories.hs
View File

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

57
builder/src/Gren/Details.hs
View File

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

61
builder/src/Gren/Outline.hs
View File

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

42
builder/src/Gren/PossibleFilePath.hs Normal file
View File

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

76
builder/src/Reporting/Exit.hs
View File

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

2
compiler/src/Json/Decode.hs
View File

@ -6,7 +6,7 @@
module Json.Decode
( fromByteString,
Decoder,
Decoder (..),
string,
customString,
bool,

1
gren.cabal
View File

@ -91,6 +91,7 @@ Common gren-common
Gren.Outline
Gren.Platform
Gren.Details
Gren.PossibleFilePath
--
Gren.Compiler.Imports
Gren.Compiler.Type

18
terminal/src/Init.hs
View File

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

18
terminal/src/Package/Install.hs
View File

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

9
terminal/src/Package/Outdated.hs
View File

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

30
terminal/src/Package/Uninstall.hs
View File

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

3
terminal/src/Repl.hs
View File

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