diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Fpm.hs | 246 |
1 files changed, 212 insertions, 34 deletions
@@ -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 |