Functionality to print a dependency list for a Fortran code base

app/Main.hs

@@ -59,6 +59,10 @@ main = do
       paths' <- expandDirs paths
       mg <- genModGraph (fortranVersion opts) (includeDirs opts) (cppOptions opts) paths'
       putStrLn $ modGraphToDOT mg
+    (paths, ShowMakeList) -> do
+      paths' <- expandDirs paths
+      mg <- genModGraph (fortranVersion opts) (includeDirs opts) (cppOptions opts) paths'
+      mapM_ putStrLn (modGraphToList mg)
     -- make: construct a build-dep graph and follow it
     (paths, Make) -> do
       let mvers = fortranVersion opts
@@ -205,38 +209,6 @@ main = do
         _ -> fail $ usageInfo programName options
     _ -> fail $ usageInfo programName options
 
--- | Expand all paths that are directories into a list of Fortran
--- files from a recursive directory listing.
-expandDirs :: [FilePath] -> IO [FilePath]
-expandDirs = fmap concat . mapM each
-  where
-    each path = do
-      isDir <- doesDirectoryExist path
-      if isDir
-        then listFortranFiles path
-        else pure [path]
-
--- | Get a list of Fortran files under the given directory.
-listFortranFiles :: FilePath -> IO [FilePath]
-listFortranFiles dir = filter isFortran <$> listDirectoryRecursively dir
-  where
-    -- | True if the file has a valid fortran extension.
-    isFortran :: FilePath -> Bool
-    isFortran x = map toLower (takeExtension x) `elem` exts
-      where exts = [".f", ".f90", ".f77", ".f03"]
-
-listDirectoryRecursively :: FilePath -> IO [FilePath]
-listDirectoryRecursively dir = listDirectoryRec dir ""
-  where
-    listDirectoryRec :: FilePath -> FilePath -> IO [FilePath]
-    listDirectoryRec d f = do
-      let fullPath = d </> f
-      isDir <- doesDirectoryExist fullPath
-      if isDir
-      then do
-        conts <- listDirectory fullPath
-        concat <$> mapM (listDirectoryRec fullPath) conts
-      else pure [fullPath]
 
 compileFileToMod :: Maybe FortranVersion -> ModFiles -> FilePath -> Maybe FilePath -> IO ModFile
 compileFileToMod mvers mods path moutfile = do
@@ -328,7 +300,7 @@ printTypeErrors = putStrLn . showTypeErrors
 
 data Action
   = Lex | Parse | Typecheck | Rename | BBlocks | SuperGraph | Reprint | DumpModFile | Compile
-  | ShowFlows Bool Bool Int | ShowBlocks (Maybe Int) | ShowMakeGraph | Make
+  | ShowFlows Bool Bool Int | ShowBlocks (Maybe Int) | ShowMakeGraph | ShowMakeList | Make
   deriving Eq
 
 instance Read Action where
@@ -423,6 +395,10 @@ options =
       ["show-make-graph"]
       (NoArg $ \ opts -> opts { action = ShowMakeGraph })
       "dump a graph showing the build structure of modules"
