From de6ae189266c533893218cbd22797077f7f68f55 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Tue, 19 May 2020 20:21:35 -0700 Subject: Enable reading in dependencies --- src/Fpm.hs | 117 ++++++++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 88 insertions(+), 29 deletions(-) (limited to 'src/Fpm.hs') diff --git a/src/Fpm.hs b/src/Fpm.hs index 3f06c05..0392fa3 100644 --- a/src/Fpm.hs +++ b/src/Fpm.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Fpm @@ -11,6 +12,7 @@ where import Build ( buildLibrary , buildProgram ) +import qualified Data.Map as Map import qualified Data.Text.IO as TIO import Development.Shake ( FilePattern , () @@ -22,6 +24,7 @@ import Development.Shake.FilePath ( () ) import Options.Applicative ( Parser , (<**>) + , (<|>) , command , execParser , fullDesc @@ -51,6 +54,7 @@ data TomlSettings = TomlSettings { , tomlSettingsLibrary :: (Maybe Library) , tomlSettingsExecutables :: [Executable] , tomlSettingsTests :: [Executable] + , tomlSettingsDependencies :: (Map.Map String Version) } data AppSettings = AppSettings { @@ -61,6 +65,7 @@ data AppSettings = AppSettings { , appSettingsLibrary :: (Maybe Library) , appSettingsExecutables :: [Executable] , appSettingsTests :: [Executable] + , appSettingsDependencies :: (Map.Map String Version) } data Library = Library { librarySourceDir :: String } @@ -71,6 +76,12 @@ data Executable = Executable { , executableName :: String } +data Version = SimpleVersion String | GitVersion GitVersionSpec + +data GitVersionSpec = GitVersionSpec { gitVersionSpecUrl :: String, gitVersionSpecRef :: Maybe GitRef } + +data GitRef = Tag String | Branch String | Commit String + data Command = Run | Test | Build start :: Arguments -> IO () @@ -211,6 +222,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 +238,50 @@ 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 + +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) + +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") + toml2AppSettings :: TomlSettings -> Bool -> IO AppSettings toml2AppSettings tomlSettings release = do let projectName = tomlSettingsProjectName tomlSettings @@ -235,36 +292,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) -- cgit v1.2.3 From 524866688adf2a3a4756eab85cf5956127d21e6d Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Sat, 23 May 2020 10:29:47 -0700 Subject: Enable fetching and building dependencies properly --- src/Fpm.hs | 95 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 90 insertions(+), 5 deletions(-) (limited to 'src/Fpm.hs') diff --git a/src/Fpm.hs b/src/Fpm.hs index 0392fa3..a648382 100644 --- a/src/Fpm.hs +++ b/src/Fpm.hs @@ -12,6 +12,8 @@ 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 @@ -40,8 +42,9 @@ import Options.Applicative ( Parser import System.Directory ( doesDirectoryExist , doesFileExist , makeAbsolute + , withCurrentDirectory ) -import System.Process ( runCommand ) +import System.Process ( runCommand, system ) import Toml ( TomlCodec , (.=) ) @@ -84,6 +87,13 @@ data GitRef = Tag String | Branch String | Commit 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" @@ -136,19 +146,22 @@ build settings = do let flags = appSettingsFlags settings let executables = appSettingsExecutables settings let tests = appSettingsTests settings + builtDependencies <- + fetchDependencies (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 @@ -374,3 +387,75 @@ 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" + +-- This really needs to be a tree instead +fetchDependencies :: Map.Map String Version -> IO [DependencyTree] +fetchDependencies dependencies = do + theseDependencies <- mapM (uncurry fetchDependency) (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 (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) + +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 -- cgit v1.2.3 From 382ce71efae399897c8a008c0042bb0511516fe6 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Sat, 23 May 2020 12:39:30 -0700 Subject: Avoid problems with circular dependencies --- src/Fpm.hs | 42 +++++++++++++++++++++++++----------------- 1 file changed, 25 insertions(+), 17 deletions(-) (limited to 'src/Fpm.hs') diff --git a/src/Fpm.hs b/src/Fpm.hs index a648382..2fdb707 100644 --- a/src/Fpm.hs +++ b/src/Fpm.hs @@ -44,7 +44,9 @@ import System.Directory ( doesDirectoryExist , makeAbsolute , withCurrentDirectory ) -import System.Process ( runCommand, system ) +import System.Process ( runCommand + , system + ) import Toml ( TomlCodec , (.=) ) @@ -147,7 +149,7 @@ build settings = do let executables = appSettingsExecutables settings let tests = appSettingsTests settings builtDependencies <- - fetchDependencies (appSettingsDependencies settings) + fetchDependencies [projectName] (appSettingsDependencies settings) >>= buildDependencies buildPrefix compiler flags executableDepends <- case appSettingsLibrary settings of Just librarySettings -> do @@ -389,26 +391,32 @@ makeBuildPrefix compiler release = return $ "build" compiler ++ "_" ++ if release then "release" else "debug" -- This really needs to be a tree instead -fetchDependencies :: Map.Map String Version -> IO [DependencyTree] -fetchDependencies dependencies = do - theseDependencies <- mapM (uncurry fetchDependency) (Map.toList dependencies) +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) + tomlSettings <- Toml.decodeFile settingsCodec (path "fpm.toml") + librarySettingsM <- withCurrentDirectory path + $ getLibrarySettings (tomlSettingsLibrary tomlSettings) case librarySettingsM of - Just librarySettings -> do - newDependencies <- fetchDependencies (tomlSettingsDependencies tomlSettings) - return $ Dependency { dependencyName = name - , dependencyPath = path - , dependencySourcePath = path (librarySourceDir librarySettings) - , dependencyDependencies = newDependencies - } - Nothing -> do - putStrLn $ "No library found in " ++ name - undefined + 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 -- cgit v1.2.3 From b5a1ada4f24a4334dcaef6d2d8dcfb53e17ecc6c Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Sat, 23 May 2020 12:50:42 -0700 Subject: Add some explanatory comments to the dependency functions --- src/Fpm.hs | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) (limited to 'src/Fpm.hs') diff --git a/src/Fpm.hs b/src/Fpm.hs index 2fdb707..c3b682a 100644 --- a/src/Fpm.hs +++ b/src/Fpm.hs @@ -390,12 +390,21 @@ makeBuildPrefix compiler release = -- Probably version, and make sure to not include path to the compiler return $ "build" compiler ++ "_" ++ if release then "release" else "debug" --- This really needs to be a tree instead +{- + 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)) + (filter (\(name, _) -> not (name `elem` knownPackages)) + (Map.toList dependencies) + ) mapM fetchTransitiveDependencies theseDependencies where fetchTransitiveDependencies :: (String, FilePath) -> IO DependencyTree @@ -444,6 +453,10 @@ fetchDependency name version = do return (name, clonePath) Nothing -> return (name, clonePath) +{- + 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 -- cgit v1.2.3 From d89214ba52c968a950dc3118f54b8547350536d9 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Sat, 23 May 2020 20:43:04 -0700 Subject: Add path dependencies and a test to make sure it works --- src/Fpm.hs | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) (limited to 'src/Fpm.hs') diff --git a/src/Fpm.hs b/src/Fpm.hs index c3b682a..253bc85 100644 --- a/src/Fpm.hs +++ b/src/Fpm.hs @@ -81,12 +81,14 @@ data Executable = Executable { , executableName :: String } -data Version = SimpleVersion String | GitVersion GitVersionSpec +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 { @@ -263,6 +265,11 @@ 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 @@ -282,6 +289,7 @@ 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 = @@ -297,6 +305,10 @@ gitRefCodec = <|> 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 @@ -452,6 +464,7 @@ fetchDependency name version = do ) 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 -- cgit v1.2.3