From 914d428ff1a1529b98206f9f3575c88ade7ea38b Mon Sep 17 00:00:00 2001
From: Daniel Gröber <dxld@darkboxed.org>
Date: Fri, 26 Oct 2018 04:21:38 +0200
Subject: Split up Compile.hs into multiple modules

---
 lib/Distribution/Helper.hs | 62 +++-------------------------------------------
 1 file changed, 4 insertions(+), 58 deletions(-)

(limited to 'lib/Distribution')

diff --git a/lib/Distribution/Helper.hs b/lib/Distribution/Helper.hs
index 8a4676b..e98427e 100644
--- a/lib/Distribution/Helper.hs
+++ b/lib/Distribution/Helper.hs
@@ -90,13 +90,11 @@ module Distribution.Helper (
   ) where
 
 import Cabal.Plan hiding (Unit, UnitId, uDistDir)
-import qualified Cabal.Plan as CP
 import Control.Applicative
 import Control.Monad
 import Control.Monad.Trans.Maybe
 import Control.Monad.IO.Class
 import Control.Exception as E
-import Data.Coerce
 import Data.IORef
 import Data.List hiding (filter)
 import Data.String
@@ -117,11 +115,12 @@ import System.Process
 import System.Posix.Types
 import System.PosixCompat.Files
 import Text.Printf
-import Text.Show.Pretty
 import Prelude
 
 import CabalHelper.Compiletime.Compile
 import qualified CabalHelper.Compiletime.Program.Stack as Stack
+import qualified CabalHelper.Compiletime.Program.GHC as GHC
+import qualified CabalHelper.Compiletime.Program.CabalInstall as CabalInstall
 import CabalHelper.Compiletime.Types
 import CabalHelper.Compiletime.Types.RelativePath
 import CabalHelper.Shared.InterfaceTypes
@@ -131,7 +130,6 @@ import CabalHelper.Shared.Common
 import CabalHelper.Compiletime.Compat.Version
 import qualified CabalHelper.Compiletime.Compat.ProgramDb as ProgDb
     ( defaultProgramDb, programPath, lookupProgram, ghcProgram, ghcPkgProgram)
-import CabalHelper.Shared.Common
 
 import Distribution.System (buildPlatform)
 import Distribution.Text (display)
@@ -139,11 +137,6 @@ import Distribution.Verbosity (silent, deafening)
 --import Distribution.Package (packageName, packageVersion)
 import Distribution.Simple.GHC as GHC (configure)
 
-import qualified CabalHelper.Compiletime.Compat.ProgramDb as ProgDb
-    ( defaultProgramDb, programPath, lookupProgram, ghcProgram, ghcPkgProgram)
-import CabalHelper.Compiletime.Compat.Version
-import CabalHelper.Shared.Common
-
 -- | A lazy, cached, query against a package's Cabal configuration. Use
 -- 'runQuery' to execute it.
 newtype Query pt a = Query
@@ -347,20 +340,6 @@ reconfigureUnit QueryEnv{qeDistDir=DistDirStack{}, ..} Unit{uPackageDir} = do
          ["stack", "build", "--only-configure", "."] ""
   return ()
 
-findCabalFile :: FilePath -> IO FilePath
-findCabalFile pkgdir = do
-    [cfile] <- filter isCabalFile <$> getDirectoryContents pkgdir
-    return cfile
-  where
-    isCabalFile :: FilePath -> Bool
-    isCabalFile f = takeExtension' f == ".cabal"
-
-    takeExtension' :: FilePath -> String
-    takeExtension' p =
-        if takeFileName p == takeExtension p
-          then "" -- just ".cabal" is not a valid cabal file
-          else takeExtension p
-
 getFileModTime :: FilePath -> IO (FilePath, EpochTime)
 getFileModTime f = do
   t <- modificationTime <$> getFileStatus f
@@ -399,7 +378,7 @@ readProjInfo qe pc pcm = withVerbosity $ do
                     , pjCompilerId=PkgId (PkgName compName) (Ver compVer)
                     }
           <- decodePlanJson plan_path
-      units <- planUnits plan
+      units <- CabalInstall.planUnits plan
       return ProjInfo
         { piCabalVersion = makeDataVersion pjCabalLibVersion
         , piProjConfModTimes = pcm
@@ -421,7 +400,7 @@ readProjInfo qe pc pcm = withVerbosity $ do
       Just (cabalVer:_) <- runMaybeT $
         let ?cprogs = cprogs in
         let ?progs  = qePrograms qe in
-        listCabalVersions' (Just (sppGlobalPkgDb proj_paths))
+        GHC.listCabalVersions (Just (sppGlobalPkgDb proj_paths))
       -- ^ See [Note Stack Cabal Version]
       return ProjInfo
         { piCabalVersion = cabalVer
@@ -432,39 +411,6 @@ readProjInfo qe pc pcm = withVerbosity $ do
           }
         }
 
-planUnits :: CP.PlanJson -> IO [Unit]
-planUnits plan = do
-    units <- fmap catMaybes $ mapM takeunit $ Map.elems $ CP.pjUnits plan
-    case lefts units of
-      [] -> return $ rights units
-      us@(_:_) -> panicIO $
-        msg ++ (concat $ map (unlines . map ("  "++) . lines . ppShow) us)
-  where
-    msg = "\
-\plan.json doesn't contain 'dist-dir' key for the following local units:\n"
-    takeunit u@CP.Unit
-      { uType=CP.UnitTypeLocal
-      , uDistDir=Just distdirv1
-      , uPkgSrc=Just (CP.LocalUnpackedPackage pkgdir)
-      } = do
-        cabal_file <- findCabalFile pkgdir
-        return $ Just $ Right $ Unit
-          { uUnitId     = UnitId $ Text.unpack (coerce (CP.uId u))
-          , uPackageDir = pkgdir
-          , uCabalFile  = CabalFile cabal_file
-          , uDistDir    = DistDirLib distdirv1
-          }
-    takeunit u@CP.Unit {uType=CP.UnitTypeLocal} =
-      return $ Just $ Left u
-    takeunit _ =
-      return $ Nothing
--- [Note Stack Cabal Version]
---
--- Stack just uses a ghc-pkg invocation on the global-pkg-db to determine the
--- appropriate Cabal version for a resolver when building, see
--- Stack.GhcPkg.getCabalPkgVer. We do essentially the same thing here, but we
--- use --simple-output instead of using @ghc-pkg field@.
-
 readUnitInfo :: QueryEnvI c pt -> FilePath -> Unit -> IO UnitInfo
 readUnitInfo
   qe exe unit@Unit {uUnitId=uiUnitId, uCabalFile, uDistDir} = do
-- 
cgit v1.2.3