Add support for relative extra-lib-dirs / extra-include-dirs #2830

src/Stack/Config.hs

@@ -30,6 +30,7 @@ module Stack.Config
   ,loadConfig
   ,loadConfigMaybeProject
   ,loadMiniConfig
+  ,loadConfigYaml
   ,packagesParser
   ,getLocalPackages
   ,resolvePackageEntry
@@ -194,9 +195,8 @@ makeConcreteResolver ar = do
                 config <- view configL
                 implicitGlobalDir <- getImplicitGlobalProjectDir config
                 let fp = implicitGlobalDir </> stackDotYaml
-                WithJSONWarnings (ProjectAndConfigMonoid project _) _warnings <-
-                    liftIO (Yaml.decodeFileEither $ toFilePath fp)
-                    >>= either throwM return
+                ProjectAndConfigMonoid project _ <-
+                    loadConfigYaml (parseProjectAndConfigMonoid (parent fp)) fp
                 return $ projectResolver project
             ARLatestNightly -> return $ ResolverSnapshot $ Nightly $ snapshotsNightly snapshots
             ARLatestLTSMajor x ->
@@ -456,7 +456,8 @@ loadConfigMaybeProject configArgs mresolver mproject = do
 
     let loadHelper mproject' = do
           userConfigPath <- getDefaultUserConfigPath stackRoot
-          extraConfigs0 <- getExtraConfigs userConfigPath >>= mapM loadConfigYaml
+          extraConfigs0 <- getExtraConfigs userConfigPath >>=
+              mapM (\file -> loadConfigYaml (parseConfigMonoid (parent file)) file)
           let extraConfigs =
                 -- non-project config files' existence of a docker section should never default docker
                 -- to enabled, so make it look like they didn't exist
@@ -541,7 +542,7 @@ loadBuildConfig mproject config mresolver mcompiler = do
             exists <- doesFileExist dest
             if exists
                then do
-                   ProjectAndConfigMonoid project _ <- loadConfigYaml dest
+                   ProjectAndConfigMonoid project _ <- loadConfigYaml (parseProjectAndConfigMonoid destDir) dest
                    when (view terminalL env) $
                        case mresolver of
                            Nothing ->
@@ -901,25 +902,28 @@ getExtraConfigs userConfigPath = do
 -- | Load and parse YAML from the given config file. Throws
 -- 'ParseConfigFileException' when there's a decoding error.
 loadConfigYaml
-    :: (FromJSON (WithJSONWarnings a), MonadIO m, MonadLogger m)
-    => Path Abs File -> m a
-loadConfigYaml path = do
-    eres <- loadYaml path
+    :: (MonadIO m, MonadLogger m)
+    => (Value -> Yaml.Parser (WithJSONWarnings a)) -> Path Abs File -> m a
+loadConfigYaml parser path = do
+    eres <- loadYaml parser path
     case eres of
         Left err -> liftIO $ throwM (ParseConfigFileException path err)
         Right res -> return res
 
 -- | Load and parse YAML from the given file.
 loadYaml
-    :: (FromJSON (WithJSONWarnings a), MonadIO m, MonadLogger m)
-    => Path Abs File -> m (Either Yaml.ParseException a)
-loadYaml path = do
+    :: (MonadIO m, MonadLogger m)
+    => (Value -> Yaml.Parser (WithJSONWarnings a)) -> Path Abs File -> m (Either Yaml.ParseException a)
+loadYaml parser path = do
     eres <- liftIO $ Yaml.decodeFileEither (toFilePath path)
     case eres  of
         Left err -> return (Left err)
-        Right (WithJSONWarnings res warnings) -> do
-            logJSONWarnings (toFilePath path) warnings
-            return (Right res)
+        Right val ->
+            case Yaml.parseEither parser val of
+                Left err -> return (Left (Yaml.AesonException err))
+                Right (WithJSONWarnings res warnings) -> do
+                    logJSONWarnings (toFilePath path) warnings
+                    return (Right res)
 
 -- | Get the location of the project config file, if it exists.
 getProjectConfig :: (MonadIO m, MonadThrow m, MonadLogger m)
