From c70e8076803bd29d7675ed493ebb1ca246891b34 Mon Sep 17 00:00:00 2001
From: Daniel Gröber <dxld@darkboxed.org>
Date: Tue, 6 Aug 2019 01:54:29 +0200
Subject: Fix ProjLoc to source directory correspondence

We cannot always assume `takeDirectory cfg_file` will be the project source
directory!
---
 lib/Distribution/Helper.hs          | 20 +++++++-------------
 lib/Distribution/Helper/Discover.hs |  6 +++---
 2 files changed, 10 insertions(+), 16 deletions(-)

(limited to 'lib')

diff --git a/lib/Distribution/Helper.hs b/lib/Distribution/Helper.hs
index c7ffe63..98afbd3 100644
--- a/lib/Distribution/Helper.hs
+++ b/lib/Distribution/Helper.hs
@@ -220,8 +220,8 @@ projConf (ProjLocV1Dir pkgdir) =
 projConf (ProjLocV1CabalFile cabal_file _) = return $
   ProjConfV1 cabal_file
 projConf (ProjLocV2Dir projdir_path) =
-  projConf $ ProjLocV2File $ projdir_path </> "cabal.project"
-projConf (ProjLocV2File proj_file) = return $
+  projConf $ ProjLocV2File (projdir_path </> "cabal.project") projdir_path
+projConf (ProjLocV2File proj_file _) = return $
   ProjConfV2
     { pcV2CabalProjFile       = proj_file
     , pcV2CabalProjLocalFile  = proj_file <.> "local"
@@ -380,9 +380,8 @@ shallowReconfigureProject QueryEnv
   , qeDistDir = DistDirCabal SCV1 _distdirv1 } =
     return ()
 shallowReconfigureProject QueryEnv
-  { qeProjLoc = ProjLocV2File projfile
+  { qeProjLoc = ProjLocV2File projfile projdir
   , qeDistDir = DistDirCabal SCV2 _distdirv2, .. } = do
-    let projdir = takeDirectory projfile
     _ <- qeCallProcess (Just projdir) [] (cabalProgram qePrograms)
            ["new-build", "--dry-run", "--project-file="++projfile, "all"]
     return ()
@@ -405,7 +404,7 @@ reconfigureUnit :: QueryEnvI c pt -> Unit pt -> IO ()
 reconfigureUnit QueryEnv{qeDistDir=(DistDirCabal SCV1 _), ..} Unit{uPackageDir=_} = do
   return ()
 reconfigureUnit
-  QueryEnv{qeProjLoc=ProjLocV2File projfile, ..}
+  QueryEnv{qeProjLoc=ProjLocV2File projfile _projdir, ..}
   Unit{uPackageDir, uImpl}
   = do
   _ <- qeCallProcess (Just uPackageDir) [] (cabalProgram qePrograms)
@@ -687,7 +686,7 @@ mkCompHelperEnv
   ProjInfo{piCabalVersion}
   = CompHelperEnv
     { cheCabalVer = CabalVersion piCabalVersion
-    , cheProjDir  = plV1Dir projloc
+    , cheProjDir  = plCabalProjectDir projloc
     , cheProjLocalCacheDir = distdir
     , chePkgDb    = Nothing
     , chePlanJson = Nothing
@@ -697,14 +696,9 @@ mkCompHelperEnv
   projloc
   (DistDirCabal SCV2 distdir)
   ProjInfo{piImpl=ProjInfoV2{piV2Plan=plan}}
-  = case projloc of
-      ProjLocV2Dir projdir ->
-        let cheProjDir  = projdir in
-        CompHelperEnv {..}
-      ProjLocV2File proj_file ->
-        let cheProjDir = takeDirectory proj_file in
-        CompHelperEnv {..}
+  = CompHelperEnv {..}
   where
+    cheProjDir  = plCabalProjectDir projloc
     cheCabalVer = CabalVersion $ makeDataVersion pjCabalLibVersion
     cheProjLocalCacheDir = distdir </> "cache"
     chePkgDb    = Nothing
diff --git a/lib/Distribution/Helper/Discover.hs b/lib/Distribution/Helper/Discover.hs
index 9e6a7ca..93346f5 100644
--- a/lib/Distribution/Helper/Discover.hs
+++ b/lib/Distribution/Helper/Discover.hs
@@ -55,7 +55,7 @@ findProjects :: FilePath -> IO [Ex ProjLoc]
 findProjects dir = execWriterT $ do
   let cabalProject = dir </> "cabal.project"
   whenM (liftIO $ doesFileExist cabalProject) $
-    tell [Ex $ ProjLocV2File cabalProject]
+    tell [Ex $ ProjLocV2File cabalProject dir]
   let stackYaml = dir </> "stack.yaml"
   whenM (liftIO $ doesFileExist stackYaml) $
     tell [Ex $ ProjLocStackYaml stackYaml]
@@ -74,8 +74,8 @@ getDefaultDistDir (ProjLocV1CabalFile _cabal_file pkgdir) =
   DistDirCabal SCV1 $ pkgdir </> "dist"
 getDefaultDistDir (ProjLocV1Dir pkgdir) =
   DistDirCabal SCV1 $ pkgdir </> "dist"
-getDefaultDistDir (ProjLocV2File cabal_project) =
-  DistDirCabal SCV2 $ replaceFileName cabal_project "dist-newstyle"
+getDefaultDistDir (ProjLocV2File cabal_project projdir) =
+  DistDirCabal SCV2 $ projdir </> "dist-newstyle"
 getDefaultDistDir (ProjLocV2Dir projdir) =
   DistDirCabal SCV2 $ projdir </> "dist-newstyle"
 getDefaultDistDir (ProjLocStackYaml _) =
-- 
cgit v1.2.3