Skip to content

Commit 2e163e0

Browse files
robinheghanrobinheghan
authored
Merge pull request #163 from gren-lang/fix-stdout-output-when-compiling-docs
Fix stdout output when compiling docs
2 parents 5b6bb45 + 3235397 commit 2e163e0

File tree

10 files changed

+102
-80
lines changed

10 files changed

+102
-80
lines changed

‎builder/src/Deps/Package.hs‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ module Deps.Package
66
latestCompatibleVersionForPackages,
77
--
88
bumpPossibilities,
9+
isPackageInCache,
910
installPackageVersion,
1011
)
1112
where
@@ -120,6 +121,11 @@ sameMinor (V.Version major1 minor1 _) (V.Version major2 minor2 _) =
120121

121122
-- INSTALL PACKAGE VERSION
122123

124+
isPackageInCache :: Dirs.PackageCache -> Pkg.Name -> V.Version -> IO Bool
125+
isPackageInCache cache pkg vsn = do
126+
let versionedPkgPath = Dirs.package cache pkg vsn
127+
Dir.doesDirectoryExist versionedPkgPath
128+
123129
installPackageVersion :: Dirs.PackageCache -> Pkg.Name -> V.Version -> IO (Either Git.Error ())
124130
installPackageVersion cache pkg vsn = do
125131
let versionedPkgPath = Dirs.package cache pkg vsn

‎builder/src/Deps/Solver.hs‎

Lines changed: 55 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,7 @@ import Gren.Package qualified as Pkg
2828
import Gren.Platform qualified as Platform
2929
import Gren.Version qualified as V
3030
import Json.Decode qualified as D
31+
import Reporting qualified
3132
import Reporting.Exit qualified as Exit
3233
import System.FilePath ((</>))
3334

@@ -67,13 +68,14 @@ data Details
6768
= Details V.Version (Map.Map Pkg.Name C.Constraint)
6869

6970
verify ::
71+
Reporting.DKey ->
7072
Dirs.PackageCache ->
7173
Platform.Platform ->
7274
Map.Map Pkg.Name C.Constraint ->
7375
IO (Result (Map.Map Pkg.Name Details))
74-
verify cache rootPlatform constraints =
76+
verify key cache rootPlatform constraints =
7577
Dirs.withRegistryLock cache $
76-
case try rootPlatform constraints of
78+
case try key rootPlatform constraints of
7779
Solver solver ->
7880
solver
7981
(State cache Map.empty)
@@ -96,17 +98,19 @@ data AppSolution = AppSolution
9698
}
9799

98100
addToApp ::
101+
Reporting.DKey ->
99102
Dirs.PackageCache ->
100103
Pkg.Name ->
101104
V.Version ->
102105
Outline.AppOutline ->
103106
IO (Result AppSolution)
104-
addToApp cache pkg compatibleVsn outline@(Outline.AppOutline _ rootPlatform _ direct indirect) =
107+
addToApp key cache pkg compatibleVsn outline@(Outline.AppOutline _ rootPlatform _ direct indirect) =
105108
Dirs.withRegistryLock cache $
106109
let allDeps = Map.union direct indirect
107110

108111
attempt toConstraint deps =
109112
try
113+
key
110114
rootPlatform
111115
(Map.insert pkg (C.untilNextMajor compatibleVsn) (Map.map toConstraint deps))
112116
in case oneOf
@@ -145,9 +149,9 @@ getTransitive constraints solution unvisited visited =
145149

146150
-- TRY
147151

148-
try :: Platform.Platform -> Map.Map Pkg.Name C.Constraint -> Solver (Map.Map Pkg.Name V.Version)
149-
try rootPlatform constraints =
150-
exploreGoals (Goals rootPlatform constraints Map.empty)
152+
try :: Reporting.DKey -> Platform.Platform -> Map.Map Pkg.Name C.Constraint -> Solver (Map.Map Pkg.Name V.Version)
153+
try key rootPlatform constraints =
154+
exploreGoals key (Goals rootPlatform constraints Map.empty)
151155

152156
-- EXPLORE GOALS
153157

