Merge pull request #82 from everythingfunctional/EnableDependencies

Enable dependencies

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