blob: 122fdfd1c411f8d374586bd8433983c1667e1866 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
{-# LANGUAGE Haskell2010 #-}
{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE ViewPatterns #-}
import GHC
import GHC.Driver.Make
import GHC.Driver.Session
import GHC.Driver.Env
import GHC.Unit.Module.ModSummary (ExtendedModSummary(..))
import GHC.Unit.Finder
import Control.Monad.IO.Class (liftIO)
import Data.List (sort, stripPrefix)
import Data.Either
import System.Environment
import System.Directory
import System.IO
main :: IO ()
main = do
libdir:args <- getArgs
runGhc (Just libdir) $
defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
dflags0 <- getSessionDynFlags
logger <- getLogger
(dflags1, _, _) <- parseDynamicFlags logger dflags0 $ map noLoc $
[ "-i", "-i.", "-imydir"
-- , "-v3"
] ++ args
_ <- setSessionDynFlags dflags1
liftIO $ mapM_ writeMod
[ [ "module A where"
, "import B"
]
, [ "module B where"
]
]
tgt <- guessTarget "A" Nothing
setTargets [tgt]
hsc_env <- getSession
liftIO $ do
_emss <- downsweep hsc_env [] [] False
flushFinderCaches (hsc_FC hsc_env) (hsc_home_unit hsc_env)
createDirectoryIfMissing False "mydir"
renameFile "B.hs" "mydir/B.hs"
emss <- downsweep hsc_env [] [] False
-- If 'checkSummaryTimestamp' were to call 'addHomeModuleToFinder' with
-- (ms_location old_summary) like summariseFile used to instead of
-- using the 'location' parameter we'd end up using the old location of
-- the "B" module in this test. Make sure that doesn't happen.
hPrint stderr $ sort (map (ml_hs_file . ms_location) (map emsModSummary (rights emss)))
writeMod :: [String] -> IO ()
writeMod src@(head -> stripPrefix "module " -> Just (takeWhile (/=' ') -> mod))
= writeFile (mod++".hs") $ unlines src
|
