ghc-make 0.2.1 → 0.3
raw patch · 10 files changed
+307/−308 lines, 10 filesdep ~shake
Dependency ranges changed: shake
Files
- Arguments.hs +0/−139
- Build.hs +0/−105
- CHANGES.txt +3/−0
- Main.hs +0/−4
- Makefile.hs +0/−55
- README.md +1/−1
- ghc-make.cabal +4/−4
- src/Arguments.hs +139/−0
- src/Main.hs +105/−0
- src/Makefile.hs +55/−0
− Arguments.hs
@@ -1,139 +0,0 @@-{-# LANGUAGE PatternGuards, RecordWildCards #-}--module Arguments(Arguments(..), getArguments) where--import Control.Monad-import Data.Char-import Data.Either-import Data.List-import Data.Maybe-import System.Environment-import System.Exit-import Development.Shake.FilePath-import Makefile---data Arguments = Arguments- {argsGHC :: [String] -- ^ Arguments to pass to ghc, does not include --make- ,argsShake :: [String] -- ^ Arguments to pass to shake- ,threads :: Int -- ^ Number of threads to use- -- Interpretation of the flags- ,modeGHC :: Bool -- ^ Are these flags which should go direct to GHC, not a --make/-M mode- ,prefix :: FilePath -- ^ Where make should put its files, e.g. .ghc-make- -- Where should things live- ,outputFile :: FilePath -> FilePath -- ^ Root source file, .exe file- ,hiDir :: FilePath -- ^ -hidir- ,oDir :: FilePath -- ^ -odir- ,hiFile :: Module -> FilePath -- ^ .hi files- ,oFile :: Module -> FilePath -- ^ .o files- ,hiModule :: FilePath -> Maybe Module- ,oModule :: FilePath -> Maybe Module- }--helpMessage =- ["ghc-make, (C) Neil Mitchell"- ,""- ," ghc-make [ghc-options] --shake[shake-options] [-jN]"- ,""- ,"ghc-make is a drop-in replacement for 'ghc', and accepts GHC arugments."- ,"For GHC arguments, see 'ghc --help' or <http://haskell.org/haskellwiki/GHC>."- ,""- ,"ghc-make uses 'shake', and accepts Shake arguments prefixed by '--shake'."- ,"For Shake arguments, see 'ghc-make --shake--help'."- ,"As an example, to write a profile report to stdout pass '--shake--report=-'."- ,""- ,"In addition, 'ghc-make' accepts the following option:"- ,""- ," -jN --threads=N Allow N modules to compile in parallel (defaults to 1)."- ]---getArguments :: IO Arguments-getArguments = do- args <- getArgs- when (any (`elem` helpFlags) args) $ do- putStrLn $ unlines helpMessage- exitSuccess-- let (argsThreads, argsRest) = partition (isJust . parseThreads) args- let threads = max 1 $ fromMaybe 1 $ msum $ map parseThreads argsThreads- let (argsShake, argsGHC) = splitFlags $ delete "--make" argsRest- let hasArg x = x `elem` argsGHC- let getArg b x = findArg b x argsGHC-- let modeGHC = any hasArg $ "--version" : "--numeric-version" : flagsConflictingWithM- let prefix = fromMaybe "" (getArg True ["-outputdir","-odir"] `mplus` getArg True ["-outputdir","-hidir"]) </> ".ghc-make"- let outputFile file = let s = fromMaybe (dropExtension file) (getArg False ["-o"])- in if null $ takeExtension s then s <.> exe else s- - let (hiDir, hiFile, hiModule) = extFileModule getArg "hi"- let ( oDir, oFile, oModule) = extFileModule getArg "o"- return Arguments{..}---extFileModule :: (Bool -> [String] -> Maybe String) -> String -> (FilePath, Module -> FilePath, FilePath -> Maybe Module)-extFileModule getArg ext = (extDir, extFile, extModule)- where- extDir = fromMaybe "" $ getArg True ["-outputdir","-" ++ ext ++ "dir"]- extSuf = fromMaybe ext $ getArg True ["-" ++ ext ++ "suf"]- extFile (Module name boot) = extDir </> joinPath name <.> extSuf ++ (if boot then "-boot" else "")- extModule s- | "-boot" `isSuffixOf` s, Just (Module name _) <- extModule $ take (length s - 5) s = newModule name True- | extDir `isPrefixOf` s && extSuf `isSuffixOf` s- = newModule (splitDirectories $ dropWhile isPathSeparator $ dropExtensions $ drop (length extDir) s) False- | otherwise = Nothing--newModule :: [String] -> Bool -> Maybe Module-newModule xs y = if all isValid xs then Just $ Module xs y else Nothing- where isValid (x:xs) = isUpper x && all (\x -> isAlphaNum x || x `elem` "\'_") xs- isValid [] = False---parseThreads :: String -> Maybe Int-parseThreads x = do- x <- msum $ map (`stripPrefix` x) ["-threads","--threads","-j"]- x <- return $ fromMaybe x $ stripPrefix "=" x- [(i,"")] <- return $ reads x- return i----- | -odir is implicit since -odirfoo works, but -o is explicit-findArg :: Bool -> [String] -> [String] -> Maybe String-findArg implicit flags xs- | x1:x2:xs <- xs, x1 `elem` flags = add x2 $ rec xs- | implicit, x:xs <- xs, Just x <- msum $ map (`stripPrefix` x) flags- = add (if "=" `isPrefixOf` x then drop 1 x else x) $ rec xs- | x:xs <- xs = rec xs- | otherwise = Nothing- where add a b = Just $ fromMaybe a b- rec = findArg implicit flags---helpFlags = words "-? --help"---- Obtained from the man page (listed in the same order as they appear there)--- and ghc/Main.hs, `data PostLoadMode`:-flagsConflictingWithM = words $- -- "Help and verbosity options"- "-? --help -V " ++- "--supported-extensions --supported-languages " ++- "--info --version --numeric-version --print-libdir " ++- -- "Which phases to run"- "-E -C -S -c " ++- -- "Alternative modes of operation"- "--interactive -e " ++- -- "Interface file options"- "--show-iface " ++- -- Undocumented?- "--abi-hash"------ | Split flags into (Shake flags, GHC flags)-splitFlags :: [String] -> ([String], [String])-splitFlags = partitionEithers . map f- where- f x | Just x <- stripPrefix "--shake-" x = Left $ '-':x- | Just x <- stripPrefix "-shake-" x = Left $ '-':x- | otherwise = Right x-
− Build.hs
@@ -1,105 +0,0 @@-{-# LANGUAGE RecordWildCards, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}--module Build(main) where--import Control.Monad-import Data.Either-import Data.Maybe-import Development.Shake-import Development.Shake.Classes-import Development.Shake.FilePath-import System.Environment-import System.Exit-import System.Process-import qualified Data.HashMap.Strict as Map-import Arguments-import Makefile----- | Increment every time I change the rules in an incompatible way-ghcMakeVer :: Int-ghcMakeVer = 3---newtype AskImports = AskImports Module deriving (Show,Typeable,Eq,Hashable,Binary,NFData)--newtype AskSource = AskSource Module deriving (Show,Typeable,Eq,Hashable,Binary,NFData)---main :: IO ()-main = do- Arguments{..} <- getArguments-- when modeGHC $- exitWith =<< rawSystem "ghc" argsGHC-- let opts = shakeOptions- {shakeThreads=threads- ,shakeFiles=prefix- ,shakeVerbosity=if threads == 1 then Quiet else Normal- ,shakeVersion=show ghcMakeVer}- withArgs argsShake $ shakeArgs opts $ do- want [prefix <.> "result"]-- -- A file containing the GHC arguments- prefix <.> "args" *> \out -> do- alwaysRerun- writeFileChanged out $ unlines argsGHC- needArgs <- return $ do need [prefix <.> "args"]; return argsGHC-- -- A file containing the ghc-pkg list output- prefix <.> "pkgs" *> \out -> do- alwaysRerun- (Stdout s, Stderr _) <- cmd "ghc-pkg list --verbose"- writeFileChanged out s- needPkgs <- return $ need [prefix <.> "pkgs"]-- -- A file containing the output of -M- prefix <.> "makefile" *> \out -> do- args <- needArgs- needPkgs- -- Use the default o/hi settings so we can parse the makefile properly- () <- cmd "ghc -M -include-pkg-deps -dep-suffix='' -dep-makefile" [out] args "-odir. -hidir. -hisuf=_hi_ -osuf=_o_"- mk <- liftIO $ makefile out- need $ Map.elems $ source mk- needMk <- do cache <- newCache (\x -> do need [x]; liftIO $ makefile x); return $ cache $ prefix <.> "makefile"- askImports <- addOracle $ \(AskImports x) -> do mk <- needMk; return $ Map.lookupDefault [] x $ imports mk- askSource <- addOracle $ \(AskSource x) -> do mk <- needMk; return $ source mk Map.! x--- -- The result, we can't want the object directly since it is painful to- -- define a build rule for it because its name depends on both args and makefile- prefix <.> "result" *> \out -> do- args <- needArgs- mk <- needMk- let output = if "-no-link" `elem` argsGHC then Nothing- else fmap outputFile $ Map.lookup (Module ["Main"] False) $ source mk-- -- if you don't specify an odir/hidir then impossible to reverse from the file name to the module- let exec = when (isJust output || threads == 1) $- cmd "ghc --make -odir. -hidir." args- grab = need $ map oFile $ Map.keys $ source mk- if threads == 1 then exec >> grab else grab >> exec-- case output of- Nothing -> return ()- Just output -> do- -- ensure that if the file gets deleted we rerun this rule without first trying to- -- need the output, since we don't have a rule to build the output- b <- doesFileExist output- unless b $- error $ "Failed to build output file: " ++ output ++ "\n" ++- "Most likely ghc-make has guessed the output location wrongly."- need [output]- writeFile' out ""-- let match x = do m <- oModule x `mplus` hiModule x; return [oFile m, hiFile m]- match &?> \[o,hi] -> do- let Just m = oModule o- source <- askSource (AskSource m)- (files,mods) <- fmap partitionEithers $ askImports (AskImports m)- need $ source : map hiFile mods ++ files- when (threads /= 1) $ do- args <- needArgs- let isRoot x = x == "Main" || takeExtension x `elem` [".hs",".lhs"]- cmd "ghc -odir. -hidir." (filter (not . isRoot) args) (if hiDir == "" then [] else ["-i" ++ hiDir]) "-o" [o] "-c" [source]
CHANGES.txt view
@@ -1,5 +1,8 @@ Changelog for ghc-make +0.3+ GHC 7.8 compatibility, following -M output changes (GHC #9287)+ Fix a bug on Windows with shake-0.14 and filepath separators 0.2.1 Support GHC-7.8, which requires -dep-suffix #3, support -no-link flag
− Main.hs
@@ -1,4 +0,0 @@--module Main(main) where--import Build
− Makefile.hs
@@ -1,55 +0,0 @@-{-# LANGUAGE RecordWildCards, PatternGuards, DeriveDataTypeable #-}--module Makefile(Makefile(..), Module(..), makefile) where--import Data.List-import Development.Shake.FilePath-import Development.Shake.Classes-import Development.Shake.Util-import Data.Bits-import qualified Data.HashMap.Strict as Map---data Module = Module {moduleName :: [String], moduleBoot :: Bool}- deriving (Typeable, Eq)--instance Show Module where- show (Module name boot) = intercalate "." name ++ (if boot then "[boot]" else "")--instance Hashable Module where- hashWithSalt salt (Module a b) = hashWithSalt salt a `xor` hashWithSalt salt b--instance NFData Module where- rnf (Module a b) = rnf (a,b)--instance Binary Module where- put (Module a b) = put a >> put b- get = do a <- get; b <- get; return $ Module a b--data Makefile = Makefile- {imports :: !(Map.HashMap Module [Either FilePath Module]) -- What does a module import- ,source :: !(Map.HashMap Module FilePath) -- Where is that modules source located- }- deriving Show---makefile :: FilePath -> IO Makefile-makefile file = fmap (foldl' f z . parseMakefile) $ readFile file- where- z = Makefile Map.empty Map.empty-- -- We rely on the order of the generated makefile, in particular- -- * The Foo.o : Foo.hs line is always the first with Foo.o on the LHS- -- * The root module (often Main.o) is always last- f m (a,[b])- | Just o <- fromExt "_o_" a, not $ Map.member o $ source m = m{source=Map.insert o b $ source m}- | Just o <- fromExt "_o_" a, Just hi <- fromExt "_hi_" b = m{imports = Map.insertWith (++) o [Right hi] $ imports m}- | Just o <- fromExt "_o_" a = m{imports = Map.insertWith (++) o [Left b] $ imports m}- | otherwise = m- f m (a,bs) = foldl' f m [(a,[b]) | b <- bs]---fromExt ext x- | "-boot" `isSuffixOf` x, Just (Module m _) <- fromExt ext $ take (length x - 5) x = Just $ Module m True- | takeExtension x == "." ++ ext = Just $ Module (splitDirectories $ dropExtension x) False- | otherwise = Nothing
README.md view
@@ -1,4 +1,4 @@-# ghc-make [](https://travis-ci.org/ndmitchell/ghc-make)+# ghc-make [](https://hackage.haskell.org/package/ghc-make) [](https://travis-ci.org/ndmitchell/ghc-make) An alternative to `ghc --make` which supports parallel compilation of modules and runs faster when nothing needs compiling.
ghc-make.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.8 build-type: Simple name: ghc-make-version: 0.2.1+version: 0.3 license: BSD3 license-file: LICENSE category: Development@@ -25,7 +25,7 @@ extra-source-files: README.md CHANGES.txt-tested-with: GHC==7.8.2, GHC==7.6.3, GHC==7.4.2+tested-with: GHC==7.8.3, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2 source-repository head type: git@@ -34,12 +34,12 @@ executable ghc-make main-is: Main.hs ghc-options: -threaded+ hs-source-dirs: src build-depends: base == 4.*,- shake >= 0.13,+ shake >= 0.13.3, unordered-containers >= 0.2.1, process >= 1.0 other-modules: Arguments- Build Makefile
+ src/Arguments.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE PatternGuards, RecordWildCards #-}++module Arguments(Arguments(..), getArguments) where++import Control.Monad+import Data.Char+import Data.Either+import Data.List+import Data.Maybe+import System.Environment+import System.Exit+import Development.Shake.FilePath+import Makefile+++data Arguments = Arguments+ {argsGHC :: [String] -- ^ Arguments to pass to ghc, does not include --make+ ,argsShake :: [String] -- ^ Arguments to pass to shake+ ,threads :: Int -- ^ Number of threads to use+ -- Interpretation of the flags+ ,modeGHC :: Bool -- ^ Are these flags which should go direct to GHC, not a --make/-M mode+ ,prefix :: FilePath -- ^ Where make should put its files, e.g. .ghc-make+ -- Where should things live+ ,outputFile :: FilePath -> FilePath -- ^ Root source file, .exe file+ ,hiDir :: FilePath -- ^ -hidir+ ,oDir :: FilePath -- ^ -odir+ ,hiFile :: Module -> FilePath -- ^ .hi files+ ,oFile :: Module -> FilePath -- ^ .o files+ ,hiModule :: FilePath -> Maybe Module+ ,oModule :: FilePath -> Maybe Module+ }++helpMessage =+ ["ghc-make, (C) Neil Mitchell"+ ,""+ ," ghc-make [ghc-options] --shake[shake-options] [-jN]"+ ,""+ ,"ghc-make is a drop-in replacement for 'ghc', and accepts GHC arugments."+ ,"For GHC arguments, see 'ghc --help' or <http://haskell.org/haskellwiki/GHC>."+ ,""+ ,"ghc-make uses 'shake', and accepts Shake arguments prefixed by '--shake'."+ ,"For Shake arguments, see 'ghc-make --shake--help'."+ ,"As an example, to write a profile report to stdout pass '--shake--report=-'."+ ,""+ ,"In addition, 'ghc-make' accepts the following option:"+ ,""+ ," -jN --threads=N Allow N modules to compile in parallel (defaults to 1)."+ ]+++getArguments :: IO Arguments+getArguments = do+ args <- getArgs+ when (any (`elem` helpFlags) args) $ do+ putStrLn $ unlines helpMessage+ exitSuccess++ let (argsThreads, argsRest) = partition (isJust . parseThreads) args+ let threads = max 1 $ fromMaybe 1 $ msum $ map parseThreads argsThreads+ let (argsShake, argsGHC) = splitFlags $ delete "--make" argsRest+ let hasArg x = x `elem` argsGHC+ let getArg b x = findArg b x argsGHC++ let modeGHC = any hasArg $ "--version" : "--numeric-version" : flagsConflictingWithM+ let prefix = fromMaybe "" (getArg True ["-outputdir","-odir"] `mplus` getArg True ["-outputdir","-hidir"]) </> ".ghc-make"+ let outputFile file = let s = fromMaybe (dropExtension file) (getArg False ["-o"])+ in if null $ takeExtension s then s <.> exe else s+ + let (hiDir, hiFile, hiModule) = extFileModule getArg "hi"+ let ( oDir, oFile, oModule) = extFileModule getArg "o"+ return Arguments{..}+++extFileModule :: (Bool -> [String] -> Maybe String) -> String -> (FilePath, Module -> FilePath, FilePath -> Maybe Module)+extFileModule getArg ext = (extDir, extFile, extModule)+ where+ extDir = fromMaybe "" $ getArg True ["-outputdir","-" ++ ext ++ "dir"]+ extSuf = fromMaybe ext $ getArg True ["-" ++ ext ++ "suf"]+ extFile (Module name boot) = extDir </> joinPath name <.> extSuf ++ (if boot then "-boot" else "")+ extModule s+ | "-boot" `isSuffixOf` s, Just (Module name _) <- extModule $ take (length s - 5) s = newModule name True+ | toStandard extDir `isPrefixOf` toStandard s && extSuf `isSuffixOf` s+ = newModule (splitDirectories $ dropWhile isPathSeparator $ dropExtensions $ drop (length extDir) s) False+ | otherwise = Nothing++newModule :: [String] -> Bool -> Maybe Module+newModule xs y = if all isValid xs then Just $ Module xs y else Nothing+ where isValid (x:xs) = isUpper x && all (\x -> isAlphaNum x || x `elem` "\'_") xs+ isValid [] = False+++parseThreads :: String -> Maybe Int+parseThreads x = do+ x <- msum $ map (`stripPrefix` x) ["-threads","--threads","-j"]+ x <- return $ fromMaybe x $ stripPrefix "=" x+ [(i,"")] <- return $ reads x+ return i+++-- | -odir is implicit since -odirfoo works, but -o is explicit+findArg :: Bool -> [String] -> [String] -> Maybe String+findArg implicit flags xs+ | x1:x2:xs <- xs, x1 `elem` flags = add x2 $ rec xs+ | implicit, x:xs <- xs, Just x <- msum $ map (`stripPrefix` x) flags+ = add (if "=" `isPrefixOf` x then drop 1 x else x) $ rec xs+ | x:xs <- xs = rec xs+ | otherwise = Nothing+ where add a b = Just $ fromMaybe a b+ rec = findArg implicit flags+++helpFlags = words "-? --help"++-- Obtained from the man page (listed in the same order as they appear there)+-- and ghc/Main.hs, `data PostLoadMode`:+flagsConflictingWithM = words $+ -- "Help and verbosity options"+ "-? --help -V " +++ "--supported-extensions --supported-languages " +++ "--info --version --numeric-version --print-libdir " +++ -- "Which phases to run"+ "-E -C -S -c " +++ -- "Alternative modes of operation"+ "--interactive -e " +++ -- "Interface file options"+ "--show-iface " +++ -- Undocumented?+ "--abi-hash"++++-- | Split flags into (Shake flags, GHC flags)+splitFlags :: [String] -> ([String], [String])+splitFlags = partitionEithers . map f+ where+ f x | Just x <- stripPrefix "--shake-" x = Left $ '-':x+ | Just x <- stripPrefix "-shake-" x = Left $ '-':x+ | otherwise = Right x+
+ src/Main.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE RecordWildCards, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}++module Main(main) where++import Control.Monad+import Data.Either+import Data.Maybe+import Development.Shake+import Development.Shake.Classes+import Development.Shake.FilePath+import System.Environment+import System.Exit+import System.Process+import qualified Data.HashMap.Strict as Map+import Arguments+import Makefile+++-- | Increment every time I change the rules in an incompatible way+ghcMakeVer :: Int+ghcMakeVer = 3+++newtype AskImports = AskImports Module deriving (Show,Typeable,Eq,Hashable,Binary,NFData)++newtype AskSource = AskSource Module deriving (Show,Typeable,Eq,Hashable,Binary,NFData)+++main :: IO ()+main = do+ Arguments{..} <- getArguments++ when modeGHC $+ exitWith =<< rawSystem "ghc" argsGHC++ let opts = shakeOptions+ {shakeThreads=threads+ ,shakeFiles=prefix+ ,shakeVerbosity=if threads == 1 then Quiet else Normal+ ,shakeVersion=show ghcMakeVer}+ withArgs argsShake $ shakeArgs opts $ do+ want [prefix <.> "result"]++ -- A file containing the GHC arguments+ prefix <.> "args" *> \out -> do+ alwaysRerun+ writeFileChanged out $ unlines argsGHC+ needArgs <- return $ do need [prefix <.> "args"]; return argsGHC++ -- A file containing the ghc-pkg list output+ prefix <.> "pkgs" *> \out -> do+ alwaysRerun+ (Stdout s, Stderr _) <- cmd "ghc-pkg list --verbose"+ writeFileChanged out s+ needPkgs <- return $ need [prefix <.> "pkgs"]++ -- A file containing the output of -M+ prefix <.> "makefile" *> \out -> do+ args <- needArgs+ needPkgs+ -- Use the default o/hi settings so we can parse the makefile properly+ () <- cmd "ghc -M -include-pkg-deps -dep-suffix=" [""] "-dep-makefile" [out] args "-odir. -hidir. -hisuf=hi -osuf=o"+ mk <- liftIO $ makefile out+ need $ Map.elems $ source mk+ needMk <- do cache <- newCache (\x -> do need [x]; liftIO $ makefile x); return $ cache $ prefix <.> "makefile"+ askImports <- addOracle $ \(AskImports x) -> do mk <- needMk; return $ Map.lookupDefault [] x $ imports mk+ askSource <- addOracle $ \(AskSource x) -> do mk <- needMk; return $ source mk Map.! x+++ -- The result, we can't want the object directly since it is painful to+ -- define a build rule for it because its name depends on both args and makefile+ prefix <.> "result" *> \out -> do+ args <- needArgs+ mk <- needMk+ let output = if "-no-link" `elem` argsGHC then Nothing+ else fmap outputFile $ Map.lookup (Module ["Main"] False) $ source mk++ -- if you don't specify an odir/hidir then impossible to reverse from the file name to the module+ let exec = when (isJust output || threads == 1) $+ cmd "ghc --make -odir. -hidir." args+ grab = need $ map oFile $ Map.keys $ source mk+ if threads == 1 then exec >> grab else grab >> exec++ case output of+ Nothing -> return ()+ Just output -> do+ -- ensure that if the file gets deleted we rerun this rule without first trying to+ -- need the output, since we don't have a rule to build the output+ b <- doesFileExist output+ unless b $+ error $ "Failed to build output file: " ++ output ++ "\n" +++ "Most likely ghc-make has guessed the output location wrongly."+ need [output]+ writeFile' out ""++ let match x = do m <- oModule x `mplus` hiModule x; return [oFile m, hiFile m]+ match &?> \[o,hi] -> do+ let Just m = oModule o+ source <- askSource (AskSource m)+ (files,mods) <- fmap partitionEithers $ askImports (AskImports m)+ need $ source : map hiFile mods ++ files+ when (threads /= 1) $ do+ args <- needArgs+ let isRoot x = x == "Main" || takeExtension x `elem` [".hs",".lhs"]+ cmd "ghc -odir. -hidir." (filter (not . isRoot) args) (if hiDir == "" then [] else ["-i" ++ hiDir]) "-o" [o] "-c" [source]
+ src/Makefile.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE RecordWildCards, PatternGuards, DeriveDataTypeable #-}++module Makefile(Makefile(..), Module(..), makefile) where++import Data.List+import Development.Shake.FilePath+import Development.Shake.Classes+import Development.Shake.Util+import Data.Bits+import qualified Data.HashMap.Strict as Map+++data Module = Module {moduleName :: [String], moduleBoot :: Bool}+ deriving (Typeable, Eq)++instance Show Module where+ show (Module name boot) = intercalate "." name ++ (if boot then "[boot]" else "")++instance Hashable Module where+ hashWithSalt salt (Module a b) = hashWithSalt salt a `xor` hashWithSalt salt b++instance NFData Module where+ rnf (Module a b) = rnf (a,b)++instance Binary Module where+ put (Module a b) = put a >> put b+ get = do a <- get; b <- get; return $ Module a b++data Makefile = Makefile+ {imports :: !(Map.HashMap Module [Either FilePath Module]) -- What does a module import+ ,source :: !(Map.HashMap Module FilePath) -- Where is that modules source located+ }+ deriving Show+++makefile :: FilePath -> IO Makefile+makefile file = fmap (foldl' f z . parseMakefile) $ readFile file+ where+ z = Makefile Map.empty Map.empty++ -- We rely on the order of the generated makefile, in particular+ -- * The Foo.o : Foo.hs line is always the first with Foo.o on the LHS+ -- * The root module (often Main.o) is always last+ f m (a,[b])+ | Just o <- fromExt "o" a, not $ Map.member o $ source m = m{source=Map.insert o b $ source m}+ | Just o <- fromExt "o" a, Just hi <- fromExt "hi" b = m{imports = Map.insertWith (++) o [Right hi] $ imports m}+ | Just o <- fromExt "o" a = m{imports = Map.insertWith (++) o [Left b] $ imports m}+ | otherwise = m+ f m (a,bs) = foldl' f m [(a,[b]) | b <- bs]+++fromExt ext x+ | "-boot" `isSuffixOf` x, Just (Module m _) <- fromExt ext $ take (length x - 5) x = Just $ Module m True+ | takeExtension x == "." ++ ext, isRelative x = Just $ Module (splitDirectories $ dropExtension x) False+ | otherwise = Nothing