aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Fpm.hs246
1 files changed, 212 insertions, 34 deletions
diff --git a/src/Fpm.hs b/src/Fpm.hs
index 3f06c05..253bc85 100644
--- a/src/Fpm.hs
+++ b/src/Fpm.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Fpm
@@ -11,6 +12,9 @@ where
import Build ( buildLibrary
, buildProgram
)
+import Control.Monad.Extra ( concatMapM )
+import Data.List ( nub )
+import qualified Data.Map as Map
import qualified Data.Text.IO as TIO
import Development.Shake ( FilePattern
, (<//>)
@@ -22,6 +26,7 @@ import Development.Shake.FilePath ( (</>)
)
import Options.Applicative ( Parser
, (<**>)
+ , (<|>)
, command
, execParser
, fullDesc
@@ -37,8 +42,11 @@ import Options.Applicative ( Parser
import System.Directory ( doesDirectoryExist
, doesFileExist
, makeAbsolute
+ , withCurrentDirectory
+ )
+import System.Process ( runCommand
+ , system
)
-import System.Process ( runCommand )
import Toml ( TomlCodec
, (.=)
)
@@ -51,6 +59,7 @@ data TomlSettings = TomlSettings {
, tomlSettingsLibrary :: (Maybe Library)
, tomlSettingsExecutables :: [Executable]
, tomlSettingsTests :: [Executable]
+ , tomlSettingsDependencies :: (Map.Map String Version)
}
data AppSettings = AppSettings {
@@ -61,6 +70,7 @@ data AppSettings = AppSettings {
, appSettingsLibrary :: (Maybe Library)
, appSettingsExecutables :: [Executable]
, appSettingsTests :: [Executable]
+ , appSettingsDependencies :: (Map.Map String Version)
}
data Library = Library { librarySourceDir :: String }
@@ -71,8 +81,23 @@ data Executable = Executable {
, executableName :: String
}
+data Version = SimpleVersion String | GitVersion GitVersionSpec | PathVersion PathVersionSpec
+
+data GitVersionSpec = GitVersionSpec { gitVersionSpecUrl :: String, gitVersionSpecRef :: Maybe GitRef }
+
+data GitRef = Tag String | Branch String | Commit String
+
+data PathVersionSpec = PathVersionSpec { pathVersionSpecPath :: String }
+
data Command = Run | Test | Build
+data DependencyTree = Dependency {
+ dependencyName :: String
+ , dependencyPath :: FilePath
+ , dependencySourcePath :: FilePath
+ , dependencyDependencies :: [DependencyTree]
+}
+
start :: Arguments -> IO ()
start args = do
fpmContents <- TIO.readFile "fpm.toml"
@@ -125,19 +150,22 @@ build settings = do
let flags = appSettingsFlags settings
let executables = appSettingsExecutables settings
let tests = appSettingsTests settings
+ builtDependencies <-
+ fetchDependencies [projectName] (appSettingsDependencies settings)
+ >>= buildDependencies buildPrefix compiler flags
executableDepends <- case appSettingsLibrary settings of
Just librarySettings -> do
let librarySourceDir' = librarySourceDir librarySettings
buildLibrary librarySourceDir'
[".f90", ".f", ".F", ".F90", ".f95", ".f03"]
- (buildPrefix </> "library")
+ (buildPrefix </> projectName)
compiler
flags
projectName
- []
- return [buildPrefix </> "library"]
+ builtDependencies
+ return $ (buildPrefix </> projectName) : builtDependencies
Nothing -> do
- return []
+ return builtDependencies
mapM_
(\Executable { executableSourceDir = sourceDir, executableMainFile = mainFile, executableName = name } ->
do
@@ -211,6 +239,8 @@ settingsCodec =
.= tomlSettingsExecutables
<*> Toml.list executableCodec "test"
.= tomlSettingsTests
+ <*> Toml.tableMap Toml._KeyString versionCodec "dependencies"
+ .= tomlSettingsDependencies
libraryCodec :: TomlCodec Library
libraryCodec = Library <$> Toml.string "source-dir" .= librarySourceDir
@@ -225,6 +255,60 @@ executableCodec =
<*> Toml.string "name"
.= executableName
+matchSimpleVersion :: Version -> Maybe String
+matchSimpleVersion = \case
+ SimpleVersion v -> Just v
+ _ -> Nothing
+
+matchGitVersion :: Version -> Maybe GitVersionSpec
+matchGitVersion = \case
+ GitVersion v -> Just v
+ _ -> Nothing
+
+matchPathVersion :: Version -> Maybe PathVersionSpec
+matchPathVersion = \case
+ PathVersion v -> Just v
+ _ -> Nothing
+
+matchTag :: GitRef -> Maybe String
+matchTag = \case
+ Tag v -> Just v
+ _ -> Nothing
+
+matchBranch :: GitRef -> Maybe String
+matchBranch = \case
+ Branch v -> Just v
+ _ -> Nothing
+
+matchCommit :: GitRef -> Maybe String
+matchCommit = \case
+ Commit v -> Just v
+ _ -> Nothing
+
+versionCodec :: Toml.Key -> Toml.TomlCodec Version
+versionCodec key =
+ Toml.dimatch matchSimpleVersion SimpleVersion (Toml.string key)
+ <|> Toml.dimatch matchGitVersion GitVersion (Toml.table gitVersionCodec key)
+ <|> Toml.dimatch matchPathVersion PathVersion (Toml.table pathVersionCodec key)
+
+gitVersionCodec :: Toml.TomlCodec GitVersionSpec
+gitVersionCodec =
+ GitVersionSpec
+ <$> Toml.string "git"
+ .= gitVersionSpecUrl
+ <*> Toml.dioptional gitRefCodec
+ .= gitVersionSpecRef
+
+gitRefCodec :: Toml.TomlCodec GitRef
+gitRefCodec =
+ Toml.dimatch matchTag Tag (Toml.string "tag")
+ <|> Toml.dimatch matchBranch Branch (Toml.string "branch")
+ <|> Toml.dimatch matchCommit Commit (Toml.string "rev")
+
+pathVersionCodec :: Toml.TomlCodec PathVersionSpec
+pathVersionCodec =
+ PathVersionSpec <$> Toml.string "path" .= pathVersionSpecPath
+
toml2AppSettings :: TomlSettings -> Bool -> IO AppSettings
toml2AppSettings tomlSettings release = do
let projectName = tomlSettingsProjectName tomlSettings
@@ -235,36 +319,38 @@ toml2AppSettings tomlSettings release = do
projectName
testSettings <- getTestSettings $ tomlSettingsTests tomlSettings
buildPrefix <- makeBuildPrefix compiler release
+ let dependencies = tomlSettingsDependencies 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
+ { 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
}
getLibrarySettings :: Maybe Library -> IO (Maybe Library)
@@ -315,3 +401,95 @@ makeBuildPrefix compiler release =
-- 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"
+
+{-
+ Fetching the dependencies is done on a sort of breadth first approach. All
+ of the dependencies are fetched before doing the transitive dependencies.
+ This means that the top level dependencies dictate which version is fetched.
+ The fetchDependency function is idempotent, so we don't have to worry about
+ dealing with half fetched, or adding dependencies.
+ TODO check for version compatibility issues
+-}
+fetchDependencies :: [String] -> Map.Map String Version -> IO [DependencyTree]
+fetchDependencies knownPackages dependencies = do
+ theseDependencies <- mapM
+ (uncurry fetchDependency)
+ (filter (\(name, _) -> not (name `elem` knownPackages))
+ (Map.toList dependencies)
+ )
+ mapM fetchTransitiveDependencies theseDependencies
+ where
+ fetchTransitiveDependencies :: (String, FilePath) -> IO DependencyTree
+ fetchTransitiveDependencies (name, path) = do
+ tomlSettings <- Toml.decodeFile settingsCodec (path </> "fpm.toml")
+ librarySettingsM <- withCurrentDirectory path
+ $ getLibrarySettings (tomlSettingsLibrary tomlSettings)
+ case librarySettingsM of
+ Just librarySettings -> do
+ newDependencies <- fetchDependencies
+ (name : knownPackages)
+ (tomlSettingsDependencies tomlSettings)
+ return $ Dependency
+ { dependencyName = name
+ , dependencyPath = path
+ , dependencySourcePath = path </> (librarySourceDir librarySettings)
+ , dependencyDependencies = newDependencies
+ }
+ Nothing -> do
+ putStrLn $ "No library found in " ++ name
+ undefined
+
+fetchDependency :: String -> Version -> IO (String, FilePath)
+fetchDependency name version = do
+ let clonePath = "build" </> "dependencies" </> name
+ alreadyFetched <- doesDirectoryExist clonePath
+ if alreadyFetched
+ then return (name, clonePath)
+ else case version of
+ SimpleVersion _ -> do
+ putStrLn "Simple dependencies are not yet supported :("
+ undefined
+ GitVersion versionSpec -> do
+ system
+ ("git clone " ++ gitVersionSpecUrl versionSpec ++ " " ++ clonePath)
+ case gitVersionSpecRef versionSpec of
+ Just ref -> withCurrentDirectory clonePath $ do
+ system
+ ( "git checkout "
+ ++ (case ref of
+ Tag tag -> tag
+ Branch branch -> branch
+ Commit commit -> commit
+ )
+ )
+ return (name, clonePath)
+ Nothing -> return (name, clonePath)
+ PathVersion versionSpec -> return (name, pathVersionSpecPath versionSpec)
+
+{-
+ Bulding the dependencies is done on a depth first basis to ensure all of
+ the transitive dependencies have been built before trying to build this one
+-}
+buildDependencies
+ :: String -> String -> [String] -> [DependencyTree] -> IO [FilePath]
+buildDependencies buildPrefix compiler flags dependencies = do
+ built <- concatMapM (buildDependency buildPrefix compiler flags) dependencies
+ return $ nub built
+
+buildDependency
+ :: String -> String -> [String] -> DependencyTree -> IO [FilePath]
+buildDependency buildPrefix compiler flags (Dependency name path sourcePath dependencies)
+ = do
+ transitiveDependencies <- buildDependencies buildPrefix
+ compiler
+ flags
+ dependencies
+ let buildPath = buildPrefix </> name
+ buildLibrary sourcePath
+ [".f90", ".f", ".F", ".F90", ".f95", ".f03"]
+ buildPath
+ compiler
+ flags
+ name
+ transitiveDependencies
+ return $ buildPath : transitiveDependencies