on master help sign in
Merge pull request #2402 from david-christiansen/entering-dir-message
06df4ecDavid Christiansen
src/Pkg/Package.hs+55−48
@@ -42,20 +42,19 @@ import IRTS.System
42buildPkg :: Bool -> (Bool, FilePath) -> IO ()
42buildPkg :: Bool -> (Bool, FilePath) -> IO ()
43buildPkg warnonly (install, fp)
43buildPkg warnonly (install, fp)
44 = do pkgdesc <- parseDesc fp
44 = do pkgdesc <- parseDesc fp
45+ dir <- getCurrentDirectory
45 let idx = PkgIndex (pkgIndex (pkgname pkgdesc))
46 let idx = PkgIndex (pkgIndex (pkgname pkgdesc))
46 ok <- mapM (testLib warnonly (pkgname pkgdesc)) (libdeps pkgdesc)
47 ok <- mapM (testLib warnonly (pkgname pkgdesc)) (libdeps pkgdesc)
47 when (and ok) $
48 when (and ok) $
48− do dir <- getCurrentDirectory
49+ do m_ist <- inPkgDir pkgdesc $
49− setCurrentDirectory $ dir </> sourcedir pkgdesc
50− make (makefile pkgdesc)
50+ do make (makefile pkgdesc)
51− m_ist <- case (execout pkgdesc) of
51+ case (execout pkgdesc) of
52− Nothing -> buildMods (idx : NoREPL : Verbose : idris_opts pkgdesc)
52+ Nothing -> buildMods (idx : NoREPL : Verbose : idris_opts pkgdesc)
53− (modules pkgdesc)
53+ (modules pkgdesc)
54− Just o -> do let exec = dir </> o
54+ Just o -> do let exec = dir </> o
55− buildMods
55+ buildMods
56− (idx : NoREPL : Verbose : Output exec : idris_opts pkgdesc)
56+ (idx : NoREPL : Verbose : Output exec : idris_opts pkgdesc)
57− [idris_main pkgdesc]
57+ [idris_main pkgdesc]
58− setCurrentDirectory dir
59 case m_ist of
58 case m_ist of
60 Nothing -> exitWith (ExitFailure 1)
59 Nothing -> exitWith (ExitFailure 1)
61 Just ist -> do
60 Just ist -> do
@@ -77,12 +76,10 @@ checkPkg warnonly quit fpath
77 = do pkgdesc <- parseDesc fpath
76 = do pkgdesc <- parseDesc fpath
78 ok <- mapM (testLib warnonly (pkgname pkgdesc)) (libdeps pkgdesc)
77 ok <- mapM (testLib warnonly (pkgname pkgdesc)) (libdeps pkgdesc)
79 when (and ok) $
78 when (and ok) $
80− do dir <- getCurrentDirectory
79+ do res <- inPkgDir pkgdesc $
81− setCurrentDirectory $ dir </> sourcedir pkgdesc
82− make (makefile pkgdesc)
80+ do make (makefile pkgdesc)
83− res <- buildMods (NoREPL : Verbose : idris_opts pkgdesc)
81+ buildMods (NoREPL : Verbose : idris_opts pkgdesc)
84− (modules pkgdesc)
82+ (modules pkgdesc)
85− setCurrentDirectory dir
86 when quit $ case res of
83 when quit $ case res of
87 Nothing -> exitWith (ExitFailure 1)
84 Nothing -> exitWith (ExitFailure 1)
88 Just res' -> do
85 Just res' -> do
@@ -115,13 +112,13 @@ cleanPkg :: FilePath -- ^ Path to ipkg file.
115cleanPkg fp
112cleanPkg fp
116 = do pkgdesc <- parseDesc fp
113 = do pkgdesc <- parseDesc fp
117 dir <- getCurrentDirectory
114 dir <- getCurrentDirectory
118− setCurrentDirectory $ dir </> sourcedir pkgdesc
115+ inPkgDir pkgdesc $
119− clean (makefile pkgdesc)
116+ do clean (makefile pkgdesc)
120− mapM_ rmIBC (modules pkgdesc)
117+ mapM_ rmIBC (modules pkgdesc)
121− rmIdx (pkgname pkgdesc)
118+ rmIdx (pkgname pkgdesc)
122− case execout pkgdesc of
119+ case execout pkgdesc of
123− Nothing -> return ()
120+ Nothing -> return ()
124− Just s -> rmFile $ dir </> s
121+ Just s -> rmFile $ dir </> s
125
122
126-- | Generate IdrisDoc for package
123-- | Generate IdrisDoc for package
127-- TODO: Handle case where module does not contain a matching namespace
124-- TODO: Handle case where module does not contain a matching namespace
@@ -163,26 +160,25 @@ testPkg fp
163 = do pkgdesc <- parseDesc fp
160 = do pkgdesc <- parseDesc fp
164 ok <- mapM (testLib True (pkgname pkgdesc)) (libdeps pkgdesc)
161 ok <- mapM (testLib True (pkgname pkgdesc)) (libdeps pkgdesc)
165 when (and ok) $
162 when (and ok) $
166− do dir <- getCurrentDirectory
163+ do m_ist <- inPkgDir pkgdesc $
167− setCurrentDirectory $ dir </> sourcedir pkgdesc
168− make (makefile pkgdesc)
164+ do make (makefile pkgdesc)
169− -- Get a temporary file to save the tests' source in
165+ -- Get a temporary file to save the tests' source in
170− (tmpn, tmph) <- tempIdr
166+ (tmpn, tmph) <- tempIdr
171− hPutStrLn tmph $
167+ hPutStrLn tmph $
172− "module Test_______\n" ++
168+ "module Test_______\n" ++
173− concat ["import " ++ show m ++ "\n"
169+ concat ["import " ++ show m ++ "\n"
174− | m <- modules pkgdesc] ++
170+ | m <- modules pkgdesc] ++
175− "namespace Main\n" ++
171+ "namespace Main\n" ++
176− " main : IO ()\n" ++
172+ " main : IO ()\n" ++
177− " main = do " ++
173+ " main = do " ++
178− concat [show t ++ "\n "
174+ concat [show t ++ "\n "
179− | t <- idris_tests pkgdesc]
175+ | t <- idris_tests pkgdesc]
180− hClose tmph
176+ hClose tmph
181− (tmpn', tmph') <- tempfile
177+ (tmpn', tmph') <- tempfile
182− hClose tmph'
178+ hClose tmph'
183− m_ist <- idris (Filename tmpn : NoREPL : Verbose : Output tmpn' : idris_opts pkgdesc)
179+ m_ist <- idris (Filename tmpn : NoREPL : Verbose : Output tmpn' : idris_opts pkgdesc)
184− rawSystem tmpn' []
180+ rawSystem tmpn' []
185− setCurrentDirectory dir
181+ return m_ist
186 case m_ist of
182 case m_ist of
187 Nothing -> exitWith (ExitFailure 1)
183 Nothing -> exitWith (ExitFailure 1)
188 Just ist -> do
184 Just ist -> do
@@ -197,13 +193,12 @@ testPkg fp
197-- | Install package
193-- | Install package
198installPkg :: PkgDesc -> IO ()
194installPkg :: PkgDesc -> IO ()
199installPkg pkgdesc
195installPkg pkgdesc
200− = do dir <- getCurrentDirectory
196+ = inPkgDir pkgdesc $
201− setCurrentDirectory $ dir </> sourcedir pkgdesc
202− case (execout pkgdesc) of
197+ do case (execout pkgdesc) of
203 Nothing -> do mapM_ (installIBC (pkgname pkgdesc)) (modules pkgdesc)
198 Nothing -> do mapM_ (installIBC (pkgname pkgdesc)) (modules pkgdesc)
204 installIdx (pkgname pkgdesc)
199 installIdx (pkgname pkgdesc)
205 Just o -> return () -- do nothing, keep executable locally, for noe
200 Just o -> return () -- do nothing, keep executable locally, for noe
206− mapM_ (installObj (pkgname pkgdesc)) (objs pkgdesc)
201+ mapM_ (installObj (pkgname pkgdesc)) (objs pkgdesc)
207
202
208-- ---------------------------------------------------------- [ Helper Methods ]
203-- ---------------------------------------------------------- [ Helper Methods ]
209-- Methods for building, testing, installing, and removal of idris
204-- Methods for building, testing, installing, and removal of idris
@@ -275,6 +270,18 @@ mkDirCmd = "mkdir "
275mkDirCmd = "mkdir -p "
270mkDirCmd = "mkdir -p "
276#endif
271#endif
277
272
273+inPkgDir :: PkgDesc -> IO a -> IO a
274+inPkgDir pkgdesc action =
275+ do dir <- getCurrentDirectory
276+ when (sourcedir pkgdesc /= "") $
277+ do putStrLn $ "Entering directory `" ++ ("." </> sourcedir pkgdesc) ++ "'"
278+ setCurrentDirectory $ dir </> sourcedir pkgdesc
279+ res <- action
280+ when (sourcedir pkgdesc /= "") $
281+ do putStrLn $ "Leaving directory `" ++ ("." </> sourcedir pkgdesc) ++ "'"
282+ setCurrentDirectory dir
283+ return res
284+
278-- ------------------------------------------------------- [ Makefile Commands ]
285-- ------------------------------------------------------- [ Makefile Commands ]
279-- | Invoke a Makefile's default target.
286-- | Invoke a Makefile's default target.
280make :: Maybe String -> IO ()
287make :: Maybe String -> IO ()
test/totality007/expected+2
@@ -1,3 +1,5 @@
1+Entering directory `./src'
1Totality.idr:4:1:
2Totality.idr:4:1:
2Totality.foo is not total as there are missing cases
3Totality.foo is not total as there are missing cases
3Totality.idr:4:1:Could not build: Totality.foo is not total as there are missing cases
4Totality.idr:4:1:Could not build: Totality.foo is not total as there are missing cases
5+Leaving directory `./src'