diff options
| -rw-r--r-- | app/Main.hs | 89 | ||||
| -rw-r--r-- | example_fpm.toml | 25 | ||||
| -rw-r--r-- | example_project/fpm.toml | 19 | ||||
| -rw-r--r-- | package.yaml | 3 | ||||
| -rw-r--r-- | src/Build.hs | 367 | ||||
| -rw-r--r-- | stack.yaml | 2 | ||||
| -rw-r--r-- | stack.yaml.lock | 8 |
7 files changed, 280 insertions, 233 deletions
diff --git a/app/Main.hs b/app/Main.hs index 88bb302..eceb260 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,8 +1,14 @@ +{-# LANGUAGE OverloadedStrings #-} + module Main where import Build ( buildLibrary , buildPrograms ) +import Data.Text ( Text + , unpack + ) +import qualified Data.Text.IO as TIO import Development.Shake ( FilePattern , (<//>) , getDirectoryFilesIO @@ -19,54 +25,64 @@ import Options.Applicative ( Parser , progDesc , subparser ) +import Toml ( TomlCodec + , (.=) + ) +import qualified Toml newtype Arguments = Arguments { command' :: Command } +data Settings = Settings { compiler :: !Text } + data Command = Run | Test | Build main :: IO () main = do - args <- getArguments - app args + args <- getArguments + fpmContents <- TIO.readFile "fpm.toml" + let settings = Toml.decode settingsCodec fpmContents + case settings of + Left err -> print err + Right settings -> app args settings -app :: Arguments -> IO () -app args = case command' args of - Run -> putStrLn "Run" - Test -> putStrLn "Test" - Build -> build +app :: Arguments -> Settings -> IO () +app args settings = case command' args of + Run -> putStrLn "Run" + Test -> putStrLn "Test" + Build -> build settings -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"] +build :: Settings -> IO () +build settings = do + putStrLn "Building" + buildLibrary "src" + [".f90", ".f", ".F", ".F90", ".f95", ".f03"] + ("build" </> "library") + (unpack $ compiler settings) + ["-g", "-Wall", "-Wextra", "-Werror", "-pedantic"] + "library" + [] + buildPrograms "app" + ["build" </> "library"] + [".f90", ".f", ".F", ".F90", ".f95", ".f03"] + ("build" </> "app") + (unpack $ compiler settings) + ["-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 +95,9 @@ 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 + +settingsCodec :: TomlCodec Settings +settingsCodec = Settings <$> Toml.text "compiler" .= compiler diff --git a/example_fpm.toml b/example_fpm.toml new file mode 100644 index 0000000..b7a2057 --- /dev/null +++ b/example_fpm.toml @@ -0,0 +1,25 @@ +name = "package-name" +version = "0.1.0" +license = "BSD3" +author = "Author name here" +maintainer = "example@example.com" +copyright = "2020 Author name here" +dependencies = ["../std-lib.tar.gz"] +compiler = "gfortran" +devel-options = ["-g", "-Wall", "-Wextra", "-Werror", "-pedantic"] +release-options = ["-O3"] + +[library] +source-dirs = "src" + +[executables.executable-name] +main = "Main.f90" +source-dirs = "app" +linker-options = ["-O3"] +dependencies = ["iso_varying_string"] + +[tests.test-name] +main = "Spec.f90" +source-dirs = "test" +linker-options = ["-Og"] +dependencies = ["vegetables >= 1.0 && < 2.0"] diff --git a/example_project/fpm.toml b/example_project/fpm.toml new file mode 100644 index 0000000..eda6e6b --- /dev/null +++ b/example_project/fpm.toml @@ -0,0 +1,19 @@ +name = "example_project" +version = "0.1.0" +license = "BSD3" +author = "Author" +maintainer = "example@example.com" +copyright = "2020 Author" +dependencies = [] +compiler = "gfortran" +devel-options = ["-g", "-Wall", "-Wextra", "-Werror", "-pedantic"] +release-options = ["-O3"] + +[library] +source-dirs = "src" + +[executables.Hello_world] +main = "Hello_world.f90" +source-dirs = "app" +linker-options = ["-O3"] +dependencies = [] diff --git a/package.yaml b/package.yaml index fd12307..c46000a 100644 --- a/package.yaml +++ b/package.yaml @@ -24,11 +24,12 @@ dependencies: - containers - directory - filepath -- MissingH - optparse-applicative - process - shake - split +- text +- tomland >= 1.0 library: 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 @@ -17,7 +17,7 @@ # # resolver: ./custom-snapshot.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml -resolver: lts-12.26 +resolver: lts-14.27 # User packages to be built. # Various formats can be used as shown in the example below. diff --git a/stack.yaml.lock b/stack.yaml.lock index 6bee1e8..e24dcac 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -6,7 +6,7 @@ packages: [] snapshots: - completed: - size: 509471 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/12/26.yaml - sha256: 95f014df58d0679b1c4a2b7bf2b652b61da8d30de5f571abb0d59015ef678646 - original: lts-12.26 + size: 524996 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/27.yaml + sha256: 7ea31a280c56bf36ff591a7397cc384d0dff622e7f9e4225b47d8980f019a0f0 + original: lts-14.27 |