@@ -157,22 +161,22 @@ data Goals = Goals
157161
_solved :: Map.Map Pkg.Name V.Version
158162
}
159163

160-
exploreGoals :: Goals -> Solver (Map.Map Pkg.Name V.Version)
161-
exploreGoals (Goals rootPlatform pending solved) =
164+
exploreGoals :: Reporting.DKey -> Goals -> Solver (Map.Map Pkg.Name V.Version)
165+
exploreGoals key (Goals rootPlatform pending solved) =
162166
case Map.minViewWithKey pending of
163167
Nothing ->
164168
return solved
165169
Just ((name, constraint), otherPending) ->
166170
do
167171
let goals1 = Goals rootPlatform otherPending solved
168172
let lowestVersion = C.lowerBound constraint
169-
goals2 <- addVersion goals1 name lowestVersion
170-
exploreGoals goals2
173+
goals2 <- addVersion key goals1 name lowestVersion
174+
exploreGoals key goals2
171175

172-
addVersion :: Goals -> Pkg.Name -> V.Version -> Solver Goals
173-
addVersion (Goals rootPlatform pending solved) name version =
176+
addVersion :: Reporting.DKey -> Goals -> Pkg.Name -> V.Version -> Solver Goals
177+
addVersion reportKey (Goals rootPlatform pending solved) name version =
174178
do
175-
(Constraints gren platform deps) <- getConstraints name version
179+
(Constraints gren platform deps) <- getConstraints reportKey name version
176180
if C.goodGren gren
177181
then
178182
if Platform.compatible rootPlatform platform
@@ -209,8 +213,8 @@ addConstraint sourcePkg solved unsolved (name, newConstraint) =
209213

210214
-- GET CONSTRAINTS
211215

212-
getConstraints :: Pkg.Name -> V.Version -> Solver Constraints
213-
getConstraints pkg vsn =
216+
getConstraints :: Reporting.DKey -> Pkg.Name -> V.Version -> Solver Constraints
217+
getConstraints reportKey pkg vsn =
214218
Solver $ \state@(State cache cDict) ok back err ->
215219
do
216220
let key = (pkg, vsn)
@@ -219,24 +223,43 @@ getConstraints pkg vsn =
219223
ok state cs back
220224
Nothing ->
221225
do
222-
let toNewState cs = State cache (Map.insert key cs cDict)
223-
let home = Dirs.package cache pkg vsn
224-
packageInstalResult <- Package.installPackageVersion cache pkg vsn
225-
case packageInstalResult of
226-
Left gitErr ->
227-
err $ Exit.SolverBadGitOperationVersionedPkg pkg vsn gitErr
228-
Right () -> do
229-
let path = home </> "gren.json"
230-
outlineExists <- File.exists path
231-
if outlineExists
232-
then do
233-
bytes <- File.readUtf8 path
234-
case D.fromByteString constraintsDecoder bytes of
226+
isPackageInCache <- Package.isPackageInCache cache pkg vsn
227+
if isPackageInCache
228+
then do
229+
Reporting.report reportKey Reporting.DCached
230+
constraintsDecodeResult <- getConstraintsHelper cache pkg vsn
231+
case constraintsDecodeResult of
232+
Left exitMsg ->
233+
err exitMsg
234+
Right cs ->
235+
ok (State cache (Map.insert key cs cDict)) cs back
236+
else do
237+
Reporting.report reportKey Reporting.DRequested
238+
packageInstalResult <- Package.installPackageVersion cache pkg vsn
239+
case packageInstalResult of
240+
Left gitErr ->
241+
do
242+
Reporting.report reportKey $ Reporting.DFailed pkg vsn
243+
err $ Exit.SolverBadGitOperationVersionedPkg pkg vsn gitErr
244+
Right () -> do
245+
Reporting.report reportKey $ Reporting.DReceived pkg vsn
246+
constraintsDecodeResult <- getConstraintsHelper cache pkg vsn
247+
case constraintsDecodeResult of
248+
Left exitMsg ->
249+
err exitMsg
235250
Right cs ->
236-
ok (toNewState cs) cs back
237-
Left _ ->
238-
err (Exit.SolverBadCacheData pkg vsn)
239-
else err (Exit.SolverBadCacheData pkg vsn)
251+
ok (State cache (Map.insert key cs cDict)) cs back
252+
253+
getConstraintsHelper :: Dirs.PackageCache -> Pkg.Name -> V.Version -> IO (Either Exit.Solver Constraints)
254+
getConstraintsHelper cache pkg vsn =
255+
do
256+
let path = Dirs.package cache pkg vsn </> "gren.json"
257+
bytes <- File.readUtf8 path
258+
case D.fromByteString constraintsDecoder bytes of
259+
Right cs ->
260+
return $ Right cs
261+
Left _ ->
262+
return $ Left $ Exit.SolverBadCacheData pkg vsn
240263