+  , Option []
+      ["show-make-list"]
+      (NoArg $ \ opts -> opts { action = ShowMakeList })
+      "dump a list of files in build dependency order (topological sort from the dependency graph)"
   , Option []
       ["show-block-numbers"]
       (OptArg (\a opts -> opts { action = ShowBlocks (a >>= readMaybe) }

fortran-src.cabal

@@ -27,6 +27,10 @@ extra-source-files:
     CHANGELOG.md
     test-data/f77-include/foo.f
     test-data/f77-include/no-newline/foo.f
+    test-data/module/leaf.f90
+    test-data/module/mid1.f90
+    test-data/module/mid2.f90
+    test-data/module/top.f90
     test-data/rewriter/replacementsmap-columnlimit/001_foo.f
     test-data/rewriter/replacementsmap-columnlimit/001_foo.f.expected
     test-data/rewriter/replacementsmap-columnlimit/002_other.f
@@ -276,6 +280,7 @@ test-suite spec
   other-modules:
       Language.Fortran.Analysis.BBlocksSpec
       Language.Fortran.Analysis.DataFlowSpec
+      Language.Fortran.Analysis.ModGraphSpec
       Language.Fortran.Analysis.RenamingSpec
       Language.Fortran.Analysis.SemanticTypesSpec
       Language.Fortran.Analysis.TypesSpec

src/Language/Fortran/Analysis/ModGraph.hs

@@ -1,6 +1,6 @@
 -- | Generate a module use-graph.
 module Language.Fortran.Analysis.ModGraph
-  (genModGraph, ModGraph(..), ModOrigin(..), modGraphToDOT, takeNextMods, delModNodes)
+  (genModGraph, ModGraph(..), ModOrigin(..), modGraphToList, modGraphToDOT, takeNextMods, delModNodes)
 where
 
 import Language.Fortran.AST hiding (setName)
@@ -85,16 +85,28 @@ genModGraph mversion includeDirs cppOpts paths = do
         let version = fromMaybe (deduceFortranVersion path) mversion
             mods = map snd fileMods
             parserF0 = Parser.byVerWithMods mods version
-            parserF fn bs = fromRight' $ parserF0 fn bs
+            parserF fn bs =
+              case parserF0 fn bs of
+                Right x -> return x
+                Left  err -> do
+                  error $ show err
         forM_ fileMods $ \ (fileName, mod) -> do
           forM_ [ name | Named name <- M.keys (combinedModuleMap [mod]) ] $ \ name -> do
             _ <- maybeAddModName name . Just $ MOFSMod fileName
             pure ()
-        let pf = parserF path contents
+        pf <- parserF path contents
         mapM_ (perModule path) (childrenBi pf :: [ProgramUnit ()])
         pure ()
   execStateT (mapM_ iter paths) modGraph0
 
+-- Remove duplicates from a list preserving the left most occurrence.
+removeDuplicates :: Eq a => [a] -> [a]
+removeDuplicates [] = []
+removeDuplicates (x:xs) =
+  if x `elem` xs
+    then x : removeDuplicates (filter (/= x) xs)
+    else x : removeDuplicates xs
+
 modGraphToDOT :: ModGraph -> String
 modGraphToDOT ModGraph { mgGraph = gr } = unlines dot
   where
@@ -108,6 +120,18 @@ modGraphToDOT ModGraph { mgGraph = gr } = unlines dot
                     (labNodes gr) ++
           [ "}\n" ]
 
+-- Provides a topological sort of the graph, giving a list of filenames
+modGraphToList :: ModGraph -> [String]
+modGraphToList m = removeDuplicates $ modGraphToList' m
+  where
+    modGraphToList' mg
+      | nxt <- takeNextMods mg
+      , not (null nxt) =
+          let mg' = delModNodes (map fst nxt) mg
+          in [ fn | (_, Just (MOFile fn)) <- nxt ] ++ modGraphToList' mg'
+    modGraphToList' _ = []
+
+
 takeNextMods :: ModGraph -> [(Node, Maybe ModOrigin)]
 takeNextMods ModGraph { mgModNodeMap = mnmap, mgGraph = gr } = noDepFiles
   where

src/Language/Fortran/Util/Files.hs

@@ -3,18 +3,21 @@ module Language.Fortran.Util.Files
   , runCPP
   , getDirContents
   , rGetDirContents
+  , expandDirs
+  , listFortranFiles
+  , listDirectoryRecursively
   ) where
 
 import qualified Data.Text.Encoding         as T
 import qualified Data.Text.Encoding.Error   as T
 import qualified Data.ByteString.Char8      as B
 import           System.Directory (listDirectory, canonicalizePath,
                                    doesDirectoryExist, getDirectoryContents)
-import           System.FilePath  ((</>))
+import           System.FilePath  ((</>), takeExtension)
 import           System.IO.Temp   (withSystemTempDirectory)
 import           System.Process   (callProcess)
 import           Data.List        ((\\), foldl')
-import           Data.Char        (isNumber)
+import           Data.Char        (isNumber, toLower)
 -- | Obtain a UTF-8 safe 'B.ByteString' representation of a file's contents.
 --
 -- Invalid UTF-8 is replaced with the space character.
@@ -36,11 +39,11 @@ rGetDirContents d = canonicalizePath d >>= \d' -> go [d'] d'
       fmap concat . mapM f $ ds \\ [".", ".."] -- remove '.' and '..' entries
         where
           f x = do
-            path <- canonicalizePath $ d ++ "/" ++ x
+            path <- canonicalizePath $ d </> x
             g <- doesDirectoryExist path
             if g && notElem path seen then do
               x' <- go (path : seen) path
-              return $ map (\ y -> x ++ "/" ++ y) x'
+              return $ map (\ y -> x </> y) x'
             else return [x]
 
 -- | Run the C Pre Processor over the file before reading into a bytestring
@@ -68,3 +71,36 @@ runCPP (Just cppOpts) path   = do
     let ls = B.lines contents
     let ls' = reverse . fst $ foldl' processCPPLine ([], 1) ls
     return $ B.unlines ls'
+
+-- | Expand all paths that are directories into a list of Fortran
+-- files from a recursive directory listing.
+expandDirs :: [FilePath] -> IO [FilePath]
+expandDirs = fmap concat . mapM each
+  where
+    each path = do
+      isDir <- doesDirectoryExist path
+      if isDir
+        then listFortranFiles path
+        else pure [path]
+
+-- | Get a list of Fortran files under the given directory.
+listFortranFiles :: FilePath -> IO [FilePath]
+listFortranFiles dir = filter isFortran <$> listDirectoryRecursively dir
+  where
+    -- | True if the file has a valid fortran extension.
+    isFortran :: FilePath -> Bool
+    isFortran x = map toLower (takeExtension x) `elem` exts
+      where exts = [".f", ".f90", ".f77", ".f03"]
+
+listDirectoryRecursively :: FilePath -> IO [FilePath]
+listDirectoryRecursively dir = listDirectoryRec dir ""
+  where
+    listDirectoryRec :: FilePath -> FilePath -> IO [FilePath]
+    listDirectoryRec d f = do
+      let fullPath = d </> f
+      isDir <- doesDirectoryExist fullPath
+      if isDir
+      then do
+        conts <- listDirectory fullPath
+        concat <$> mapM (listDirectoryRec fullPath) conts
+      else pure [fullPath]

test-data/module/leaf.f90

@@ -0,0 +1,4 @@
+module leaf
+  implicit none
+  real :: constant = 0.1
+end module

test-data/module/mid1.f90

@@ -0,0 +1,4 @@
+module mid1
+  implicit none
+  use leaf
+end module

test-data/module/mid2.f90

@@ -0,0 +1,4 @@
+module mid2
+  implicit none
+  use leaf
+end module

test-data/module/top.f90

@@ -0,0 +1,5 @@
+module top
+  implicit none
+  use mid1
+  use mid2
+end module

test/Language/Fortran/Analysis/ModGraphSpec.hs

@@ -0,0 +1,26 @@
+module Language.Fortran.Analysis.ModGraphSpec (spec) where
+
+import Test.Hspec
+import TestUtil
+
+import Language.Fortran.Analysis.ModGraph
+import Language.Fortran.Util.Files (expandDirs)
+import Language.Fortran.Version
+import System.FilePath ((</>))
+
+spec :: Spec
+spec =
+  describe "Modgraph" $
+    it "Dependency graph and topological sort on small package" $
+      testDependencyList
+
+-- A simple test on a simple module structure to check that
+-- we are understanding this correctly (via the dependency graph
+-- and then its topological sort).
+testDependencyList = do
+    paths' <- expandDirs ["test-data" </> "module"]
+    mg <- genModGraph (Just Fortran90) ["."] Nothing paths'
+    let list = modGraphToList mg
+    let files = ["leaf.f90", "mid1.f90", "mid2.f90", "top.f90"]
+    let filesWithPaths = map (("test-data" </> "module") </>) files
+    list `shouldBe` filesWithPaths