diff options
| -rw-r--r-- | app/Main.hs | 62 | ||||
| -rw-r--r-- | src/Build.hs | 367 |
2 files changed, 206 insertions, 223 deletions
diff --git a/app/Main.hs b/app/Main.hs index 88bb302..5b1f864 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -26,47 +26,47 @@ data Command = Run | Test | Build main :: IO () main = do - args <- getArguments - app args + args <- getArguments + app args app :: Arguments -> IO () app args = case command' args of - Run -> putStrLn "Run" - Test -> putStrLn "Test" - Build -> build + Run -> putStrLn "Run" + Test -> putStrLn "Test" + Build -> build build :: IO () build = do - putStrLn "Building" - buildLibrary "src" - [".f90", ".f", ".F", ".F90", ".f95", ".f03"] - ("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"] + putStrLn "Building" + buildLibrary "src" + [".f90", ".f", ".F", ".F90", ".f95", ".f03"] + ("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 - (info - (arguments <**> helper) - (fullDesc <> progDesc "Work with Fortran projects" <> header - "fpm - A Fortran package manager and build system" - ) + (info + (arguments <**> helper) + (fullDesc <> progDesc "Work with Fortran projects" <> header + "fpm - A Fortran package manager and build system" ) + ) arguments :: Parser Arguments arguments = subparser - ( command "run" (info runArguments (progDesc "Run the executable")) - <> command "test" (info testArguments (progDesc "Run the tests")) - <> command "build" (info buildArguments (progDesc "Build the executable")) - ) + ( command "run" (info runArguments (progDesc "Run the executable")) + <> command "test" (info testArguments (progDesc "Run the tests")) + <> command "build" (info buildArguments (progDesc "Build the executable")) + ) runArguments :: Parser Arguments runArguments = pure $ Arguments Run @@ -79,6 +79,6 @@ buildArguments = pure $ Arguments Build getDirectoriesFiles :: [FilePath] -> [FilePattern] -> IO [FilePath] getDirectoriesFiles dirs exts = getDirectoryFilesIO "" newPatterns - where - newPatterns = concatMap appendExts dirs - appendExts dir = map ((dir <//> "*") ++) exts + where + newPatterns = concatMap appendExts dirs + appendExts dir = map ((dir <//> "*") ++) exts diff --git a/src/Build.hs b/src/Build.hs index 0353ca5..e7a43f6 100644 --- a/src/Build.hs +++ b/src/Build.hs @@ -1,7 +1,7 @@ module Build - ( buildLibrary - , buildPrograms - ) + ( buildLibrary + , buildPrograms + ) where import Control.Applicative ( (<|>) ) @@ -59,232 +59,215 @@ type ModuleName = String data LineContents = ModuleUsed ModuleName | Other buildPrograms - :: FilePath - -> [FilePath] - -> [FilePattern] - -> FilePath - -> FilePath - -> [String] - -> IO () + :: 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 realObjectFile = - foldl (</>) "" $ splitDirectories objectFile - let sourceFile = fromMaybe - undefined - (Map.lookup realObjectFile sourceFileLookupMap) - need [sourceFile] - modulesUsed <- liftIO $ getModulesUsed sourceFile - let - moduleFilesNeeded = mapMaybe - (`Map.lookup` libraryModuleMap) - modulesUsed - need moduleFilesNeeded - cmd compiler - ["-c"] - includeFlags - flags - ["-o", objectFile, sourceFile] - (\file -> - foldl (</>) "" (splitDirectories file) `elem` executables - ) - ?> \exe -> do - let objectFile = map toLower exe -<.> "o" - need [objectFile] - need archives - cmd compiler objectFile archives ["-o", exe] flags - want executables + = 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 realObjectFile = foldl (</>) "" $ splitDirectories objectFile + let sourceFile = fromMaybe + undefined + (Map.lookup realObjectFile sourceFileLookupMap) + need [sourceFile] + modulesUsed <- liftIO $ getModulesUsed sourceFile + let moduleFilesNeeded = + mapMaybe (`Map.lookup` libraryModuleMap) modulesUsed + need moduleFilesNeeded + cmd compiler + ["-c"] + includeFlags + flags + ["-o", objectFile, sourceFile] + (\file -> foldl (</>) "" (splitDirectories file) `elem` executables) + ?> \exe -> do + let objectFile = map toLower exe -<.> "o" + need [objectFile] + need archives + cmd compiler objectFile archives ["-o", exe] flags + want executables buildLibrary - :: FilePath - -> [FilePattern] - -> FilePath - -> FilePath - -> [String] - -> String - -> [FilePath] - -> IO () + :: FilePath + -> [FilePattern] + -> FilePath + -> FilePath + -> [String] + -> String + -> [FilePath] + -> IO () buildLibrary libraryDirectory sourceExtensions buildDirectory compiler flags libraryName otherLibraryDirectories - = do - sourceFiles <- getDirectoriesFiles [libraryDirectory] sourceExtensions - let sourceFileLookupMap = createSourceFileLookupMap - buildDirectory - libraryDirectory - sourceFiles - let moduleLookupMap = createModuleLookupMap buildDirectory - libraryDirectory - sourceFiles - otherModuleMaps <- mapM getLibraryModuleMap otherLibraryDirectories - let allModuleMaps = - moduleLookupMap - `Map.union` foldl Map.union Map.empty otherModuleMaps - let archiveFile = buildDirectory </> libraryName <.> "a" - shake shakeOptions { shakeFiles = buildDirectory - , shakeChange = ChangeModtimeAndDigest - , shakeColor = True - , shakeThreads = 0 - , shakeProgress = progressSimple - } - $ do - map (\ext -> buildDirectory </> "*" <.> ext) ["o", "mod"] - &%> \[objectFile, moduleFile] -> do - let - realObjectFile = foldl (</>) "" - $ splitDirectories objectFile - let sourceFile = fromMaybe - undefined - (Map.lookup realObjectFile - sourceFileLookupMap - ) - need [sourceFile] - modulesUsed <- liftIO $ getModulesUsed sourceFile - let - moduleFilesNeeded = mapMaybe - (`Map.lookup` allModuleMaps) - modulesUsed - let includeFlags = - map ("-I" ++) otherLibraryDirectories - need moduleFilesNeeded - cmd compiler - ["-c", "-J" ++ buildDirectory] - includeFlags - flags - ["-o", objectFile, sourceFile] - archiveFile %> \a -> do - let objectFiles = Map.keys sourceFileLookupMap - need objectFiles - cmd "ar" ["rs"] a objectFiles - want [archiveFile] + = do + sourceFiles <- getDirectoriesFiles [libraryDirectory] sourceExtensions + let sourceFileLookupMap = + createSourceFileLookupMap buildDirectory libraryDirectory sourceFiles + let moduleLookupMap = + createModuleLookupMap buildDirectory libraryDirectory sourceFiles + otherModuleMaps <- mapM getLibraryModuleMap otherLibraryDirectories + let allModuleMaps = + moduleLookupMap `Map.union` foldl Map.union Map.empty otherModuleMaps + let archiveFile = buildDirectory </> libraryName <.> "a" + shake shakeOptions { shakeFiles = buildDirectory + , shakeChange = ChangeModtimeAndDigest + , shakeColor = True + , shakeThreads = 0 + , shakeProgress = progressSimple + } + $ do + map (\ext -> buildDirectory </> "*" <.> ext) ["o", "mod"] + &%> \[objectFile, moduleFile] -> do + let realObjectFile = + foldl (</>) "" $ splitDirectories objectFile + let sourceFile = fromMaybe + undefined + (Map.lookup realObjectFile sourceFileLookupMap) + need [sourceFile] + modulesUsed <- liftIO $ getModulesUsed sourceFile + let moduleFilesNeeded = + mapMaybe (`Map.lookup` allModuleMaps) modulesUsed + let includeFlags = map ("-I" ++) otherLibraryDirectories + need moduleFilesNeeded + cmd compiler + ["-c", "-J" ++ buildDirectory] + includeFlags + flags + ["-o", objectFile, sourceFile] + archiveFile %> \a -> do + let objectFiles = Map.keys sourceFileLookupMap + need objectFiles + cmd "ar" ["rs"] a objectFiles + want [archiveFile] -- A little wrapper around getDirectoryFiles so we can get files from multiple directories getDirectoriesFiles :: [FilePath] -> [FilePattern] -> IO [FilePath] getDirectoriesFiles dirs exts = getDirectoryFilesIO "" newPatterns - where - newPatterns = concatMap appendExts dirs - appendExts dir = map ((dir <//> "*") ++) exts + where + 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) + 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 + :: FilePath -> FilePath -> [FilePath] -> Map.Map FilePath FilePath createSourceFileLookupMap buildDirectory libraryDirectory sourceFiles = foldl - Map.union - Map.empty - (map (createSourceToObjectMap buildDirectory libraryDirectory) sourceFiles) + Map.union + Map.empty + (map (createSourceToObjectMap buildDirectory libraryDirectory) sourceFiles) createModuleLookupMap - :: FilePath -> FilePath -> [FilePath] -> Map.Map ModuleName FilePath + :: FilePath -> FilePath -> [FilePath] -> Map.Map ModuleName FilePath createModuleLookupMap buildDirectory libraryDirectory sourceFiles = foldl - Map.union - Map.empty - (map (createSourceToModuleMap buildDirectory libraryDirectory) sourceFiles) + Map.union + Map.empty + (map (createSourceToModuleMap buildDirectory libraryDirectory) sourceFiles) createSourceToModuleMap - :: FilePath -> FilePath -> FilePath -> Map.Map ModuleName FilePath + :: FilePath -> FilePath -> FilePath -> Map.Map ModuleName FilePath createSourceToModuleMap buildDirectory libraryDirectory sourceFile = - Map.singleton - (sourceFileToModuleName libraryDirectory sourceFile) - (sourceFileToModFile buildDirectory libraryDirectory sourceFile) + Map.singleton + (sourceFileToModuleName libraryDirectory sourceFile) + (sourceFileToModFile buildDirectory libraryDirectory sourceFile) sourceFileToModuleName :: FilePath -> FilePath -> ModuleName sourceFileToModuleName libraryDirectory sourceFile = - map toLower $ pathSeparatorsToUnderscores - (dropExtension (makeRelative libraryDirectory sourceFile)) + map toLower $ pathSeparatorsToUnderscores + (dropExtension (makeRelative libraryDirectory sourceFile)) createSourceToObjectMap - :: FilePath -> FilePath -> FilePath -> Map.Map FilePath FilePath + :: FilePath -> FilePath -> FilePath -> Map.Map FilePath FilePath createSourceToObjectMap buildDirectory libraryDirectory sourceFile = - Map.singleton - (sourceFileToObjectFile buildDirectory libraryDirectory sourceFile) - sourceFile + Map.singleton + (sourceFileToObjectFile buildDirectory libraryDirectory sourceFile) + sourceFile sourceFileToObjectFile :: FilePath -> FilePath -> FilePath -> FilePath sourceFileToObjectFile buildDirectory libraryDirectory sourceFile = - buildDirectory - </> map - toLower - (pathSeparatorsToUnderscores - (makeRelative libraryDirectory sourceFile) - ) - -<.> "o" + buildDirectory + </> map + toLower + (pathSeparatorsToUnderscores + (makeRelative libraryDirectory sourceFile) + ) + -<.> "o" sourceFileToExecutable :: FilePath -> FilePath -> FilePath -> FilePath sourceFileToExecutable buildDirectory appDirectory sourceFile = - buildDirectory - </> pathSeparatorsToUnderscores (makeRelative appDirectory sourceFile) - -<.> exe + buildDirectory + </> pathSeparatorsToUnderscores (makeRelative appDirectory sourceFile) + -<.> exe sourceFileToModFile :: FilePath -> FilePath -> FilePath -> FilePath sourceFileToModFile buildDirectory libraryDirectory sourceFile = - buildDirectory - </> map - toLower - (pathSeparatorsToUnderscores - (makeRelative libraryDirectory sourceFile) - ) - -<.> "mod" + buildDirectory + </> map + toLower + (pathSeparatorsToUnderscores + (makeRelative libraryDirectory sourceFile) + ) + -<.> "mod" pathSeparatorsToUnderscores :: FilePath -> FilePath pathSeparatorsToUnderscores fileName = - intercalate "_" (splitDirectories fileName) + intercalate "_" (splitDirectories fileName) getModulesUsed :: FilePath -> IO [ModuleName] getModulesUsed sourceFile = do - fileLines <- readFileLinesIO sourceFile - let lineContents = map parseFortranLine fileLines - return $ contentsToModuleNames lineContents + fileLines <- readFileLinesIO sourceFile + let lineContents = map parseFortranLine fileLines + return $ contentsToModuleNames lineContents contentsToModuleNames :: [LineContents] -> [ModuleName] contentsToModuleNames = mapMaybe contentToMaybeModuleName - where - contentToMaybeModuleName content = case content of - ModuleUsed moduleName -> Just moduleName - _ -> Nothing + where + contentToMaybeModuleName content = case content of + ModuleUsed moduleName -> Just moduleName + _ -> Nothing readFileLinesIO :: FilePath -> IO [String] readFileLinesIO file = do - contents <- readFile file - return $ lines contents + contents <- readFile file + return $ lines contents parseFortranLine :: String -> LineContents parseFortranLine line = - let line' = map toLower line - result = readP_to_S doFortranLineParse line' - in getResult result - where - getResult (_ : (contents, _) : _) = contents - getResult [(contents, _) ] = contents - getResult [] = Other + let line' = map toLower line + result = readP_to_S doFortranLineParse line' + in getResult result + where + getResult (_ : (contents, _) : _) = contents + getResult [(contents, _) ] = contents + getResult [] = Other doFortranLineParse :: ReadP LineContents doFortranLineParse = option Other fortranUsefulContents @@ -294,17 +277,17 @@ fortranUsefulContents = useStatement useStatement :: ReadP LineContents useStatement = do - skipSpaces - _ <- string "use" - skipAtLeastOneWhiteSpace - modName <- validIdentifier - skipSpaceCommaOrEnd - return $ ModuleUsed modName + skipSpaces + _ <- string "use" + skipAtLeastOneWhiteSpace + modName <- validIdentifier + skipSpaceCommaOrEnd + return $ ModuleUsed modName skipAtLeastOneWhiteSpace :: ReadP () skipAtLeastOneWhiteSpace = do - _ <- many1 whiteSpace - return () + _ <- many1 whiteSpace + return () skipSpaceOrEnd :: ReadP () skipSpaceOrEnd = eof <|> skipAtLeastOneWhiteSpace @@ -314,17 +297,17 @@ skipSpaceCommaOrEnd = eof <|> skipComma <|> skipAtLeastOneWhiteSpace skipComma :: ReadP () skipComma = do - _ <- char ',' - return () + _ <- char ',' + return () whiteSpace :: ReadP Char whiteSpace = satisfy (`elem` " \t") validIdentifier :: ReadP String validIdentifier = do - first <- validFirstCharacter - rest <- many validIdentifierCharacter - return $ first : rest + first <- validFirstCharacter + rest <- many validIdentifierCharacter + return $ first : rest validFirstCharacter :: ReadP Char validFirstCharacter = alphabet |