241264
constraintsDecoder :: D.Decoder () Constraints
242265
constraintsDecoder =

‎builder/src/Git.hs‎

Lines changed: 1 addition & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -56,9 +56,8 @@ githubUrl pkg =
5656
--
5757

5858
clone :: GitUrl -> V.Version -> FilePath -> IO (Either Error ())
59-
clone (GitUrl (pkgName, gitUrl)) vsn targetFolder = do
59+
clone (GitUrl (_, gitUrl)) vsn targetFolder = do
6060
maybeExec <- checkInstalledGit
61-
putStrFlush $ "Cloning " ++ pkgName ++ " " ++ V.toChars vsn ++ "... "
6261
case maybeExec of
6362
Nothing ->
6463
return $ Left MissingGit
@@ -78,13 +77,10 @@ clone (GitUrl (pkgName, gitUrl)) vsn targetFolder = do
7877
""
7978
case exitCode of
8079
Exit.ExitFailure 128 -> do
81-
putStrLn "Error!"
8280
return $ Left $ NoSuchRepoOrVersion vsn
8381
Exit.ExitFailure _ -> do
84-
putStrLn "Error!"
8582
return $ Left $ FailedCommand ("git" : args) stderr
8683
Exit.ExitSuccess -> do
87-
putStrLn "Ok!"
8884
return $ Right ()
8985

9086
tags :: GitUrl -> IO (Either Error (V.Version, [V.Version]))

‎builder/src/Gren/Details.hs‎

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -129,7 +129,7 @@ verifyInstall scope root (Solver.Env cache) outline =
129129
Outline.Pkg pkg -> Task.run (verifyPkg env time pkg >> return ())
130130
Outline.App app -> Task.run (verifyApp env time app >> return ())
131131

132-
-- LOAD -- used by Make, Repl
132+
-- LOAD -- used by Make, Docs, Repl
133133

134134
load :: Reporting.Style -> BW.Scope -> FilePath -> IO (Either Exit.Details Details)
135135
load style scope root =
@@ -186,19 +186,21 @@ initEnv key scope root =
186186
type Task a = Task.Task Exit.Details a
187187

188188
verifyPkg :: Env -> File.Time -> Outline.PkgOutline -> Task Details
189-
verifyPkg env time (Outline.PkgOutline pkg _ _ _ exposed direct gren rootPlatform) =
189+
verifyPkg env@(Env reportKey _ _ _) time (Outline.PkgOutline pkg _ _ _ exposed direct gren rootPlatform) =
190190
if Con.goodGren gren
191191
then do
192+
_ <- Task.io $ Reporting.report reportKey $ Reporting.DStart $ Map.size direct
192193
solution <- verifyConstraints env rootPlatform (Map.map (Con.exactly . Con.lowerBound) direct)
193194
let exposedList = Outline.flattenExposed exposed
194195
verifyDependencies env time (ValidPkg rootPlatform pkg exposedList) solution direct
195196
else Task.throw $ Exit.DetailsBadGrenInPkg gren
196197

