From 16daa62ac79573fc87127df6e1ba080f197c5e31 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Sun, 14 Jun 2020 16:52:28 -0700 Subject: Add support for Makefiles and generic build scripts --- src/Build.hs | 46 ++++++++- src/Fpm.hs | 115 ++++++++++++++------- test/Spec.hs | 10 ++ test/example_packages/makefile_complex/.gitignore | 1 + test/example_packages/makefile_complex/Makefile | 9 ++ .../example_packages/makefile_complex/app/main.f90 | 7 ++ test/example_packages/makefile_complex/fpm.toml | 8 ++ .../makefile_complex/src/wrapper_mod.f90 | 12 +++ test/example_packages/with_makefile/.gitignore | 1 + test/example_packages/with_makefile/Makefile | 9 ++ test/example_packages/with_makefile/fpm.toml | 5 + .../with_makefile/src/hello_makefile.f90 | 10 ++ 12 files changed, 194 insertions(+), 39 deletions(-) create mode 100644 test/example_packages/makefile_complex/.gitignore create mode 100644 test/example_packages/makefile_complex/Makefile create mode 100644 test/example_packages/makefile_complex/app/main.f90 create mode 100644 test/example_packages/makefile_complex/fpm.toml create mode 100644 test/example_packages/makefile_complex/src/wrapper_mod.f90 create mode 100644 test/example_packages/with_makefile/.gitignore create mode 100644 test/example_packages/with_makefile/Makefile create mode 100644 test/example_packages/with_makefile/fpm.toml create mode 100644 test/example_packages/with_makefile/src/hello_makefile.f90 diff --git a/src/Build.hs b/src/Build.hs index 913e754..ce1f161 100644 --- a/src/Build.hs +++ b/src/Build.hs @@ -1,6 +1,8 @@ +{-# LANGUAGE MultiWayIf #-} module Build ( buildLibrary , buildProgram + , buildWithScript ) where @@ -10,7 +12,9 @@ import Data.Char ( isAsciiLower , isDigit , toLower ) -import Data.List ( intercalate ) +import Data.List ( intercalate + , isSuffixOf + ) import qualified Data.Map as Map import Data.Maybe ( fromMaybe , mapMaybe @@ -42,8 +46,13 @@ import Development.Shake.FilePath ( dropExtension , (<.>) , (-<.>) ) -import System.Directory ( makeAbsolute ) +import System.Directory ( createDirectoryIfMissing + , makeAbsolute + , withCurrentDirectory + ) +import System.Environment ( setEnv ) import System.FilePath ( splitDirectories ) +import System.Process ( system ) import Text.ParserCombinators.ReadP ( ReadP , char , eof @@ -359,3 +368,36 @@ digit = satisfy isDigit underscore :: ReadP Char underscore = char '_' + +buildWithScript + :: String + -> FilePath + -> FilePath + -> FilePath + -> [String] + -> String + -> [FilePath] + -> IO (FilePath) +buildWithScript script projectDirectory buildDirectory compiler flags libraryName otherLibraryDirectories + = do + absoluteBuildDirectory <- makeAbsolute buildDirectory + createDirectoryIfMissing True absoluteBuildDirectory + absoluteLibraryDirectories <- mapM makeAbsolute otherLibraryDirectories + setEnv "FC" compiler + setEnv "FFLAGS" (intercalate " " flags) + setEnv "BUILD_DIR" absoluteBuildDirectory + setEnv "INCLUDE_DIRS" (intercalate " " absoluteLibraryDirectories) + let archiveFile = absoluteBuildDirectory "lib" ++ libraryName <.> "a" + withCurrentDirectory + projectDirectory + if + | isMakefile script -> system + ("make -f " ++ script ++ " " ++ archiveFile) + | otherwise -> system (script ++ " " ++ archiveFile) + return archiveFile + +isMakefile :: String -> Bool +isMakefile script | script == "Makefile" = True + | script == "makefile" = True + | ".mk" `isSuffixOf` script = True + | otherwise = False diff --git a/src/Fpm.hs b/src/Fpm.hs index 2caf6e4..10335c0 100644 --- a/src/Fpm.hs +++ b/src/Fpm.hs @@ -11,9 +11,13 @@ where import Build ( buildLibrary , buildProgram + , buildWithScript ) import Control.Monad.Extra ( concatMapM ) -import Data.List (isSuffixOf, find, nub ) +import Data.List ( isSuffixOf + , find + , nub + ) import qualified Data.Map as Map import qualified Data.Text.IO as TIO import Development.Shake ( FilePattern @@ -79,7 +83,7 @@ data AppSettings = AppSettings { , appSettingsDevDependencies :: (Map.Map String Version) } -data Library = Library { librarySourceDir :: String } +data Library = Library { librarySourceDir :: String, libraryBuildScript :: Maybe String } data Executable = Executable { executableSourceDir :: String @@ -102,6 +106,7 @@ data DependencyTree = Dependency { dependencyName :: String , dependencyPath :: FilePath , dependencySourcePath :: FilePath + , dependencyBuildScript :: Maybe String , dependencyDependencies :: [DependencyTree] } @@ -117,8 +122,8 @@ start args = do app :: Arguments -> AppSettings -> IO () app args settings = case command' args of - Build -> build settings - Run whichOne -> do + Build -> build settings + Run whichOne -> do build settings let buildPrefix = appSettingsBuildPrefix settings let @@ -133,13 +138,15 @@ app args settings = case command' args of case canonicalExecutables of [] -> putStrLn "No Executables Found" _ -> case whichOne of - "" -> mapM_ system (map (++ " " ++ commandArguments args) canonicalExecutables) + "" -> mapM_ + system + (map (++ " " ++ commandArguments args) canonicalExecutables) name -> do - case find (name `isSuffixOf`) canonicalExecutables of - Nothing -> putStrLn "Executable Not Found" - Just specified -> do - system (specified ++ " " ++ (commandArguments args)) - return () + case find (name `isSuffixOf`) canonicalExecutables of + Nothing -> putStrLn "Executable Not Found" + Just specified -> do + system (specified ++ " " ++ (commandArguments args)) + return () Test whichOne -> do build settings let buildPrefix = appSettingsBuildPrefix settings @@ -155,13 +162,15 @@ app args settings = case command' args of case canonicalExecutables of [] -> putStrLn "No Tests Found" _ -> case whichOne of - "" -> mapM_ system (map (++ " " ++ commandArguments args) canonicalExecutables) + "" -> mapM_ + system + (map (++ " " ++ commandArguments args) canonicalExecutables) name -> do - case find (name `isSuffixOf`) canonicalExecutables of - Nothing -> putStrLn "Test Not Found" - Just specified -> do - system (specified ++ " " ++ (commandArguments args)) - return () + case find (name `isSuffixOf`) canonicalExecutables of + Nothing -> putStrLn "Test Not Found" + Just specified -> do + system (specified ++ " " ++ (commandArguments args)) + return () build :: AppSettings -> IO () build settings = do @@ -183,15 +192,24 @@ build settings = do { dependencyName = projectName , dependencyPath = "." , dependencySourcePath = librarySourceDir' + , dependencyBuildScript = libraryBuildScript librarySettings , dependencyDependencies = mainDependencyTrees } - thisArchive <- buildLibrary librarySourceDir' - [".f90", ".f", ".F", ".F90", ".f95", ".f03"] - (buildPrefix projectName) - compiler - flags - projectName - (map fst builtDependencies) + thisArchive <- case libraryBuildScript librarySettings of + Just script -> buildWithScript script + "." + (buildPrefix projectName) + compiler + flags + projectName + (map fst builtDependencies) + Nothing -> buildLibrary librarySourceDir' + [".f90", ".f", ".F", ".F90", ".f95", ".f03"] + (buildPrefix projectName) + compiler + flags + projectName + (map fst builtDependencies) return $ ( (buildPrefix projectName, thisArchive) : builtDependencies , Just thisDependencyTree @@ -263,13 +281,18 @@ arguments = (info buildArguments (progDesc "Build the executable")) ) <*> switch (long "release" <> help "Build in release mode") - <*> strOption (long "args" <> metavar "ARGS" <> value "" <> help "Arguments to pass to executables/tests") + <*> strOption + (long "args" <> metavar "ARGS" <> value "" <> help + "Arguments to pass to executables/tests" + ) runArguments :: Parser Command -runArguments = Run <$> strArgument (metavar "EXE" <> value "" <> help "Which executable to run") +runArguments = Run <$> strArgument + (metavar "EXE" <> value "" <> help "Which executable to run") testArguments :: Parser Command -testArguments = Test <$> strArgument (metavar "TEST" <> value "" <> help "Which test to run") +testArguments = + Test <$> strArgument (metavar "TEST" <> value "" <> help "Which test to run") buildArguments :: Parser Command buildArguments = pure Build @@ -297,7 +320,12 @@ settingsCodec = .= tomlSettingsDevDependencies libraryCodec :: TomlCodec Library -libraryCodec = Library <$> Toml.string "source-dir" .= librarySourceDir +libraryCodec = + Library + <$> Toml.string "source-dir" + .= librarySourceDir + <*> Toml.dioptional (Toml.string "build-script") + .= libraryBuildScript executableCodec :: TomlCodec Executable executableCodec = @@ -419,7 +447,10 @@ getLibrarySettings maybeSettings = case maybeSettings of Nothing -> do defaultExists <- doesDirectoryExist "src" if defaultExists - then return (Just (Library { librarySourceDir = "src" })) + then return + (Just + (Library { librarySourceDir = "src", libraryBuildScript = Nothing }) + ) else return Nothing getExecutableSettings :: [Executable] -> String -> IO [Executable] @@ -490,6 +521,7 @@ fetchDependencies dependencies = do { dependencyName = name , dependencyPath = path , dependencySourcePath = path (librarySourceDir librarySettings) + , dependencyBuildScript = libraryBuildScript librarySettings , dependencyDependencies = newDependencies } Nothing -> do @@ -500,7 +532,7 @@ fetchExecutableDependencies :: (Maybe DependencyTree) -> Map.Map String Version -> IO [DependencyTree] fetchExecutableDependencies maybeProjectTree dependencies = case maybeProjectTree of - Just projectTree@(Dependency name _ _ _) -> + Just projectTree@(Dependency name _ _ _ _) -> if name `Map.member` dependencies {- map contains this project-} then fmap (projectTree :) (fetchDependencies (Map.delete name dependencies)) {- fetch the other dependencies and include the project tree in the result -} @@ -524,6 +556,7 @@ fetchExecutableDependencies maybeProjectTree dependencies = { dependencyName = name , dependencyPath = path , dependencySourcePath = path (librarySourceDir librarySettings) + , dependencyBuildScript = libraryBuildScript librarySettings , dependencyDependencies = newDependencies } Nothing -> do @@ -573,18 +606,26 @@ buildDependencies buildPrefix compiler flags dependencies = do buildDependency :: String -> String -> [String] -> DependencyTree -> IO [(FilePath, FilePath)] -buildDependency buildPrefix compiler flags (Dependency name path sourcePath dependencies) +buildDependency buildPrefix compiler flags (Dependency name path sourcePath mBuildScript dependencies) = do transitiveDependencies <- buildDependencies buildPrefix compiler flags dependencies let buildPath = buildPrefix name - thisArchive <- buildLibrary sourcePath - [".f90", ".f", ".F", ".F90", ".f95", ".f03"] - buildPath - compiler - flags - name - (map fst transitiveDependencies) + thisArchive <- case mBuildScript of + Just script -> buildWithScript script + path + buildPath + compiler + flags + name + (map fst transitiveDependencies) + Nothing -> buildLibrary sourcePath + [".f90", ".f", ".F", ".F90", ".f95", ".f03"] + buildPath + compiler + flags + name + (map fst transitiveDependencies) return $ (buildPath, thisArchive) : transitiveDependencies diff --git a/test/Spec.hs b/test/Spec.hs index 18da62f..6fb4006 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -13,6 +13,8 @@ main = do testHelloComplex testHelloFpm testCircular + testWithMakefile + testMakefileComplex testHelloWorld :: IO () testHelloWorld = @@ -29,3 +31,11 @@ testHelloFpm = testCircular :: IO () testCircular = withCurrentDirectory (example_path "circular_example") $ start $ Arguments (Test "") False "" + +testWithMakefile :: IO () +testWithMakefile = + withCurrentDirectory (example_path "with_makefile") $ start $ Arguments (Build) False "" + +testMakefileComplex :: IO () +testMakefileComplex = + withCurrentDirectory (example_path "makefile_complex") $ start $ Arguments (Run "") False "" diff --git a/test/example_packages/makefile_complex/.gitignore b/test/example_packages/makefile_complex/.gitignore new file mode 100644 index 0000000..a007fea --- /dev/null +++ b/test/example_packages/makefile_complex/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/test/example_packages/makefile_complex/Makefile b/test/example_packages/makefile_complex/Makefile new file mode 100644 index 0000000..497c6b2 --- /dev/null +++ b/test/example_packages/makefile_complex/Makefile @@ -0,0 +1,9 @@ +INCLUDE_FLAGS = $(addprefix -I,$(INCLUDE_DIRS)) + +$(BUILD_DIR)/libmakefile_complex.a: $(BUILD_DIR)/wrapper_mod.o + ar rs $(@) $(^) + +$(BUILD_DIR)/wrapper_mod.mod: src/wrapper_mod.f90 + +$(BUILD_DIR)/wrapper_mod.o: src/wrapper_mod.f90 + $(FC) -c -J$(BUILD_DIR) $(INCLUDE_FLAGS) $(FFLAGS) -o $(@) $(<) diff --git a/test/example_packages/makefile_complex/app/main.f90 b/test/example_packages/makefile_complex/app/main.f90 new file mode 100644 index 0000000..ac9ed51 --- /dev/null +++ b/test/example_packages/makefile_complex/app/main.f90 @@ -0,0 +1,7 @@ +program makefile_complex + use wrapper_mod, only: do_stuff + + implicit none + + call do_stuff +end program makefile_complex diff --git a/test/example_packages/makefile_complex/fpm.toml b/test/example_packages/makefile_complex/fpm.toml new file mode 100644 index 0000000..3282cbe --- /dev/null +++ b/test/example_packages/makefile_complex/fpm.toml @@ -0,0 +1,8 @@ +name = "makefile_complex" + +[dependencies] +with_makefile = { path = "../with_makefile" } + +[library] +source-dir = "src" +build-script = "Makefile" diff --git a/test/example_packages/makefile_complex/src/wrapper_mod.f90 b/test/example_packages/makefile_complex/src/wrapper_mod.f90 new file mode 100644 index 0000000..e8028b5 --- /dev/null +++ b/test/example_packages/makefile_complex/src/wrapper_mod.f90 @@ -0,0 +1,12 @@ +module wrapper_mod + use hello_makefile, only: say_hello_from_makefile + + implicit none + private + + public :: do_stuff +contains + subroutine do_stuff + call say_hello_from_makefile + end subroutine do_stuff +end module wrapper_mod diff --git a/test/example_packages/with_makefile/.gitignore b/test/example_packages/with_makefile/.gitignore new file mode 100644 index 0000000..a007fea --- /dev/null +++ b/test/example_packages/with_makefile/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/test/example_packages/with_makefile/Makefile b/test/example_packages/with_makefile/Makefile new file mode 100644 index 0000000..51e72d4 --- /dev/null +++ b/test/example_packages/with_makefile/Makefile @@ -0,0 +1,9 @@ +INCLUDE_FLAGS = $(addprefix -I,$(INCLUDE_DIRS)) + +$(BUILD_DIR)/libwith_makefile.a: $(BUILD_DIR)/hello_makefile.o + ar rs $(@) $(^) + +$(BUILD_DIR)/hello_makefile.mod: src/hello_makefile.f90 + +$(BUILD_DIR)/hello_makefile.o: src/hello_makefile.f90 + $(FC) -c -J$(BUILD_DIR) $(INCLUDE_FLAGS) $(FFLAGS) -o $(@) $(<) diff --git a/test/example_packages/with_makefile/fpm.toml b/test/example_packages/with_makefile/fpm.toml new file mode 100644 index 0000000..81dd02a --- /dev/null +++ b/test/example_packages/with_makefile/fpm.toml @@ -0,0 +1,5 @@ +name = "with_makefile" + +[library] +source-dir = "src" +build-script = "Makefile" diff --git a/test/example_packages/with_makefile/src/hello_makefile.f90 b/test/example_packages/with_makefile/src/hello_makefile.f90 new file mode 100644 index 0000000..2d4d1a2 --- /dev/null +++ b/test/example_packages/with_makefile/src/hello_makefile.f90 @@ -0,0 +1,10 @@ +module hello_makefile + implicit none + private + + public :: say_hello_from_makefile +contains + subroutine say_hello_from_makefile() + print *, "Hello from Makefile library!" + end subroutine say_hello_from_makefile +end module hello_makefile -- cgit v1.2.3 From 778fb0e8e2e97e57deff3daf781329ae0976fb31 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Sun, 14 Jun 2020 17:10:55 -0700 Subject: Add info on custom build scripts to Packaging Guide --- PACKAGING.md | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/PACKAGING.md b/PACKAGING.md index 2d6fcfd..e8086f8 100644 --- a/PACKAGING.md +++ b/PACKAGING.md @@ -12,6 +12,8 @@ for it to successfully build with the Fortran Package Manager (FPM). - [Multi-level library](#multi-level-library) - [Be more explicit](#be-more-explicit) - [Add some tests](#add-some-tests) + - [Adding dependencies](#adding-dependencies) + - [Custom build scripts](#custom-build-scripts) ## What kind of package can FPM build? @@ -662,3 +664,32 @@ You can even specify the path to another folder, if for example you've got anoth fpm package in the same repository. Like this: `helloff = { path = "helloff" }`. Note that you should *not* specify paths outside of your repository, or things won't work for your users. + +### Custom Build Scripts + +If there is something special about your library that makes fpm unable to build +it, you can provide your own build script. fpm will then simply call your +build script to build the library. + +To specify a build script to be used, put it in the library section of your +`fpm.toml` file, like: + +```toml +[library] +source-dir="src" +build-script="my_build_script" +``` + +fpm will set the following environment variables to specify some parameters to +the build script. + +* `FC` - The Fortran compiler to be used +* `FFLAGS` - The flags that should be passed to the Fortran compiler +* `BUILD_DIR` - Where the compiled files should be placed +* `INCLUDE_DIRS` - The folders where any dependencies can be found + +Additionally, script will be called with the name of the archive (`*.a` file) +that should be produced as the command line argument. + +> Note: If the name of the build script is `Makefile` or ends with `.mk`, then +> the make program will be used to run it. -- cgit v1.2.3 From 91a649cdd80bf1062a03bcbc58715789ae0d3422 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Sun, 14 Jun 2020 19:18:26 -0700 Subject: Try escaping the colon in buildscript BUILD_DIR --- package.yaml | 1 + src/Build.hs | 6 +++++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/package.yaml b/package.yaml index ece47c9..7cf11c6 100644 --- a/package.yaml +++ b/package.yaml @@ -25,6 +25,7 @@ dependencies: - directory - extra - filepath +- MissingH - optparse-applicative - process - shake diff --git a/src/Build.hs b/src/Build.hs index ce1f161..96b58ab 100644 --- a/src/Build.hs +++ b/src/Build.hs @@ -15,6 +15,7 @@ import Data.Char ( isAsciiLower import Data.List ( intercalate , isSuffixOf ) +import Data.List.Utils (replace) import qualified Data.Map as Map import Data.Maybe ( fromMaybe , mapMaybe @@ -385,7 +386,7 @@ buildWithScript script projectDirectory buildDirectory compiler flags libraryNam absoluteLibraryDirectories <- mapM makeAbsolute otherLibraryDirectories setEnv "FC" compiler setEnv "FFLAGS" (intercalate " " flags) - setEnv "BUILD_DIR" absoluteBuildDirectory + setEnv "BUILD_DIR" (escapeColon absoluteBuildDirectory) setEnv "INCLUDE_DIRS" (intercalate " " absoluteLibraryDirectories) let archiveFile = absoluteBuildDirectory "lib" ++ libraryName <.> "a" withCurrentDirectory @@ -401,3 +402,6 @@ isMakefile script | script == "Makefile" = True | script == "makefile" = True | ".mk" `isSuffixOf` script = True | otherwise = False + +escapeColon :: String -> String +escapeColon = replace ":" "\\:" -- cgit v1.2.3 From ac01e266362251ba6c10443aeacf2e13061e4a05 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Sun, 14 Jun 2020 19:45:06 -0700 Subject: Revert "Try escaping the colon in buildscript BUILD_DIR" This reverts commit 91a649cdd80bf1062a03bcbc58715789ae0d3422. --- package.yaml | 1 - src/Build.hs | 6 +----- 2 files changed, 1 insertion(+), 6 deletions(-) diff --git a/package.yaml b/package.yaml index 7cf11c6..ece47c9 100644 --- a/package.yaml +++ b/package.yaml @@ -25,7 +25,6 @@ dependencies: - directory - extra - filepath -- MissingH - optparse-applicative - process - shake diff --git a/src/Build.hs b/src/Build.hs index 96b58ab..ce1f161 100644 --- a/src/Build.hs +++ b/src/Build.hs @@ -15,7 +15,6 @@ import Data.Char ( isAsciiLower import Data.List ( intercalate , isSuffixOf ) -import Data.List.Utils (replace) import qualified Data.Map as Map import Data.Maybe ( fromMaybe , mapMaybe @@ -386,7 +385,7 @@ buildWithScript script projectDirectory buildDirectory compiler flags libraryNam absoluteLibraryDirectories <- mapM makeAbsolute otherLibraryDirectories setEnv "FC" compiler setEnv "FFLAGS" (intercalate " " flags) - setEnv "BUILD_DIR" (escapeColon absoluteBuildDirectory) + setEnv "BUILD_DIR" absoluteBuildDirectory setEnv "INCLUDE_DIRS" (intercalate " " absoluteLibraryDirectories) let archiveFile = absoluteBuildDirectory "lib" ++ libraryName <.> "a" withCurrentDirectory @@ -402,6 +401,3 @@ isMakefile script | script == "Makefile" = True | script == "makefile" = True | ".mk" `isSuffixOf` script = True | otherwise = False - -escapeColon :: String -> String -escapeColon = replace ":" "\\:" -- cgit v1.2.3 From 100d30c57ffafb06b13d655bce5a09b518f732f1 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Sun, 14 Jun 2020 20:01:44 -0700 Subject: See if removing the drive letter works --- src/Build.hs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/Build.hs b/src/Build.hs index ce1f161..7646ed6 100644 --- a/src/Build.hs +++ b/src/Build.hs @@ -385,9 +385,9 @@ buildWithScript script projectDirectory buildDirectory compiler flags libraryNam absoluteLibraryDirectories <- mapM makeAbsolute otherLibraryDirectories setEnv "FC" compiler setEnv "FFLAGS" (intercalate " " flags) - setEnv "BUILD_DIR" absoluteBuildDirectory - setEnv "INCLUDE_DIRS" (intercalate " " absoluteLibraryDirectories) - let archiveFile = absoluteBuildDirectory "lib" ++ libraryName <.> "a" + setEnv "BUILD_DIR" $ removeDriveLetter absoluteBuildDirectory + setEnv "INCLUDE_DIRS" (intercalate " " (map removeDriveLetter absoluteLibraryDirectories)) + let archiveFile = (removeDriveLetter absoluteBuildDirectory) "lib" ++ libraryName <.> "a" withCurrentDirectory projectDirectory if @@ -401,3 +401,8 @@ isMakefile script | script == "Makefile" = True | script == "makefile" = True | ".mk" `isSuffixOf` script = True | otherwise = False + +removeDriveLetter :: String -> String +removeDriveLetter path + | ':' `elem` path = (tail . dropWhile (/= ':')) path + | otherwise = path -- cgit v1.2.3 From 5fae72c579869e6e2636ef38e47d91e3877dc47f Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Sun, 14 Jun 2020 20:42:45 -0700 Subject: Try using Linux like paths for build scripts --- package.yaml | 1 + src/Build.hs | 28 ++++++++++++++++++++-------- 2 files changed, 21 insertions(+), 8 deletions(-) diff --git a/package.yaml b/package.yaml index ece47c9..7cf11c6 100644 --- a/package.yaml +++ b/package.yaml @@ -25,6 +25,7 @@ dependencies: - directory - extra - filepath +- MissingH - optparse-applicative - process - shake diff --git a/src/Build.hs b/src/Build.hs index 7646ed6..c7519e5 100644 --- a/src/Build.hs +++ b/src/Build.hs @@ -15,6 +15,7 @@ import Data.Char ( isAsciiLower import Data.List ( intercalate , isSuffixOf ) +import Data.List.Utils ( replace ) import qualified Data.Map as Map import Data.Maybe ( fromMaybe , mapMaybe @@ -383,11 +384,17 @@ buildWithScript script projectDirectory buildDirectory compiler flags libraryNam absoluteBuildDirectory <- makeAbsolute buildDirectory createDirectoryIfMissing True absoluteBuildDirectory absoluteLibraryDirectories <- mapM makeAbsolute otherLibraryDirectories - setEnv "FC" compiler - setEnv "FFLAGS" (intercalate " " flags) - setEnv "BUILD_DIR" $ removeDriveLetter absoluteBuildDirectory - setEnv "INCLUDE_DIRS" (intercalate " " (map removeDriveLetter absoluteLibraryDirectories)) - let archiveFile = (removeDriveLetter absoluteBuildDirectory) "lib" ++ libraryName <.> "a" + setEnv "FC" compiler + setEnv "FFLAGS" (intercalate " " flags) + setEnv "BUILD_DIR" $ unWindowsPath absoluteBuildDirectory + setEnv + "INCLUDE_DIRS" + (intercalate " " (map unWindowsPath absoluteLibraryDirectories)) + let archiveFile = + (removeDriveLetter absoluteBuildDirectory) + "lib" + ++ libraryName + <.> "a" withCurrentDirectory projectDirectory if @@ -402,7 +409,12 @@ isMakefile script | script == "Makefile" = True | ".mk" `isSuffixOf` script = True | otherwise = False +unWindowsPath :: String -> String +unWindowsPath = changeSeparators . removeDriveLetter + removeDriveLetter :: String -> String -removeDriveLetter path - | ':' `elem` path = (tail . dropWhile (/= ':')) path - | otherwise = path +removeDriveLetter path | ':' `elem` path = (tail . dropWhile (/= ':')) path + | otherwise = path + +changeSeparators :: String -> String +changeSeparators = replace "\\" "/" -- cgit v1.2.3 From a124c4206b2eaed141c25ca18dee0a8ad70f122d Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Sun, 14 Jun 2020 20:55:01 -0700 Subject: Fix missed unWindowsPath --- src/Build.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Build.hs b/src/Build.hs index c7519e5..ee8cbed 100644 --- a/src/Build.hs +++ b/src/Build.hs @@ -391,7 +391,7 @@ buildWithScript script projectDirectory buildDirectory compiler flags libraryNam "INCLUDE_DIRS" (intercalate " " (map unWindowsPath absoluteLibraryDirectories)) let archiveFile = - (removeDriveLetter absoluteBuildDirectory) + (unWindowsPath absoluteBuildDirectory) "lib" ++ libraryName <.> "a" -- cgit v1.2.3 From ec8855dc7272f24c5e84cfbca53a53b544a61304 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Sun, 14 Jun 2020 21:05:58 -0700 Subject: Fix another path issue for build script --- src/Build.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Build.hs b/src/Build.hs index ee8cbed..67ec2f9 100644 --- a/src/Build.hs +++ b/src/Build.hs @@ -392,7 +392,7 @@ buildWithScript script projectDirectory buildDirectory compiler flags libraryNam (intercalate " " (map unWindowsPath absoluteLibraryDirectories)) let archiveFile = (unWindowsPath absoluteBuildDirectory) - "lib" + ++ "/lib" ++ libraryName <.> "a" withCurrentDirectory -- cgit v1.2.3 From df531fcffdd5c7b6233d0107152725ce3f8f22c1 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Mon, 15 Jun 2020 19:41:16 -0700 Subject: Add clarifications to PACKAGING.md --- PACKAGING.md | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/PACKAGING.md b/PACKAGING.md index e8086f8..941f1b0 100644 --- a/PACKAGING.md +++ b/PACKAGING.md @@ -686,10 +686,16 @@ the build script. * `FC` - The Fortran compiler to be used * `FFLAGS` - The flags that should be passed to the Fortran compiler * `BUILD_DIR` - Where the compiled files should be placed -* `INCLUDE_DIRS` - The folders where any dependencies can be found +* `INCLUDE_DIRS` - The folders where any dependencies can be found, space seperated. + It is then the responsibility of the build script to generate the appropriate + include flags. Additionally, script will be called with the name of the archive (`*.a` file) that should be produced as the command line argument. > Note: If the name of the build script is `Makefile` or ends with `.mk`, then -> the make program will be used to run it. +> the make program will be used to run it. Not the the archive file is explicitly +> specified as the target to be built + +> Note: All file and directory names are specified with their full canonical +> path. -- cgit v1.2.3