git.iko.soy/elk
on master help sign in
promote dependencies properly with `elm install`

Before there was not anything special for the case of promoting dependencies. For example, it is already in your “transitive-dependencies” and just needs to move into “dependencies” The new code detects these cases and gives appropriate information to the user. I also made `elm install` always asks for permission to make elm.json changes. I think it’s just nicer this way.

commit3d190f122e8b0368940bc6ae8ca45a4c450d1132 authorEvan Czaplicki <evancz@users.noreply.github.com> dateWed 16 May 2018, 00:39 (8 years ago) parent5c327b7
8 files changed+191−126
compare with master
unifiedsplit
builder/src/Elm/Bump.hs+2−3 builder/src/Elm/Install.hs+128−84 builder/src/Reporting/Progress.hs+14−3 builder/src/Reporting/Progress/Json.hs+4−1 builder/src/Reporting/Progress/Repl.hs+4−1 builder/src/Reporting/Progress/Terminal.hs+19 builder/src/Reporting/Task.hs+19−33 ui/terminal/src/Develop.hs+1−1
builder/src/Elm/Bump.hs+2−3
@@ -123,11 +123,10 @@ suggestVersion summary@(Summary.Summary root _ _ _ _) info@(Project.PkgInfo name
123123
124124changeVersion :: FilePath -> Project.PkgInfo -> Pkg.Version -> D.Doc -> Task.Task ()
125125changeVersion root info targetVersion explanation =
126− do liftIO $ Help.toStdout explanation
127− approved <- Task.getApproval
126+ do approved <- Task.getApproval explanation
128127 if not approved
129128 then
130− liftIO $ putStrLn "Okay, no changes were made."
129+ liftIO $ putStrLn "Okay, I did not change anything!"
131130
132131 else
133132 do liftIO $ Project.write root $ Project.Pkg $
builder/src/Elm/Install.hs+128−84
@@ -7,13 +7,11 @@ module Elm.Install
77
88import Control.Monad (filterM, forM, msum, void)
99import Control.Monad.Except (catchError, lift, liftIO)
10−import Data.Map (Map, (!))
10+import Data.Map ((!))
1111import qualified Data.Map as Map
1212import qualified Data.Map.Merge.Lazy as Map
13−import System.IO (stdout)
1413
1514import qualified Elm.Package as Pkg
16−import Elm.Package (Name, Version)
1715
1816import qualified Deps.Cache as Cache
1917import Deps.Explorer (Explorer)
@@ -35,57 +33,133 @@ import qualified Reporting.Task as Task
3533-- INSTALL
3634
3735
38−install :: Name -> Task.Task ()
36+install :: Pkg.Name -> Task.Task ()
3937install pkg =
4038 do (root, oldProject) <- Root.unsafeGet
41− makePlan pkg oldProject $ \newProject ->
42− let
43− upgrade =
44− do liftIO $ Project.write root newProject
45− void $ Verify.verify root newProject
4639
47− revert err =
48− do liftIO $ Project.write root oldProject
49− Task.throw err
50− in
51− upgrade `catchError` revert
40+ case oldProject of
41+ Project.App info ->
42+ do changes <- makeAppPlan pkg info
43+ attemptElmJsonChange root oldProject Pkg.versionToString changes
5244
45+ Project.Pkg info ->
46+ do changes <- makePkgPlan pkg info
47+ attemptElmJsonChange root oldProject Con.toString changes
5348
5449
55−-- MAKE PLAN
56−
57−
58−makePlan :: Name -> Project.Project -> (Project.Project -> Task.Task ()) -> Task.Task ()
59−makePlan pkg project attemptInstall =
60− case project of
61− Project.App info@(Project.AppInfo elm srcDirs deps test trans) ->
62− do registry <- Cache.optionalUpdate
63− changes <- addToApp registry pkg info
64−
65− let news = Map.mapMaybe keepNew changes
66− let newDeps = addNews (Just pkg) news deps
67− let newTest = addNews Nothing news test
68− let newTrans = Map.union (Map.difference news (Map.union newDeps newTest)) trans
69− let newInfo = Project.AppInfo elm srcDirs newDeps newTest newTrans
70− let newProject = Project.App newInfo
50+attemptElmJsonChange :: FilePath -> Project.Project -> (a -> String) -> Changes a -> Task.Task ()
51+attemptElmJsonChange root oldProject toString changes =
52+ let
53+ attempt newProject question =
54+ do approved <- Task.getApproval question
55+ if approved
56+ then upgrade newProject `catchError` revert
57+ else liftIO $ putStrLn "Okay, I did not change anything!"
58+
59+ upgrade newProject =
60+ do liftIO $ Project.write root newProject
61+ void $ Verify.verify root newProject
62+
63+ revert err =
64+ do liftIO $ Project.write root oldProject
65+ Task.throw err
66+ in
67+ case changes of
68+ AlreadyInstalled ->
69+ do liftIO $ putStrLn "It is already installed!"
70+
71+ PromoteTest newProject ->
72+ attempt newProject $ D.vcat $
73+ [ "I found it in your elm.json file!"
74+ , "In \"test-dependencies\" though."
75+ , "Should I move it into \"dependencies\" for more general use? [Y/n]: "
76+ ]
77+
78+ PromoteTrans newProject ->
79+ attempt newProject $ D.vcat $
80+ [ "I found it in your elm.json file!"
81+ , "In \"transitive-dependencies\" though."
82+ , "Should I move it into \"dependencies\" for more general use? [Y/n]: "
83+ ]
84+
85+ Changes changeDict newProject ->
86+ let
87+ widths = Map.foldrWithKey (widen toString) (Widths 0 0 0) changeDict
88+ changeDocs = Map.foldrWithKey (addChange toString widths) (Docs [] [] []) changeDict
89+ in
90+ attempt newProject $ D.vcat $
91+ [ "Here is my plan:"
92+ , viewChangeDocs changeDocs
93+ , ""
94+ , "Would you like me to update your elm.json accordingly? [Y/n]: "
95+ ]
96+
97+
98+
99+-- MAKE PLANS
100+
101+
102+data Changes vsn
103+ = AlreadyInstalled
104+ | PromoteTest Project.Project
105+ | PromoteTrans Project.Project
106+ | Changes (Map.Map Pkg.Name (Change vsn)) Project.Project
107+
108+
109+makeAppPlan :: Pkg.Name -> Project.AppInfo -> Task.Task (Changes Pkg.Version)
110+makeAppPlan pkg info@(Project.AppInfo elm srcDirs deps test trans) =
111+ if Map.member pkg deps then
112+ return AlreadyInstalled
113+ else
114+ case Map.lookup pkg test of
115+ Just vsn ->
116+ return $ PromoteTest $ Project.App $
117+ Project.AppInfo elm srcDirs (Map.insert pkg vsn deps) (Map.delete pkg test) trans
71118
72− withApproval Pkg.versionToString changes (attemptInstall newProject)
119+ Nothing ->
120+ case Map.lookup pkg trans of
121+ Just vsn ->
122+ return $ PromoteTrans $ Project.App $
123+ Project.AppInfo elm srcDirs (Map.insert pkg vsn deps) test (Map.delete pkg trans)
73124
74− Project.Pkg info@(Project.PkgInfo _ _ _ _ _ deps test _) ->
75− do registry <- Cache.optionalUpdate
76− changes <- addToPkg registry pkg info
125+ Nothing ->
126+ do registry <- Cache.optionalUpdate
127+ changes <- addToApp registry pkg info
77128
78− let news = Map.mapMaybe keepNew changes
79− let newProject = Project.Pkg $
80− info
81− { Project._pkg_deps = addNews (Just pkg) news deps
82− , Project._pkg_test_deps = addNews Nothing news test
83− }
129+ let news = Map.mapMaybe keepNew changes
130+ let newDeps = addNews (Just pkg) news deps
131+ let newTest = addNews Nothing news test
132+ let newTrans = Map.union (Map.difference news (Map.union newDeps newTest)) trans
84133
85− withApproval (show . Con.toString) changes (attemptInstall newProject)
134+ return $ Changes changes $ Project.App $
135+ Project.AppInfo elm srcDirs newDeps newTest newTrans
86136
87137
88−addNews :: Maybe Name -> Map Name a -> Map Name a -> Map Name a
138+makePkgPlan :: Pkg.Name -> Project.PkgInfo -> Task.Task (Changes Constraint)
139+makePkgPlan pkg info@(Project.PkgInfo _ _ _ _ _ deps test _) =
140+ if Map.member pkg deps then
141+ return AlreadyInstalled
142+ else
143+ case Map.lookup pkg test of
144+ Just con ->
145+ return $ PromoteTest $ Project.Pkg $
146+ info
147+ { Project._pkg_deps = Map.insert pkg con deps
148+ , Project._pkg_test_deps = Map.delete pkg test
149+ }
150+
151+ Nothing ->
152+ do registry <- Cache.optionalUpdate
153+ changes <- addToPkg registry pkg info
154+ let news = Map.mapMaybe keepNew changes
155+ return $ Changes changes $ Project.Pkg $
156+ info
157+ { Project._pkg_deps = addNews (Just pkg) news deps
158+ , Project._pkg_test_deps = addNews Nothing news test
159+ }
160+
161+
162+addNews :: Maybe Pkg.Name -> Map.Map Pkg.Name a -> Map.Map Pkg.Name a -> Map.Map Pkg.Name a
89163addNews pkg new old =
90164 Map.merge
91165 Map.preserveMissing
@@ -105,7 +179,7 @@ data Change a
105179 | Remove a
106180
107181
108−detectChanges :: (Eq a) => Map Name a -> Map Name a -> Map Name (Change a)
182+detectChanges :: (Eq a) => Map.Map Pkg.Name a -> Map.Map Pkg.Name a -> Map.Map Pkg.Name (Change a)
109183detectChanges old new =
110184 Map.merge
111185 (Map.mapMissing (\_ v -> Remove v))
@@ -140,7 +214,7 @@ keepNew change =
140214-- ADD TO APP
141215
142216
143−addToApp :: Cache.PackageRegistry -> Name -> Project.AppInfo -> Task.Task (Map Name (Change Version))
217+addToApp :: Cache.PackageRegistry -> Pkg.Name -> Project.AppInfo -> Task.Task (Map.Map Pkg.Name (Change Pkg.Version))
144218addToApp registry pkg info@(Project.AppInfo _ _ deps tests trans) =
145219 Explorer.run registry $
146220 do Explorer.exists pkg
@@ -155,7 +229,7 @@ addToApp registry pkg info@(Project.AppInfo _ _ deps tests trans) =
155229 lift $ Task.throw (Exit.Install (E.NoSolution badNames))
156230
157231
158−addToAppHelp :: Name -> Project.AppInfo -> Solver.Solver (Map Name Version)
232+addToAppHelp :: Pkg.Name -> Project.AppInfo -> Solver.Solver (Map.Map Pkg.Name Pkg.Version)
159233addToAppHelp pkg (Project.AppInfo _ _ deps tests trans) =
160234 let
161235 directs =
@@ -180,7 +254,7 @@ addToAppHelp pkg (Project.AppInfo _ _ deps tests trans) =
180254-- ADD TO PKG
181255
182256
183−addToPkg :: Cache.PackageRegistry -> Name -> Project.PkgInfo -> Task.Task (Map Name (Change Constraint))
257+addToPkg :: Cache.PackageRegistry -> Pkg.Name -> Project.PkgInfo -> Task.Task (Map.Map Pkg.Name (Change Constraint))
184258addToPkg registry pkg info@(Project.PkgInfo _ _ _ _ _ deps tests _) =
185259 Explorer.run registry $
186260 do Explorer.exists pkg
@@ -196,7 +270,7 @@ addToPkg registry pkg info@(Project.PkgInfo _ _ _ _ _ deps tests _) =
196270 lift $ Task.throw (Exit.Install (E.NoSolution badNames))
197271
198272
199−addToPkgHelp :: Name -> Project.PkgInfo -> Solver.Solver (Map Name Constraint)
273+addToPkgHelp :: Pkg.Name -> Project.PkgInfo -> Solver.Solver (Map.Map Pkg.Name Constraint)
200274addToPkgHelp pkg (Project.PkgInfo _ _ _ _ _ deps tests _) =
201275 do let directs = Map.union deps tests
202276 let newCons = Map.insert pkg Con.anything directs
@@ -209,7 +283,7 @@ addToPkgHelp pkg (Project.PkgInfo _ _ _ _ _ deps tests _) =
209283-- FAILURE HINTS
210284
211285
212−isBadElm :: Name -> Explorer Bool
286+isBadElm :: Pkg.Name -> Explorer Bool
213287isBadElm name =
214288 do versions <- Explorer.getVersions name
215289
@@ -220,36 +294,6 @@ isBadElm name =
220294
221295
222296
223−-- VIEW
224−
225−
226−withApproval :: (a -> String) -> Map Name (Change a) -> Task.Task () -> Task.Task ()
227−withApproval toString changes attemptInstall =
228− let
229− widths =
230− Map.foldrWithKey (widen toString) (Widths 0 0 0) changes
231−
232− changeDocs =
233− Map.foldrWithKey (addChange toString widths) (Docs [] [] []) changes
234− in
235− case changeDocs of
236− Docs [] [] [] ->
237− do liftIO $ putStrLn "Already installed. No changes necessary!"
238−
239− Docs inserts [] [] ->
240− do liftIO $ putStrLn "Adding the following dependencies:\n"
241− liftIO $ D.toAnsi stdout $ D.indent 2 (D.vcat (reverse inserts))
242− liftIO $ putStrLn "\n"
243− attemptInstall
244−
245− Docs _ _ _ ->
246− do liftIO $ putStrLn "Here is my plan:"
247− liftIO $ D.toAnsi stdout $ viewChangeDocs changeDocs
248− liftIO $ putStrLn "\nDo you approve? [Y/n]: "
249− Task.withApproval attemptInstall
250−
251−
252−
253297-- VIEW CHANGE DOCS
254298
255299
@@ -285,7 +329,7 @@ viewNonZero title entries =
285329-- VIEW CHANGE
286330
287331
288−addChange :: (a -> String) -> Widths -> Name -> Change a -> ChangeDocs -> ChangeDocs
332+addChange :: (a -> String) -> Widths -> Pkg.Name -> Change a -> ChangeDocs -> ChangeDocs
289333addChange toString widths name change (Docs inserts changes removes) =
290334 case change of
291335 Insert new ->
@@ -298,12 +342,12 @@ addChange toString widths name change (Docs inserts changes removes) =
298342 Docs inserts changes (viewRemove toString widths name old : removes)
299343
300344
301−viewInsert :: (a -> String) -> Widths -> Name -> a -> D.Doc
345+viewInsert :: (a -> String) -> Widths -> Pkg.Name -> a -> D.Doc
302346viewInsert toString (Widths nameWidth leftWidth _) name new =
303347 viewName nameWidth name <+> pad leftWidth (toString new)
304348
305349
306−viewChange :: (a -> String) -> Widths -> Name -> a -> a -> D.Doc
350+viewChange :: (a -> String) -> Widths -> Pkg.Name -> a -> a -> D.Doc
307351viewChange toString (Widths nameWidth leftWidth rightWidth) name old new =
308352 D.hsep
309353 [ viewName nameWidth name
@@ -313,12 +357,12 @@ viewChange toString (Widths nameWidth leftWidth rightWidth) name old new =
313357 ]
314358
315359
316−viewRemove :: (a -> String) -> Widths -> Name -> a -> D.Doc
360+viewRemove :: (a -> String) -> Widths -> Pkg.Name -> a -> D.Doc
317361viewRemove toString (Widths nameWidth leftWidth _) name old =
318362 viewName nameWidth name <+> pad leftWidth (toString old)
319363
320364
321−viewName :: Int -> Name -> D.Doc
365+viewName :: Int -> Pkg.Name -> D.Doc
322366viewName width name =
323367 D.fill (width + 3) (D.fromText (Pkg.toText name))
324368
@@ -340,7 +384,7 @@ data Widths =
340384 }
341385
342386
343−widen :: (a -> String) -> Name -> Change a -> Widths -> Widths
387+widen :: (a -> String) -> Pkg.Name -> Change a -> Widths -> Widths
344388widen toString pkg change (Widths name left right) =
345389 let
346390 toLength a =
builder/src/Reporting/Progress.hs+14−3
@@ -13,10 +13,11 @@ module Reporting.Progress
1313
1414
1515import Control.Concurrent.Chan (Chan, writeChan)
16−import Control.Concurrent.MVar (MVar, readMVar)
16+import Control.Concurrent.MVar (MVar, newEmptyMVar, readMVar)
1717import qualified Elm.Compiler.Module as Module
1818import Deps.Diff (Magnitude)
1919import Elm.Package (Name, Version)
20+import qualified Reporting.Doc as D
2021import Reporting.Exit (Exit)
2122
2223
@@ -27,6 +28,7 @@ import Reporting.Exit (Exit)
2728data Reporter =
2829 Reporter
2930 { _tell :: Progress -> IO ()
31+ , _ask :: D.Doc -> IO Bool
3032 , _end :: Maybe Exit -> IO ()
3133 }
3234
@@ -37,17 +39,23 @@ makeReporter chan mvar =
3739 tell progress =
3840 writeChan chan (Progress progress)
3941
42+ ask doc =
43+ do var <- newEmptyMVar
44+ writeChan chan (Ask doc var)
45+ readMVar var
46+
4047 end maybeError =
4148 do writeChan chan (End maybeError)
4249 readMVar mvar
4350 in
44− Reporter tell end
51+ Reporter tell ask end
4552
4653
4754silentReporter :: Reporter
4855silentReporter =
4956 Reporter
5057 (\_ -> return ())
58+ (\_ -> return True)
5159 (\_ -> return ())
5260
5361
@@ -55,7 +63,10 @@ silentReporter =
5563-- MESSAGES
5664
5765
58−data Msg = Progress Progress | End (Maybe Exit)
66+data Msg
67+ = Progress Progress
68+ | Ask D.Doc (MVar Bool)
69+ | End (Maybe Exit)
5970
6071
6172data Progress
builder/src/Reporting/Progress/Json.hs+4−1
@@ -18,7 +18,10 @@ import qualified Json.Encode as Encode
1818
1919reporter :: Progress.Reporter
2020reporter =
21− Progress.Reporter (\_ -> return ()) end
21+ Progress.Reporter
22+ (\_ -> return ())
23+ (\_ -> return True)
24+ end
2225
2326
2427end :: Maybe Exit.Exit -> IO ()
builder/src/Reporting/Progress/Repl.hs+4−1
@@ -14,7 +14,10 @@ import qualified Reporting.Progress as Progress
1414
1515reporter :: Progress.Reporter
1616reporter =
17− Progress.Reporter (\_ -> return ()) end
17+ Progress.Reporter
18+ (\_ -> return ())
19+ (\_ -> return True)
20+ end
1821
1922
2023end :: Maybe Exit.Exit -> IO ()
builder/src/Reporting/Progress/Terminal.hs+19
@@ -62,10 +62,29 @@ loop chan state =
6262 End Nothing ->
6363 return ()
6464
65+ Ask doc mvar ->
66+ do Help.toStdout doc
67+ putMVar mvar =<< getApproval
68+ loop chan state
69+
6570 Progress progress ->
6671 loopHelp chan progress state
6772
6873
74+getApproval :: IO Bool
75+getApproval =
76+ do hFlush stdout
77+ input <- getLine
78+ case input of
79+ "" -> return True
80+ "Y" -> return True
81+ "y" -> return True
82+ "n" -> return False
83+ _ ->
84+ do putStr "Must type 'y' for yes or 'n' for no: "
85+ getApproval
86+
87+
6988loopHelp :: Chan Msg -> Progress -> State -> IO ()
7089loopHelp chan progress state@(State total good bad) =
7190 case progress of
builder/src/Reporting/Task.hs+19−33
@@ -10,7 +10,6 @@ module Reporting.Task
1010 , getPackageCacheDirFor
1111 , report
1212 , getReporter
13− , withApproval
1413 , getApproval
1514 , silently
1615 , getSilentRunner
@@ -23,18 +22,18 @@ import Control.Concurrent (forkIO)
2322import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
2423import Control.Monad (forever, join, replicateM_)
2524import Control.Monad.Except (ExceptT, runExceptT, throwError, withExceptT)
26−import Control.Monad.Reader (ReaderT, runReaderT, ask, asks)
25+import qualified Control.Monad.Reader as R
2726import Control.Monad.Trans (liftIO)
2827import qualified Network.HTTP.Client as Http
2928import qualified Network.HTTP.Client.TLS as Http
3029import qualified System.Directory as Dir
3130import qualified System.Exit as Exit
3231import System.FilePath ((</>))
33−import qualified System.IO as IO
3432
3533import Elm.Package (Name, Version)
3634import qualified Elm.Package as Pkg
3735import qualified Elm.PerUserCache as PerUserCache
36+import qualified Reporting.Doc as D
3837import qualified Reporting.Exit as Exit
3938import qualified Reporting.Progress as Progress
4039
@@ -48,7 +47,7 @@ type Task =
4847
4948
5049type Task_ e =
51− ExceptT e (ReaderT Env IO)
50+ ExceptT e (R.ReaderT Env IO)
5251
5352
5453data Env =
@@ -57,16 +56,17 @@ data Env =
5756 , _worker :: IO () -> IO ()
5857 , _httpManager :: Http.Manager
5958 , _tell :: Progress.Progress -> IO ()
59+ , _ask :: D.Doc -> IO Bool
6060 }
6161
6262
6363try :: Progress.Reporter -> Task a -> IO (Maybe a)
64−try (Progress.Reporter tell end) task =
64+try (Progress.Reporter tell ask end) task =
6565 do root <- PerUserCache.getPackageRoot
6666 pool <- initPool 4
6767 httpManager <- Http.newManager Http.tlsManagerSettings
68− let env = Env root pool httpManager tell
69− result <- runReaderT (runExceptT task) env
68+ let env = Env root pool httpManager tell ask
69+ result <- R.runReaderT (runExceptT task) env
7070 case result of
7171 Left err ->
7272 do end (Just err)
@@ -101,7 +101,7 @@ mapError =
101101
102102getPackageCacheDir :: Task_ e FilePath
103103getPackageCacheDir =
104− asks _cacheDir
104+ R.asks _cacheDir
105105
106106
107107getPackageCacheDirFor :: Name -> Version -> Task_ e FilePath
@@ -118,37 +118,23 @@ getPackageCacheDirFor name version =
118118
119119report :: Progress.Progress -> Task_ e ()
120120report progress =
121− do tell <- asks _tell
121+ do tell <- R.asks _tell
122122 liftIO (tell progress)
123123
124124
125125getReporter :: Task (Progress.Progress -> IO ())
126126getReporter =
127− asks _tell
127+ R.asks _tell
128128
129129
130130
131131-- APPROVAL
132132
133133
134−withApproval :: Task_ e () -> Task_ e ()
135−withApproval task =
136− do approval <- getApproval
137− if approval then task else return ()
138−
139−
140−getApproval :: Task_ e Bool
141−getApproval =
142− do liftIO $ IO.hFlush IO.stdout
143− input <- liftIO getLine
144− case input of
145− "" -> return True
146− "Y" -> return True
147− "y" -> return True
148− "n" -> return False
149− _ ->
150− do liftIO $ putStr "Must type 'y' for yes or 'n' for no: "
151− getApproval
134+getApproval :: D.Doc -> Task_ e Bool
135+getApproval doc =
136+ do ask <- R.asks _ask
137+ liftIO (ask doc)
152138
153139
154140
@@ -164,9 +150,9 @@ silently task =
164150
165151getSilentRunner :: Task_ x (Task_ e a -> IO (Either e a))
166152getSilentRunner =
167− do env <- ask
153+ do env <- R.ask
168154 let silentEnv = env { _tell = \_ -> return () }
169− return $ \task -> runReaderT (runExceptT task) silentEnv
155+ return $ \task -> R.runReaderT (runExceptT task) silentEnv
170156
171157
172158
@@ -175,10 +161,10 @@ getSilentRunner =
175161
176162workerChan :: Chan (Either e a) -> Task_ e a -> Task_ x ()
177163workerChan chan task =
178− do env <- ask
164+ do env <- R.ask
179165
180166 liftIO $ _worker env $
181− do result <- runReaderT (runExceptT task) env
167+ do result <- R.runReaderT (runExceptT task) env
182168 writeChan chan result
183169
184170
@@ -198,6 +184,6 @@ initPool size =
198184
199185runHttp :: (Http.Manager -> (Progress.Progress -> IO ()) -> IO (Either Exit.Exit a)) -> Task a
200186runHttp fetcher =
201− do (Env _ _ manager tell) <- ask
187+ do (Env _ _ manager tell _) <- R.ask
202188 result <- liftIO $ fetcher manager tell
203189 either throwError return result
ui/terminal/src/Develop.hs+1−1
@@ -163,7 +163,7 @@ compileToHtmlBuilder file =
163163 do mvar1 <- newEmptyMVar
164164 mvar2 <- newEmptyMVar
165165
166− let reporter = Progress.Reporter (\_ -> return ()) (putMVar mvar1)
166+ let reporter = Progress.Reporter (\_ -> return ()) (\_ -> return True) (putMVar mvar1)
167167 let output = Just (Output.HtmlBuilder mvar2)
168168
169169 void $ Task.try reporter $