197198
verifyApp :: Env -> File.Time -> Outline.AppOutline -> Task Details
198-
verifyApp env time outline@(Outline.AppOutline grenVersion rootPlatform srcDirs direct _) =
199+
verifyApp env@(Env reportKey _ _ _) time outline@(Outline.AppOutline grenVersion rootPlatform srcDirs direct _) =
199200
if grenVersion == V.compiler
200201
then do
201202
stated <- checkAppDeps outline
203+
_ <- Task.io $ Reporting.report reportKey $ Reporting.DStart (Map.size stated)
202204
actual <- verifyConstraints env rootPlatform (Map.map Con.exactly stated)
203205
if Map.size stated == Map.size actual
204206
then verifyDependencies env time (ValidApp rootPlatform srcDirs) actual direct
@@ -221,9 +223,9 @@ verifyConstraints ::
221223
Platform.Platform ->
222224
Map.Map Pkg.Name Con.Constraint ->
223225
Task (Map.Map Pkg.Name Solver.Details)
224-
verifyConstraints (Env _ _ _ cache) rootPlatform constraints =
226+
verifyConstraints (Env reportKey _ _ cache) rootPlatform constraints =
225227
do
226-
result <- Task.io $ Solver.verify cache rootPlatform constraints
228+
result <- Task.io $ Solver.verify reportKey cache rootPlatform constraints
227229
case result of
228230
Solver.Ok details -> return details
229231
Solver.NoSolution -> Task.throw $ Exit.DetailsNoSolution
@@ -251,10 +253,9 @@ fork work =
251253
-- VERIFY DEPENDENCIES
252254

253255
verifyDependencies :: Env -> File.Time -> ValidOutline -> Map.Map Pkg.Name Solver.Details -> Map.Map Pkg.Name a -> Task Details
254-
verifyDependencies env@(Env key scope root cache) time outline solution directDeps =
256+
verifyDependencies env@(Env _ scope root cache) time outline solution directDeps =
255257
Task.eio id $
256258
do
257-
Reporting.report key (Reporting.DStart (Map.size solution))
258259
mvar <- newEmptyMVar
259260
mvars <-
260261
Dirs.withRegistryLock cache $
@@ -316,7 +317,6 @@ verifyDep :: Env -> MVar (Map.Map Pkg.Name (MVar Dep)) -> Map.Map Pkg.Name Solve
316317
verifyDep (Env key _ _ cache) depsMVar solution pkg details@(Solver.Details vsn directDeps) =
317318
do
318319
let fingerprint = Map.intersectionWith (\(Solver.Details v _) _ -> v) solution directDeps
319-
Reporting.report key Reporting.DCached
320320
maybeCache <- File.readBinary (Dirs.package cache pkg vsn </> "artifacts.dat")
321321
case maybeCache of
322322
Nothing ->

‎terminal/src/Docs.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -71,7 +71,7 @@ runHelp root style (Flags maybeOutput _) =
7171
return ()
7272
Just DevStdOut ->
7373
do
74-
docs <- buildExposed style root details Build.KeepDocs exposed
74+
docs <- buildExposed Reporting.silent root details Build.KeepDocs exposed
7575
let builder = Json.encodeUgly $ Docs.encode docs
7676
Task.io $ B.hPutBuilder IO.stdout builder
7777
Nothing ->

‎terminal/src/Init.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -84,7 +84,7 @@ init flags =
8484
Left (DPkg.GitError gitError) ->
8585
return $ Left $ Exit.InitNoCompatibleDependencies $ Just gitError
8686
Right deps -> do
87-
result <- Solver.verify cache platform deps
87+
result <- Solver.verify Reporting.ignorer cache platform deps
8888
case result of
8989
Solver.Err exit ->
9090
return (Left (Exit.InitSolverProblem exit))

‎terminal/src/Make.hs‎

Lines changed: 8 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -56,9 +56,9 @@ data ReportType
5656
type Task a = Task.Task Exit.Make a
5757

5858
run :: [FilePath] -> Flags -> IO ()
59-
run paths flags@(Flags _ _ _ report) =
59+
run paths flags@(Flags _ _ maybeOutput report) =
6060
do
61-
style <- getStyle report
61+
style <- getStyle maybeOutput report
6262
maybeRoot <- Dirs.findRoot
6363
Reporting.attemptWithStyle style Exit.makeToReport $
6464
case maybeRoot of
@@ -135,11 +135,12 @@ runHelp root paths style (Flags debug optimize maybeOutput _) =
135135

136136
-- GET INFORMATION
137137

