Implement behaviour for cabal new-* (#61)

Add list of components to Unit data type to handle v2 based builds
per cabal unit.

4 files changed, 37 insertions, 17 deletions

diff --git a/lib/Distribution/Helper.hs b/lib/Distribution/Helper.hs
index 97670de..890d772 100644
--- a/lib/Distribution/Helper.hs
+++ b/lib/Distribution/Helper.hs
@@ -214,7 +214,7 @@ getProjConfModTime ProjConfStack{..} =
     [ pcStackYaml
     ]
 
-getUnitModTimes :: Unit -> IO UnitModTimes
+getUnitModTimes :: Unit pt -> IO UnitModTimes
 getUnitModTimes
   Unit
     { uDistDir=DistDirLib distdirv1
@@ -223,7 +223,7 @@ getUnitModTimes
   = do
     cabal_file_mtime <- getFileModTime cabal_file_path
     let setup_config = distdirv1 </> "setup-config"
-    setup_config_mtime <- getFileModTime setup_config
+    setup_config_mtime <- (traverse getFileModTime <=< mightExist) setup_config
     return UnitModTimes
       { umtCabalFile   = cabal_file_mtime
       , umtSetupConfig = setup_config_mtime
@@ -234,11 +234,11 @@ compilerVersion       :: Query pt (String, Version)
 compilerVersion = undefined
 
 -- | List of units in a project
-projectUnits          :: Query pt [Unit]
+projectUnits          :: Query pt [Unit pt]
 projectUnits = Query $ \qe -> piUnits <$> getProjInfo qe
 
 -- | Run a 'UnitQuery' on a given unit. To get a a unit see 'projectUnits'.
-unitQuery          :: Unit -> Query pt UnitInfo
+unitQuery          :: Unit pt -> Query pt UnitInfo
 unitQuery u = Query $ \qe -> getUnitInfo qe u
 
 -- | Get information on all units in a project.
@@ -275,7 +275,7 @@ checkUpdateProjInfo qe mproj_info = do
       shallowReconfigureProject qe
       readProjInfo qe proj_conf mtime
 
-getUnitInfo :: QueryEnv pt -> Unit -> IO UnitInfo
+getUnitInfo :: QueryEnv pt -> Unit pt -> IO UnitInfo
 getUnitInfo qe@QueryEnv{..} unit@Unit{uDistDir} = do
   proj_info <- getProjInfo qe
   cache@QueryCache{qcUnitInfos} <- readIORef qeCacheRef
@@ -288,7 +288,7 @@ getUnitInfo qe@QueryEnv{..} unit@Unit{uDistDir} = do
 checkUpdateUnitInfo
     :: QueryEnvI c pt
     -> ProjInfo pt
-    -> Unit
+    -> Unit pt
     -> Maybe UnitInfo
     -> IO UnitInfo
 checkUpdateUnitInfo qe proj_info unit munit_info = do
@@ -308,7 +308,7 @@ checkUpdateUnitInfo qe proj_info unit munit_info = do
 
 -- | Restrict 'UnitInfo' cache to units that are still active
 discardInactiveUnitInfos
-    :: [Unit]
+    :: [Unit pt]
     -> Map DistDirLib UnitInfo
     -> Map DistDirLib UnitInfo
 discardInactiveUnitInfos active_units uis0 =
@@ -337,11 +337,13 @@ shallowReconfigureProject QueryEnv
     -- do stuff here?
     return ()
 
-reconfigureUnit :: QueryEnvI c pt -> Unit -> IO ()
+reconfigureUnit :: QueryEnvI c pt -> Unit pt -> IO ()
 reconfigureUnit QueryEnv{qeDistDir=DistDirV1{}, ..} Unit{uPackageDir=_} = do
   return ()
-reconfigureUnit QueryEnv{qeDistDir=DistDirV2{}, ..} Unit{uPackageDir=_} = do
-  return () -- TODO: new-build --only-configure
+reconfigureUnit QueryEnv{qeDistDir=DistDirV2{}, ..} Unit{uPackageDir, uImpl} = do
+  _ <- liftIO $ qeReadProcess (Just uPackageDir) (cabalProgram qePrograms)
+        (["new-build"] ++ uiV2Components uImpl) ""
+  return ()
 reconfigureUnit QueryEnv{qeDistDir=DistDirStack{}, ..} Unit{uPackageDir} = do
   _ <- liftIO $ qeReadProcess (Just uPackageDir) (stackProgram qePrograms)
          ["stack", "build", "--only-configure", "."] ""
@@ -375,6 +377,7 @@ readProjInfo qe pc pcm = withVerbosity $ do
               , uPackageDir = projdir
               , uCabalFile = CabalFile pcV1CabalFile
               , uDistDir = DistDirLib distdir
+              , uImpl = UnitImplV1
               }
             , piImpl = ProjInfoV1
             }
@@ -418,7 +421,7 @@ readProjInfo qe pc pcm = withVerbosity $ do
           }
         }
 
-readUnitInfo :: QueryEnvI c pt -> FilePath -> Unit -> IO UnitInfo
+readUnitInfo :: QueryEnvI c pt -> FilePath -> Unit pt -> IO UnitInfo
 readUnitInfo
   qe exe unit@Unit {uUnitId=uiUnitId, uCabalFile, uDistDir} = do
     res <- readHelper qe exe uCabalFile uDistDir
@@ -491,7 +494,7 @@ prepare qe = do
 
 -- | Create @cabal_macros.h@ and @Paths_\<pkg\>@ possibly other generated files
 -- in the usual place. See 'Distribution.Simple.Build.initialBuildSteps'.