@@ -976,7 +980,7 @@ loadProjectConfig mstackYaml = do
             return LCSNoConfig
   where
     load fp = do
-        ProjectAndConfigMonoid project config <- loadConfigYaml fp
+        ProjectAndConfigMonoid project config <- loadConfigYaml (parseProjectAndConfigMonoid (parent fp)) fp
         return (project, fp, config)
 
 -- | Get the location of the default stack configuration file.

src/Stack/Options/ConfigParser.hs

@@ -15,10 +15,11 @@ import           Stack.Options.GhcVariantParser
 import           Stack.Options.NixParser
 import           Stack.Options.Utils
 import           Stack.Types.Config
+import qualified System.FilePath as FilePath
 
 -- | Command-line arguments parser for configuration.
-configOptsParser :: GlobalOptsContext -> Parser ConfigMonoid
-configOptsParser hide0 =
+configOptsParser :: FilePath -> GlobalOptsContext -> Parser ConfigMonoid
+configOptsParser currentDir hide0 =
     (\stackRoot workDir buildOpts dockerOpts nixOpts systemGHC installGHC arch ghcVariant ghcBuild jobs includes libs overrideGccPath skipGHCCheck skipMsys localBin modifyCodePage allowDifferentUser dumpLogs -> mempty
         { configMonoidStackRoot = stackRoot
         , configMonoidWorkDir = workDir
@@ -81,13 +82,13 @@ configOptsParser hide0 =
            <> help "Number of concurrent jobs to run"
            <> hide
             ))
