on master help sign in
Merge pull request #2402 from david-christiansen/entering-dir-message

Bracket new directory operations in messages

commit06df4ec1e171c9a4c3e45579f24d3b601b7cda02 authorDavid Christiansen <david@davidchristiansen.dk> dateWed 8 Jul 2015, 16:42 (11 years ago) parentfd80612fb3d1a8
2 files changed+57−48
src/Pkg/Package.hs+55−48 test/totality007/expected+2
src/Pkg/Package.hs+55−48
@@ -42,20 +42,19 @@ import IRTS.System
4242buildPkg :: Bool -> (Bool, FilePath) -> IO ()
4343buildPkg warnonly (install, fp)
4444 = do pkgdesc <- parseDesc fp
45+ dir <- getCurrentDirectory
4546 let idx = PkgIndex (pkgIndex (pkgname pkgdesc))
4647 ok <- mapM (testLib warnonly (pkgname pkgdesc)) (libdeps pkgdesc)
4748 when (and ok) $
48− do dir <- getCurrentDirectory
49− setCurrentDirectory $ dir </> sourcedir pkgdesc
50− make (makefile pkgdesc)
51− m_ist <- case (execout pkgdesc) of
52− Nothing -> buildMods (idx : NoREPL : Verbose : idris_opts pkgdesc)
53− (modules pkgdesc)
54− Just o -> do let exec = dir </> o
55− buildMods
56− (idx : NoREPL : Verbose : Output exec : idris_opts pkgdesc)
57− [idris_main pkgdesc]
58− setCurrentDirectory dir
49+ do m_ist <- inPkgDir pkgdesc $
50+ do make (makefile pkgdesc)
51+ case (execout pkgdesc) of
52+ Nothing -> buildMods (idx : NoREPL : Verbose : idris_opts pkgdesc)
53+ (modules pkgdesc)
54+ Just o -> do let exec = dir </> o
55+ buildMods
56+ (idx : NoREPL : Verbose : Output exec : idris_opts pkgdesc)
57+ [idris_main pkgdesc]
5958 case m_ist of
6059 Nothing -> exitWith (ExitFailure 1)
6160 Just ist -> do
@@ -77,12 +76,10 @@ checkPkg warnonly quit fpath
7776 = do pkgdesc <- parseDesc fpath
7877 ok <- mapM (testLib warnonly (pkgname pkgdesc)) (libdeps pkgdesc)
7978 when (and ok) $
80− do dir <- getCurrentDirectory
81− setCurrentDirectory $ dir </> sourcedir pkgdesc
82− make (makefile pkgdesc)
83− res <- buildMods (NoREPL : Verbose : idris_opts pkgdesc)
84− (modules pkgdesc)
85− setCurrentDirectory dir
79+ do res <- inPkgDir pkgdesc $
80+ do make (makefile pkgdesc)
81+ buildMods (NoREPL : Verbose : idris_opts pkgdesc)
82+ (modules pkgdesc)
8683 when quit $ case res of
8784 Nothing -> exitWith (ExitFailure 1)
8885 Just res' -> do
@@ -115,13 +112,13 @@ cleanPkg :: FilePath -- ^ Path to ipkg file.
115112cleanPkg fp
116113 = do pkgdesc <- parseDesc fp
117114 dir <- getCurrentDirectory
118− setCurrentDirectory $ dir </> sourcedir pkgdesc
119− clean (makefile pkgdesc)
120− mapM_ rmIBC (modules pkgdesc)
121− rmIdx (pkgname pkgdesc)
122− case execout pkgdesc of
123− Nothing -> return ()
124− Just s -> rmFile $ dir </> s
115+ inPkgDir pkgdesc $
116+ do clean (makefile pkgdesc)
117+ mapM_ rmIBC (modules pkgdesc)
118+ rmIdx (pkgname pkgdesc)
119+ case execout pkgdesc of
120+ Nothing -> return ()
121+ Just s -> rmFile $ dir </> s
125122
126123-- | Generate IdrisDoc for package
127124-- TODO: Handle case where module does not contain a matching namespace
@@ -163,26 +160,25 @@ testPkg fp
163160 = do pkgdesc <- parseDesc fp
164161 ok <- mapM (testLib True (pkgname pkgdesc)) (libdeps pkgdesc)
165162 when (and ok) $
166− do dir <- getCurrentDirectory
167− setCurrentDirectory $ dir </> sourcedir pkgdesc
168− make (makefile pkgdesc)
169− -- Get a temporary file to save the tests' source in
170− (tmpn, tmph) <- tempIdr
171− hPutStrLn tmph $
172− "module Test_______\n" ++
173− concat ["import " ++ show m ++ "\n"
174− | m <- modules pkgdesc] ++
175− "namespace Main\n" ++
176− " main : IO ()\n" ++
177− " main = do " ++
178− concat [show t ++ "\n "
179− | t <- idris_tests pkgdesc]
180− hClose tmph
181− (tmpn', tmph') <- tempfile
182− hClose tmph'
183− m_ist <- idris (Filename tmpn : NoREPL : Verbose : Output tmpn' : idris_opts pkgdesc)
184− rawSystem tmpn' []
185− setCurrentDirectory dir
163+ do m_ist <- inPkgDir pkgdesc $
164+ do make (makefile pkgdesc)
165+ -- Get a temporary file to save the tests' source in
166+ (tmpn, tmph) <- tempIdr
167+ hPutStrLn tmph $
168+ "module Test_______\n" ++
169+ concat ["import " ++ show m ++ "\n"
170+ | m <- modules pkgdesc] ++
171+ "namespace Main\n" ++
172+ " main : IO ()\n" ++
173+ " main = do " ++
174+ concat [show t ++ "\n "
175+ | t <- idris_tests pkgdesc]
176+ hClose tmph
177+ (tmpn', tmph') <- tempfile
178+ hClose tmph'
179+ m_ist <- idris (Filename tmpn : NoREPL : Verbose : Output tmpn' : idris_opts pkgdesc)
180+ rawSystem tmpn' []
181+ return m_ist
186182 case m_ist of
187183 Nothing -> exitWith (ExitFailure 1)
188184 Just ist -> do
@@ -197,13 +193,12 @@ testPkg fp
197193-- | Install package
198194installPkg :: PkgDesc -> IO ()
199195installPkg pkgdesc
200− = do dir <- getCurrentDirectory
201− setCurrentDirectory $ dir </> sourcedir pkgdesc
202− case (execout pkgdesc) of
196+ = inPkgDir pkgdesc $
197+ do case (execout pkgdesc) of
203198 Nothing -> do mapM_ (installIBC (pkgname pkgdesc)) (modules pkgdesc)
204199 installIdx (pkgname pkgdesc)
205200 Just o -> return () -- do nothing, keep executable locally, for noe
206− mapM_ (installObj (pkgname pkgdesc)) (objs pkgdesc)
201+ mapM_ (installObj (pkgname pkgdesc)) (objs pkgdesc)
207202
208203-- ---------------------------------------------------------- [ Helper Methods ]
209204-- Methods for building, testing, installing, and removal of idris
@@ -275,6 +270,18 @@ mkDirCmd = "mkdir "
275270mkDirCmd = "mkdir -p "
276271#endif
277272
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+
278285-- ------------------------------------------------------- [ Makefile Commands ]
279286-- | Invoke a Makefile's default target.
280287make :: Maybe String -> IO ()
test/totality007/expected+2
@@ -1,3 +1,5 @@
1+Entering directory `./src'
12Totality.idr:4:1:
23Totality.foo is not total as there are missing cases
34Totality.idr:4:1:Could not build: Totality.foo is not total as there are missing cases
5+Leaving directory `./src'