From 868b51bc5e26df88696e782c131d3fc47995facb Mon Sep 17 00:00:00 2001
From: alexwl <alexey.a.kiryushin@gmail.com>
Date: Fri, 23 Nov 2018 18:54:34 +0300
Subject: Improve error messages about dist directory

---
 src/HaskellCodeExplorer/PackageInfo.hs | 61 +++++++++++++++++++++++-----------
 1 file changed, 42 insertions(+), 19 deletions(-)

(limited to 'src/HaskellCodeExplorer/PackageInfo.hs')

diff --git a/src/HaskellCodeExplorer/PackageInfo.hs b/src/HaskellCodeExplorer/PackageInfo.hs
index 9be74e2..2b1eeac 100644
--- a/src/HaskellCodeExplorer/PackageInfo.hs
+++ b/src/HaskellCodeExplorer/PackageInfo.hs
@@ -111,8 +111,11 @@ import System.FilePath
   , splitPath
   , takeExtension
   , takeBaseName
+  , takeDirectory
   , splitDirectories  
   )
+import System.FilePath.Find
+import System.Exit (exitFailure)
 import System.Process (readProcess)
 
 createPackageInfo ::
@@ -129,7 +132,12 @@ createPackageInfo packageDirectoryPath mbDistDirRelativePath sourceCodePreproces
   distDir <-
     case mbDistDirRelativePath of
       Just path -> return $ packageDirectoryAbsPath </> path
-      Nothing -> findDistDirectory packageDirectoryAbsPath
+      Nothing -> do
+        eitherDistDir <- findDistDirectory packageDirectoryAbsPath
+        case eitherDistDir of
+          Right distDir -> return distDir
+          Left errorMessage ->
+            logErrorN (T.pack errorMessage) >> liftIO exitFailure
   let cabalHelperQueryEnv = mkQueryEnv packageDirectoryAbsPath distDir
   ((packageName, packageVersion), compInfo) <-
     liftIO $
@@ -310,7 +318,7 @@ addReferencesFromModule references modInfo@HCE.ModuleInfo {..} =
                HM.insertWith S.union externalId (S.singleton idSrcSpan) occMap
              Nothing -> occMap)
 
-findDistDirectory :: FilePath -> LoggingT IO FilePath
+findDistDirectory :: FilePath -> LoggingT IO (Either String FilePath)
 findDistDirectory packagePath = do
   let parents =
         reverse . map joinPath . filter (not . null) . L.inits . splitPath $
@@ -319,34 +327,49 @@ findDistDirectory packagePath = do
   hasStackYaml <-
     liftIO $ anyM (\path -> doesFileExist (path </> "stack.yaml")) parents
   mbStackExecutable <- liftIO $ findExecutable "stack"
-  let defaultDistDir = packagePath </> "dist"
   case (hasStackYaml, mbStackExecutable) of
     (True, Just stack) -> do
       let removeEndOfLine str
             | null str = str
             | otherwise = init str
+      logInfoN
+        "Found stack.yaml. Executing \"stack path --dist-dir\" to get dist directory."
       eitherDistDir :: (Either IOException String) <-
         liftIO .
         try . fmap removeEndOfLine . readProcess stack ["path", "--dist-dir"] $
         ""
       case eitherDistDir of
         Right distDir -> do
-          logDebugN $ T.append "Stack dist directory : " $ T.pack distDir
-          return distDir
-        Left exception -> do
-          logDebugN $
-            T.append
-              "Error while executing \"stack path --dist-dir\" : "
-              (T.pack . show $ exception)
-          return defaultDistDir
-    (False, _) -> do
-      logDebugN
-        "stack.yaml is not found in the package directory. Using default dist directory."
-      return defaultDistDir
-    (_, Nothing) -> do
-      logDebugN "stack executable is not found. Using default dist directory."
-      return defaultDistDir
-      
+          logInfoN $ T.append "Stack dist directory : " $ T.pack distDir
+          hasSetupConfig <- liftIO $ doesFileExist $ distDir </> "setup-config"
+          if hasSetupConfig
+            then return $ Right distDir
+            else return $
+                 Left
+                   "Cannot find setup-config file in a dist directory. Has the package been built?"
+        Left exception ->
+          return $
+          Left $
+          "Error while executing \"stack path --dist-dir\" : " ++ show exception
+    _ -> do
+      logInfoN "Trying to find dist directory"
+      setupConfigPaths <-
+        liftIO $
+        map (takeDirectory . normalise) <$>
+        find always (fileName ==? "setup-config") "."
+      case setupConfigPaths of
+        [] ->
+          return $
+          Left "Cannot find dist directory. Has the package been built?"
+        [path] -> do
+          logInfoN $ T.append "Found dist directory : " $ T.pack path
+          return $ Right path
+        _ ->
+          return $
+          Left $
+          "Found multiple possible dist directories : \n" ++
+          show setupConfigPaths ++ " \nPlease specify --dist option"
+          
 eachIdentifierOccurrence ::
      forall a.
      a
-- 
cgit v1.2.3