Enable building executables

6 files changed, 105 insertions, 9 deletions

diff --git a/.gitignore b/.gitignore
index 39e2861..e125769 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,4 @@
 .stack-work/
 fpm.cabal
 *~
-example_library/build/*
+example_project/build/*
diff --git a/app/Main.hs b/app/Main.hs
index e1451af..02d54d6 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,10 +1,13 @@
 module Main where
 
-import           Build                          ( buildLibrary )
+import           Build                          ( buildLibrary
+                                                , buildPrograms
+                                                )
 import           Development.Shake              ( FilePattern
                                                 , (<//>)
                                                 , getDirectoryFilesIO
                                                 )
+import           Development.Shake.FilePath     ( (</>) )
 import           Options.Applicative            ( Parser
                                                 , (<**>)
                                                 , command
@@ -37,10 +40,16 @@ build = do
     putStrLn "Building"
     buildLibrary "src"
                  [".f90", ".f", ".F", ".F90", ".f95", ".f03"]
-                 "build"
+                 ("build" </> "library")
                  "gfortran"
                  ["-g", "-Wall", "-Wextra", "-Werror", "-pedantic"]
                  "library"
+    buildPrograms "app"
+                  ["build" </> "library"]
+                  [".f90", ".f", ".F", ".F90", ".f95", ".f03"]
+                  ("build" </> "app")
+                  "gfortran"
+                  ["-g", "-Wall", "-Wextra", "-Werror", "-pedantic"]
 
 getArguments :: IO Arguments
 getArguments = execParser
diff --git a/example_library/src/example_m.f90 b/example_library/src/example_m.f90
deleted file mode 100644
index 947dcfc..0000000
--- a/example_library/src/example_m.f90
+++ /dev/null
@@ -1,6 +0,0 @@
-module example_m
-    implicit none
-    private
-
-    integer, public, parameter :: ANSWER = 42
-end module example_m
diff --git a/example_project/app/hello_world.f90 b/example_project/app/hello_world.f90
new file mode 100644
index 0000000..b95062d
--- /dev/null
+++ b/example_project/app/hello_world.f90
@@ -0,0 +1,7 @@
+program hello_world
+    use hello_m, only: sayHello
+
+    implicit none
+
+    call sayHello("World")
+end program hello_world
diff --git a/example_project/src/hello_m.f90 b/example_project/src/hello_m.f90
new file mode 100644
index 0000000..a341602
--- /dev/null
+++ b/example_project/src/hello_m.f90
@@ -0,0 +1,12 @@
+module hello_m
+    implicit none
+    private
+
+    public :: sayHello
+contains
+    subroutine sayHello(name)
+        character(len=*), intent(in) :: name
+
+        print *, "Hello, " // name // "!"
+    end subroutine sayHello
+end module hello_m
diff --git a/src/Build.hs b/src/Build.hs
index b1cd141..fa0fa96 100644
--- a/src/Build.hs
+++ b/src/Build.hs
@@ -1,5 +1,6 @@
 module Build
     ( buildLibrary
+    , buildPrograms
     )
 where
 
@@ -31,8 +32,10 @@ import           Development.Shake              ( FilePattern
                                                 , (<//>)
                                                 , (&%>)
                                                 , (%>)
+                                                , (?>)
                                                 )
 import           Development.Shake.FilePath     ( dropExtension
+                                                , exe
                                                 , makeRelative
                                                 , (</>)
                                                 , (<.>)
@@ -55,6 +58,59 @@ type ModuleName = String
 
 data LineContents = ModuleUsed ModuleName | Other
 
+buildPrograms
+    :: FilePath
+    -> [FilePath]
+    -> [FilePattern]
+    -> FilePath
+    -> FilePath
+    -> [String]
+    -> IO ()
+buildPrograms programDirectory libraryDirectories sourceExtensions buildDirectory compiler flags
+    = do
+        sourceFiles <- getDirectoriesFiles [programDirectory] sourceExtensions
+        let sourceFileLookupMap = createSourceFileLookupMap
+                buildDirectory
+                programDirectory
+                sourceFiles
+        libraryModuleMaps <- mapM getLibraryModuleMap libraryDirectories
+        let libraryModuleMap = foldl Map.union Map.empty libraryModuleMaps
+        let includeFlags     = map ("-I" ++) libraryDirectories
+        archives <- getDirectoriesFiles libraryDirectories [".a"]
+        let executables = map
+                (sourceFileToExecutable buildDirectory programDirectory)
+                sourceFiles
+        shake shakeOptions { shakeFiles    = buildDirectory
+                           , shakeChange   = ChangeModtimeAndDigest
+                           , shakeColor    = True
+                           , shakeThreads  = 0
+                           , shakeProgress = progressSimple
+                           }
+            $ do
+                  buildDirectory </> "*" <.> "o" %> \objectFile -> do
+                      let
+                          sourceFile = fromMaybe
+                              undefined
+                              (Map.lookup objectFile sourceFileLookupMap)
+                      need [sourceFile]
+                      modulesUsed <- liftIO $ getModulesUsed sourceFile
+                      let
+                          moduleFilesNeeded = mapMaybe
+                              (`Map.lookup` libraryModuleMap)
+                              modulesUsed
+                      need moduleFilesNeeded
+                      cmd compiler
+                          ["-c"]
+                          includeFlags
+                          flags
+                          ["-o", objectFile, sourceFile]
+                  (`elem` executables) ?> \exe -> do
+                      let objectFile = exe -<.> "o"
+                      need [objectFile]
+                      need archives
+                      cmd compiler objectFile archives ["-o", exe] flags
+                  want executables
+
 buildLibrary
     :: FilePath
     -> [FilePattern]
@@ -112,6 +168,18 @@ getDirectoriesFiles dirs exts = getDirectoryFilesIO "" newPatterns
     newPatterns = concatMap appendExts dirs
     appendExts dir = map ((dir <//> "*") ++) exts
 
+getLibraryModuleMap :: FilePath -> IO (Map.Map ModuleName FilePath)
+getLibraryModuleMap libraryDirectory = do
+    moduleFiles <- getDirectoriesFiles [libraryDirectory] ["*.mod"]
+    let moduleMap = foldl
+            Map.union
+            Map.empty
+            (map (\m -> Map.singleton (moduleFileToModuleName m) m) moduleFiles)
+    return moduleMap
+  where
+    moduleFileToModuleName moduleFile =
+        map toLower $ dropExtension (makeRelative libraryDirectory moduleFile)
+
 createSourceFileLookupMap
     :: FilePath -> FilePath -> [FilePath] -> Map.Map FilePath FilePath
 createSourceFileLookupMap buildDirectory libraryDirectory sourceFiles = foldl
@@ -152,6 +220,12 @@ sourceFileToObjectFile buildDirectory libraryDirectory sourceFile =
                  (makeRelative libraryDirectory sourceFile)
         -<.> "o"
 
+sourceFileToExecutable :: FilePath -> FilePath -> FilePath -> FilePath
+sourceFileToExecutable buildDirectory appDirectory sourceFile =
+    buildDirectory
+        </>  pathSeparatorsToUnderscores (makeRelative appDirectory sourceFile)
+        -<.> exe
+
 sourceFileToModFile :: FilePath -> FilePath -> FilePath -> FilePath
 sourceFileToModFile buildDirectory libraryDirectory sourceFile =
     buildDirectory