-    <*> fmap Set.fromList (many (absDirOption
+    <*> fmap Set.fromList (many ((currentDir FilePath.</>) <$> strOption
             ( long "extra-include-dirs"
            <> metavar "DIR"
            <> help "Extra directories to check for C header files"
            <> hide
             )))
-    <*> fmap Set.fromList (many (absDirOption
+    <*> fmap Set.fromList (many ((currentDir FilePath.</>) <$> strOption
             ( long "extra-lib-dirs"
            <> metavar "DIR"
            <> help "Extra directories to check for libraries"

src/Stack/Options/GlobalParser.hs

@@ -16,8 +16,8 @@ import           Stack.Types.Config
 import           Stack.Types.Docker
 
 -- | Parser for global command-line options.
-globalOptsParser :: GlobalOptsContext -> Maybe LogLevel -> Parser GlobalOptsMonoid
-globalOptsParser kind defLogLevel =
+globalOptsParser :: FilePath -> GlobalOptsContext -> Maybe LogLevel -> Parser GlobalOptsMonoid
+globalOptsParser currentDir kind defLogLevel =
     GlobalOptsMonoid <$>
     optionalFirst (strOption (long Docker.reExecArgName <> hidden <> internal)) <*>
     optionalFirst (option auto (long dockerEntrypointArgName <> hidden <> internal)) <*>
@@ -26,7 +26,7 @@ globalOptsParser kind defLogLevel =
         "time-in-log"
         "inclusion of timings in logs, for the purposes of using diff with logs"
         hide <*>
-    configOptsParser kind <*>
+    configOptsParser currentDir kind <*>
     optionalFirst (abstractResolverOptsParser hide0) <*>
     optionalFirst (compilerOptsParser hide0) <*>
     firstBoolFlags

src/Stack/Package.hs

@@ -361,8 +361,8 @@ data BioInput = BioInput
     , biAddPackages :: ![PackageName]
     , biBuildInfo :: !BuildInfo
     , biDotCabalPaths :: !(Set DotCabalPath)
-    , biConfigLibDirs :: !(Set (Path Abs Dir))
-    , biConfigIncludeDirs :: !(Set (Path Abs Dir))
+    , biConfigLibDirs :: !(Set FilePath)
+    , biConfigIncludeDirs :: !(Set FilePath)
     , biComponentName :: !NamedComponent
     }
 
@@ -423,8 +423,7 @@ generateBuildInfoOpts BioInput {..} =
     toIncludeDir relDir = concatAndColapseAbsDir biCabalDir relDir
     includeOpts =
         map ("-I" <>) (configExtraIncludeDirs <> pkgIncludeOpts)
-    configExtraIncludeDirs =
-        map toFilePathNoTrailingSep (S.toList biConfigIncludeDirs)
+    configExtraIncludeDirs = S.toList biConfigIncludeDirs
     pkgIncludeOpts =
         [ toFilePathNoTrailingSep absDir
         | dir <- includeDirs biBuildInfo
@@ -433,8 +432,7 @@ generateBuildInfoOpts BioInput {..} =
     libOpts =
         map ("-l" <>) (extraLibs biBuildInfo) <>
         map ("-L" <>) (configExtraLibDirs <> pkgLibDirs)
-    configExtraLibDirs =
-        map toFilePathNoTrailingSep (S.toList biConfigLibDirs)
+    configExtraLibDirs = S.toList biConfigLibDirs
     pkgLibDirs =
         [ toFilePathNoTrailingSep absDir
         | dir <- extraLibDirs biBuildInfo

src/Stack/Path.hs

@@ -159,10 +159,10 @@ paths =
       , view $ configL.to configLocalBin.to toFilePathNoTrailingSep.to T.pack)
     , ( "Extra include directories"
       , "extra-include-dirs"
-      , T.intercalate ", " . map (T.pack . toFilePathNoTrailingSep) . Set.elems . configExtraIncludeDirs . view configL )
+      , T.intercalate ", " . map T.pack . Set.elems . configExtraIncludeDirs . view configL )
     , ( "Extra library directories"
       , "extra-library-dirs"
-      , T.intercalate ", " . map (T.pack . toFilePathNoTrailingSep) . Set.elems . configExtraLibDirs . view configL )
+      , T.intercalate ", " . map T.pack . Set.elems . configExtraLibDirs . view configL )
     , ( "Snapshot package database"
       , "snapshot-pkg-db"
       , T.pack . toFilePathNoTrailingSep . piSnapDb )

src/Stack/Setup.hs

@@ -350,10 +350,10 @@ addIncludeLib :: ExtraDirs -> Config -> Config
 addIncludeLib (ExtraDirs _bins includes libs) config = config
     { configExtraIncludeDirs = Set.union
         (configExtraIncludeDirs config)
-        (Set.fromList includes)
+        (Set.fromList (map toFilePathNoTrailingSep includes))
     , configExtraLibDirs = Set.union
         (configExtraLibDirs config)
-        (Set.fromList libs)
+        (Set.fromList (map toFilePathNoTrailingSep libs))
     }
 
 -- | Ensure compiler (ghc or ghcjs) is installed and provide the PATHs to add if necessary

src/Stack/Solver.hs

@@ -27,8 +27,7 @@ import           Control.Monad (when,void,join,liftM,unless,mapAndUnzipM, zipWit
 import           Control.Monad.Catch
 import           Control.Monad.IO.Class
 import           Control.Monad.Logger
-import           Data.Aeson.Extended         ( WithJSONWarnings(..), object, (.=), toJSON
-                                             , logJSONWarnings)
+import           Data.Aeson.Extended         (object, (.=), toJSON)
 import qualified Data.ByteString as S
 import           Data.Char (isSpace)
 import           Data.Either
@@ -61,7 +60,7 @@ import           Path
 import           Path.Find (findFiles)
 import           Path.IO hiding (findExecutable, findFiles)
 import           Stack.BuildPlan
-import           Stack.Config (getLocalPackages)
+import           Stack.Config (getLocalPackages, loadConfigYaml)
 import           Stack.Constants (stackDotYaml, wiredInPackages)
 import           Stack.Package               (printCabalFileWarning
                                              , hpack
@@ -755,9 +754,8 @@ solveExtraDeps modStackYaml = do
         writeStackYaml path res deps fl = do
             let fp = toFilePath path
             obj <- liftIO (Yaml.decodeFileEither fp) >>= either throwM return
-            WithJSONWarnings (ProjectAndConfigMonoid _ _) warnings <-
-                liftIO (Yaml.decodeFileEither fp) >>= either throwM return
-            logJSONWarnings fp warnings
+            -- Check input file and show warnings
+            _ <- loadConfigYaml (parseProjectAndConfigMonoid (parent path)) path
             let obj' =
                     HashMap.insert "extra-deps"
                         (toJSON $ map fromTuple $ Map.toList deps)

src/Stack/Types/Build.hs

@@ -560,8 +560,8 @@ configureOptsNoDir econfig bco deps isLocal package = concat
                        flagNameString name)
                     (Map.toList flags)
     , concatMap (\x -> [compilerOptionsCabalFlag wc, T.unpack x]) (packageGhcOptions package)
-    , map (("--extra-include-dirs=" ++) . toFilePathNoTrailingSep) (Set.toList (configExtraIncludeDirs config))
-    , map (("--extra-lib-dirs=" ++) . toFilePathNoTrailingSep) (Set.toList (configExtraLibDirs config))
+    , map ("--extra-include-dirs=" ++) (Set.toList (configExtraIncludeDirs config))
+    , map ("--extra-lib-dirs=" ++) (Set.toList (configExtraLibDirs config))
     , maybe [] (\customGcc -> ["--with-gcc=" ++ toFilePath customGcc]) (configOverrideGccPath config)
     , ["--ghcjs" | wc == Ghcjs]
     , ["--exact-configuration" | useExactConf]

src/Stack/Types/Config.hs

@@ -63,6 +63,7 @@ module Stack.Types.Config
   ,ConfigMonoid(..)
   ,configMonoidInstallGHCName
   ,configMonoidSystemGHCName
+  ,parseConfigMonoid
   -- ** DumpLogs
   ,DumpLogs(..)
   -- ** EnvSettings
@@ -99,6 +100,7 @@ module Stack.Types.Config
   -- ** Project & ProjectAndConfigMonoid
   ,Project(..)
   ,ProjectAndConfigMonoid(..)
+  ,parseProjectAndConfigMonoid
   -- ** PvpBounds
   ,PvpBounds(..)
   ,parsePvpBounds
@@ -238,6 +240,7 @@ import           Stack.Types.TemplateName
 import           Stack.Types.Urls
 import           Stack.Types.Version
 import           System.FilePath (takeBaseName)
+import qualified System.FilePath as FilePath
 import           System.PosixCompat.Types (UserID, GroupID, FileMode)
 import           System.Process.Read (EnvOverride, findExecutable)
 
@@ -325,9 +328,9 @@ data Config =
          -- ^ How many concurrent jobs to run, defaults to number of capabilities
          ,configOverrideGccPath     :: !(Maybe (Path Abs File))
          -- ^ Optional gcc override path
-         ,configExtraIncludeDirs    :: !(Set (Path Abs Dir))
+         ,configExtraIncludeDirs    :: !(Set FilePath)
          -- ^ --extra-include-dirs arguments
-         ,configExtraLibDirs        :: !(Set (Path Abs Dir))
+         ,configExtraLibDirs        :: !(Set FilePath)
          -- ^ --extra-lib-dirs arguments
          ,configConcurrentTests     :: !Bool
          -- ^ Run test suites concurrently
@@ -740,9 +743,9 @@ data ConfigMonoid =
     -- ^ Used for overriding the GHC build
     ,configMonoidJobs                :: !(First Int)
     -- ^ See: 'configJobs'
-    ,configMonoidExtraIncludeDirs    :: !(Set (Path Abs Dir))
+    ,configMonoidExtraIncludeDirs    :: !(Set FilePath)
     -- ^ See: 'configExtraIncludeDirs'
-    ,configMonoidExtraLibDirs        :: !(Set (Path Abs Dir))
+    ,configMonoidExtraLibDirs        :: !(Set FilePath)
     -- ^ See: 'configExtraLibDirs'
     , configMonoidOverrideGccPath    :: !(First (Path Abs File))
     -- ^ Allow users to override the path to gcc
@@ -791,14 +794,14 @@ instance Monoid ConfigMonoid where
     mempty = memptydefault
     mappend = mappenddefault
 
-instance FromJSON (WithJSONWarnings ConfigMonoid) where
-  parseJSON = withObjectWarnings "ConfigMonoid" parseConfigMonoidJSON
+parseConfigMonoid :: Path Abs Dir -> Value -> Yaml.Parser (WithJSONWarnings ConfigMonoid)
+parseConfigMonoid = withObjectWarnings "ConfigMonoid" . parseConfigMonoidObject
 
 -- | Parse a partial configuration.  Used both to parse both a standalone config
 -- file and a project file, so that a sub-parser is not required, which would interfere with
 -- warnings for missing fields.
-parseConfigMonoidJSON :: Object -> WarningParser ConfigMonoid
-parseConfigMonoidJSON obj = do
+parseConfigMonoidObject :: Path Abs Dir -> Object -> WarningParser ConfigMonoid
+parseConfigMonoidObject rootDir obj = do
     -- Parsing 'stackRoot' from 'stackRoot'/config.yaml would be nonsensical
     let configMonoidStackRoot = First Nothing
     configMonoidWorkDir <- First <$> obj ..:? configMonoidWorkDirName
@@ -821,8 +824,10 @@ parseConfigMonoidJSON obj = do
     configMonoidGHCVariant <- First <$> obj ..:? configMonoidGHCVariantName
     configMonoidGHCBuild <- First <$> obj ..:? configMonoidGHCBuildName
     configMonoidJobs <- First <$> obj ..:? configMonoidJobsName
-    configMonoidExtraIncludeDirs <- obj ..:?  configMonoidExtraIncludeDirsName ..!= Set.empty
-    configMonoidExtraLibDirs <- obj ..:?  configMonoidExtraLibDirsName ..!= Set.empty
+    configMonoidExtraIncludeDirs <- fmap (Set.map (toFilePath rootDir FilePath.</>)) $
+        obj ..:?  configMonoidExtraIncludeDirsName ..!= Set.empty
+    configMonoidExtraLibDirs <- fmap (Set.map (toFilePath rootDir FilePath.</>)) $
+        obj ..:?  configMonoidExtraLibDirsName ..!= Set.empty
     configMonoidOverrideGccPath <- First <$> obj ..:? configMonoidOverrideGccPathName
     configMonoidConcurrentTests <- First <$> obj ..:? configMonoidConcurrentTestsName
     configMonoidLocalBinPath <- First <$> obj ..:? configMonoidLocalBinPathName
@@ -1425,8 +1430,9 @@ getCompilerPath wc = do
 data ProjectAndConfigMonoid
   = ProjectAndConfigMonoid !Project !ConfigMonoid
 
-instance FromJSON (WithJSONWarnings ProjectAndConfigMonoid) where
-    parseJSON = withObjectWarnings "ProjectAndConfigMonoid" $ \o -> do
+parseProjectAndConfigMonoid :: Path Abs Dir -> Value -> Yaml.Parser (WithJSONWarnings ProjectAndConfigMonoid)
+parseProjectAndConfigMonoid rootDir =
+    withObjectWarnings "ProjectAndConfigMonoid" $ \o -> do
         dirs <- jsonSubWarningsTT (o ..:? "packages") ..!= [packageEntryCurrDir]
         extraDeps' <- o ..:? "extra-deps" ..!= []
         extraDeps <-
@@ -1438,7 +1444,7 @@ instance FromJSON (WithJSONWarnings ProjectAndConfigMonoid) where
         resolver <- jsonSubWarnings (o ..: "resolver")
         compiler <- o ..:? "compiler"
         msg <- o ..:? "user-message"
-        config <- parseConfigMonoidJSON o
+        config <- parseConfigMonoidObject rootDir o
         extraPackageDBs <- o ..:? "extra-package-dbs" ..!= []
         let project = Project
                 { projectUserMsg = msg