138-
getStyle :: Maybe ReportType -> IO Reporting.Style
139-
getStyle report =
140-
case report of
141-
Nothing -> Reporting.terminal
142-
Just Json -> return Reporting.json
138+
getStyle :: Maybe Output -> Maybe ReportType -> IO Reporting.Style
139+
getStyle maybeOutput report =
140+
case (maybeOutput, report) of
141+
(Just DevStdOut, _) -> return Reporting.silent
142+
(_, Nothing) -> Reporting.terminal
143+
(_, Just Json) -> return Reporting.json
143144

144145
getMode :: Bool -> Bool -> Task DesiredMode
145146
getMode debug optimize =

‎terminal/src/Package/Install.hs‎

Lines changed: 18 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -44,13 +44,13 @@ run args (Flags _skipPrompts) =
4444
return (Left Exit.InstallNoOutline)
4545
Just root ->
4646
Task.run $
47-
do
48-
env <- Task.io Solver.initEnv
49-
oldOutline <- Task.eio Exit.InstallBadOutline $ Outline.read root
50-
case args of
51-
NoArgs ->
52-
installDependencies env oldOutline
53-
Install pkg ->
47+
case args of
48+
NoArgs ->
49+
Task.eio Exit.InstallBadDetails $ installDependencies root
50+
Install pkg ->
51+
do
52+
env <- Task.io Solver.initEnv
53+
oldOutline <- Task.eio Exit.InstallBadOutline $ Outline.read root
5454
case oldOutline of
5555
Outline.App outline ->
5656
do
@@ -146,21 +146,17 @@ attemptChangesHelp root env skipPrompt oldOutline newOutline question =
146146

147147
-- INSTALL DEPENDENCIES
148148

149-
installDependencies :: Solver.Env -> Outline.Outline -> Task ()
150-
installDependencies (Solver.Env cache) outline =
149+
installDependencies :: FilePath -> IO (Either Exit.Details ())
150+
installDependencies path =
151151
do
152-
let rootPlatform = Outline.platform outline
153-
let dependencies = Outline.dependencyConstraints outline
154-
result <- Task.io $ Solver.verify cache rootPlatform dependencies
152+
terminalStyle <- Reporting.terminal
153+
result <- BW.withScope $ \scope ->
154+
Details.load terminalStyle scope path
155155
case result of
156-
Solver.Ok _ ->
157-
do
158-
Task.io $ putStrLn "All required dependencies are installed."
159-
return ()
160-
Solver.NoSolution ->
161-
Task.throw Exit.InstallNoSolverSolution
162-
Solver.Err exit ->
163-
Task.throw (Exit.InstallHadSolverTrouble exit)
156+
Left err ->
157+
return $ Left err
158+
Right _ ->
159+
return $ Right ()
164160

165161
-- MAKE APP PLAN
166162

@@ -190,7 +186,7 @@ makeAppPlan (Solver.Env cache) pkg outline@(Outline.AppOutline _ _ _ direct indi
190186
Exit.InstallHadSolverTrouble $
191187
Exit.SolverBadGitOperationUnversionedPkg pkg gitError
192188
Right compatibleVersion -> do
193-
result <- Task.io $ Solver.addToApp cache pkg compatibleVersion outline
189+
result <- Task.io $ Solver.addToApp Reporting.ignorer cache pkg compatibleVersion outline
194190
case result of
195191
Solver.Ok (Solver.AppSolution old new app) ->
196192
return (Changes (detectChanges old new) (Outline.App app))
@@ -220,7 +216,7 @@ makePkgPlan (Solver.Env cache) pkg outline@(Outline.PkgOutline _ _ _ _ _ deps _
220216
Right compatibleVersion -> do
221217
let old = deps
222218
let cons = Map.insert pkg (C.untilNextMajor compatibleVersion) old
223-
result <- Task.io $ Solver.verify cache rootPlatform cons
219+
result <- Task.io $ Solver.verify Reporting.ignorer cache rootPlatform cons
224220
case result of
225221
Solver.Ok solution ->
226222
let (Solver.Details vsn _) = solution ! pkg

0 commit comments

Comments
 (0)