Start refactoring to support cabal v2-build

2 files changed, 58 insertions, 41 deletions

diff --git a/src/CabalHelper/Compiletime/Compile.hs b/src/CabalHelper/Compiletime/Compile.hs
index 305c11c..3126128 100644
--- a/src/CabalHelper/Compiletime/Compile.hs
+++ b/src/CabalHelper/Compiletime/Compile.hs
@@ -13,8 +13,8 @@
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see <http://www.gnu.org/licenses/>.
-{-# LANGUAGE RecordWildCards, FlexibleContexts, NamedFieldPuns, DeriveFunctor,
-  GADTs, ImplicitParams, ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts, DeriveFunctor, GADTs, ConstraintKinds,
+  ImplicitParams, NamedFieldPuns, RecordWildCards #-}
 
 {-|
 Module      : CabalHelper.Compiletime.Compile
@@ -24,7 +24,9 @@ License     : GPL-3
 
 module CabalHelper.Compiletime.Compile where
 
+import qualified Cabal.Plan as CP
 import Cabal.Plan
+  ( PlanJson(..), PkgId(..), PkgName(..), Ver(..), uPId)
 import Control.Applicative
 import Control.Arrow
 import Control.Exception as E
@@ -49,16 +51,24 @@ import System.IO.Error
 import System.IO.Temp
 import Prelude
 
-
 import qualified Data.Text as Text
 import qualified Data.Map.Strict as Map
 
-import Distribution.System (buildPlatform)
-import Distribution.Text (display)
+import Distribution.System
+  ( buildPlatform )
+import Distribution.Text
+  ( display )
+
+import Paths_cabal_helper
+  ( version )
 
-import Paths_cabal_helper (version)
+--import CabalHelper.Compiletime.Cabal
 import CabalHelper.Compiletime.Data
+--import CabalHelper.Compiletime.Log
+--import CabalHelper.Compiletime.Program.GHC
+--import CabalHelper.Compiletime.Program.CabalInstall
 import CabalHelper.Compiletime.Types
+
 import CabalHelper.Shared.Common
 import CabalHelper.Shared.Sandbox (getSandboxPkgDb)
 
@@ -87,18 +97,17 @@ data CompPaths = CompPaths
 data CompilationProductScope = CPSGlobal | CPSProject
 
 compileHelper
-    :: CompileOptions
-    -> Version
+    :: Env
+    => Version
+    -> Maybe PackageDbDir
     -> FilePath
     -> Maybe (PlanJson, FilePath)
     -> FilePath
     -> IO (Either ExitCode FilePath)
-compileHelper opts hdrCabalVersion projdir mnewstyle cachedir = do
-    let ?opts = opts
-
+compileHelper hdrCabalVersion cabalPkgDb projdir mnewstyle cachedir = do
     ghcVer <- ghcVersion
     Just (prepare, comp) <- runMaybeT $ msum $
-      case oCabalPkgDb opts of
+      case cabalPkgDb of
         Nothing ->
           [ compileCabalSource
           , compileNewBuild ghcVer
@@ -107,7 +116,7 @@ compileHelper opts hdrCabalVersion projdir mnewstyle cachedir = do
           , MaybeT $ Just <$> compileWithCabalInPrivatePkgDb
           ]
         Just db ->
-            [ return $ (return (), compileWithPkg (Just db) hdrCabalVersion CPSProject)
+          [ pure $ (pure (), compileWithPkg (Just db) hdrCabalVersion CPSProject)
           ]
 
     appdir <- appCacheDir
@@ -122,7 +131,7 @@ compileHelper opts hdrCabalVersion projdir mnewstyle cachedir = do
         vLog $ "helper exe does not exist, compiling "++compExePath
         prepare >> compile comp cp
 
- where
+  where
    logMsg = "using helper compiled with Cabal from "
 
 -- for relaxed deps: find (sameMajorVersionAs hdrCabalVersion) . reverse . sort
@@ -130,7 +139,7 @@ compileHelper opts hdrCabalVersion projdir mnewstyle cachedir = do
    -- | Check if this version is globally available
    compileGlobal :: Env => MaybeT IO (IO (), Compile)
    compileGlobal = do
-       cabal_versions <- listCabalVersions
+       cabal_versions <- listCabalVersions' Nothing
        ver <- MaybeT $ return $ find (== hdrCabalVersion) cabal_versions
        vLog $ logMsg ++ "user/global package-db"
        return $ (return (), compileWithPkg Nothing ver CPSGlobal)
@@ -150,10 +159,10 @@ compileHelper opts hdrCabalVersion projdir mnewstyle cachedir = do
        (PlanJson {pjUnits}, distdir_newstyle) <- maybe mzero pure mnewstyle
        let cabal_pkgid =
                PkgId (PkgName (Text.pack "Cabal"))
-                     (Ver $ versionBranch hdrCabalVersion)
+                        (Ver $ versionBranch hdrCabalVersion)
            mcabal_unit = listToMaybe $
-             Map.elems $ Map.filter (\Unit {..} -> uPId == cabal_pkgid) pjUnits
-       Unit {} <- maybe mzero pure mcabal_unit
+             Map.elems $ Map.filter (\CP.Unit{..} -> uPId == cabal_pkgid) pjUnits
+       CP.Unit {} <- maybe mzero pure mcabal_unit
        let inplace_db_path = distdir_newstyle
              </> "packagedb" </> ("ghc-" ++ showVersion ghcVer)
            inplace_db = PackageDbDir inplace_db_path
@@ -175,7 +184,7 @@ compileHelper opts hdrCabalVersion projdir mnewstyle cachedir = do
          db_exists <- liftIO $ cabalVersionExistsInPkgDb hdrCabalVersion db
          when (not db_exists) $
            void $ installCabal (Right hdrCabalVersion) `E.catch`
-             \(SomeException _) -> errorInstallCabal hdrCabalVersion cachedir
+             \(SomeException _) -> errorInstallCabal hdrCabalVersion
 
    -- | See if we're in a cabal source tree
    compileCabalSource :: Env => MaybeT IO (IO (), Compile)
@@ -318,7 +327,7 @@ cabalMinVersionMacro _ =
 
 invokeGhc :: Env => GhcInvocation -> IO (Either ExitCode FilePath)
 invokeGhc GhcInvocation {..} = do
-    rv <- callProcessStderr' Nothing oGhcProgram $ concat
+    rv <- callProcessStderr' Nothing (ghcProgram ?progs) $ concat
       [ [ "-outputdir", giOutDir
         , "-o", giOutput
         ]
@@ -335,8 +344,6 @@ invokeGhc GhcInvocation {..} = do
       case rv of
         ExitSuccess -> Right giOutput
         e@(ExitFailure _) -> Left e
-  where
-    CompileOptions {..} = ?opts
 
 
 -- | Cabal library version we're compiling the helper exe against.
@@ -460,7 +467,7 @@ runCabalInstall (PackageDbDir db) (CabalSourceDir srcdir) ever = do
              then ["--no-require-sandbox"]
              else []
         , [ "install", srcdir ]
-        , if oVerbose ?opts
+        , if ?verbose
             then ["-v"]
             else []
         , [ "--only-dependencies" ]
@@ -635,8 +642,8 @@ unpackCabalHEAD tmpdir = do
          (liftIO . setCurrentDirectory)
          (\_ -> liftIO (setCurrentDirectory dir) >> action)
 
-errorInstallCabal :: Version -> FilePath -> IO a
-errorInstallCabal cabalVer _distdir = panicIO $ printf "\
+errorInstallCabal :: Version -> IO a
+errorInstallCabal cabalVer = panicIO $ printf "\
 \Installing Cabal version %s failed.\n\
 \\n\
 \You have the following choices to fix this:\n\
@@ -670,9 +677,6 @@ errorInstallCabal cabalVer _distdir = panicIO $ printf "\
  where
    sver = showVersion cabalVer
 
-listCabalVersions :: Env => MaybeT IO [Version]
-listCabalVersions = listCabalVersions' Nothing
-
 listCabalVersions' :: Env => Maybe PackageDbDir -> MaybeT IO [Version]
 listCabalVersions' mdb = do
   case mdb of
@@ -746,12 +750,12 @@ cabalFileTopField field cabalFile = value
   ls = map (map toLower) $ lines cabalFile
   extract = dropWhile (/=':') >>> drop 1 >>> dropWhile isSpace >>> takeWhile (not . isSpace)
 
-vLog :: (Env, MonadIO m) => String -> m ()
-vLog msg | CompileOptions { oVerbose = True } <- ?opts =
-    liftIO $ hPutStrLn stderr msg
-vLog _ = return ()
+vLog :: (MonadIO m, Verbose) => String -> m ()
+vLog msg
+    | ?verbose  = liftIO $ hPutStrLn stderr msg
+    | otherwise = return ()
 
-logIOError :: Env => String -> IO (Maybe a) -> IO (Maybe a)
+logIOError :: Verbose => String -> IO (Maybe a) -> IO (Maybe a)
 logIOError label a = do
   a `catchIOError` \ex -> do
       vLog $ label ++ ": " ++ show ex
diff --git a/src/CabalHelper/Compiletime/Types.hs b/src/CabalHelper/Compiletime/Types.hs
index 10fe916..843a886 100644
--- a/src/CabalHelper/Compiletime/Types.hs
+++ b/src/CabalHelper/Compiletime/Types.hs
@@ -15,7 +15,8 @@
 -- along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 {-# LANGUAGE DeriveGeneric, DeriveDataTypeable, DefaultSignatures,
-  KindSignatures, ImplicitParams, ConstraintKinds #-}
+  StandaloneDeriving, GADTs, DataKinds, KindSignatures, ImplicitParams,
+  ConstraintKinds, RankNTypes #-}
 
 {-|
 Module      : CabalHelper.Compiletime.Types
@@ -25,13 +26,25 @@ License     : GPL-3
 
 module CabalHelper.Compiletime.Types where
 
+import Cabal.Plan
+  ( PlanJson )
+import Data.IORef
 import Data.Version
 import Data.Typeable
+import Data.Map.Strict (Map)
 import GHC.Generics
+import System.Posix.Types
+import CabalHelper.Shared.InterfaceTypes
 
-type Env = (?opts :: CompileOptions)
+type Verbose = (?verbose :: Bool)
+type Progs = (?progs :: Programs)
+-- TODO: rname to `CompEnv` or something
+type Env =
+    ( ?verbose :: Bool
+    , ?progs   :: Programs
+    )
 
--- | Paths or names of various programs we need.
+-- | Configurable paths to various programs we use.
 data Programs = Programs {
       -- | The path to the @cabal@ program.
       cabalProgram  :: FilePath,
@@ -44,8 +57,8 @@ data Programs = Programs {
       ghcPkgProgram :: FilePath
     } deriving (Eq, Ord, Show, Read, Generic, Typeable)
 
--- | Default all programs to their unqualified names, i.e. they will be searched
--- for on @PATH@.
+-- | By default all programs use their unqualified names, i.e. they will be
+-- searched for on @PATH@.
 defaultPrograms :: Programs
 defaultPrograms = Programs "cabal" "ghc" "ghc-pkg"
 
@@ -57,13 +70,13 @@ data CompileOptions = CompileOptions
     }
 
 oCabalProgram :: Env => FilePath
-oCabalProgram = cabalProgram $ oPrograms ?opts
+oCabalProgram = cabalProgram ?progs
 
 oGhcProgram :: Env => FilePath
-oGhcProgram = ghcProgram $ oPrograms ?opts
+oGhcProgram = ghcProgram ?progs
 
 oGhcPkgProgram :: Env => FilePath
-oGhcPkgProgram = ghcPkgProgram $ oPrograms ?opts
+oGhcPkgProgram = ghcPkgProgram ?progs
 
 defaultCompileOptions :: CompileOptions
 defaultCompileOptions =