aboutsummaryrefslogtreecommitdiff
path: root/bootstrap/src/Fpm.hs
diff options
context:
space:
mode:
Diffstat (limited to 'bootstrap/src/Fpm.hs')
-rw-r--r--bootstrap/src/Fpm.hs342
1 files changed, 240 insertions, 102 deletions
diff --git a/bootstrap/src/Fpm.hs b/bootstrap/src/Fpm.hs
index 115b63e..cfb67df 100644
--- a/bootstrap/src/Fpm.hs
+++ b/bootstrap/src/Fpm.hs
@@ -3,7 +3,6 @@
module Fpm
( Arguments(..)
- , Command(..)
, getArguments
, start
)
@@ -17,6 +16,7 @@ import Control.Monad.Extra ( concatMapM
, forM_
, when
)
+import Data.Hashable ( hash )
import Data.List ( isSuffixOf
, find
, nub
@@ -30,6 +30,7 @@ import Development.Shake ( FilePattern
import Development.Shake.FilePath ( (</>)
, (<.>)
, exe
+ , splitDirectories
)
import Options.Applicative ( Parser
, (<**>)
@@ -42,8 +43,12 @@ import Options.Applicative ( Parser
, helper
, info
, long
+ , many
, metavar
+ , optional
, progDesc
+ , short
+ , showDefault
, strArgument
, strOption
, subparser
@@ -59,7 +64,7 @@ import System.Directory ( createDirectory
import System.Exit ( ExitCode(..)
, exitWith
)
-import System.Process ( runCommand
+import System.Process ( readProcess
, system
)
import Toml ( TomlCodec
@@ -67,7 +72,32 @@ import Toml ( TomlCodec
)
import qualified Toml
-data Arguments = Arguments { command' :: Command, release :: Bool, commandArguments :: String }
+data Arguments =
+ New
+ { newName :: String
+ , newWithExecutable :: Bool
+ , newWithTest :: Bool
+ , newWithLib :: Bool
+ }
+ | Build
+ { buildRelease :: Bool
+ , buildCompiler :: FilePath
+ , buildFlags :: [String]
+ }
+ | Run
+ { runRelease :: Bool
+ , runCompiler :: FilePath
+ , runFlags :: [String]
+ , runTarget :: Maybe String
+ , runArgs :: Maybe String
+ }
+ | Test
+ { testRelease :: Bool
+ , testCompiler :: FilePath
+ , testFlags :: [String]
+ , testTarget :: Maybe String
+ , testArgs :: Maybe String
+ }
data TomlSettings = TomlSettings {
tomlSettingsProjectName :: String
@@ -107,8 +137,6 @@ data GitRef = Tag String | Branch String | Commit String deriving Show
data PathVersionSpec = PathVersionSpec { pathVersionSpecPath :: String } deriving Show
-data Command = Run String | Test String | Build | New String Bool Bool
-
data DependencyTree = Dependency {
dependencyName :: String
, dependencyPath :: FilePath
@@ -118,22 +146,22 @@ data DependencyTree = Dependency {
}
start :: Arguments -> IO ()
-start args = case command' args of
- New projectName withExecutable withTest ->
- createNewProject projectName withExecutable withTest
+start args = case args of
+ New { newName = name, newWithExecutable = withExecutable, newWithTest = withTest, newWithLib = withLib }
+ -> createNewProject name withExecutable withTest withLib
_ -> do
fpmContents <- TIO.readFile "fpm.toml"
let tomlSettings = Toml.decode settingsCodec fpmContents
case tomlSettings of
Left err -> print err
Right tomlSettings' -> do
- appSettings <- toml2AppSettings tomlSettings' (release args)
+ appSettings <- toml2AppSettings tomlSettings' args
app args appSettings
app :: Arguments -> AppSettings -> IO ()
-app args settings = case command' args of
- Build -> build settings
- Run whichOne -> do
+app args settings = case args of
+ Build{} -> build settings
+ Run { runTarget = whichOne, runArgs = runArgs } -> do
build settings
let buildPrefix = appSettingsBuildPrefix settings
let
@@ -148,10 +176,16 @@ app args settings = case command' args of
case canonicalExecutables of
[] -> putStrLn "No Executables Found"
_ -> case whichOne of
- "" -> do
+ Nothing -> do
exitCodes <- mapM
system
- (map (++ " " ++ commandArguments args) canonicalExecutables)
+ (map
+ (++ case runArgs of
+ Nothing -> ""
+ Just theArgs -> " " ++ theArgs
+ )
+ canonicalExecutables
+ )
forM_
exitCodes
(\exitCode -> when
@@ -161,13 +195,15 @@ app args settings = case command' args of
)
(exitWith exitCode)
)
- name -> do
+ Just name -> do
case find (name `isSuffixOf`) canonicalExecutables of
Nothing -> putStrLn "Executable Not Found"
Just specified -> do
- exitCode <- system (specified ++ " " ++ (commandArguments args))
+ exitCode <- case runArgs of
+ Nothing -> system specified
+ Just theArgs -> system (specified ++ " " ++ theArgs)
exitWith exitCode
- Test whichOne -> do
+ Test { testTarget = whichOne, testArgs = testArgs } -> do
build settings
let buildPrefix = appSettingsBuildPrefix settings
let
@@ -182,10 +218,16 @@ app args settings = case command' args of
case canonicalExecutables of
[] -> putStrLn "No Tests Found"
_ -> case whichOne of
- "" -> do
+ Nothing -> do
exitCodes <- mapM
system
- (map (++ " " ++ commandArguments args) canonicalExecutables)
+ (map
+ (++ case testArgs of
+ Nothing -> ""
+ Just theArgs -> " " ++ theArgs
+ )
+ canonicalExecutables
+ )
forM_
exitCodes
(\exitCode -> when
@@ -195,12 +237,15 @@ app args settings = case command' args of
)
(exitWith exitCode)
)
- name -> do
+ Just name -> do
case find (name `isSuffixOf`) canonicalExecutables of
Nothing -> putStrLn "Test Not Found"
Just specified -> do
- exitCode <- system (specified ++ " " ++ (commandArguments args))
+ exitCode <- case testArgs of
+ Nothing -> system specified
+ Just theArgs -> system (specified ++ " " ++ theArgs)
exitWith exitCode
+ _ -> putStrLn "Shouldn't be able to get here"
build :: AppSettings -> IO ()
build settings = do
@@ -302,42 +347,110 @@ getArguments = execParser
)
arguments :: Parser Arguments
-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
- "new"
- (info newArguments
- (progDesc "Create a new project in a new directory")
- )
+arguments = subparser
+ ( command
+ "new"
+ (info (newArguments <**> helper)
+ (progDesc "Create a new project in a new directory")
+ )
+ <> command
+ "build"
+ (info (buildArguments <**> helper) (progDesc "Build the project"))
+ <> command
+ "run"
+ (info (runArguments <**> helper) (progDesc "Run the executable(s)"))
+ <> command "test"
+ (info (testArguments <**> helper) (progDesc "Run the test(s)"))
+ )
+
+newArguments :: Parser Arguments
+newArguments =
+ New
+ <$> strArgument
+ ( metavar "NAME"
+ <> help "Name of new project (must be a valid Fortran identifier)"
+ )
+ <*> switch (long "app" <> help "Include an executable")
+ <*> switch (long "test" <> help "Include a test")
+ <*> switch (long "lib" <> help "Include a library")
+
+buildArguments :: Parser Arguments
+buildArguments =
+ Build
+ <$> switch
+ ( long "release"
+ <> help "Build with optimizations instead of debugging"
)
- <*> switch (long "release" <> help "Build in release mode")
<*> strOption
- (long "args" <> metavar "ARGS" <> value "" <> help
- "Arguments to pass to executables/tests"
+ ( long "compiler"
+ <> metavar "COMPILER"
+ <> value "gfortran"
+ <> help "specify the compiler to use"
+ <> showDefault
+ )
+ <*> many
+ (strOption
+ ( long "flag"
+ <> metavar "FLAG"
+ <> help
+ "specify an addional argument to pass to the compiler (can appear multiple times)"
+ )
)
-runArguments :: Parser Command
-runArguments = Run <$> strArgument
- (metavar "EXE" <> value "" <> help "Which executable to run")
+runArguments :: Parser Arguments
+runArguments =
+ Run
+ <$> switch
+ ( long "release"
+ <> help "Build with optimizations instead of debugging"
+ )
+ <*> strOption
+ ( long "compiler"
+ <> metavar "COMPILER"
+ <> value "gfortran"
+ <> help "specify the compiler to use"
+ <> showDefault
+ )
+ <*> many
+ (strOption
+ ( long "flag"
+ <> metavar "FLAG"
+ <> help
+ "specify an addional argument to pass to the compiler (can appear multiple times)"
+ )
+ )
+ <*> optional
+ (strArgument
+ (metavar "TARGET" <> help "Name of the executable to run")
+ )
+ <*> optional
+ (strArgument (metavar "ARGS" <> help "Arguments to the executable"))
-testArguments :: Parser Command
+testArguments :: Parser Arguments
testArguments =
- Test <$> strArgument (metavar "TEST" <> value "" <> help "Which test to run")
-
-buildArguments :: Parser Command
-buildArguments = pure Build
-
-newArguments :: Parser Command
-newArguments =
- New
- <$> strArgument (metavar "NAME" <> help "Name of new project")
- <*> switch (long "with-executable" <> help "Include an executable")
- <*> switch (long "with-test" <> help "Include a test")
+ Test
+ <$> switch
+ ( long "release"
+ <> help "Build with optimizations instead of debugging"
+ )
+ <*> strOption
+ ( long "compiler"
+ <> metavar "COMPILER"
+ <> value "gfortran"
+ <> help "specify the compiler to use"
+ <> showDefault
+ )
+ <*> many
+ (strOption
+ ( long "flag"
+ <> metavar "FLAG"
+ <> help
+ "specify an addional argument to pass to the compiler (can appear multiple times)"
+ )
+ )
+ <*> optional
+ (strArgument (metavar "TARGET" <> help "Name of the test to run"))
+ <*> optional (strArgument (metavar "ARGS" <> help "Arguments to the test"))
getDirectoriesFiles :: [FilePath] -> [FilePattern] -> IO [FilePath]
getDirectoriesFiles dirs exts = getDirectoryFilesIO "" newPatterns
@@ -437,51 +550,66 @@ pathVersionCodec :: Toml.TomlCodec PathVersionSpec
pathVersionCodec =
PathVersionSpec <$> Toml.string "path" .= pathVersionSpecPath
-toml2AppSettings :: TomlSettings -> Bool -> IO AppSettings
-toml2AppSettings tomlSettings release = do
+toml2AppSettings :: TomlSettings -> Arguments -> IO AppSettings
+toml2AppSettings tomlSettings args = do
+ let release = case args of
+ Build { buildRelease = r } -> r
+ Run { runRelease = r } -> r
+ Test { testRelease = r } -> r
let projectName = tomlSettingsProjectName tomlSettings
- let compiler = "gfortran"
+ let compiler = case args of
+ Build { buildCompiler = c } -> c
+ Run { runCompiler = c } -> c
+ Test { testCompiler = c } -> c
+ let specifiedFlags = case args of
+ Build { buildFlags = f } -> f
+ Run { runFlags = f } -> f
+ Test { testFlags = f } -> f
librarySettings <- getLibrarySettings $ tomlSettingsLibrary tomlSettings
executableSettings <- getExecutableSettings
(tomlSettingsExecutables tomlSettings)
projectName
testSettings <- getTestSettings $ tomlSettingsTests tomlSettings
- buildPrefix <- makeBuildPrefix compiler release
+ let flags = if compiler == "gfortran"
+ then case specifiedFlags of
+ [] -> if release
+ then
+ [ "-Wall"
+ , "-Wextra"
+ , "-Wimplicit-interface"
+ , "-fPIC"
+ , "-fmax-errors=1"
+ , "-O3"
+ , "-march=native"
+ , "-ffast-math"
+ , "-funroll-loops"
+ ]
+ else
+ [ "-Wall"
+ , "-Wextra"
+ , "-Wimplicit-interface"
+ , "-fPIC"
+ , "-fmax-errors=1"
+ , "-g"
+ , "-fbounds-check"
+ , "-fcheck-array-temporaries"
+ , "-fbacktrace"
+ ]
+ flags -> flags
+ else specifiedFlags
+ buildPrefix <- makeBuildPrefix compiler flags
let dependencies = tomlSettingsDependencies tomlSettings
let devDependencies = tomlSettingsDevDependencies tomlSettings
- return AppSettings
- { appSettingsCompiler = compiler
- , appSettingsProjectName = projectName
- , appSettingsBuildPrefix = buildPrefix
- , appSettingsFlags = if release
- then
- [ "-Wall"
- , "-Wextra"
- , "-Wimplicit-interface"
- , "-fPIC"
- , "-fmax-errors=1"
- , "-O3"
- , "-march=native"
- , "-ffast-math"
- , "-funroll-loops"
- ]
- else
- [ "-Wall"
- , "-Wextra"
- , "-Wimplicit-interface"
- , "-fPIC"
- , "-fmax-errors=1"
- , "-g"
- , "-fbounds-check"
- , "-fcheck-array-temporaries"
- , "-fbacktrace"
- ]
- , appSettingsLibrary = librarySettings
- , appSettingsExecutables = executableSettings
- , appSettingsTests = testSettings
- , appSettingsDependencies = dependencies
- , appSettingsDevDependencies = devDependencies
- }
+ return AppSettings { appSettingsCompiler = compiler
+ , appSettingsProjectName = projectName
+ , appSettingsBuildPrefix = buildPrefix
+ , appSettingsFlags = flags
+ , appSettingsLibrary = librarySettings
+ , appSettingsExecutables = executableSettings
+ , appSettingsTests = testSettings
+ , appSettingsDependencies = dependencies
+ , appSettingsDevDependencies = devDependencies
+ }
getLibrarySettings :: Maybe Library -> IO (Maybe Library)
getLibrarySettings maybeSettings = case maybeSettings of
@@ -531,11 +659,21 @@ getTestSettings [] = do
else return []
getTestSettings tests = return tests
-makeBuildPrefix :: String -> Bool -> IO String
-makeBuildPrefix compiler release =
+makeBuildPrefix :: FilePath -> [String] -> IO FilePath
+makeBuildPrefix compiler flags = do
-- TODO Figure out what other info should be part of this
-- Probably version, and make sure to not include path to the compiler
- return $ "build" </> compiler ++ "_" ++ if release then "release" else "debug"
+ versionInfo <- readProcess compiler ["--version"] []
+ let compilerName = last (splitDirectories compiler)
+ let versionHash = hash versionInfo
+ let flagsHash = hash flags
+ return
+ $ "build"
+ </> compilerName
+ ++ "_"
+ ++ show versionHash
+ ++ "_"
+ ++ show flagsHash
{-
Fetching the dependencies is done on a sort of breadth first approach. All
@@ -682,19 +820,20 @@ buildDependency buildPrefix compiler flags (Dependency name path sourcePath mBui
(map fst transitiveDependencies)
return $ (buildPath, thisArchive) : transitiveDependencies
-createNewProject :: String -> Bool -> Bool -> IO ()
-createNewProject projectName withExecutable withTest = do
+createNewProject :: String -> Bool -> Bool -> Bool -> IO ()
+createNewProject projectName withExecutable withTest withLib = do
createDirectory projectName
writeFile (projectName </> "fpm.toml") (templateFpmToml projectName)
writeFile (projectName </> "README.md") (templateReadme projectName)
writeFile (projectName </> ".gitignore") "build/*\n"
- createDirectory (projectName </> "src")
- writeFile (projectName </> "src" </> projectName <.> "f90")
- (templateModule projectName)
+ when withLib $ do
+ createDirectory (projectName </> "src")
+ writeFile (projectName </> "src" </> projectName <.> "f90")
+ (templateModule projectName)
when withExecutable $ do
createDirectory (projectName </> "app")
writeFile (projectName </> "app" </> "main.f90")
- (templateProgram projectName)
+ (templateProgram projectName withLib)
when withTest $ do
createDirectory (projectName </> "test")
writeFile (projectName </> "test" </> "main.f90") templateTest
@@ -736,12 +875,11 @@ templateReadme :: String -> String
templateReadme projectName =
"# " ++ projectName ++ "\n" ++ "\n" ++ "My cool new project!\n"
-templateProgram :: String -> String
-templateProgram projectName =
+templateProgram :: String -> Bool -> String
+templateProgram projectName withLib =
"program main\n"
- ++ " use "
- ++ projectName
- ++ ", only: say_hello\n"
+ ++ (if withLib then " use " ++ projectName ++ ", only: say_hello\n" else ""
+ )
++ "\n"
++ " implicit none\n"
++ "\n"
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-15 07:05:17 +0000