fixing distdir

1 files changed, 66 insertions, 57 deletions

diff --git a/src/HaskellCodeExplorer/PackageInfo.hs b/src/HaskellCodeExplorer/PackageInfo.hs
index b31be70..279a9a1 100644
--- a/src/HaskellCodeExplorer/PackageInfo.hs
+++ b/src/HaskellCodeExplorer/PackageInfo.hs
@@ -10,6 +10,7 @@
 
 module HaskellCodeExplorer.PackageInfo
   ( createPackageInfo
+  , testCreatePkgInfo
   , ghcVersion
   ) where
 import qualified Data.List.NonEmpty as NE
@@ -32,6 +33,7 @@ import Control.Monad.Logger
   , logDebugN
   , logErrorN
   , logInfoN
+  , runStdoutLoggingT
   )
 import qualified Data.ByteString as BS
 import qualified Data.HashMap.Strict as HM
@@ -128,6 +130,10 @@ import System.FilePath
 import System.FilePath.Find (find,always,(==?),fileName)
 import System.Process (readProcess)
 
+testCreatePkgInfo :: FilePath -> IO (HCE.PackageInfo HCE.ModuleInfo)
+testCreatePkgInfo pkgPath = runStdoutLoggingT $
+  createPackageInfo pkgPath Nothing HCE.AfterPreprocessing [] []
+
 createPackageInfo ::
      FilePath -- ^ Path to a Cabal package
   -> Maybe FilePath -- ^ Relative path to a dist directory
@@ -142,12 +148,13 @@ createPackageInfo packageDirectoryPath mbDistDirRelativePath sourceCodePreproces
   distDir <-
     case mbDistDirRelativePath of
       Just path -> return $ packageDirectoryAbsPath </> path
-      Nothing -> do
-        eitherDistDir <- findDistDirectory packageDirectoryAbsPath
-        case eitherDistDir of
-          Right distDir -> return distDir
-          Left errorMessage ->
-            logErrorN (T.pack errorMessage) >> liftIO exitFailure
+      Nothing -> return $ packageDirectoryAbsPath </> "dist-newstyle"
+      -- Nothing -> do
+      --   eitherDistDir <- findDistDirectory packageDirectoryAbsPath
+      --   case eitherDistDir of
+      --     Right distDir -> return distDir
+      --     Left errorMessage ->
+      --       logErrorN (T.pack errorMessage) >> liftIO exitFailure
   cabalFiles <-
     liftIO $
     length .
@@ -186,6 +193,8 @@ createPackageInfo packageDirectoryPath mbDistDirRelativePath sourceCodePreproces
       --  (zip3 <$> components ((,) <$> ghcOptions) <*>
       --   components ((,) <$> entrypoints) <*>
       --   components ((,) <$> sourceDirs)))
+  -- logInfoN $ "unitinfo: " <> (T.pack $ show (packageName, packageVersion))
+  -- logInfoN $ "compinfo: " <> (T.pack $ show compInfo)
   let currentPackageId = HCE.PackageId (T.pack packageName) packageVersion
   unless
     (take 3 (versionBranch packageCompilerVersion) ==
@@ -393,57 +402,57 @@ addReferencesFromModule references modInfo@HCE.ModuleInfo {..} =
                HM.insertWith S.union externalId (S.singleton idSrcSpan) occMap
              Nothing -> occMap)
 
-findDistDirectory :: FilePath -> LoggingT IO (Either String FilePath)
-findDistDirectory packagePath = do
-  let parents =
-        reverse . map joinPath . filter (not . null) . L.inits . splitPath $
-        packagePath
-  -- e.g., ["/dir/subdir/subsubdir","/dir/subdir/","/dir/","/"]
-  hasStackYaml <-
-    liftIO $ anyM (\path -> doesFileExist (path </> "stack.yaml")) parents
-  mbStackExecutable <- liftIO $ findExecutable "stack"
-  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
-          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"
+-- findDistDirectory :: FilePath -> LoggingT IO (Either String FilePath)
+-- findDistDirectory packagePath = do
+--   let parents =
+--         reverse . map joinPath . filter (not . null) . L.inits . splitPath $
+--         packagePath
+--   -- e.g., ["/dir/subdir/subsubdir","/dir/subdir/","/dir/","/"]
+--   hasStackYaml <-
+--     liftIO $ anyM (\path -> doesFileExist (path </> "stack.yaml")) parents
+--   mbStackExecutable <- liftIO $ findExecutable "stack"
+--   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
+--           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.