-writeAutogenFiles :: Unit -> Query pt ()
+writeAutogenFiles :: Unit pt -> Query pt ()
 writeAutogenFiles Unit{uCabalFile, uDistDir} = Query $ \qe -> do
   proj_info <- getProjInfo qe
   exe <- getHelperExe proj_info qe
diff --git a/src/CabalHelper/Compiletime/Program/CabalInstall.hs b/src/CabalHelper/Compiletime/Program/CabalInstall.hs
index a4df188..637d577 100644
--- a/src/CabalHelper/Compiletime/Program/CabalInstall.hs
+++ b/src/CabalHelper/Compiletime/Program/CabalInstall.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DataKinds #-}
+
 -- cabal-helper: Simple interface to Cabal's configuration state
 -- Copyright (C) 2018  Daniel Gröber <cabal-helper@dxld.at>
 --
@@ -181,7 +183,7 @@ cabalWithGHCProgOpts = concat
       else []
   ]
 
-planUnits :: CP.PlanJson -> IO [Unit]
+planUnits :: CP.PlanJson -> IO [Unit 'V2]
 planUnits plan = do
     units <- fmap catMaybes $ mapM takeunit $ Map.elems $ CP.pjUnits plan
     case lefts units of
@@ -195,13 +197,16 @@ planUnits plan = do
       { uType=CP.UnitTypeLocal
       , uDistDir=Just distdirv1
       , uPkgSrc=Just (CP.LocalUnpackedPackage pkgdir)
+      , uComps=comps
       } = do
         cabal_file <- Cabal.findCabalFile pkgdir
+        let uiV2Components = map (Text.unpack . CP.dispCompName) $ Map.keys comps
         return $ Just $ Right $ Unit
           { uUnitId     = UnitId $ Text.unpack (coerce (CP.uId u))
           , uPackageDir = pkgdir
           , uCabalFile  = CabalFile cabal_file
           , uDistDir    = DistDirLib distdirv1
+          , uImpl       = UnitImplV2 {..}
           }
     takeunit u@CP.Unit {uType=CP.UnitTypeLocal} =
       return $ Just $ Left u
diff --git a/src/CabalHelper/Compiletime/Program/Stack.hs b/src/CabalHelper/Compiletime/Program/Stack.hs
index 4f3680f..f4ada8f 100644
--- a/src/CabalHelper/Compiletime/Program/Stack.hs
+++ b/src/CabalHelper/Compiletime/Program/Stack.hs
@@ -36,7 +36,7 @@ import Prelude
 import CabalHelper.Compiletime.Types
 import CabalHelper.Compiletime.Types.RelativePath
 
-getUnit :: QueryEnvI c 'Stack -> CabalFile -> IO Unit
+getUnit :: QueryEnvI c 'Stack -> CabalFile -> IO (Unit 'Stack)
 getUnit qe cabal_file@(CabalFile cabal_file_path) = do
   let pkgdir = takeDirectory cabal_file_path
   let pkg_name = dropExtension $ takeFileName cabal_file_path
@@ -47,6 +47,7 @@ getUnit qe cabal_file@(CabalFile cabal_file_path) = do
     , uPackageDir = pkgdir
     , uCabalFile  = cabal_file
     , uDistDir    = DistDirLib distdirv1
+    , uImpl       = UnitImplStack
     }
 
 -- TODO: patch ghc/ghc-pkg program paths like in ghc-mod when using stack so
diff --git a/src/CabalHelper/Compiletime/Types.hs b/src/CabalHelper/Compiletime/Types.hs
index cb2fbda..e432c6d 100644
--- a/src/CabalHelper/Compiletime/Types.hs
+++ b/src/CabalHelper/Compiletime/Types.hs
@@ -139,13 +139,24 @@ newtype DistDirLib = DistDirLib FilePath
 --
 -- As opposed to components, different 'Unit's can be queried independently
 -- since their on-disk information is stored separately.
-data Unit = Unit
+data Unit pt = Unit
     { uUnitId      :: !UnitId
     , uPackageDir  :: !FilePath
     , uCabalFile   :: !CabalFile
     , uDistDir     :: !DistDirLib
+    , uImpl        :: !(UnitImpl pt)
     }
 
+data UnitImpl pt where
+  UnitImplV1 :: UnitImpl 'V1
+
+  UnitImplV2 ::
+    { uiV2Components :: ![String]
+    } -> UnitImpl 'V2
+
+  UnitImplStack :: UnitImpl 'Stack
+
+
 newtype UnitId = UnitId String
     deriving (Eq, Ord, Read, Show)
 
@@ -206,7 +217,7 @@ newtype ProjConfModTimes = ProjConfModTimes [(FilePath, EpochTime)]
 data ProjInfo pt = ProjInfo
   { piCabalVersion     :: !Version
   , piProjConfModTimes :: !ProjConfModTimes
-  , piUnits            :: ![Unit]
+  , piUnits            :: ![Unit pt]
   , piImpl             :: !(ProjInfoImpl pt)
   }
 
@@ -225,7 +236,7 @@ data ProjInfoImpl pt where
 
 data UnitModTimes = UnitModTimes
     { umtCabalFile   :: !(FilePath, EpochTime)
-    , umtSetupConfig :: !(FilePath, EpochTime)
+    , umtSetupConfig :: !(Maybe (FilePath, EpochTime))
     } deriving (Eq, Ord, Read, Show)
 
 newtype CabalFile = CabalFile FilePath