packages feed

build-env 1.1.0.0 → 1.2.0.0

raw patch · 14 files changed

+1115/−648 lines, 14 filesdep +semaphore-compatdep ~aesondep ~basedep ~containersPVP ok

version bump matches the API change (PVP)

Dependencies added: semaphore-compat

Dependency ranges changed: aeson, base, containers, filepath, text, time, transformers

API changes (from Hackage documentation)

- BuildEnv.BuildOne: getPkgDbDirsForBuild :: Paths ForBuild -> IO (PkgDbDirs ForBuild)
- BuildEnv.BuildOne: getPkgDbDirsForPrep :: Paths ForPrep -> PkgDbDirs ForPrep
- BuildEnv.Config: NoSem :: AsyncSem
- BuildEnv.Utils: [progPath] :: ProgPath -> !FilePath
- BuildEnv.Utils: newAbstractSem :: AsyncSem -> IO AbstractSem
+ BuildEnv.BuildOne: getPkgDbDirForBuild :: Paths ForBuild -> IO (PkgDbDir ForBuild)
+ BuildEnv.BuildOne: getPkgDbDirForPrep :: Paths ForPrep -> PkgDbDir ForPrep
+ BuildEnv.Config: ExistingJSem :: !String -> AsyncSem
+ BuildEnv.Config: IndexState :: Text -> IndexState
+ BuildEnv.Config: NewJSem :: !Word16 -> AsyncSem
+ BuildEnv.Config: instance GHC.Classes.Eq BuildEnv.Config.IndexState
+ BuildEnv.Config: instance GHC.Show.Show (BuildEnv.Config.BuildPaths 'BuildEnv.Config.ForBuild)
+ BuildEnv.Config: instance GHC.Show.Show (BuildEnv.Config.BuildPaths 'BuildEnv.Config.ForPrep)
+ BuildEnv.Config: instance GHC.Show.Show (BuildEnv.Config.BuildPaths 'BuildEnv.Config.Raw)
+ BuildEnv.Config: instance GHC.Show.Show (BuildEnv.Config.BuildPaths use) => GHC.Show.Show (BuildEnv.Config.Paths use)
+ BuildEnv.Config: instance GHC.Show.Show BuildEnv.Config.IndexState
+ BuildEnv.Config: newtype IndexState
+ BuildEnv.Path: (<.>) :: FileLike p => p -> String -> p
+ BuildEnv.Path: (</>) :: PathLike p q r => p -> q -> r
+ BuildEnv.Path: Dir :: Type -> FileOrDir
+ BuildEnv.Path: File :: FileOrDir
+ BuildEnv.Path: absoluteSymbolicPath :: AbsolutePath to -> SymbolicPath from to
+ BuildEnv.Path: data AbsolutePath to
+ BuildEnv.Path: data CWD
+ BuildEnv.Path: data Fetch
+ BuildEnv.Path: data FileOrDir
+ BuildEnv.Path: data Install
+ BuildEnv.Path: data Logs
+ BuildEnv.Path: data Pkg
+ BuildEnv.Path: data PkgDb
+ BuildEnv.Path: data Prefix
+ BuildEnv.Path: data Project
+ BuildEnv.Path: data Tmp
+ BuildEnv.Path: getAbsolutePath :: AbsolutePath to -> FilePath
+ BuildEnv.Path: getSymbolicPath :: SymbolicPathX allowAbsolute from to -> FilePath
+ BuildEnv.Path: infixr 5 </>
+ BuildEnv.Path: infixr 7 <.>
+ BuildEnv.Path: instance (b1 GHC.Types.~ 'BuildEnv.Path.Dir b2, a3 GHC.Types.~ a1, c2 GHC.Types.~ c3) => BuildEnv.Path.PathLike (BuildEnv.Path.SymbolicPathX allowAbsolute a1 b1) (BuildEnv.Path.SymbolicPathX midAbsolute b2 c2) (BuildEnv.Path.SymbolicPathX allowAbsolute a3 c3)
+ BuildEnv.Path: instance (b1 GHC.Types.~ 'BuildEnv.Path.Dir b2, c2 GHC.Types.~ c3, midAbsolute GHC.Types.~ 'BuildEnv.Path.OnlyRelative) => BuildEnv.Path.PathLike (BuildEnv.Path.AbsolutePath b1) (BuildEnv.Path.SymbolicPathX midAbsolute b2 c2) (BuildEnv.Path.AbsolutePath c3)
+ BuildEnv.Path: instance (p GHC.Types.~ 'BuildEnv.Path.File) => BuildEnv.Path.FileLike (BuildEnv.Path.AbsolutePath p)
+ BuildEnv.Path: instance (p GHC.Types.~ 'BuildEnv.Path.File) => BuildEnv.Path.FileLike (BuildEnv.Path.SymbolicPathX allowAbsolute dir p)
+ BuildEnv.Path: instance (q GHC.Types.~ GHC.IO.FilePath) => BuildEnv.Path.PathLike GHC.IO.FilePath q GHC.IO.FilePath
+ BuildEnv.Path: instance BuildEnv.Path.FileLike GHC.IO.FilePath
+ BuildEnv.Path: instance GHC.Show.Show (BuildEnv.Path.AbsolutePath to)
+ BuildEnv.Path: instance GHC.Show.Show (BuildEnv.Path.SymbolicPathX allowAbsolute from to)
+ BuildEnv.Path: interpretSymbolicPath :: SymbolicPath CWD (Dir dir) -> SymbolicPathX allowAbsolute dir to -> FilePath
+ BuildEnv.Path: makeAbsolute :: SymbolicPath CWD (Dir dir) -> SymbolicPath dir to -> IO (AbsolutePath to)
+ BuildEnv.Path: mkAbsolutePath :: FilePath -> AbsolutePath to
+ BuildEnv.Path: mkRelativePath :: FilePath -> RelativePath from to
+ BuildEnv.Path: mkSymbolicPath :: FilePath -> SymbolicPath from to
+ BuildEnv.Path: sameDirectory :: SymbolicPathX allowAbsolute from to
+ BuildEnv.Path: type RelativePath = SymbolicPathX 'OnlyRelative
+ BuildEnv.Path: type SymbolicPath = SymbolicPathX 'AllowAbsolute
+ BuildEnv.Script: [scriptWorkingDir] :: ScriptConfig -> !SymbolicPath CWD (Dir Project)
+ BuildEnv.Utils: [absProgPath] :: ProgPath from -> !AbsolutePath File
+ BuildEnv.Utils: [relProgPath] :: ProgPath from -> !SymbolicPath from File
+ BuildEnv.Utils: withNewAbstractSem :: AsyncSem -> (AbstractSem -> Args -> IO r) -> IO r
- BuildEnv.Build: buildPlan :: Verbosity -> FilePath -> Paths ForPrep -> Paths ForBuild -> BuildStrategy -> Bool -> Maybe [UnitId] -> (ConfiguredUnit -> UnitArgs) -> CabalPlan -> IO ()
+ BuildEnv.Build: buildPlan :: Verbosity -> SymbolicPath CWD (Dir Project) -> Paths ForPrep -> Paths ForBuild -> Maybe (SymbolicPath Project (Dir Logs)) -> BuildStrategy -> Bool -> Maybe [UnitId] -> (ConfiguredUnit -> UnitArgs) -> CabalPlan -> IO ()
- BuildEnv.Build: cabalProjectContentsFromPackages :: FilePath -> UnitSpecs -> PkgSpecs -> AllowNewer -> Text
+ BuildEnv.Build: cabalProjectContentsFromPackages :: SymbolicPath CWD (Dir Project) -> UnitSpecs -> PkgSpecs -> AllowNewer -> Maybe IndexState -> IO Text
- BuildEnv.Build: computePlan :: TempDirPermanence -> Verbosity -> Compiler -> Cabal -> CabalFilesContents -> IO CabalPlanBinary
+ BuildEnv.Build: computePlan :: TempDirPermanence -> Verbosity -> Compiler -> Cabal -> SymbolicPath CWD (Dir Project) -> CabalFilesContents -> IO CabalPlanBinary
- BuildEnv.Build: fetchPlan :: Verbosity -> Cabal -> FilePath -> CabalPlan -> IO ()
+ BuildEnv.Build: fetchPlan :: Verbosity -> Cabal -> SymbolicPath CWD (Dir Project) -> Maybe IndexState -> SymbolicPath Project (Dir Fetch) -> CabalPlan -> IO ()
- BuildEnv.BuildOne: PkgDir :: !String -> !FilePath -> PkgDir use
+ BuildEnv.BuildOne: PkgDir :: !String -> !SymbolicPath Project (Dir Pkg) -> PkgDir use
- BuildEnv.BuildOne: [$sel:pkgDir:PkgDir] :: PkgDir use -> !FilePath
+ BuildEnv.BuildOne: [$sel:pkgDir:PkgDir] :: PkgDir use -> !SymbolicPath Project (Dir Pkg)
- BuildEnv.BuildOne: buildUnit :: Verbosity -> Compiler -> BuildPaths ForBuild -> PkgDbDirs ForBuild -> PkgDir ForBuild -> UnitArgs -> Map UnitId PlanUnit -> ConfiguredUnit -> BuildScript
+ BuildEnv.BuildOne: buildUnit :: Verbosity -> Compiler -> SymbolicPath CWD (Dir Project) -> BuildPaths ForBuild -> PkgDbDir ForBuild -> PkgDir ForBuild -> UnitArgs -> Map UnitId PlanUnit -> ConfiguredUnit -> BuildScript
- BuildEnv.BuildOne: data family PkgDbDirs use
+ BuildEnv.BuildOne: data family PkgDbDir use
- BuildEnv.BuildOne: getPkgDir :: FilePath -> Paths use -> ConfiguredUnit -> PkgDir use
+ BuildEnv.BuildOne: getPkgDir :: Paths use -> ConfiguredUnit -> PkgDir use
- BuildEnv.BuildOne: setupPackage :: Verbosity -> Compiler -> BuildPaths ForBuild -> PkgDbDirs ForBuild -> PkgDir ForPrep -> PkgDir ForBuild -> Map UnitId PlanUnit -> ConfiguredUnit -> IO BuildScript
+ BuildEnv.BuildOne: setupPackage :: Verbosity -> Compiler -> SymbolicPath CWD (Dir Project) -> BuildPaths ForBuild -> PkgDbDir ForBuild -> PkgDir ForPrep -> PkgDir ForBuild -> Map UnitId PlanUnit -> ConfiguredUnit -> IO BuildScript
- BuildEnv.CabalPlan: Local :: !FilePath -> PkgSrc
+ BuildEnv.CabalPlan: Local :: !SymbolicPath Project (Dir Pkg) -> PkgSrc
- BuildEnv.Config: Cabal :: !FilePath -> !Args -> Cabal
+ BuildEnv.Config: Cabal :: !AbsolutePath File -> !Args -> Cabal
- BuildEnv.Config: Compiler :: !FilePath -> !FilePath -> Compiler
+ BuildEnv.Config: Compiler :: !AbsolutePath File -> !AbsolutePath File -> Compiler
- BuildEnv.Config: Paths :: !FilePath -> BuildPaths use -> Paths use
+ BuildEnv.Config: Paths :: !SymbolicPath Project (Dir Fetch) -> BuildPaths use -> Paths use
- BuildEnv.Config: Script :: !FilePath -> !Bool -> BuildStrategy
+ BuildEnv.Config: Script :: !SymbolicPath CWD File -> !Bool -> BuildStrategy
- BuildEnv.Config: [$sel:cabalPath:Cabal] :: Cabal -> !FilePath
+ BuildEnv.Config: [$sel:cabalPath:Cabal] :: Cabal -> !AbsolutePath File
- BuildEnv.Config: [$sel:fetchDir:Paths] :: Paths use -> !FilePath
+ BuildEnv.Config: [$sel:fetchDir:Paths] :: Paths use -> !SymbolicPath Project (Dir Fetch)
- BuildEnv.Config: [$sel:ghcPath:Compiler] :: Compiler -> !FilePath
+ BuildEnv.Config: [$sel:ghcPath:Compiler] :: Compiler -> !AbsolutePath File
- BuildEnv.Config: [$sel:ghcPkgPath:Compiler] :: Compiler -> !FilePath
+ BuildEnv.Config: [$sel:ghcPkgPath:Compiler] :: Compiler -> !AbsolutePath File
- BuildEnv.Config: [$sel:scriptPath:Execute] :: BuildStrategy -> !FilePath
+ BuildEnv.Config: [$sel:scriptPath:Execute] :: BuildStrategy -> !SymbolicPath CWD File
- BuildEnv.Config: canonicalizePaths :: Compiler -> BuildStrategy -> Paths Raw -> IO (Paths ForPrep, Paths ForBuild)
+ BuildEnv.Config: canonicalizePaths :: Compiler -> BuildStrategy -> SymbolicPath CWD (Dir Project) -> Paths Raw -> IO (Paths ForPrep, Paths ForBuild)
- BuildEnv.Script: CallProcess :: CallProcess -> BuildStep
+ BuildEnv.Script: CallProcess :: CallProcess dir -> BuildStep
- BuildEnv.Script: CreateDir :: FilePath -> BuildStep
+ BuildEnv.Script: CreateDir :: AbsolutePath (Dir dir) -> BuildStep
- BuildEnv.Script: ScriptConfig :: !ScriptOutput -> !Style -> !Maybe Word -> ScriptConfig
+ BuildEnv.Script: ScriptConfig :: !ScriptOutput -> !SymbolicPath CWD (Dir Project) -> !Style -> !Maybe Word -> ScriptConfig
- BuildEnv.Script: callProcess :: CallProcess -> BuildScript
+ BuildEnv.Script: callProcess :: CallProcess dir -> BuildScript
- BuildEnv.Script: createDir :: FilePath -> BuildScript
+ BuildEnv.Script: createDir :: AbsolutePath (Dir dir) -> BuildScript
- BuildEnv.Script: executeBuildScript :: Maybe Counter -> BuildScript -> IO ()
+ BuildEnv.Script: executeBuildScript :: SymbolicPath CWD (Dir Project) -> Maybe Counter -> BuildScript -> IO ()
- BuildEnv.Script: hostRunCfg :: Maybe Word -> ScriptConfig
+ BuildEnv.Script: hostRunCfg :: SymbolicPath CWD (Dir Project) -> Maybe Word -> ScriptConfig
- BuildEnv.Utils: AbsPath :: !FilePath -> ProgPath
+ BuildEnv.Utils: AbsPath :: !AbsolutePath File -> ProgPath from
- BuildEnv.Utils: CP :: !FilePath -> ![FilePath] -> ![(String, String)] -> !ProgPath -> !Args -> !Maybe FilePath -> !AbstractSem -> CallProcess
+ BuildEnv.Utils: CP :: !SymbolicPath CWD (Dir dir) -> ![FilePath] -> ![(String, String)] -> !ProgPath dir -> !Args -> !Maybe (AbsolutePath File) -> !AbstractSem -> CallProcess dir
- BuildEnv.Utils: RelPath :: !FilePath -> ProgPath
+ BuildEnv.Utils: RelPath :: !SymbolicPath from File -> ProgPath from
- BuildEnv.Utils: [args] :: CallProcess -> !Args
+ BuildEnv.Utils: [args] :: CallProcess dir -> !Args
- BuildEnv.Utils: [cwd] :: CallProcess -> !FilePath
+ BuildEnv.Utils: [cwd] :: CallProcess dir -> !SymbolicPath CWD (Dir dir)
- BuildEnv.Utils: [extraEnvVars] :: CallProcess -> ![(String, String)]
+ BuildEnv.Utils: [extraEnvVars] :: CallProcess dir -> ![(String, String)]
- BuildEnv.Utils: [extraPATH] :: CallProcess -> ![FilePath]
+ BuildEnv.Utils: [extraPATH] :: CallProcess dir -> ![FilePath]
- BuildEnv.Utils: [logBasePath] :: CallProcess -> !Maybe FilePath
+ BuildEnv.Utils: [logBasePath] :: CallProcess dir -> !Maybe (AbsolutePath File)
- BuildEnv.Utils: [prog] :: CallProcess -> !ProgPath
+ BuildEnv.Utils: [prog] :: CallProcess dir -> !ProgPath dir
- BuildEnv.Utils: [sem] :: CallProcess -> !AbstractSem
+ BuildEnv.Utils: [sem] :: CallProcess dir -> !AbstractSem
- BuildEnv.Utils: callProcessInIO :: HasCallStack => Maybe Counter -> CallProcess -> IO ()
+ BuildEnv.Utils: callProcessInIO :: HasCallStack => Maybe Counter -> CallProcess dir -> IO ()
- BuildEnv.Utils: data CallProcess
+ BuildEnv.Utils: data CallProcess dir
- BuildEnv.Utils: data ProgPath
+ BuildEnv.Utils: data ProgPath from
- BuildEnv.Utils: withTempDir :: TempDirPermanence -> String -> (FilePath -> IO a) -> IO a
+ BuildEnv.Utils: withTempDir :: TempDirPermanence -> String -> (AbsolutePath (Dir Tmp) -> IO a) -> IO a

Files

app/BuildEnv/Options.hs view
@@ -15,17 +15,26 @@ -- build-env
 import BuildEnv.CabalPlan
 import BuildEnv.Config
+import BuildEnv.Path
 
 --------------------------------------------------------------------------------
 
 -- | The command-line options for the @build-env@ application.
-data Opts = Opts { compiler  :: Compiler
-                 , cabal     :: Cabal
-                 , mode      :: Mode
-                 , verbosity :: Verbosity
-                 , delTemp   :: TempDirPermanence
-                 , workDir   :: FilePath
-                 }
+data GlobalOpts =
+  GlobalOpts
+    { compiler   :: !Compiler
+      -- ^ The compiler to use to build packages
+    , cabal      :: !Cabal
+      -- ^ The @cabal-install@ executable to use for computing and fetching build plans
+    , verbosity  :: !Verbosity
+      -- ^ Verbosity
+    , delTemp    :: !TempDirPermanence
+      -- ^ Whether to preserve temporary directories (for debugging purposes)
+    , workDir    :: !( SymbolicPath CWD ( Dir Project ) )
+      -- ^ Working directory
+    , indexState :: !( Maybe IndexState )
+      -- ^ Hackage index state (optional)
+    }
 
 -- | The mode in which to run the executable:
 --
@@ -35,22 +44,22 @@ data Mode
   -- | Find a build plan.
   = PlanMode
-     { planModeInputs :: PlanInputs
-     , planOutput     :: FilePath
+     { planModeInputs :: !PlanInputs
+     , planOutput     :: !( SymbolicPath Project File )
        -- ^ Where to output the @plan.json@ file.
      }
   -- | Fetch sources from a build plan.
   | FetchMode
-      FetchDescription -- ^ what to fetch
-      NewOrExisting    -- ^ whether to create a new directory
+      !FetchDescription -- ^ what to fetch
+      !NewOrExisting    -- ^ whether to create a new directory
                        -- or add to an existing one
   -- | Build and register packages from fetched sources.
-  | BuildMode Build
+  | BuildMode !Build
 
 -- | How to specify which packages/units to constraint/build.
 data PackageData pkgs
   -- | Explicit description of packages/units.
-  = Explicit pkgs
+  = Explicit !pkgs
   -- | Parse package information from the given file.
   --
   -- The file contents will be interpreted as follows:
@@ -61,17 +70,17 @@   --   - seed units: this is a list of seed units to build,
   --     with inline flags and constraints, and allow-newer stanzas.
   --     See 'parseSeedFile'.
-  | FromFile FilePath
+  | FromFile !( SymbolicPath Project File )
   deriving stock Show
 
 -- | Inputs for the computation of a cabal plan.
 data PlanInputs
   = PlanInputs
-    { planUnits      :: PackageData UnitSpecs
+    { planUnits      :: !( PackageData UnitSpecs )
       -- ^ Seed dependencies for the build plan.
-    , planPins       :: Maybe (PackageData PkgSpecs)
+    , planPins       :: !( Maybe ( PackageData PkgSpecs ) )
       -- ^ Additional package constraints.
-    , planAllowNewer :: AllowNewer
+    , planAllowNewer :: !AllowNewer
       -- ^ Allow-newer specification.
     }
   deriving stock Show
@@ -80,9 +89,9 @@ -- and what build plan they correspond to.
 data FetchDescription
   = FetchDescription
-    { rawFetchDir    :: FilePath
+    { fetchDir       :: !( SymbolicPath Project ( Dir Fetch ) )
       -- ^ Directory for fetched sources.
-    , fetchInputPlan :: Plan
+    , fetchInputPlan :: !Plan
       -- ^ The build plan corresponding to the fetched sources.
     }
   deriving stock Show
@@ -92,20 +101,20 @@ data Plan
   -- | Compute a plan.
   = ComputePlan
-      PlanInputs
+      !PlanInputs
         -- ^ Input needed to compute the plan.
-      (Maybe FilePath)
+      !( Maybe ( SymbolicPath Project File ) )
         -- ^ Optional filepath at which to write out the computed plan.
 
   -- | Use an existing @plan.json@ by reading the given file.
   | UsePlan
-    { planJSONPath :: FilePath }
+    { planJSONPath :: !( SymbolicPath Project File ) }
   deriving stock Show
 
 -- | At which point to start/continue a build.
 data BuildStart
   -- | Fetch sources and start a new build.
-  = Fetch NewOrExisting
+  = Fetch !NewOrExisting
   -- | Start a new build from prefetched sources.
   | Prefetched
   -- | Resume a previous build.
@@ -123,20 +132,24 @@ -- | Information needed to perform a build.
 data Build
   = Build
-    { buildRawPaths   :: Paths Raw
+    { buildRawPaths   :: !( Paths Raw )
       -- ^ The directories relevant for the build:
       --
       --  - fetched sources directory,
       --  - build output directory structure
-    , buildStart      :: BuildStart
+    , buildStart      :: !BuildStart
       -- ^ At which stage should the build start?
-    , buildBuildPlan  :: Plan
+    , buildBuildPlan  :: !Plan
       -- ^ The build plan to follow.
-    , buildStrategy   :: BuildStrategy
+    , buildStrategy   :: !BuildStrategy
       -- ^ How to perform the build (see 'BuildStrategy').
-    , mbOnlyDepsOf    :: Maybe ( Set PkgName )
+    , mbOnlyDepsOf    :: !( Maybe ( Set PkgName ) )
       -- ^ @Just pkgs@ <=> only build @pkgs@ (and their dependencies).
       --   @Nothing@ <=> build all units in the build plan.
+    , eventLogDir     :: !( Maybe ( SymbolicPath Project ( Dir Logs ) ) )
+      -- ^ Optional output directory in which to output GHC eventlogs
+      -- for the build.
     , userUnitArgs    :: ConfiguredUnit -> UnitArgs
       -- ^ Extra per-unit arguments.
     }
+
app/BuildEnv/Parse.hs view
@@ -11,12 +11,18 @@ module BuildEnv.Parse ( options, runOptionsParser ) where
 
 -- base
+import Control.Concurrent
+  ( getNumCapabilities )
 import Data.Char
   ( isSpace )
 import Data.Bool
   ( bool )
+import Data.Word
+  ( Word16 )
 import System.Environment
   ( getArgs )
+import Text.Read
+  ( readMaybe )
 
 -- containers
 import qualified Data.Map.Strict as Map
@@ -28,6 +34,8 @@ 
 -- optparse-applicative
 import Options.Applicative
+import Options.Applicative.Help.Pretty
+  ( (.$.) )
 
 -- text
 import Data.Text
@@ -39,21 +47,24 @@ import BuildEnv.CabalPlan
 import BuildEnv.Config
 import BuildEnv.Options
+import BuildEnv.Path
 import BuildEnv.Utils
   ( splitOn )
 
 --------------------------------------------------------------------------------
 
 -- | Run the command-line options parser.
-runOptionsParser :: FilePath -> IO Opts
-runOptionsParser currWorkDir = do
+runOptionsParser :: IO ( GlobalOpts, Mode )
+runOptionsParser = do
   args <- getArgs
-  handleParseResult $ execParserPure pPrefs pInfo args
-  where
+  caps <- NumCapabilities . fromIntegral <$> getNumCapabilities
+  let
     pInfo =
-      info ( helper <*> options currWorkDir )
+      info ( helper <*> options caps )
         (  fullDesc
         <> header "build-env - compute, fetch and build Cabal build plans" )
+  handleParseResult $ execParserPure pPrefs pInfo args
+  where
     pPrefs = prefs $
       mconcat [ showHelpOnEmpty
               , subparserInline
@@ -61,30 +72,45 @@               , multiSuffix "*"
               , columns 90 ]
 
+newtype NumCapabilities = NumCapabilities { numCapabilities :: Word16 }
+  deriving stock ( Show, Eq, Ord )
+
 -- | The command-line options parser for the 'build-env' executable.
-options :: FilePath -> Parser Opts
-options currWorkDir = do
-  mode      <- optMode
-  compiler  <- optCompiler
-  cabal     <- optCabal
-  workDir   <- optChangeWorkingDirectory currWorkDir
-  verbosity <- optVerbosity
-  delTemp   <- optTempDirPermanence
-  pure $ Opts { compiler, cabal, mode, verbosity, delTemp, workDir }
+options :: NumCapabilities -> Parser ( GlobalOpts, Mode )
+options caps = do
+  mode       <- optMode caps
+  globalOpts <- optGlobalOpts
+  pure ( globalOpts, mode )
 
+-- | Parse global options for 'build-env'.
+optGlobalOpts :: Parser GlobalOpts
+optGlobalOpts = do
+  compiler   <- optCompiler
+  cabal      <- optCabal
+  workDir    <- optChangeWorkingDirectory
+  verbosity  <- optVerbosity
+  indexState <- optIndexState
+  delTemp    <- optTempDirPermanence
+  pure $
+    GlobalOpts
+      { compiler, cabal
+      , verbosity, delTemp
+      , workDir, indexState
+      }
+
 -- | Parse @ghc@ and @ghc-pkg@ paths.
 optCompiler :: Parser Compiler
 optCompiler =
     Compiler
-      <$> option str
+      <$> option ( fmap mkAbsolutePath str )
             (  long "ghc"
-            <> value "ghc"
+            <> value ( mkAbsolutePath "ghc" )
             <> help "'ghc' executable path"
             <> metavar "GHC"
             )
-      <*> option str
+      <*> option ( fmap mkAbsolutePath str )
             (  long "ghc-pkg"
-            <> value "ghc-pkg"
+            <> value ( mkAbsolutePath "ghc-pkg" )
             <> help "'ghc-pkg' executable path"
             <> metavar "GHC-PKG"
             )
@@ -93,9 +119,9 @@ optCabal :: Parser Cabal
 optCabal = do
   cabalPath <-
-    option str
+    option ( fmap mkAbsolutePath str )
       (  long "cabal"
-      <> value "cabal"
+      <> value ( mkAbsolutePath "cabal" )
       <> help "'cabal' executable path"
       <> metavar "CABAL" )
   globalCabalArgs <-
@@ -105,11 +131,11 @@   pure $ Cabal { cabalPath, globalCabalArgs }
 
 -- | Parse a @cwd@ (change working directory) option.
-optChangeWorkingDirectory :: FilePath -> Parser FilePath
-optChangeWorkingDirectory currWorkDir =
-    option str
+optChangeWorkingDirectory :: Parser ( SymbolicPath CWD ( Dir Project ) )
+optChangeWorkingDirectory =
+    option ( fmap mkSymbolicPath str )
       (  long "cwd"
-      <> value currWorkDir
+      <> value sameDirectory
       <> help "Set working directory"
       <> metavar "DIR" )
 
@@ -131,9 +157,17 @@       switch (  long "preserve-tmp"
              <> help "Preserve temporary build directories (useful for debugging)" )
 
+-- | Parse a Hackage index state.
+optIndexState :: Parser ( Maybe IndexState )
+optIndexState =
+  optional $ fmap ( IndexState . Text.pack ) $
+    option str ( long "index-state" <> help helpStr <> metavar "DATE" )
+  where
+    helpStr = "Use Hackage state as of DATE, e.g. 2022-12-25T00:00:00Z"
+
 -- | Parse the mode in which to run the application: plan, fetch, build.
-optMode :: Parser Mode
-optMode =
+optMode :: NumCapabilities -> Parser Mode
+optMode caps =
   hsubparser . mconcat $
     [ command "plan"  $
         info ( PlanMode  <$> planInputs Planning <*> optOutput )
@@ -142,17 +176,18 @@         info ( FetchMode <$> fetchDescription <*> newOrExisting )
         ( fullDesc <> fetchInfo )
     , command "build" $
-        info ( BuildMode <$> build )
+        info ( BuildMode <$> build caps )
         ( fullDesc <> buildInfo )
     ]
   where
-    optOutput :: Parser FilePath
+    optOutput :: Parser ( SymbolicPath Project File )
     optOutput =
-      option str (  short 'p'
-                 <> long "plan"
-                 <> help "Output 'plan.json' file"
-                 <> metavar "OUTFILE"
-                 )
+      option ( fmap mkSymbolicPath str )
+        (  short 'p'
+        <> long "plan"
+        <> help "Output 'plan.json' file"
+        <> metavar "OUTFILE"
+        )
     planInfo, fetchInfo, buildInfo :: InfoMod a
     planInfo  = progDesc "Compute a build plan from a collection of seeds"
     fetchInfo = progDesc "Fetch package sources"
@@ -191,8 +226,9 @@ freeze :: ModeDescription -> Parser ( PackageData PkgSpecs )
 freeze modeDesc = FromFile <$> freezeFile
   where
-    freezeFile :: Parser FilePath
-    freezeFile = option str ( long "freeze" <> help helpStr <> metavar "INFILE" )
+    freezeFile :: Parser ( SymbolicPath Project File )
+    freezeFile = option ( fmap mkSymbolicPath str )
+                   ( long "freeze" <> help helpStr <> metavar "INFILE" )
 
     helpStr :: String
     helpStr = modeDescription modeDesc <> " 'cabal.config' freeze file"
@@ -238,8 +274,9 @@ 
   where
 
-    seeds :: Parser FilePath
-    seeds = option str ( long "seeds" <> help seedsHelp <> metavar "INFILE" )
+    seeds :: Parser ( SymbolicPath Project File )
+    seeds = option ( fmap mkSymbolicPath str )
+              ( long "seeds" <> help seedsHelp <> metavar "INFILE" )
 
     explicitUnits :: Parser ( PackageData UnitSpecs )
     explicitUnits = do
@@ -252,20 +289,20 @@              [ (pkg, (Local loc, emptyPkgSpec, mempty))
              | (pkg, loc) <- locals ]
 
-    localPkg :: Parser (PkgName, FilePath)
+    localPkg :: Parser ( PkgName, SymbolicPath Project ( Dir Pkg ) )
     localPkg =
       option readLocalPkg
         (  long "local"
         <> help "Local package source location"
         <> metavar "PKG=PATH" )
 
-    readLocalPkg :: ReadM (PkgName, FilePath)
+    readLocalPkg :: ReadM ( PkgName, SymbolicPath Project ( Dir Pkg ) )
     readLocalPkg = do
       ln <- str
       case Text.splitOn "=" ln of
         pkg:loc:_
           | validPackageName pkg
-          -> return (PkgName pkg, Text.unpack loc)
+          -> return ( PkgName pkg, mkSymbolicPath $ Text.unpack loc )
         _ -> readerError $
               "Could not parse --local argument\n" ++
               "Valid usage is of the form: --local PKG=PATH"
@@ -292,17 +329,17 @@             <|> ( ComputePlan <$> planInputs modeDesc <*> optPlanOutput )
 
   where
-    optPlanPath :: Parser FilePath
+    optPlanPath :: Parser ( SymbolicPath Project File )
     optPlanPath =
-      option str
+      option ( fmap mkSymbolicPath str )
         (  short 'p'
         <> long "plan"
         <> help "Input 'plan.json' file"
         <> metavar "INFILE" )
 
-    optPlanOutput :: Parser (Maybe FilePath)
+    optPlanOutput :: Parser ( Maybe ( SymbolicPath Project File ) )
     optPlanOutput =
-      option (fmap Just str)
+      option ( fmap ( Just . mkSymbolicPath ) str )
         (  long "output-plan"
         <> value Nothing
         <> help "Output 'plan.json' file"
@@ -313,13 +350,13 @@ fetchDescription :: Parser FetchDescription
 fetchDescription = do
   fetchInputPlan <- plan Fetching
-  rawFetchDir    <- optFetchDir Fetching
-  pure $ FetchDescription { rawFetchDir, fetchInputPlan }
+  fetchDir       <- optFetchDir Fetching
+  pure $ FetchDescription { fetchDir, fetchInputPlan }
 
 -- | Parse the fetch directory.
-optFetchDir :: ModeDescription -> Parser FilePath
+optFetchDir :: ModeDescription -> Parser ( SymbolicPath Project ( Dir Fetch ) )
 optFetchDir modeDesc =
-  option str
+  option ( fmap mkSymbolicPath str )
     (  short 'f'
     <> long "fetchdir"
     <> help "Directory for fetched sources"
@@ -338,23 +375,24 @@              <> help "Update existing fetched sources directory" )
 
 -- | Parse the options for the @build@ command.
-build :: Parser Build
-build = do
-
-  buildBuildPlan     <- plan Building
-  buildStart         <- optStart
-  buildStrategy      <- optStrategy
-  buildRawPaths      <- optRawPaths
-  userUnitArgs       <- optUnitArgs
-  mbOnlyDepsOf       <- optOnlyDepsOf
+build :: NumCapabilities -> Parser Build
+build ( NumCapabilities numCaps ) = do
 
+  buildBuildPlan <- plan Building
+  buildStart     <- optStart
+  buildStrategy  <- optStrategy
+  buildRawPaths  <- optRawPaths
+  userUnitArgs   <- optUnitArgs
+  mbOnlyDepsOf   <- optOnlyDepsOf
+  eventLogDir    <- optEventLogDir
   pure $
     Build { buildStart
           , buildBuildPlan
           , buildStrategy
           , buildRawPaths
           , userUnitArgs
-          , mbOnlyDepsOf }
+          , mbOnlyDepsOf
+          , eventLogDir }
 
   where
 
@@ -366,12 +404,39 @@ 
     asyncSem :: Parser AsyncSem
     asyncSem =
-      option (fmap NewQSem auto <|> pure NoSem)
+      option jsem
+        (  long "jsem"
+        <> help "Use a system semaphore to control parallelism"
+        <> metavar "[N|SEM_NAME]" )
+      <|>
+      option ( fmap NewQSem j )
         (  short 'j'
-        <> long "async"
         <> help "Use asynchronous package building"
-        <> metavar "N" )
+        <> metavar "[N]" )
 
+    j :: ReadM Word16
+    j = do
+      x <- str
+      if null x
+      then return numCaps
+      else
+        case readMaybe x of
+          Just n -> return n
+          Nothing ->
+           readerError $
+             "Invalid -j argument: " <> x
+
+    jsem :: ReadM AsyncSem
+    jsem = do
+      x <- str
+      return $
+        if null x
+        then NewJSem numCaps
+        else
+          case readMaybe x of
+            Just n  -> NewJSem n
+            Nothing -> ExistingJSem x
+
     optScript :: Parser BuildStrategy
     optScript = do
       scriptPath <- optScriptPath
@@ -381,11 +446,12 @@           <> help "Use variables in the shell script output ($PREFIX etc)" )
       pure $ Script { scriptPath, useVariables }
 
-    optScriptPath :: Parser FilePath
+    optScriptPath :: Parser ( SymbolicPath CWD File )
     optScriptPath =
-      option str
+      option ( fmap mkSymbolicPath str )
         (  long "script"
-        <> help "Output a shell script containing build steps"
+        <> helpDoc ( Just $  "Output a shell script containing build steps"
+                         .$. "  NB: path is interpreted relative to current work dir, NOT --cwd" )
         <> metavar "OUTFILE" )
 
     optStart :: Parser BuildStart
@@ -404,7 +470,7 @@         (  long "prefetched"
         <> help "Start the build from the prefetched sources" )
 
-    optRawPaths :: Parser (Paths Raw)
+    optRawPaths :: Parser ( Paths Raw )
     optRawPaths = do
       fetchDir   <- optFetchDir Building
       buildPaths <- optBuildPaths
@@ -413,15 +479,17 @@     optBuildPaths :: Parser (BuildPaths Raw)
     optBuildPaths = do
       rawPrefix <-
-        option str (  short 'o'
-                   <> long "prefix"
-                   <> help "Installation prefix"
-                   <> metavar "OUTDIR" )
+        option ( fmap mkSymbolicPath str )
+          (  short 'o'
+          <> long "prefix"
+          <> help "Installation prefix"
+          <> metavar "OUTDIR" )
       rawDestDir <-
-        option str (  long "destdir"
-                   <> help "Installation destination directory"
-                   <> value "/"
-                   <> metavar "OUTDIR" )
+        option ( fmap mkSymbolicPath str )
+          (  long "destdir"
+          <> help "Installation destination directory"
+          <> value ( mkSymbolicPath "/" )
+          <> metavar "OUTDIR" )
       pure $ RawBuildPaths { rawPrefix, rawDestDir }
 
     -- TODO: we only support passing arguments for all units at once,
@@ -447,7 +515,7 @@     optHaddockArgs = do
       doHaddock <-
         switch (  long "haddock"
-               <> help "Generate haddock documentation" )
+               <> help "Generate Haddock documentation" )
       args <- many $
         option str (  long "haddock-arg"
                    <> help "Pass argument to 'Setup haddock'"
@@ -484,3 +552,11 @@       then return $ PkgName nm
       else readerError $
             "Invalid package name: " <> Text.unpack nm
+
+    optEventLogDir :: Parser ( Maybe ( SymbolicPath Project ( Dir Logs ) ) )
+    optEventLogDir = do
+        option ( fmap ( Just . mkSymbolicPath ) str )
+          (  long "eventlogs"
+          <> help "Directory for GHC event logs"
+          <> value Nothing
+          <> metavar "OUTDIR" )
app/Main.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE DataKinds #-}
+
 module Main ( main ) where
 
 -- base
@@ -34,54 +36,59 @@ import BuildEnv.Options
 import BuildEnv.Parse
   ( runOptionsParser )
+import BuildEnv.Path
 
 --------------------------------------------------------------------------------
 
 main :: IO ()
 main = do
-  currentDir <- getCurrentDirectory
-  Opts { compiler, cabal, mode, verbosity, delTemp, workDir }
-    <- runOptionsParser currentDir
+  ( GlobalOpts
+      { compiler, cabal
+      , verbosity, delTemp, workDir
+      , indexState = mbIndexState }
+    , mode )
+    <- runOptionsParser
   hSetBuffering stdout $ BlockBuffering Nothing
-  withCurrentDirectory workDir $
-    case mode of
-      PlanMode { planModeInputs, planOutput } -> do
-        CabalPlanBinary planBinary <-
-          computePlanFromInputs delTemp verbosity workDir compiler cabal planModeInputs
-        normalMsg verbosity $
-          "Writing build plan to '" <> Text.pack planOutput <> "'"
-        Lazy.ByteString.writeFile planOutput planBinary
-      FetchMode ( FetchDescription { rawFetchDir, fetchInputPlan } ) newOrUpd -> do
-        plan <- getPlan delTemp verbosity workDir compiler cabal fetchInputPlan
-        fetchDir <- canonicalizePath rawFetchDir
-        doFetch verbosity cabal fetchDir True newOrUpd plan
-      BuildMode ( Build { buildBuildPlan
-                        , buildStart
-                        , buildStrategy
-                        , buildRawPaths = rawPaths
-                        , mbOnlyDepsOf
-                        , userUnitArgs } ) -> do
-        plan <- getPlan delTemp verbosity workDir compiler cabal buildBuildPlan
-        ( pathsForPrep@( Paths { fetchDir }), pathsForBuild )
-          <- canonicalizePaths compiler buildStrategy rawPaths
-        case buildStart of
-          Fetch newOrUpd -> doFetch verbosity cabal fetchDir False newOrUpd plan
-          _              -> return ()
-        let mbOnlyDepsOfUnits :: Maybe [UnitId]
-            mbOnlyDepsOfUnits =
-              case mbOnlyDepsOf of
-                Nothing -> Nothing
-                Just pkgs ->
-                  let wantUnit :: PlanUnit -> Maybe UnitId
-                      wantUnit pu = do
-                        ConfiguredUnit { puPkgName, puId } <- configuredUnitMaybe pu
-                        guard ( puPkgName `Set.member` pkgs )
-                        return puId
-                  in Just $ mapMaybePlanUnits wantUnit plan
+  case mode of
+    PlanMode { planModeInputs, planOutput } -> do
+      CabalPlanBinary planBinary <-
+        computePlanFromInputs
+          delTemp verbosity workDir compiler cabal
+          mbIndexState planModeInputs
+      normalMsg verbosity $
+        "Writing build plan to" <> Text.pack ( show planOutput )
+      Lazy.ByteString.writeFile ( interpretSymbolicPath workDir planOutput ) planBinary
+    FetchMode ( FetchDescription { fetchDir, fetchInputPlan } ) newOrUpd -> do
+      plan <- getPlan delTemp verbosity workDir compiler cabal mbIndexState fetchInputPlan
+      doFetch verbosity cabal workDir fetchDir mbIndexState True newOrUpd plan
+    BuildMode ( Build { buildBuildPlan
+                      , buildStart
+                      , buildStrategy
+                      , buildRawPaths = rawPaths
+                      , mbOnlyDepsOf
+                      , eventLogDir
+                      , userUnitArgs } ) -> do
+      plan <- getPlan delTemp verbosity workDir compiler cabal mbIndexState buildBuildPlan
+      ( pathsForPrep@( Paths { fetchDir }), pathsForBuild )
+        <- canonicalizePaths compiler buildStrategy workDir rawPaths
+      case buildStart of
+        Fetch newOrUpd -> doFetch verbosity cabal workDir fetchDir mbIndexState False newOrUpd plan
+        _              -> return ()
+      let mbOnlyDepsOfUnits :: Maybe [UnitId]
+          mbOnlyDepsOfUnits =
+            case mbOnlyDepsOf of
+              Nothing -> Nothing
+              Just pkgs ->
+                let wantUnit :: PlanUnit -> Maybe UnitId
+                    wantUnit pu = do
+                      ConfiguredUnit { puPkgName, puId } <- configuredUnitMaybe pu
+                      guard ( puPkgName `Set.member` pkgs )
+                      return puId
+                in Just $ mapMaybePlanUnits wantUnit plan
 
-        let resumeBuild = case buildStart of { Resume -> True; _ -> False }
-        buildPlan verbosity workDir pathsForPrep pathsForBuild
-          buildStrategy resumeBuild mbOnlyDepsOfUnits userUnitArgs plan
+      let resumeBuild = case buildStart of { Resume -> True; _ -> False }
+      buildPlan verbosity workDir pathsForPrep pathsForBuild eventLogDir
+        buildStrategy resumeBuild mbOnlyDepsOfUnits userUnitArgs plan
 
 -- | Generate the contents of @pkg.cabal@ and @cabal.project@ files, using
 --
@@ -89,94 +96,107 @@ --    and allow-newer),
 --  - a @cabal.config@ freeze file,
 --  - explicit packages and allow-newer specified as command-line arguments.
-parsePlanInputs :: Verbosity -> FilePath -> PlanInputs -> IO CabalFilesContents
-parsePlanInputs verbosity workDir (PlanInputs { planPins, planUnits, planAllowNewer })
-  = do (pkgs, fileAllowNewer) <- parsePlanUnits verbosity planUnits
-       let
-         allAllowNewer = fileAllowNewer <> planAllowNewer
-           -- NB: allow-newer specified in the command-line overrides
-           -- the allow-newer included in the seed file.
-         cabalContents = cabalFileContentsFromPackages pkgs
-       projectContents <-
-         case planPins of
-           Nothing -> return $ cabalProjectContentsFromPackages workDir pkgs Map.empty allAllowNewer
-           Just (FromFile pinCabalConfig) -> do
-             normalMsg verbosity $
-               "Reading 'cabal.config' file at '" <> Text.pack pinCabalConfig <> "'"
-             pins <- parseCabalDotConfigPkgs pinCabalConfig
-             return $ cabalProjectContentsFromPackages workDir pkgs pins allAllowNewer
-           Just (Explicit pins) -> do
-             return $ cabalProjectContentsFromPackages workDir pkgs pins allAllowNewer
-       return $ CabalFilesContents { cabalContents, projectContents }
+parsePlanInputs :: Verbosity
+                -> SymbolicPath CWD ( Dir Project )
+                -> Maybe IndexState -> PlanInputs -> IO CabalFilesContents
+parsePlanInputs verbosity workDir mbIndexState
+  ( PlanInputs { planPins, planUnits, planAllowNewer } )
+  = do
+      ( pkgs, fileAllowNewer ) <- parsePlanUnits verbosity workDir planUnits
+      let
+        allAllowNewer = fileAllowNewer <> planAllowNewer
+          -- NB: allow-newer specified in the command-line overrides
+          -- the allow-newer included in the seed file.
+        cabalContents = cabalFileContentsFromPackages pkgs
+      pins <-
+        case planPins of
+          Nothing -> return Map.empty
+          Just ( FromFile pinCabalConfig ) -> do
+            normalMsg verbosity $
+              "Reading 'cabal.config' file at " <> Text.pack ( show pinCabalConfig )
+            pins <- parseCabalDotConfigPkgs ( interpretSymbolicPath workDir pinCabalConfig )
+            return pins
+          Just ( Explicit pins ) -> do
+            return pins
+      projectContents <-
+        cabalProjectContentsFromPackages workDir pkgs pins allAllowNewer mbIndexState
+      return $ CabalFilesContents { cabalContents, projectContents }
 
 -- | Retrieve the seed units we want to build, either from a seed file
 -- or from explicit command line arguments.
-parsePlanUnits :: Verbosity -> PackageData UnitSpecs -> IO (UnitSpecs, AllowNewer)
-parsePlanUnits _ (Explicit units) = return (units, AllowNewer Set.empty)
-parsePlanUnits verbosity (FromFile fp) =
-  do normalMsg verbosity $
-       "Reading seed packages from '" <> Text.pack fp <> "'"
-     parseSeedFile fp
+parsePlanUnits :: Verbosity
+               -> SymbolicPath CWD ( Dir Project )
+               -> PackageData UnitSpecs -> IO ( UnitSpecs, AllowNewer )
+parsePlanUnits _ _ ( Explicit units ) = return (units, AllowNewer Set.empty)
+parsePlanUnits verbosity workDir ( FromFile fp ) = do
+  normalMsg verbosity $
+    "Reading seed packages from " <> Text.pack ( show fp ) <> ""
+  parseSeedFile ( interpretSymbolicPath workDir fp )
 
 -- | Compute a build plan by calling @cabal build --dry-run@ with the generated
 -- @pkg.cabal@ and @cabal.project@ files.
 computePlanFromInputs :: TempDirPermanence
                       -> Verbosity
-                      -> FilePath
+                      -> SymbolicPath CWD ( Dir Project )
                       -> Compiler
                       -> Cabal
+                      -> Maybe IndexState
                       -> PlanInputs
                       -> IO CabalPlanBinary
-computePlanFromInputs delTemp verbosity workDir comp cabal inputs
-    = do cabalFileContents <- parsePlanInputs verbosity workDir inputs
-         normalMsg verbosity "Computing build plan"
-         computePlan delTemp verbosity comp cabal cabalFileContents
+computePlanFromInputs delTemp verbosity workDir comp cabal mbIndexState inputs = do
+  cabalFileContents <- parsePlanInputs verbosity workDir mbIndexState inputs
+  normalMsg verbosity "Computing build plan"
+  computePlan delTemp verbosity comp cabal workDir cabalFileContents
 
 -- | Retrieve a cabal build plan, either by computing it or using
 -- a pre-existing @plan.json@ file.
-getPlan :: TempDirPermanence -> Verbosity -> FilePath -> Compiler -> Cabal -> Plan -> IO CabalPlan
-getPlan delTemp verbosity workDir comp cabal planMode = do
-   planBinary <-
-     case planMode of
-       ComputePlan planInputs mbPlanOutputPath -> do
-        plan@(CabalPlanBinary planData) <-
-          computePlanFromInputs delTemp verbosity workDir comp cabal planInputs
+getPlan :: TempDirPermanence -> Verbosity
+        -> SymbolicPath CWD ( Dir Project )
+        -> Compiler -> Cabal -> Maybe IndexState -> Plan -> IO CabalPlan
+getPlan delTemp verbosity workDir comp cabal mbIndexState planMode = do
+  planBinary <-
+    case planMode of
+      ComputePlan planInputs mbPlanOutputPath -> do
+        plan@( CabalPlanBinary planData ) <-
+          computePlanFromInputs delTemp verbosity workDir comp cabal mbIndexState planInputs
         for_ mbPlanOutputPath \ planOutputPath ->
-          Lazy.ByteString.writeFile planOutputPath planData
+          Lazy.ByteString.writeFile ( interpretSymbolicPath workDir planOutputPath ) planData
         return plan
-       UsePlan { planJSONPath } ->
-         do
-           normalMsg verbosity $
-             "Reading build plan from '" <> Text.pack planJSONPath <> "'"
-           CabalPlanBinary <$> Lazy.ByteString.readFile planJSONPath
-   return $ parsePlanBinary planBinary
+      UsePlan { planJSONPath } -> do
+        normalMsg verbosity $
+          "Reading build plan from " <> Text.pack ( show planJSONPath )
+        CabalPlanBinary <$> Lazy.ByteString.readFile ( interpretSymbolicPath workDir planJSONPath )
+  return $ parsePlanBinary planBinary
 
 -- | Fetch all packages in a cabal build plan.
 doFetch :: Verbosity
         -> Cabal
-        -> FilePath
+        -> SymbolicPath CWD ( Dir Project )
+           -- ^ working directory
+        -> SymbolicPath Project ( Dir Fetch )
+           -- ^ fetch directory
+        -> Maybe IndexState
         -> Bool -- ^ True <=> we are fetching (not building)
                 -- (only relevant for error messages)
         -> NewOrExisting
         -> CabalPlan
         -> IO ()
-doFetch verbosity cabal fetchDir0 weAreFetching newOrUpd plan = do
-  fetchDir       <- canonicalizePath fetchDir0
-  fetchDirExists <- doesDirectoryExist fetchDir
+doFetch verbosity cabal workDir fetchDir mbIndexState weAreFetching newOrUpd plan = do
+  fetchDirExists <- doesDirectoryExist $ interpretSymbolicPath workDir fetchDir
   case newOrUpd of
     New | fetchDirExists ->
       error $ unlines $
        "Fetch directory already exists." : existsMsg
-          ++ [ "Fetch directory: " <> fetchDir  ]
+          ++ [ "Fetch directory: " <> show fetchDir ]
     Existing | not fetchDirExists ->
       error $ unlines
         [ "Fetch directory must already exist when using --update."
-        , "Fetch directory: " <> fetchDir ]
+        , "Fetch directory: " <> show fetchDir ]
     _ -> return ()
-  createDirectoryIfMissing True fetchDir
+  createDirectoryIfMissing True $ interpretSymbolicPath workDir fetchDir
   normalMsg verbosity $
-    "Fetching sources from build plan into directory '" <> Text.pack fetchDir <> "'"
-  fetchPlan verbosity cabal fetchDir plan
+    "Fetching sources from build plan into directory " <> Text.pack ( show fetchDir )
+  fetchPlan verbosity cabal workDir mbIndexState fetchDir plan
 
   where
     existsMsg
build-env.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0
 name:          build-env
-version:       1.1.0.0
+version:       1.2.0.0
 author:        Ben Gamari & Sam Derbyshire
 maintainer:    ben@smart-cactus.org
 license:       BSD-3-Clause
@@ -27,17 +27,19 @@ 
     build-depends:
         base
-          >= 4.15 && < 4.18
+          >= 4.15 && < 5.0
       , bytestring
           >= 0.10 && < 0.12
       , containers
-         ^>= 0.6
+          >= 0.6  && < 0.8
       , directory
          ^>= 1.3
       , filepath
-         ^>= 1.4
+          >= 1.4  && < 1.6
+      , semaphore-compat
+           ^>= 1.0.0
       , text
-          >= 1.2 && < 2.1
+          >= 1.2  && < 2.2
 
     default-language:
         Haskell2010
@@ -80,21 +82,22 @@       , BuildEnv.Config
       , BuildEnv.File
       , BuildEnv.Script
+      , BuildEnv.Path
       , BuildEnv.Utils
 
     build-depends:
         async
          ^>= 2.2
       , aeson
-          >= 1.5 && < 2.2
+          >= 1.5 && < 2.3
       , process
          ^>= 1.6
       , temporary
          ^>= 1.3
       , time
-          >= 1.9 && < 1.13
+          >= 1.9 && < 1.15
       , transformers
-         ^>= 0.5
+          >= 0.5 && < 0.7
 
 executable build-env
 
changelog.md view
@@ -1,12 +1,25 @@ # Changelog for `build-env`
 
+## Version 1.2.0.0 (2024-08-22)
+
+- Allow specifying a Hackage index state using the `--index-state` flag (@simonmar).
+
+- Avoid using process substitution in generated build scripts, allowing the
+  build scripts to be run in environments in which `/dev/fd` is not available (@simonmar).
+
+- Add support for the GHC `-jsem` flag (GHC 9.8 and above), for speeding up parallel builds.
+
+- Add support for relocatable builds using `--configure-arg --enable-relocatable`.
+
+- Relax upper bounds on various dependencies of `build-env`.
+
 ## Version 1.1.0.0 (2023-03-09)
 
 - Change the default directory structure produced by `build-env` to be more
   predictable.
 
 - Ensure that important arguments to Cabal configure override arguments
-  passed using `--configure-arg=`, as they are essential for `build-env`
+  passed using `--configure-arg`, as they are essential for `build-env`
   to function.
 
 ## Version 1.0.0.0 (2022-12-26)
readme.md view
@@ -12,6 +12,7 @@ 
 - [Example](#example)
 - [Commands](#commands)
+  - [Parallelism](#parallelism)
 - [What does `build-env` do?](#what-does-build-env-do)
 - [Hermetic builds](#hermetic-builds)
   - [Narrowing a build down (for debugging)](#narrowing-a-build-down-for-debugging)
@@ -65,11 +66,26 @@ Being able to separate these steps affords us some extra flexibility, as
 subsequent sections will explain.
 
-Note: it is preferable to pass a previously computed build plan when calling
+__Note__: it is preferable to pass a previously computed build plan when calling
 `build-env build --prefetched`: an invocation of the form `build-env build a b c --prefetched`
 will compute a new build plan, and this build plan could be different from
 the plan that was previously fetched, for example if you have run `cabal update`
-in the meantime.
+in the meantime.  
+Another option is to pass `--index-state`, which pins down a specific Hackage
+index state.
+
+### Parallelism
+
+`build-env` supports parallel builds in much the same way as `cabal-install` does:
+
+  - `-jN` controls how many packages are built concurrently.
+  - `--configure-arg --ghc-option=-jN` controls the parallelism afforded to
+    GHC invocations when building individual packages.
+  - `--jsem N` allows `build-env` and GHC to coordinate usage of CPU resources.  
+    This is usually the fastest, but it requires:
+      - GHC >= 9.8,
+      - that GHC and `build-env` have been compiled against the same libc implementation
+    (see [GHC issue #25087](https://gitlab.haskell.org/ghc/ghc/-/issues/25087)).
 
 ## What does `build-env` do?
 
src/BuildEnv/Build.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 -- |
 -- Module      :  BuildEnv.Build
@@ -43,6 +44,8 @@   ( for_, toList )
 import Data.IORef
   ( newIORef )
+import Data.Functor
+  ( (<&>) )
 import Data.Maybe
   ( catMaybes, mapMaybe, maybeToList, isNothing )
 import Data.String
@@ -76,14 +79,10 @@ 
 -- directory
 import System.Directory
-  ( createDirectoryIfMissing, doesDirectoryExist, doesFileExist
-  , exeExtension, listDirectory, removeDirectoryRecursive
-  )
-
--- filepath
-import System.FilePath
-  ( (</>), (<.>)
-  , isAbsolute
+  ( createDirectoryIfMissing
+  , doesDirectoryExist, doesFileExist
+  , exeExtension, listDirectory
+  , removeDirectoryRecursive
   )
 
 -- process
@@ -99,9 +98,11 @@ 
 -- build-env
 import BuildEnv.BuildOne
-  ( PkgDbDirs(..)
-  , getPkgDbDirsForPrep, getPkgDbDirsForBuild, getPkgDir
-  , setupPackage, buildUnit )
+  ( PkgDbDir(..)
+  , getPkgDbDirForPrep, getPkgDbDirForBuild
+  , getPkgDir
+  , setupPackage, buildUnit
+  )
 import BuildEnv.CabalPlan
 import qualified BuildEnv.CabalPlan as Configured
   ( ConfiguredUnit(..) )
@@ -110,12 +111,14 @@   ( BuildScript, ScriptOutput(..), ScriptConfig(..)
   , emptyBuildScript
   , executeBuildScript, script
-  , createDir, logMessage
+  , createDir
+  , logMessage
   )
 import BuildEnv.Utils
   ( ProgPath(..), CallProcess(..), callProcessInIO, withTempDir
-  , AbstractSem(..), noSem, newAbstractSem
+  , AbstractSem(..), noSem, withNewAbstractSem
   )
+import BuildEnv.Path
 
 --------------------------------------------------------------------------------
 -- Planning.
@@ -144,69 +147,61 @@             -> Verbosity
             -> Compiler
             -> Cabal
+            -> SymbolicPath CWD ( Dir Project )
             -> CabalFilesContents
             -> IO CabalPlanBinary
-computePlan delTemp verbosity comp cabal ( CabalFilesContents { cabalContents, projectContents } ) =
-  withTempDir delTemp "build" \ dir -> do
-    verboseMsg verbosity $ "Computing plan in build directory " <> Text.pack dir
-    Text.writeFile (dir </> "cabal" <.> "project") projectContents
-    Text.writeFile (dir </> dummyPackageName <.> "cabal") cabalContents
+computePlan delTemp verbosity comp cabal _workDir ( CabalFilesContents { cabalContents, projectContents } ) =
+  withTempDir delTemp "build" \ tmpDir -> do
+    verboseMsg verbosity $ "Computing plan in build directory " <> Text.pack ( show tmpDir )
+    Text.writeFile (getAbsolutePath tmpDir </> "cabal" <.> "project") projectContents
+    Text.writeFile (getAbsolutePath tmpDir </> dummyPackageName <.> "cabal") cabalContents
     let cabalBuildArgs =
           globalCabalArgs cabal ++
             [ "build"
             , "--dry-run"
-            , "--with-compiler", ghcPath comp
+            , "--with-compiler", getAbsolutePath ( ghcPath comp )
             , cabalVerbosity verbosity ]
     debugMsg verbosity $
-      Text.unlines $ "cabal" : map ( ("  " <>) . Text.pack ) cabalBuildArgs
-    callProcessInIO Nothing $
-      CP { cwd          = dir
+      Text.unlines $ "cabal" : map ( ( "  " <> ) . Text.pack ) cabalBuildArgs
+    callProcessInIO @Tmp Nothing $
+      CP { cwd          = absoluteSymbolicPath tmpDir
          , prog         = AbsPath $ cabalPath cabal
          , args         = cabalBuildArgs
          , extraPATH    = []
          , extraEnvVars = []
          , logBasePath  = Nothing
-         , sem          = noSem }
+         , sem          = noSem
+         }
 
-    let planPath = dir </> "dist-newstyle" </> "cache" </> "plan.json"
+    let planPath :: FilePath
+        planPath = getAbsolutePath tmpDir </> "dist-newstyle" </> "cache" </> "plan.json"
     CabalPlanBinary <$> Lazy.ByteString.readFile planPath
 
 -- | The contents of a dummy @cabal.project@ file, specifying
 -- package constraints, flags and allow-newer.
-cabalProjectContentsFromPackages :: FilePath -> UnitSpecs -> PkgSpecs -> AllowNewer -> Text
-cabalProjectContentsFromPackages workDir units pins (AllowNewer allowNewer) =
-      packages
-   <> allowNewers
-   <> flagSpecs
-   <> constraints
-  where
+cabalProjectContentsFromPackages
+  :: SymbolicPath CWD ( Dir Project )
+  -> UnitSpecs
+  -> PkgSpecs
+  -> AllowNewer
+  -> Maybe IndexState
+  -> IO Text
+cabalProjectContentsFromPackages workDir units pins ( AllowNewer allowNewer ) mbIndexState = do
 
+  -- Make all the local package paths into absolute paths, as we are
+  -- putting the cabal.project file off in some temporary directory.
+  ( localPkgs :: [ AbsolutePath ( Dir Pkg ) ] )
+    <- traverse ( makeAbsolute workDir ) $ mapMaybe isLocal ( Map.elems units )
+
+  let
     packages
       | null localPkgs
       = "packages: .\n\n"
       | otherwise
       = Text.intercalate ",\n          "
-        ( "packages: ." : map ( Text.pack . makeAbsolute ) ( Map.elems localPkgs ) )
+        ( "packages: ." : map ( Text.pack . getAbsolutePath ) localPkgs )
       <> "\n"
 
-    makeAbsolute :: FilePath -> FilePath
-    makeAbsolute fp
-      | isAbsolute fp
-      = fp
-      | otherwise
-      = workDir </> fp
-
-    isLocal :: (PkgSrc, PkgSpec, Set ComponentName) -> Maybe FilePath
-    isLocal ( Local src, _, _ ) = Just src
-    isLocal _ = Nothing
-    localPkgs = Map.mapMaybe isLocal units
-
-    allPkgs = fmap ( \ ( _, spec, _ ) -> spec ) units
-            `unionPkgSpecsOverriding`
-              pins
-      -- Constraints from the SEED file (units) should override
-      -- constraints from the cabal.config file (pins).
-
     constraints = Text.unlines
         [ Text.unwords ["constraints:", unPkgName nm, cts]
         | (nm, ps) <- Map.assocs allPkgs
@@ -233,6 +228,31 @@         , not $ flagSpecIsEmpty flags
         ]
 
+    indexStateDecl = case mbIndexState of
+      Nothing -> ""
+      Just ( IndexState date ) ->
+        Text.unlines [ "index-state: " <> date ]
+
+  return $
+        packages
+     <> allowNewers
+     <> flagSpecs
+     <> constraints
+     <> indexStateDecl
+
+  where
+
+    isLocal :: ( PkgSrc, PkgSpec, Set ComponentName ) -> Maybe ( SymbolicPath Project ( Dir Pkg ) )
+    isLocal ( Local src, _, _ ) = Just src
+    isLocal _ = Nothing
+
+    allPkgs :: PkgSpecs
+    allPkgs = fmap ( \ ( _, spec, _ ) -> spec ) units
+            `unionPkgSpecsOverriding`
+              pins
+      -- Constraints from the SEED file (units) should override
+      -- constraints from the cabal.config file (pins).
+
 -- | The contents of a dummy Cabal file with dependencies on
 -- the specified units (without any constraints).
 cabalFileContentsFromPackages :: UnitSpecs -> Text
@@ -299,17 +319,19 @@ -- subfolder of the specified directory (e.g. @pkg-name-1.2.3@).
 fetchPlan :: Verbosity
           -> Cabal
-          -> FilePath  -- ^ Directory in which to put the sources.
+          -> SymbolicPath CWD ( Dir Project )
+          -> Maybe IndexState
+          -> SymbolicPath Project ( Dir Fetch )  -- ^ Directory in which to put the sources.
           -> CabalPlan
           -> IO ()
-fetchPlan verbosity cabal fetchDir cabalPlan =
+fetchPlan verbosity cabal workDir mbIndexState fetchDir cabalPlan =
     for_ pkgs \ (pkgNm, pkgVer) -> do
       let nameVersion = pkgNameVersion pkgNm pkgVer
           nmVerStr = Text.unpack nameVersion
-      pkgDirExists <- doesDirectoryExist (fetchDir </> nmVerStr)
+      pkgDirExists <- doesDirectoryExist ( interpretSymbolicPath workDir $ fetchDir </> mkRelativePath nmVerStr )
       if   pkgDirExists
       then normalMsg verbosity $ "NOT fetching " <> nameVersion
-      else cabalFetch verbosity cabal fetchDir nmVerStr
+      else cabalFetch verbosity cabal workDir mbIndexState fetchDir nmVerStr
   where
     pkgs :: Set (PkgName, Version)
     pkgs = Set.fromList
@@ -326,15 +348,22 @@       _ -> Nothing
 
 -- | Call @cabal get@ to fetch a single package from Hackage.
-cabalFetch :: Verbosity -> Cabal -> FilePath -> String -> IO ()
-cabalFetch verbosity cabal root pkgNmVer = do
+cabalFetch :: Verbosity -> Cabal
+           -> SymbolicPath CWD ( Dir Project )
+           -> Maybe IndexState
+           -> SymbolicPath Project ( Dir Fetch )
+           -> String
+           -> IO ()
+cabalFetch verbosity cabal workDir mbIndexState root pkgNmVer = do
     normalMsg verbosity $ "Fetching " <> Text.pack pkgNmVer
     let args = globalCabalArgs cabal ++
                  [ "get"
                  , pkgNmVer
                  , cabalVerbosity verbosity ]
-    callProcessInIO Nothing $
-      CP { cwd          = root
+                 ++ [ "--index-state=" <> Text.unpack indexState
+                    | IndexState indexState <- maybeToList mbIndexState ]
+    callProcessInIO @Fetch Nothing $
+      CP { cwd          = workDir </> root
          , prog         = AbsPath $ cabalPath cabal
          , args
          , extraPATH    = []
@@ -349,12 +378,14 @@ -- by running their @Setup@ scripts. Libraries will be registered
 -- into a local package database at @installDir/package.conf@.
 buildPlan :: Verbosity
-          -> FilePath
+          -> SymbolicPath CWD ( Dir Project )
               -- ^ Working directory.
               -- Used to compute relative paths for local packages,
               -- and to choose a logging directory.
           -> Paths ForPrep
           -> Paths ForBuild
+          -> Maybe ( SymbolicPath Project ( Dir Logs ) )
+              -- ^ event log directory
           -> BuildStrategy
           -> Bool
              -- ^ @True@ <> resume a previously-started build,
@@ -374,51 +405,51 @@ buildPlan verbosity workDir
           pathsForPrep@( Paths { buildPaths = buildPathsForPrep })
           pathsForBuild
+          mbEventLogDir
           buildStrat
           resumeBuild
           mbOnlyBuildDepsOf
           userUnitArgs
           cabalPlan
   = do
-    let paths@( BuildPaths { compiler, prefix, destDir, installDir } )
-         = buildPaths pathsForBuild
-    -- Create the temporary package database, if it doesn't already exist.
-    -- We also create the final installation package database,
-    -- but this happens later, in (*), as part of the build script itself.
-    --
-    -- See Note [Using two package databases] in BuildOne.
-    let pkgDbDirsForPrep@( PkgDbDirsForPrep { tempPkgDbDir } )
-          = getPkgDbDirsForPrep pathsForPrep
-    tempPkgDbExists <- doesDirectoryExist tempPkgDbDir
+    let paths@( BuildPaths { compiler, prefix, installDir } )
+          = buildPaths pathsForBuild
 
-    if
-      | resumeBuild && not tempPkgDbExists
-      -> error $
-          "Cannot resume build: no package database at " <> tempPkgDbDir
-      | not resumeBuild
-      -> do when tempPkgDbExists $
-              removeDirectoryRecursive tempPkgDbDir
-                `catch` \ ( _ :: IOException ) -> return ()
-            createDirectoryIfMissing True tempPkgDbDir
-      | otherwise
-      -> return ()
+        pkgDbDirForPrep
+          = getPkgDbDirForPrep pathsForPrep
 
-    pkgDbDirsForBuild@( PkgDbDirsForBuild { finalPkgDbDir } )
-      <- getPkgDbDirsForBuild pathsForBuild
+    pkgDbDirs@( PkgDbDirForBuild { finalPkgDbDir } )
+      <- getPkgDbDirForBuild pathsForBuild
 
+    -- Check the package database exists when it should,
+    -- and delete it if we are starting fresh.
+    finalPkgDbExists <- doesDirectoryExist ( getAbsolutePath finalPkgDbDir )
+    if | resumeBuild && not finalPkgDbExists
+       -> error $ "Cannot resume build: no package database at " <> show finalPkgDbDir
+       | not resumeBuild && finalPkgDbExists
+       -> removeDirectoryRecursive ( getAbsolutePath finalPkgDbDir )
+            `catch` \ ( _ :: IOException ) -> return ()
+       | otherwise
+       -> return ()
+
+    for_ mbEventLogDir \ eventLogDir -> do
+      createDirectoryIfMissing True ( interpretSymbolicPath workDir eventLogDir )
+
     verboseMsg verbosity $
       Text.unlines [ "Directory structure:"
-                   , "      prefix: " <> Text.pack prefix
-                   , "     destDir: " <> Text.pack destDir
-                   , "  installDir: " <> Text.pack installDir ]
+                   , "    work dir: " <> Text.pack ( show workDir )
+                   , "      prefix: " <> Text.pack ( show prefix )
+                   , "  installDir: " <> Text.pack ( show installDir )
+                   ]
 
     mbAlreadyBuilt <-
       if resumeBuild
       then let prepComp = compilerForPrep buildPathsForPrep
-           in Just <$> getInstalledUnits verbosity prepComp buildPathsForPrep pkgDbDirsForPrep fullDepMap
+           in Just <$> getInstalledUnits verbosity prepComp buildPathsForPrep pkgDbDirForPrep fullDepMap
       else return Nothing
 
-    let -- Units to build, in dependency order.
+    let
+        -- Units to build, in dependency order.
         unitsToBuild :: [(ConfiguredUnit, Maybe UnitId)]
         unitsToBuild
            = tagUnits $ sortPlan mbAlreadyBuilt mbOnlyBuildDepsOf cabalPlan
@@ -432,13 +463,12 @@           | ( cu@( ConfiguredUnit { puPkgName, puVersion } ), didSetup ) <- unitsToBuild
           , isNothing didSetup ]
 
-        -- Initial preparation: logging, and creating the final
-        -- package database.
+        -- Initial preparation: logging, and creating the package database.
         preparation :: BuildScript
         preparation = do
           logMessage verbosity Verbose $
-            "Creating final package database at " <> finalPkgDbDir
-          createDir finalPkgDbDir -- (*)
+            "Creating package database at " <> show finalPkgDbDir
+          createDir finalPkgDbDir
           logMessage verbosity Debug $ "Packages:\n" <>
             unlines
               [ "  - " <> Text.unpack (pkgNameVersion nm ver)
@@ -456,19 +486,28 @@         -- Setup the package for this unit.
         unitSetupScript :: ConfiguredUnit -> IO BuildScript
         unitSetupScript pu = do
-          let pkgDirForPrep  = getPkgDir workDir pathsForPrep  pu
-              pkgDirForBuild = getPkgDir workDir pathsForBuild pu
+          let pkgDirForPrep  = getPkgDir pathsForPrep  pu
+              pkgDirForBuild = getPkgDir pathsForBuild pu
           setupPackage verbosity compiler
-            paths pkgDbDirsForBuild pkgDirForPrep pkgDirForBuild
+            workDir paths pkgDbDirs pkgDirForPrep pkgDirForBuild
             fullDepMap pu
 
         -- Build and install this unit.
-        unitBuildScript :: ConfiguredUnit -> BuildScript
-        unitBuildScript pu =
-          let pkgDirForBuild = getPkgDir workDir pathsForBuild pu
-          in buildUnit verbosity compiler
-                paths pkgDbDirsForBuild pkgDirForBuild
-                (userUnitArgs pu)
+        unitBuildScript :: Args -> ConfiguredUnit -> BuildScript
+        unitBuildScript extraConfigureArgs pu@( ConfiguredUnit { puId }) =
+          let pkgDirForBuild = getPkgDir pathsForBuild pu
+              mbEventLogArg = mbEventLogDir <&> \ logDir ->
+                let logPath = getSymbolicPath logDir </> "ghc" <.> Text.unpack ( unUnitId puId ) <.> "eventlog"
+                in "--ghc-option=\"-with-rtsopts=-l-ol" <> logPath <> "\""
+              allConfigureArgs =
+                mconcat [ extraConfigureArgs
+                        , maybeToList mbEventLogArg
+                        , configureArgs ( userUnitArgs pu ) ]
+              allUnitArgs =
+                ( userUnitArgs pu ) { configureArgs = allConfigureArgs }
+          in buildUnit verbosity compiler workDir
+                paths pkgDbDirs pkgDirForBuild
+                allUnitArgs
                 fullDepMap pu
 
         -- Close out the build.
@@ -487,88 +526,93 @@                 Counter { counterRef = unitsBuiltCounterRef
                         , counterMax = nbUnitsToBuild }
 
+            execBuildScript = executeBuildScript workDir unitsBuiltCounter
+
         case runStrat of
 
           Async sem -> do
 
             normalMsg verbosity $
               "\nBuilding and installing units asynchronously with " <> semDescription sem
-            executeBuildScript unitsBuiltCounter preparation
+            execBuildScript preparation
 
-            let unitMap :: Lazy.Map UnitId (ConfiguredUnit, Maybe UnitId)
-                unitMap =
-                  Lazy.Map.fromList
-                    [ (puId, pu)
-                    | pu@( ConfiguredUnit { puId }, _ ) <- unitsToBuild ]
+            withNewAbstractSem sem \ ( AbstractSem { withAbstractSem } ) semArgs -> do
 
-            AbstractSem { withAbstractSem } <- newAbstractSem sem
-            (_, unitAsyncs) <- mfix \ ~(pkgAsyncs, unitAsyncs) -> do
+              let unitMap :: Lazy.Map UnitId (ConfiguredUnit, Maybe UnitId)
+                  unitMap =
+                    Lazy.Map.fromList
+                      [ (puId, pu)
+                      | pu@( ConfiguredUnit { puId }, _ ) <- unitsToBuild ]
 
-              let -- Compile the Setup script of the package the unit belongs to.
-                  -- (This should happen only once per package.)
-                  doPkgSetupAsync :: ConfiguredUnit -> IO ()
-                  doPkgSetupAsync cu@( ConfiguredUnit { puSetupDepends } ) = do
+              (_, unitAsyncs) <- mfix \ ~(pkgAsyncs, unitAsyncs) -> do
 
-                    -- Wait for the @setup-depends@ units.
-                    for_ puSetupDepends \ setupDepId ->
-                      for_ (unitAsyncs Map.!? setupDepId) wait
+                let -- Compile the Setup script of the package the unit belongs to.
+                    -- (This should happen only once per package.)
+                    doPkgSetupAsync :: ConfiguredUnit -> IO ()
+                    doPkgSetupAsync cu@( ConfiguredUnit { puSetupDepends } ) = do
 
-                    -- Setup the package.
-                    withAbstractSem do
-                      setupScript <- unitSetupScript cu
-                      executeBuildScript unitsBuiltCounter setupScript
+                      -- Wait for the @setup-depends@ units.
+                      for_ puSetupDepends \ setupDepId ->
+                        for_ (unitAsyncs Map.!? setupDepId) wait
 
-                  -- Configure, build and install the unit.
-                  doUnitAsync :: ( ConfiguredUnit, Maybe UnitId ) -> IO ()
-                  doUnitAsync ( pu, _didSetup ) = do
+                      -- Setup the package.
+                      withAbstractSem do
+                        setupScript <- unitSetupScript cu
+                        execBuildScript setupScript
 
-                    let nm  = Configured.puPkgName pu
-                        ver = Configured.puVersion pu
+                    -- Configure, build and install the unit.
+                    doUnitAsync :: ( ConfiguredUnit, Maybe UnitId ) -> IO ()
+                    doUnitAsync ( pu, _didSetup ) = do
 
-                    -- Wait for the package to have been setup.
-                    wait $ pkgAsyncs Map.! (nm, ver)
+                      let nm  = Configured.puPkgName pu
+                          ver = Configured.puVersion pu
 
-                    -- Wait until we have built the units we depend on.
-                    for_ (unitDepends pu) \ depUnitId ->
-                      for_ (unitAsyncs Map.!? depUnitId) wait
+                      -- Wait for the package to have been setup.
+                      wait $ pkgAsyncs Map.! (nm, ver)
 
-                    -- Build the unit!
-                    withAbstractSem $
-                      executeBuildScript unitsBuiltCounter $ unitBuildScript pu
+                      -- Wait until we have built the units we depend on.
+                      for_ (unitDepends pu) \ depUnitId ->
+                        for_ (unitAsyncs Map.!? depUnitId) wait
 
-              -- Kick off setting up the packages...
-              finalPkgAsyncs  <- for pkgMap  (async . doPkgSetupAsync)
-              -- ... and building the units.
-              finalUnitAsyncs <- for unitMap (async . doUnitAsync)
-              return (finalPkgAsyncs, finalUnitAsyncs)
-            mapM_ wait unitAsyncs
-            executeBuildScript unitsBuiltCounter finish
+                      -- Build the unit!
+                      withAbstractSem $
+                        execBuildScript $ unitBuildScript semArgs pu
 
+                -- Kick off setting up the packages...
+                finalPkgAsyncs  <- for pkgMap  (async . doPkgSetupAsync)
+                -- ... and building the units.
+                finalUnitAsyncs <- for unitMap (async . doUnitAsync)
+                return (finalPkgAsyncs, finalUnitAsyncs)
+              mapM_ wait unitAsyncs
+              execBuildScript finish
+
           TopoSort -> do
             normalMsg verbosity "\nBuilding and installing units sequentially.\n\
                                 \NB: pass -j<N> for increased parallelism."
-            executeBuildScript unitsBuiltCounter preparation
+            execBuildScript preparation
             for_ unitsToBuild \ ( cu, didSetup ) -> do
               when (isNothing didSetup) $
-                unitSetupScript cu >>= executeBuildScript unitsBuiltCounter
-              executeBuildScript unitsBuiltCounter (unitBuildScript cu)
-            executeBuildScript unitsBuiltCounter finish
+                unitSetupScript cu >>= execBuildScript
+              execBuildScript (unitBuildScript [] cu)
+            execBuildScript finish
 
       Script { scriptPath = fp, useVariables } -> do
         let scriptConfig :: ScriptConfig
             scriptConfig =
-              ScriptConfig { scriptOutput = Shell { useVariables }
-                           , scriptStyle  = hostStyle
-                           , scriptTotal  = Just nbUnitsToBuild }
+              ScriptConfig
+                { scriptOutput     = Shell { useVariables }
+                , scriptStyle      = hostStyle
+                , scriptTotal      = Just nbUnitsToBuild
+                , scriptWorkingDir = workDir }
 
-        normalMsg verbosity $ "\nWriting build scripts to " <> Text.pack fp
+        normalMsg verbosity $ "\nWriting build scripts to " <> Text.pack ( show fp )
         buildScripts <- for unitsToBuild \ ( cu, didSetup ) -> do
           mbSetup <- if   isNothing didSetup
                      then unitSetupScript cu
                      else return emptyBuildScript
-          let build = unitBuildScript cu
+          let build = unitBuildScript [] cu
           return $ mbSetup <> build
-        Text.writeFile fp $ script scriptConfig $
+        Text.writeFile ( getSymbolicPath fp ) $ script scriptConfig $
           preparation <> mconcat buildScripts <> finish
 
   where
@@ -664,21 +708,21 @@ getInstalledUnits :: Verbosity
                   -> Compiler
                   -> BuildPaths ForPrep
-                  -> PkgDbDirs ForPrep
+                  -> PkgDbDir ForPrep
                   -> Map UnitId PlanUnit
                   -> IO ( Set UnitId )
 getInstalledUnits verbosity
                   ( Compiler { ghcPkgPath } )
                   ( BuildPathsForPrep { installDir } )
-                  ( PkgDbDirsForPrep { tempPkgDbDir } )
+                  ( PkgDbDirForPrep { finalPkgDbDir } )
                   plan = do
   pkgVerUnitIds <-
     words <$>
-    Process.readProcess ( ghcPkgPath )
+    Process.readProcess ( getAbsolutePath ghcPkgPath )
       [ "list"
       , ghcPkgVerbosity verbosity
       , "--show-unit-ids", "--simple-output"
-      , "--package-db", tempPkgDbDir ]
+      , "--package-db", getAbsolutePath finalPkgDbDir ]
         -- TODO: allow user package databases too?
       ""
   let installedLibs = map ( UnitId . Text.pack ) pkgVerUnitIds
@@ -697,8 +741,8 @@     mkLine ( UnitId uid ) = "  - " <> uid
 
     binsDir :: FilePath
-    binsDir = installDir </> "bin"
-    binDirMaybe :: FilePath -> IO (Maybe UnitId)
+    binsDir = getAbsolutePath installDir </> "bin"
+    binDirMaybe :: FilePath -> IO ( Maybe UnitId )
     binDirMaybe binDir = do
       isDir <- doesDirectoryExist ( binsDir </> binDir )
       if not isDir
src/BuildEnv/BuildOne.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
 -- |
@@ -23,8 +24,8 @@ 
   , PkgDir(..)
   , getPkgDir
-  , PkgDbDirs(..)
-  , getPkgDbDirsForPrep, getPkgDbDirsForBuild
+  , PkgDbDir(..)
+  , getPkgDbDirForPrep, getPkgDbDirForBuild,
   ) where
 
 -- base
@@ -46,12 +47,6 @@ -- directory
 import System.Directory
 
--- filepath
-import System.FilePath
-  ( (</>), (<.>)
-  , makeRelative
-  )
-
 -- text
 import Data.Text
   ( Text )
@@ -62,6 +57,7 @@ import BuildEnv.Config
 import BuildEnv.CabalPlan
 import BuildEnv.Script
+import BuildEnv.Path
 import BuildEnv.Utils
   ( ProgPath(..), CallProcess(..)
   , abstractQSem, noSem
@@ -75,8 +71,9 @@ -- Returns a build script which compiles the @Setup@ script.
 setupPackage :: Verbosity
              -> Compiler
+             -> SymbolicPath CWD ( Dir Project )
              -> BuildPaths ForBuild -- ^ Overall build directory structure.
-             -> PkgDbDirs  ForBuild -- ^ Package database directories (see 'getPkgDbDirsForBuild').
+             -> PkgDbDir   ForBuild -- ^ Package database directory (see 'getPkgDbDirForBuild').
              -> PkgDir     ForPrep  -- ^ Package directory (to find the @Setup.hs@).
              -> PkgDir     ForBuild -- ^ Package directory (to build the @Setup.hs@).
              -> Map UnitId PlanUnit -- ^ All dependencies in the build plan.
@@ -84,33 +81,42 @@              -> IO BuildScript
 setupPackage verbosity
              ( Compiler { ghcPath } )
+             workDir
              paths@( BuildPaths { installDir, logDir } )
-             ( PkgDbDirsForBuild { tempPkgDbDir } )
+             ( PkgDbDirForBuild { finalPkgDbDir } )
              ( PkgDir { pkgNameVer, pkgDir = prepPkgDir } )
              ( PkgDir { pkgDir = buildPkgDir } )
              plan
              unit@( ConfiguredUnit { puId, puSetupDepends, puExeDepends } )
 
-  = do let logPath
+  = do let logPath :: Maybe ( AbsolutePath File )
+           logPath
              | verbosity <= Quiet
              = Nothing
              | otherwise
-             = Just $ logDir </> Text.unpack ( unUnitId puId )
+             = Just $ logDir </> mkRelativePath ( Text.unpack ( unUnitId puId ) )
        -- Find the appropriate Setup.hs file (creating one if necessary)
-       setupHs <- findSetupHs prepPkgDir
+       setupHs <- findSetupHs workDir prepPkgDir
        return do
          scriptCfg <- askScriptConfig
-         let setupArgs = [ quoteArg ExpandVars scriptCfg ( buildPkgDir </> setupHs )
+         let isCabalDep uid = case Map.lookup uid plan of
+               Nothing -> error $ "setupPackage: cannot find setup dependency " ++ show uid
+               Just pu -> planUnitPkgName pu == PkgName "Cabal"
+             extraCabalSetupDep = not $ any isCabalDep puSetupDepends
+             setupArgs = [ quoteArg ExpandVars scriptCfg ( getSymbolicPath $ setupHs )
                          , "-o"
-                         , quoteArg ExpandVars scriptCfg ( buildPkgDir </> "Setup" )
-                         , "-package-db=" <> quoteArg ExpandVars scriptCfg tempPkgDbDir
+                         , quoteArg ExpandVars scriptCfg ( getSymbolicPath $ mkRelativePath "Setup" )
+                         , "-package-db=" <> quoteArg ExpandVars scriptCfg ( getAbsolutePath finalPkgDbDir )
                          , ghcVerbosity verbosity
                          ] ++ map unitIdArg puSetupDepends
+                           ++ [ "-package Cabal" | extraCabalSetupDep ]
+                              -- Add an implicit dependency on the 'Cabal' library
+                              -- if there isn't an explicit dependency on it.
 
              -- Specify location of binaries and data directories.
              --
              -- See the commentary around 'depDataDirs' in 'buildUnit'.
-             binDirs = [ quoteArg ExpandVars scriptCfg $ installDir </> "bin" </> Text.unpack ( unUnitId exeUnitId )
+             binDirs = [ quoteArg ExpandVars scriptCfg $ getAbsolutePath $ installDir </> mkRelativePath ( "bin" </> Text.unpack ( unUnitId exeUnitId ) )
                        | exeUnitId <- puExeDepends ]
              setupDepDataDirs =
                dataDirs scriptCfg paths
@@ -121,8 +127,8 @@                  ]
          logMessage verbosity Verbose $
            "Compiling Setup.hs for " <> pkgNameVer
-         callProcess $
-           CP { cwd          = "."
+         callProcess @Pkg $
+           CP { cwd          = workDir </> buildPkgDir
               , prog         = AbsPath ghcPath
               , args         = setupArgs
               , extraPATH    = binDirs
@@ -133,17 +139,21 @@ 
 -- | Find the @Setup.hs@/@Setup.lhs@ file to use,
 -- or create one using @main = defaultMain@ if none exist.
-findSetupHs :: FilePath -> IO FilePath
-findSetupHs root = trySetupsOrUseDefault [ "Setup.hs", "Setup.lhs" ]
+findSetupHs :: SymbolicPath CWD ( Dir Project )
+            -> SymbolicPath Project ( Dir Pkg )
+            -> IO ( RelativePath Pkg File )
+findSetupHs workDir root =
+  trySetupsOrUseDefault [ mkRelativePath "Setup.hs", mkRelativePath "Setup.lhs" ]
   where
+
     useDefaultSetupHs = do
-        let path = root </> "Setup.hs"
-        writeFile path defaultSetupHs
-        return "Setup.hs"
+        let path = root </> mkRelativePath "Setup.hs"
+        writeFile ( interpretSymbolicPath workDir path ) defaultSetupHs
+        return $ mkRelativePath "Setup.hs"
 
     try fname = do
         let path = root </> fname
-        exists <- doesFileExist path
+        exists <- doesFileExist ( interpretSymbolicPath workDir path )
         return $ if exists then Just fname else Nothing
 
     defaultSetupHs = unlines
@@ -152,7 +162,7 @@         ]
 
     trySetupsOrUseDefault [] = useDefaultSetupHs
-    trySetupsOrUseDefault (setupPath:setups) = do
+    trySetupsOrUseDefault ( setupPath : setups ) = do
       res <- try setupPath
       case res of
         Nothing    -> trySetupsOrUseDefault setups
@@ -171,8 +181,9 @@ -- registered in the package database.
 buildUnit :: Verbosity
           -> Compiler
+          -> SymbolicPath CWD ( Dir Project )
           -> BuildPaths ForBuild -- ^ Overall build directory structure.
-          -> PkgDbDirs  ForBuild -- ^ Package database directories (see 'getPkgDbDirsForBuild').
+          -> PkgDbDir   ForBuild -- ^ Package database directory (see 'getPkgDbDirForBuild').
           -> PkgDir     ForBuild -- ^ This package's directory (see 'getPkgDir').
           -> UnitArgs            -- ^ Extra arguments for this unit.
           -> Map UnitId PlanUnit -- ^ All dependencies in the build plan.
@@ -180,29 +191,31 @@           -> BuildScript
 buildUnit verbosity
           ( Compiler { ghcPath, ghcPkgPath } )
-          paths@( BuildPaths { installDir, prefix, destDir, logDir } )
-          ( PkgDbDirsForBuild
-            { tempPkgDbDir
-            , finalPkgDbDir
-            , tempPkgDbSem
+          workDir
+          paths@( BuildPaths { installDir, prefix, logDir } )
+          ( PkgDbDirForBuild
+            { finalPkgDbDir
             , finalPkgDbSem } )
           ( PkgDir { pkgDir, pkgNameVer } )
           ( UnitArgs { configureArgs = userConfigureArgs
                      , mbHaddockArgs = mbUserHaddockArgs
                      , registerArgs  = userGhcPkgArgs } )
           plan unit@( ConfiguredUnit { puId, puDepends, puExeDepends } )
-  = let compName = Text.unpack $ cabalComponent ( puComponentName unit )
-        thisUnit'sId = Text.unpack ( unUnitId puId )
+  = let compName     = Text.unpack $ cabalComponent ( puComponentName unit )
+        thisUnit'sId = Text.unpack $ unUnitId puId
+        logPath :: Maybe ( AbsolutePath File )
         logPath
           | verbosity <= Quiet
           = Nothing
           | otherwise
-          = Just $ logDir </> thisUnit'sId
+          = Just $ logDir </> mkRelativePath thisUnit'sId
         unitPrintableName
           | verbosity >= Verbose
           = pkgNameVer <> ":" <> compName
           | otherwise
           = compName
+        setupDir :: SymbolicPath CWD ( Dir Pkg )
+        setupDir = workDir </> pkgDir
 
     in do
       scriptCfg <- askScriptConfig
@@ -210,7 +223,7 @@       let -- Specify the data directories for all dependencies,
           -- including executable dependencies (see (**)).
           -- This is important so that e.g. 'happy' can find its datadir.
-          depDataDirs =
+          setupEnvVars =
             dataDirs scriptCfg paths
               [ dep_cu
               | depUnitId <- unitDepends unit -- (**) depends ++ exeDepends
@@ -224,7 +237,7 @@               | flagSpecIsEmpty flags
               -> []
               | otherwise
-              -> [ "--flags=" <> quoteArg ExpandVars scriptCfg ( Text.unpack (showFlagSpec flags) ) ]
+              -> [ "--flags=" <> quoteArg ExpandVars scriptCfg ( Text.unpack $ showFlagSpec flags ) ]
 
           -- NB: make sure to update the readme after changing
           -- the arguments that are passed here.
@@ -249,10 +262,10 @@           -- Arguments essential to the build; can't be overriden by the user.
           essentialConfigureArgs =
             [ "--exact-configuration"
-            , "--with-compiler", quoteArg ExpandVars scriptCfg ghcPath
-            , "--prefix"       , quoteArg ExpandVars scriptCfg prefix
+            , "--with-compiler", quoteArg ExpandVars scriptCfg ( getAbsolutePath ghcPath )
+            , "--prefix"       , quoteArg ExpandVars scriptCfg ( getAbsolutePath prefix )
             , "--cid="        <> Text.unpack ( unUnitId puId )
-            , "--package-db=" <> quoteArg ExpandVars scriptCfg tempPkgDbDir
+            , "--package-db=" <> quoteArg ExpandVars scriptCfg ( getAbsolutePath finalPkgDbDir )
             , "--datadir="    <> quoteArg EscapeVars scriptCfg ( "$prefix" </> "share" )
                 -- Keep datadir in sync with the 'dataDirs' function.
             , "--datasubdir=" <> pkgNameVer
@@ -274,21 +287,23 @@           -- dependencies during the build.
           -- Keep this in sync with --bindir in essentialConfigureArgs.
           binDirs = [ quoteArg ExpandVars scriptCfg $
-                      installDir </> "bin" </> Text.unpack ( unUnitId exeUnitId )
+                      getAbsolutePath $
+                      installDir </> mkRelativePath ( "bin" </> Text.unpack ( unUnitId exeUnitId ) )
                     | exeUnitId <- puExeDepends ]
 
+          setupExe :: ProgPath Pkg
           setupExe = RelPath $ runCwdExe scriptCfg "Setup" -- relative to pkgDir
 
       logMessage verbosity Verbose $
         "Configuring " <> unitPrintableName
       logMessage verbosity Debug $
-        "Configure arguments:\n" <> unlines (map ("  " <>) configureArgs)
-      callProcess $
-        CP { cwd          = pkgDir
+        "Configure arguments:\n" <> unlines ( map ( "  " <> ) configureArgs )
+      callProcess @Pkg $
+        CP { cwd          = setupDir
            , prog         = setupExe
            , args         = "configure" : configureArgs
            , extraPATH    = binDirs
-           , extraEnvVars = depDataDirs -- Not sure this is needed for 'Setup configure'.
+           , extraEnvVars = setupEnvVars
            , logBasePath  = logPath
            , sem          = noSem
            }
@@ -296,14 +311,14 @@       -- Build
       logMessage verbosity Verbose $
         "Building " <> unitPrintableName
-      callProcess $
-        CP { cwd          = pkgDir
+      callProcess @Pkg $
+        CP { cwd          = setupDir
            , prog         = setupExe
            , args         = [ "build"
                             , "--builddir=" <> buildDir
                             , setupVerbosity verbosity ]
            , extraPATH    = binDirs
-           , extraEnvVars = depDataDirs
+           , extraEnvVars = setupEnvVars
            , logBasePath  = logPath
            , sem          = noSem
            }
@@ -312,15 +327,15 @@       for_ mbUserHaddockArgs \ userHaddockArgs -> do
         logMessage verbosity Verbose $
           "Building documentation for " <> unitPrintableName
-        callProcess $
-          CP { cwd          = pkgDir
+        callProcess @Pkg $
+          CP { cwd          = setupDir
              , prog         = setupExe
              , args         = [ "haddock"
                               , setupVerbosity verbosity ]
                               ++ userHaddockArgs
                               ++ [ "--builddir=" <> buildDir ]
              , extraPATH    = binDirs
-             , extraEnvVars = depDataDirs
+             , extraEnvVars = setupEnvVars
              , logBasePath  = logPath
              , sem          = noSem
              }
@@ -328,14 +343,15 @@        -- Copy
       logMessage verbosity Verbose $
         "Copying " <> unitPrintableName
-      callProcess $
-        CP { cwd          = pkgDir
+      callProcess @Pkg $
+        CP { cwd          = setupDir
            , prog         = setupExe
            , args         = [ "copy", setupVerbosity verbosity
                             , "--builddir=" <> buildDir
-                            , "--destdir", quoteArg ExpandVars scriptCfg destDir ]
+                            , "--target-package-db=" <> quoteArg ExpandVars scriptCfg (getAbsolutePath $ installDir </> mkRelativePath "package.conf")
+                            ]
            , extraPATH    = []
-           , extraEnvVars = []
+           , extraEnvVars = setupEnvVars
            , logBasePath  = logPath
            , sem          = noSem
            }
@@ -343,53 +359,53 @@        -- Register
       case cuComponentType unit of
         Lib -> do
-          -- Register library (in both the local and final package databases)
-          -- See Note [Using two package databases].
+          -- Register library.
           let pkgRegsFile = thisUnit'sId <> "-pkg-reg.conf"
-              dirs = [ ( tempPkgDbDir,  tempPkgDbSem, "temporary", ["--inplace"], [])
-                     , (finalPkgDbDir, finalPkgDbSem, "final"    , [], "--force" : userGhcPkgArgs) ]
 
-          for_ dirs \ (pkgDbDir, pkgDbSem, desc, extraSetupArgs, extraPkgArgs) -> do
+          logMessage verbosity Verbose $
+           mconcat [ "Writing package registration for ", unitPrintableName
+                   , " to:\n"
+                   , pkgRegsFile ]
 
-            logMessage verbosity Verbose $
-             mconcat [ "Registering ", unitPrintableName, " in "
-                     , desc, " package database at:\n  "
-                     , pkgDbDir ]
+          -- Setup register
+          callProcess @Pkg $
+            CP { cwd          = setupDir
+               , prog         = setupExe
+               , args         = [ "register", setupVerbosity verbosity
+                                , "--builddir=" <> buildDir
+                                , "--gen-pkg-config=" <> pkgRegsFile ]
+               , extraPATH    = []
+               , extraEnvVars = []
+               , logBasePath  = logPath
+               , sem          = noSem
+               }
 
-            -- Setup register
-            callProcess $
-              CP { cwd          = pkgDir
-                 , prog         = setupExe
-                 , args         = [ "register", setupVerbosity verbosity ]
-                                  ++ extraSetupArgs
-                                  ++ [ "--builddir=" <> buildDir
-                                     , "--gen-pkg-config=" <> pkgRegsFile ]
-                 , extraPATH    = []
-                 , extraEnvVars = []
-                 , logBasePath  = logPath
-                 , sem          = noSem
-                 }
+          -- NB: we have configured & built a single target,
+          -- so there should be a single "pkg-reg.conf" file,
+          -- and not a directory of registration files.
 
-            -- NB: we have configured & built a single target,
-            -- so there should be a single "pkg-reg.conf" file,
-            -- and not a directory of registration files.
+          logMessage verbosity Verbose $
+           mconcat [ "Registering ", unitPrintableName
+                   , " in package database at:\n"
+                   , show finalPkgDbDir ]
 
-            -- ghc-pkg register
-            callProcess $
-              CP { cwd          = pkgDir
-                 , prog         = AbsPath ghcPkgPath
-                 , args         = [ "register"
-                                  , ghcPkgVerbosity verbosity ]
-                                  ++ extraPkgArgs
-                                  ++ [ "--package-db", quoteArg ExpandVars scriptCfg pkgDbDir
-                                     , pkgRegsFile ]
-                 , extraPATH    = []
-                 , extraEnvVars = []
-                 , logBasePath  = logPath
-                 , sem          = abstractQSem pkgDbSem
-                   -- Take a lock to avoid contention on the package database
-                   -- when building units concurrently.
-                 }
+          -- ghc-pkg register
+          callProcess @Pkg $
+            CP { cwd          = setupDir
+               , prog         = AbsPath ghcPkgPath
+               , args         = [ "register"
+                                , ghcPkgVerbosity verbosity
+                                , "--force" ]
+                                ++ userGhcPkgArgs
+                                ++ [ "--package-db", quoteArg ExpandVars scriptCfg ( getAbsolutePath finalPkgDbDir )
+                                   , pkgRegsFile ]
+               , extraPATH    = []
+               , extraEnvVars = []
+               , logBasePath  = logPath
+               , sem          = abstractQSem finalPkgDbSem
+                 -- Take a lock to avoid contention on the package database
+                 -- when building units concurrently.
+               }
 
         _notALib -> return ()
 
@@ -443,71 +459,40 @@ --------------------------------------------------------------------------------
 -- Directory structure computation helpers
 
-{- $twoDBs
-__Note [Using two package databases]__
-
-We need __two__ distinct package databases: we might want to perform the build
-in a temporary location, before everything gets placed into its final
-destination. The final package database might use a specific, baked-in
-installation prefix (in the sense of @Setup configure --prefix pfx@). As a
-result, this package database won't be immediately usable, as we won't have
-copied over the build products yet.
-
-In order to be able to build packages in a temporary directory, we create a
-temporary package database that is used for the build, making use of it
-with @Setup register --inplace@.
-We also register the packages into the final package database using
-@ghc-pkg --force@: otherwise, @ghc-pkg@ would error because the relevant files
-haven't been copied over yet.
--}
-
--- | The package database directories.
---
--- See Note [Using two package databases].
-type PkgDbDirs :: PathUsability -> Type
-data family PkgDbDirs use
+-- | The package database directory.
+type PkgDbDir :: PathUsability -> Type
+data family PkgDbDir use
 
-data instance PkgDbDirs ForPrep
-  = PkgDbDirsForPrep
-    { tempPkgDbDir  :: !FilePath
-        -- ^ Local package database directory.
+data instance PkgDbDir ForPrep
+  = PkgDbDirForPrep
+    { finalPkgDbDir  :: !( AbsolutePath ( Dir PkgDb ) )
+        -- ^ Installation package database directory.
     }
-data instance PkgDbDirs ForBuild
-  = PkgDbDirsForBuild
-    { tempPkgDbDir  :: !FilePath
-        -- ^ Local package database directory.
-    , tempPkgDbSem  :: !QSem
-        -- ^ Semaphore controlling access to the temporary
-        -- package database.
-    , finalPkgDbDir :: !FilePath
+data instance PkgDbDir ForBuild
+  = PkgDbDirForBuild
+    { finalPkgDbDir :: !( AbsolutePath ( Dir PkgDb ) )
         -- ^ Installation package database directory.
     , finalPkgDbSem :: !QSem
         -- ^ Semaphore controlling access to the installation
         -- package database.
     }
 
--- | Compute the paths of the package database directories we are going
+-- | Compute the paths of the package database directory we are going
 -- to use.
---
--- See Note [Using two package databases].
-getPkgDbDirsForPrep :: Paths ForPrep -> PkgDbDirs ForPrep
-getPkgDbDirsForPrep ( Paths { fetchDir } ) =
-    PkgDbDirsForPrep { tempPkgDbDir = fetchDir </> "package.conf" }
+getPkgDbDirForPrep :: Paths ForPrep -> PkgDbDir ForPrep
+getPkgDbDirForPrep ( Paths { buildPaths = BuildPathsForPrep { installDir } } ) =
+    PkgDbDirForPrep { finalPkgDbDir = installDir </> mkRelativePath "package.conf" }
 
--- | Compute the paths of the package database directories we are going
--- to use, and create some semaphores to control access to them
+-- | Compute the paths of the package database directory we are going
+-- to use, and create some semaphores to control access to it
 -- in order to avoid contention.
---
--- See Note [Using two package databases].
-getPkgDbDirsForBuild :: Paths ForBuild -> IO (PkgDbDirs ForBuild)
-getPkgDbDirsForBuild ( Paths { fetchDir, buildPaths = BuildPaths { installDir } } ) = do
-  tempPkgDbSem  <- newQSem 1
+getPkgDbDirForBuild :: Paths ForBuild -> IO (PkgDbDir ForBuild)
+getPkgDbDirForBuild ( Paths { buildPaths = BuildPaths { installDir } } ) = do
   finalPkgDbSem <- newQSem 1
   return $
-    PkgDbDirsForBuild { tempPkgDbDir, finalPkgDbDir, tempPkgDbSem, finalPkgDbSem }
+    PkgDbDirForBuild { finalPkgDbDir, finalPkgDbSem }
     where
-      tempPkgDbDir  = fetchDir   </> "package.conf"
-      finalPkgDbDir = installDir </> "package.conf"
+      finalPkgDbDir = installDir </> mkRelativePath "package.conf"
 
 -- | The package @name-version@ string and its directory.
 type PkgDir :: PathUsability -> Type
@@ -515,7 +500,7 @@   = PkgDir
     { pkgNameVer :: !String
         -- ^ Package @name-version@ string.
-    , pkgDir     :: !FilePath
+    , pkgDir     :: !( SymbolicPath Project ( Dir Pkg ) )
         -- ^ Package directory.
     }
 type role PkgDir representational
@@ -523,31 +508,26 @@   -- a @PkgDir ForBuild@.
 
 -- | Compute the package directory location.
-getPkgDir :: FilePath
-              -- ^ Working directory
-              -- (used only to relativise paths to local packages).
-          -> Paths use
+getPkgDir :: Paths use
               -- ^ Overall directory structure to base the computation off.
           -> ConfiguredUnit
               -- ^ Any unit from the package in question.
           -> PkgDir use
-getPkgDir workDir ( Paths { fetchDir } )
+getPkgDir ( Paths { fetchDir } )
           ( ConfiguredUnit { puPkgName, puVersion, puPkgSrc } )
   = PkgDir { pkgNameVer, pkgDir }
     where
       pkgNameVer = Text.unpack $ pkgNameVersion puPkgName puVersion
       pkgDir
         | Local dir <- puPkgSrc
-        = makeRelative workDir dir
-          -- Give local packages paths relative to the working directory,
-          -- to enable relocatable build scripts.
+        = dir
         | otherwise
-        = fetchDir </> pkgNameVer
+        = fetchDir </> mkRelativePath pkgNameVer
 
 -- | Command to run an executable located the current working directory.
-runCwdExe :: ScriptConfig -> FilePath -> FilePath
+runCwdExe :: ScriptConfig -> String -> SymbolicPath from File
 runCwdExe ( ScriptConfig { scriptOutput, scriptStyle } )
-  = pre . ext
+  = mkSymbolicPath . pre . ext
   where
     pre
       | Run <- scriptOutput
@@ -568,6 +548,6 @@ dataDirs scriptCfg ( BuildPaths { installDir } ) units =
     [ ( mangledPkgName puPkgName <> "_datadir"
       , quoteArg ExpandVars scriptCfg $
-          installDir </> "share" </> Text.unpack (pkgNameVersion puPkgName puVersion) )
+          getAbsolutePath $ installDir </> mkRelativePath ( "share" </> Text.unpack ( pkgNameVersion puPkgName puVersion ) ) )
         -- Keep this in sync with --datadir in essentialConfigureArgs.
     | ConfiguredUnit { puPkgName, puVersion } <- units ]
src/BuildEnv/CabalPlan.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE RecordWildCards #-}
 
@@ -72,7 +73,7 @@ 
 -- base
 import Data.Char
-  ( isAlphaNum )
+  ( isAlpha, isAlphaNum )
 import Data.Maybe
   ( fromMaybe, mapMaybe )
 import Data.Version
@@ -97,6 +98,9 @@   ( Text )
 import qualified Data.Text as Text
 
+-- build-env
+import BuildEnv.Path
+
 -------------------------------------------------------------------------------
 -- Build plans
 
@@ -139,7 +143,11 @@ -- | Is the string a valid @cabal@ package name? That is, does it consist
 -- only of alphanumeric identifiers and hyphens?
 validPackageName :: Text -> Bool
-validPackageName = Text.all ( \ x -> isAlphaNum x || x == '-' )
+validPackageName txt =
+     Text.all ( \ x -> isAlphaNum x || x == '-' ) txt
+  && case Text.uncons txt of
+      Nothing    -> False
+      Just (c,_) -> isAlpha c
 
 -- | A Cabal mangled package name, in which @-@ has been replaced with @_@.
 mangledPkgName :: PkgName -> String
@@ -240,7 +248,7 @@ --   - @Just fp@: specified by the @cabal@ file at the given path.
 data PkgSrc
   = Remote
-  | Local !FilePath
+  | Local !( SymbolicPath Project ( Dir Pkg ) )
   deriving stock Show
 
 instance Semigroup PkgSrc where
@@ -254,7 +262,7 @@     parseJSON = withObject "package source" \ o -> do
       ty <- o .: "type"
       case ty :: Text of
-        "local"       -> Local <$> o .: "path"
+        "local"       -> Local . mkSymbolicPath <$> o .: "path"
         "repo-tar"    -> return Remote
                          -- <$> o .: "repo"
         _ ->
@@ -387,7 +395,7 @@ 
 -- | A mapping from a package name to its flags, constraints,
 -- and components we want to build from it.
-type UnitSpecs = Strict.Map PkgName (PkgSrc, PkgSpec, Set ComponentName)
+type UnitSpecs = Strict.Map PkgName ( PkgSrc, PkgSpec, Set ComponentName )
 
 -- | The name of a cabal component, e.g. @lib:comp@.
 data ComponentName =
src/BuildEnv/Config.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}
+
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -22,6 +23,9 @@     -- * @ghc@ and @cabal-install@ executables
   , Compiler(..), Cabal(..)
 
+    -- * Hackage index state
+  , IndexState(..)
+
     -- * Directory structure
   , Paths(..), BuildPaths(..)
   , PathUsability(..)
@@ -56,13 +60,9 @@ import System.IO
   ( hFlush, stdout )
 
--- directory
-import System.Directory
-  ( canonicalizePath )
-
 -- filepath
 import System.FilePath
-  ( (</>), dropDrive )
+  ( dropDrive )
 
 -- text
 import Data.Text
@@ -78,6 +78,9 @@ import Data.Time.Format
   ( defaultTimeLocale, formatTime )
 
+-- build-env
+import BuildEnv.Path
+
 --------------------------------------------------------------------------------
 -- Build strategy
 
@@ -87,7 +90,7 @@   = Execute RunStrategy
   -- | Output a build script that can be run later.
   | Script
-    { scriptPath   :: !FilePath
+    { scriptPath   :: !( SymbolicPath CWD File )
       -- ^ Output path at which to write the build script.
     , useVariables :: !Bool
       -- ^ Should the output shell script use variables, or baked in paths?
@@ -103,6 +106,7 @@   -- | Topologically sort the cabal build plan, and build the
   -- packages in sequence.
   = TopoSort
+
   -- | Asynchronously build all the packages, with each package
   -- waiting on its dependencies.
   | Async
@@ -111,22 +115,24 @@   deriving stock Show
 
 -- | What kind of semaphore to use in 'BuildEnv.Build.buildPlan'?
---
--- NB: this datatype depends on whether the @jsem@ flag
--- was enabled when building the @build-env@ package.
 data AsyncSem
-  -- | Don't use any semaphore (not recommended).
-  = NoSem
   -- | Create a new 'Control.Concurrent.QSem.QSem' semaphore
   -- with the given number of tokens.
-  | NewQSem !Word16
+  = NewQSem !Word16
+  -- | Create a new system semaphore with the given number of tokens,
+  -- passing it to @ghc@ invocations.
+  | NewJSem !Word16
+  -- | Use an existing system semaphore, passing it to @ghc@ invocations.
+  | ExistingJSem !String
   deriving stock Show
 
 -- | A description of the kind of semaphore we are using to control concurrency.
 semDescription :: AsyncSem -> Text
 semDescription = \case
-  NoSem     -> "no semaphore"
   NewQSem i -> "-j" <> Text.pack (show i)
+  NewJSem i -> "--jsem " <> Text.pack (show i)
+  ExistingJSem jsemName ->
+    "--jsem " <> Text.pack jsemName
 
 --------------------------------------------------------------------------------
 -- Arguments
@@ -150,7 +156,7 @@ -- GHC & cabal-install
 
 -- | Path to the @cabal-install@ executable.
-data Cabal = Cabal { cabalPath       :: !FilePath
+data Cabal = Cabal { cabalPath       :: !( AbsolutePath File )
                    , globalCabalArgs :: !Args
                      -- ^ Arguments to pass to all @cabal@ invocations,
                      -- before any @cabal@ command.
@@ -159,12 +165,19 @@ 
 -- | Paths to the @ghc@ and @ghc-pkg@ executables.
 data Compiler =
-  Compiler { ghcPath    :: !FilePath
-           , ghcPkgPath :: !FilePath
+  Compiler { ghcPath    :: !( AbsolutePath File )
+           , ghcPkgPath :: !( AbsolutePath File )
            }
   deriving stock Show
 
 --------------------------------------------------------------------------------
+-- Cabal Hackage index state
+
+-- | Hackage index-state specification, e.g. 2022-12-25T00:00:00Z.
+newtype IndexState = IndexState Text
+  deriving newtype ( Show, Eq )
+
+--------------------------------------------------------------------------------
 -- Directory structure
 
 -- | The directory structure relevant to preparing and carrying out
@@ -172,7 +185,7 @@ type Paths :: PathUsability -> Type
 data Paths use
   = Paths
-    { fetchDir   :: !FilePath
+    { fetchDir   :: !( SymbolicPath Project ( Dir Fetch ) )
        -- ^ Input fetched sources directory.
     , buildPaths :: BuildPaths use
       -- ^ Output build directory structure.
@@ -181,36 +194,39 @@       -- a shell script that uses variables.
     }
 
+deriving stock instance Show ( BuildPaths use ) => Show ( Paths use )
+
 -- | The directory structure relevant to executing a build plan.
 type BuildPaths :: PathUsability -> Type
 data family BuildPaths use
 data instance BuildPaths Raw
   = RawBuildPaths
-    { rawDestDir :: !FilePath
+    { rawDestDir :: !( SymbolicPath Project ( Dir Install ) )
       -- ^ Raw output build @destdir@ (might be relative).
-    , rawPrefix  :: !FilePath
+    , rawPrefix  :: !( SymbolicPath Project ( Dir Prefix ) )
       -- ^ Raw output build @prefix@ (might be relative).
     }
+  deriving stock Show
 data instance BuildPaths ForPrep
   = BuildPathsForPrep
     { compilerForPrep :: !Compiler
       -- ^ Which @ghc@ and @ghc-pkg@ to use.
-    , installDir      :: !FilePath
+    , installDir      :: !( AbsolutePath ( Dir Install ) )
       -- ^ Output installation directory @destdir/prefix@ (absolute).
     }
+  deriving stock Show
 data instance BuildPaths ForBuild
   = BuildPaths
     { compiler   :: !Compiler
       -- ^ Which @ghc@ and @ghc-pkg@ to use.
-    , destDir    :: !FilePath
-      -- ^ Output build @destdir@ (absolute).
-    , prefix     :: !FilePath
+    , prefix     :: !( AbsolutePath ( Dir Prefix ) )
       -- ^ Output build @prefix@ (absolute).
-    , installDir :: !FilePath
+    , installDir :: !( AbsolutePath ( Dir Install ) )
       -- ^ Output installation directory @destdir/prefix@ (absolute).
-    , logDir     :: !FilePath
+    , logDir     :: !( AbsolutePath ( Dir Logs ) )
       -- ^ Directory in which to put logs.
     }
+  deriving stock Show
 
 -- | The appropriate stage at which to use a filepath.
 data PathUsability
@@ -229,54 +245,59 @@ -- for preparing and executing a build, respectively.
 canonicalizePaths :: Compiler
                   -> BuildStrategy
+                  -> SymbolicPath CWD ( Dir Project)
                   -> Paths Raw
                   -> IO ( Paths ForPrep, Paths ForBuild )
-canonicalizePaths compiler buildStrat
+canonicalizePaths compiler buildStrat workDir
   ( Paths
-    { fetchDir   = fetchDir0
+    { fetchDir   = fetchDir
     , buildPaths = RawBuildPaths { rawPrefix, rawDestDir } } )
   = do
-      fetchDir   <- canonicalizePath fetchDir0
-      prefix     <- canonicalizePath rawPrefix
-      destDir    <- canonicalizePath rawDestDir
-      installDir <- canonicalizePath ( rawDestDir </> dropDrive prefix )
-        -- We must use dropDrive here. Quoting from the documentation of (</>):
-        --
-        --   If the second path starts with a path separator or a drive letter,
-        --   then (</>) returns the second path.
-        --
-        -- We don't want that, as we *do* want to concatenate both paths.
+      prefix     <- makeAbsolute workDir rawPrefix
+      installDir <- makeAbsolute workDir ( mkInstallDir rawDestDir prefix )
 
+
       logDir <- case buildStrat of
-        Script  {} -> return "${LOGDIR}" -- LOGDIR is defined by the script.
+        Script  {} -> return $ mkAbsolutePath "${LOGDIR}" -- LOGDIR is defined by the script.
         Execute {} -> do
           -- Pick the logging directory based on the current time.
           time <- getCurrentTime
-          let logDir = "logs" </> formatTime defaultTimeLocale "%0Y-%m-%d_%H-%M-%S" time
-          canonicalizePath logDir
+          makeAbsolute workDir
+            ( mkSymbolicPath $ "logs" </> formatTime defaultTimeLocale "%0Y-%m-%d_%H-%M-%S" time )
 
       let forBuild = case buildStrat of
             Script { useVariables }
               | useVariables
-              -> Paths { fetchDir   = "${SOURCES}"
+              -> Paths { fetchDir   = mkSymbolicPath "${SOURCES}"
                        , buildPaths =
                          BuildPaths
-                           { prefix     = "${PREFIX}"
-                           , destDir    = "${DESTDIR}"
-                           , installDir = "${DESTDIR}" </> "${PREFIX}"
+                           { prefix     = mkAbsolutePath "${PREFIX}"
+                           , installDir = mkAbsolutePath $ "${DESTDIR}" </> "${PREFIX}"
                            , logDir
                            , compiler =
-                             Compiler { ghcPath    = "${GHC}"
-                                      , ghcPkgPath = "${GHCPKG}" } } }
+                             Compiler { ghcPath    = mkAbsolutePath "${GHC}"
+                                      , ghcPkgPath = mkAbsolutePath "${GHCPKG}" } } }
             _don'tUseVars ->
               Paths { fetchDir
                     , buildPaths =
-                      BuildPaths { compiler, destDir, prefix, installDir, logDir } }
+                      BuildPaths { compiler, prefix, installDir, logDir } }
       return $
         ( Paths { fetchDir
                 , buildPaths =
                   BuildPathsForPrep { compilerForPrep = compiler, installDir } }
         , forBuild )
+
+mkInstallDir :: SymbolicPath Project ( Dir Install )
+             -> AbsolutePath ( Dir Prefix )
+             -> SymbolicPath Project ( Dir Install )
+mkInstallDir destDir prefix =
+  destDir </> mkRelativePath ( dropDrive $ getAbsolutePath prefix )
+    -- We must use dropDrive here. Quoting from the documentation of (</>):
+    --
+    --   If the second path starts with a path separator or a drive letter,
+    --   then (</>) returns the second path.
+    --
+    -- We don't want that, as we *do* want to concatenate both paths.
 
 -- | How to handle deletion of temporary directories.
 data TempDirPermanence
src/BuildEnv/File.hs view
@@ -54,7 +54,7 @@     outsideStanza pkgs []
       = pkgs
     outsideStanza pkgs (l:ls)
-      | Just rest <- Text.stripPrefix "constraints:" l
+      | Just rest <- Text.strip <$> Text.stripPrefix "constraints:" l
       = inConstraintsStanza (pkgs `addPkgFromLine` rest) ls
       | otherwise
       = outsideStanza pkgs ls
@@ -86,8 +86,7 @@   , validPackageName pkg
   = ( PkgName pkg, parsePkgSpec rest )
   | otherwise
-  = error $ "Invalid package in cabal.config file : " <> Text.unpack txt
-  where
+  = error $ "Invalid package in cabal.config file: " <> Text.unpack txt
 
 -- NB: update the readme after changing the documentation below.
 
+ src/BuildEnv/Path.hs view
@@ -0,0 +1,212 @@+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module BuildEnv.Path
+  ( SymbolicPath, RelativePath, AbsolutePath
+  , FileOrDir(..)
+  , CWD, Pkg, PkgDb, Project
+  , Tmp, Logs, Fetch, Prefix, Install
+
+  , sameDirectory
+  , mkSymbolicPath
+  , mkRelativePath
+  , mkAbsolutePath
+
+  , interpretSymbolicPath
+  , getSymbolicPath
+  , getAbsolutePath
+  , absoluteSymbolicPath
+  , makeAbsolute
+
+  , (<.>), (</>)
+  )
+  where
+
+-- base
+import Data.Kind
+  ( Type )
+
+-- directory
+import qualified System.Directory as Directory
+
+-- filepath
+import qualified System.FilePath as FilePath
+
+--------------------------------------------------------------------------------
+
+-- | A type-level symbolic name, to an abstract file or directory
+-- (e.g. the Cabal package directory).
+data FileOrDir
+  = -- | A file (with no further information).
+    File
+  | -- | The abstract name of a directory or category of directories,
+    -- e.g. the package directory or a source directory.
+    Dir Type
+
+-- | Is this symbolic path allowed to be absolute, or must it be relative?
+data AllowAbsolute
+  = -- | The path may be absolute, or it may be relative.
+    AllowAbsolute
+  | -- | The path must be relative.
+    OnlyRelative
+
+-- | A symbolic path, possibly relative to an abstract location specified
+-- by the @from@ type parameter.
+--
+-- They are *symbolic*, which means we cannot perform any 'IO'
+-- until we interpret them (using e.g. 'interpretSymbolicPath').
+type SymbolicPathX :: AllowAbsolute -> Type -> FileOrDir -> Type
+newtype SymbolicPathX allowAbsolute from to = SymbolicPath FilePath
+  deriving newtype Show
+type role SymbolicPathX nominal nominal nominal
+
+-- | A symbolic relative path, relative to an abstract location specified
+-- by the @from@ type parameter.
+--
+-- They are *symbolic*, which means we cannot perform any 'IO'
+-- until we interpret them (using e.g. 'interpretSymbolicPath').
+type RelativePath = SymbolicPathX 'OnlyRelative
+
+-- | A path which is either absolute or relative to the given abstract*
+-- location specified by the @from@ type parameter.
+--
+-- They are *symbolic*, which means we cannot perform any 'IO'
+-- until we interpret them (using e.g. 'interpretSymbolicPath').
+type SymbolicPath = SymbolicPathX 'AllowAbsolute
+
+-- | An absolute path, or a reference to a path from the PATH environment variable.
+type AbsolutePath :: FileOrDir -> Type
+newtype AbsolutePath to = AbsolutePath ( forall from. SymbolicPath from to )
+instance Show ( AbsolutePath to ) where
+  show ( AbsolutePath fp ) = show fp
+
+--------------------------------------------------------------------------------
+
+-- | Abstract directory: current working directory.
+data CWD
+
+-- | Abstract directory: project root for 'build-env' commands.
+data Project
+
+-- | Abstract directory: package directory (e.g. a directory containing the @.cabal@ file).
+data Pkg
+
+-- | Abstract directory: package database directory (e.g. a directory containing a @package.conf@ file).
+data PkgDb
+
+-- | Abstract temporary directory.
+data Tmp
+
+-- | Abstract directory for logs.
+data Logs
+
+-- | Abstract directory: fetched sources directory.
+data Fetch
+
+-- | Abstract directory: prefix.
+data Prefix
+
+-- | Abstract directory: installation directory.
+data Install
+
+--------------------------------------------------------------------------------
+
+mkSymbolicPath :: FilePath -> SymbolicPath from to
+mkSymbolicPath = SymbolicPath
+
+mkRelativePath :: FilePath -> RelativePath from to
+mkRelativePath = SymbolicPath
+
+mkAbsolutePath :: FilePath -> AbsolutePath to
+mkAbsolutePath fp = AbsolutePath ( mkSymbolicPath fp )
+
+sameDirectory :: SymbolicPathX allowAbsolute from to
+sameDirectory = SymbolicPath "."
+
+getSymbolicPath :: SymbolicPathX allowAbsolute from to -> FilePath
+getSymbolicPath ( SymbolicPath p ) = p
+
+getAbsolutePath :: AbsolutePath to -> FilePath
+getAbsolutePath ( AbsolutePath p ) = getSymbolicPath p
+
+absoluteSymbolicPath :: AbsolutePath to -> SymbolicPath from to
+absoluteSymbolicPath ( AbsolutePath p ) = p
+
+-- | Interpret a symbolic path with respect to the given directory.
+--
+-- Use this function before directly interacting with the file system in order
+-- to take into account a working directory argument.
+interpretSymbolicPath :: SymbolicPath CWD ( Dir dir ) -> SymbolicPathX allowAbsolute dir to -> FilePath
+interpretSymbolicPath ( SymbolicPath workDir ) ( SymbolicPath p ) =
+  if workDir == "."
+  then p -- NB: this just avoids creating paths of the form "./././blah".
+  else workDir </> p
+          -- Note that this properly handles an absolute symbolic path,
+          -- because if @q@ is absolute, then @p </> q = q@.
+
+-- | Make the given 'SymbolicPath' absolute.
+makeAbsolute :: SymbolicPath CWD ( Dir dir ) -> SymbolicPath dir to -> IO ( AbsolutePath to )
+makeAbsolute workDir path =
+  mkAbsolutePath <$> Directory.makeAbsolute ( interpretSymbolicPath workDir path )
+
+-------------------------------------------------------------------------------
+
+-- * Composition
+
+-------------------------------------------------------------------------------
+
+infixr 7 <.>
+
+-- | Types that support 'System.FilePath.<.>'.
+class FileLike p where
+  -- | Like 'System.FilePath.<.>', but also supporting symbolic paths.
+  (<.>) :: p -> String -> p
+
+instance FileLike FilePath where
+  (<.>) = (FilePath.<.>)
+
+instance p ~ File => FileLike ( SymbolicPathX allowAbsolute dir p ) where
+  SymbolicPath p <.> ext = SymbolicPath ( p <.> ext )
+
+instance p ~ File => FileLike ( AbsolutePath p ) where
+  p <.> ext = mkAbsolutePath ( getAbsolutePath p <.> ext )
+
+infixr 5 </>
+
+-- | Types that support 'System.FilePath.</>'.
+class PathLike p q r | q r -> p, p q -> r where
+  -- | Like 'System.FilePath.</>', but also supporting symbolic paths.
+  (</>) :: p -> q -> r
+
+instance ( q ~ FilePath ) => PathLike FilePath q FilePath where
+  (</>) = (FilePath.</>)
+
+-- | This instance ensures we don't accidentally discard a symbolic path
+-- in a 'System.FilePath.</>' operation due to the second path being absolute.
+--
+-- (Recall that @a </> b = b@ whenever @b@ is absolute.)
+instance
+  (b1 ~ 'Dir b2, a3 ~ a1, c2 ~ c3)
+  => PathLike
+      ( SymbolicPathX allowAbsolute a1 b1 )
+      ( SymbolicPathX midAbsolute   b2 c2 )
+      ( SymbolicPathX allowAbsolute a3 c3 )
+  where
+  SymbolicPath p1 </> SymbolicPath p2 =
+    if p1 == "."
+    then SymbolicPath p2 -- NB: this just avoids creating paths of the form "./././blah".
+    else SymbolicPath (p1 </> p2)
+
+instance
+  ( b1 ~ 'Dir b2, c2 ~ c3, midAbsolute ~ OnlyRelative )
+  => PathLike
+      ( AbsolutePath                 b1 )
+      ( SymbolicPathX midAbsolute b2 c2 )
+      ( AbsolutePath                 c3 )
+  where
+  AbsolutePath (SymbolicPath p1) </> SymbolicPath p2 =
+    mkAbsolutePath (p1 </> p2)
src/BuildEnv/Script.hs view
@@ -1,5 +1,9 @@+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 -- |
 -- Module      :  BuildEnv.Script
@@ -30,7 +34,8 @@     -- ** Individual build steps
   , BuildStep(..), BuildSteps
   , step
-  , callProcess, createDir, logMessage, reportProgress
+  , callProcess, createDir
+  , logMessage, reportProgress
 
     -- ** Configuring build scripts
   , ScriptOutput(..), ScriptConfig(..), hostRunCfg
@@ -58,10 +63,6 @@ import System.Directory
   ( createDirectoryIfMissing )
 
--- filepath
-import System.FilePath
-  ( (<.>) )
-
 -- text
 import Data.Text
   ( Text )
@@ -78,6 +79,7 @@   ( Verbosity(..), Counter(..), Style(..)
   , hostStyle
   )
+import BuildEnv.Path
 import BuildEnv.Utils
   ( ProgPath(..), CallProcess(..), callProcessInIO )
 
@@ -120,9 +122,9 @@ -- | A build step.
 data BuildStep
   -- | Call a processs with the given arguments.
-  = CallProcess CallProcess
+  = forall dir. CallProcess ( CallProcess dir )
   -- | Create the given directory.
-  | CreateDir   FilePath
+  | forall dir. CreateDir ( AbsolutePath ( Dir dir ) )
   -- | Log a message to @stdout@.
   | LogMessage  String
   -- | Report one unit of progress.
@@ -136,11 +138,11 @@ step s = BuildScript $ ReaderT \ _ -> tell [s]
 
 -- | Call a process with given arguments.
-callProcess :: CallProcess -> BuildScript
+callProcess :: CallProcess dir -> BuildScript
 callProcess = step . CallProcess
 
 -- | Create the given directory.
-createDir :: FilePath -> BuildScript
+createDir :: AbsolutePath ( Dir dir ) -> BuildScript
 createDir = step . CreateDir
 
 -- | Log a message.
@@ -185,22 +187,29 @@     --
     --  - add quotes around command-line arguments?
     --  - add @./@ to run an executable in the current working directory?
+
+  , scriptWorkingDir :: !( SymbolicPath CWD ( Dir Project ) )
+    -- ^ Working directory for the script.
+
   , scriptStyle :: !Style
     -- ^ Whether to use Posix or Windows style conventions. See 'Style'.
 
-  , scriptTotal :: !(Maybe Word)
+  , scriptTotal :: !( Maybe Word )
     -- ^ Optional: the total number of units we are building;
     -- used to report progress.
   }
 
 -- | Configure a script to run on the host (in @IO@).
-hostRunCfg :: Maybe Word -- ^ Optional: total to report progress against.
+hostRunCfg :: SymbolicPath CWD ( Dir Project )
+           -> Maybe Word -- ^ Optional: total to report progress against.
            -> ScriptConfig
-hostRunCfg mbTotal =
+hostRunCfg workDir mbTotal =
   ScriptConfig
-    { scriptOutput = Run
-    , scriptStyle  = hostStyle
-    , scriptTotal  = mbTotal }
+    { scriptOutput     = Run
+    , scriptStyle      = hostStyle
+    , scriptTotal      = mbTotal
+    , scriptWorkingDir = workDir
+    }
 
 -- | Whether to expand or escape variables in a shell script.
 data EscapeVars
@@ -212,7 +221,7 @@ 
 -- | Quote a string, to avoid spaces causing the string
 -- to be interpreted as multiple arguments.
-q :: ( IsString r, Monoid r ) => EscapeVars-> String -> r
+q :: ( IsString r, Monoid r ) => EscapeVars -> String -> r
 q escapeVars t = "\"" <> fromString ( escapeArg t ) <> "\""
   where
     escapeArg :: String -> String
@@ -252,12 +261,13 @@ -- IO
 
 -- | Execute a 'BuildScript' in the 'IO' monad.
-executeBuildScript :: Maybe Counter -- ^ Optional counter to use to report progress.
+executeBuildScript :: SymbolicPath CWD ( Dir Project ) -- ^ Working directory.
+                   -> Maybe Counter -- ^ Optional counter to use to report progress.
                    -> BuildScript   -- ^ The build script to execute.
                    -> IO ()
-executeBuildScript counter
+executeBuildScript workDir counter
   = traverse_  ( executeBuildStep counter )
-  . buildSteps ( hostRunCfg $ fmap counterMax counter )
+  . buildSteps ( hostRunCfg workDir $ fmap counterMax counter )
 
 -- | Execute a single 'BuildStep' in the 'IO' monad.
 executeBuildStep :: Maybe Counter
@@ -266,7 +276,7 @@                  -> IO ()
 executeBuildStep mbCounter = \case
   CallProcess cp  -> callProcessInIO mbCounter cp
-  CreateDir   dir -> createDirectoryIfMissing True dir
+  CreateDir   dir -> createDirectoryIfMissing True ( getAbsolutePath dir )
   LogMessage  msg -> do { putStrLn msg ; hFlush System.stdout }
   ReportProgress { outputProgress } ->
     for_ mbCounter \ counter -> do
@@ -293,7 +303,8 @@   Text.unlines ( header ++ concatMap ( stepScript scriptCfg ) ( buildSteps scriptCfg buildScript ) )
   where
     header, varsHelper, progressVars :: [ Text ]
-    header = [ "#!/bin/bash" , "" ] ++ varsHelper ++ logDir ++ progressVars
+    header = [ "#!/bin/bash" , "", "set -ueo pipefail" ] ++
+      varsHelper ++ logDir ++ progressVars
     varsHelper
       | Shell { useVariables } <- scriptOutput scriptCfg
       , useVariables
@@ -305,14 +316,14 @@         Nothing -> []
         Just {} ->
           [ "buildEnvProgress=0" ]
-    logDir = [ "LOGDIR=\"$PWD/logs/$(date --utc +%Y-%m-%d_%H-%M-%S)\""
+    logDir = [ "LOGDIR=\"$PWD/logs/$(date -u +%Y-%m-%d_%H-%M-%S)\""
              , "mkdir -p \"${LOGDIR}\"" ]
 
 -- | The underlying script of a build step.
 stepScript :: ScriptConfig -> BuildStep -> [ Text ]
 stepScript scriptCfg = \case
   CreateDir dir ->
-    [ "mkdir -p " <> q ExpandVars dir ]
+    [ "mkdir -p " <> q ExpandVars ( getAbsolutePath dir ) ]
   LogMessage str ->
     [ "echo " <> q ExpandVars str ]
   ReportProgress { outputProgress } ->
@@ -337,7 +348,7 @@     -- NB: we ignore the semaphore, as the build scripts we produce
     -- are inherently sequential.
     logCommand ++
-    [ "( cd " <> q ExpandVars cwd <> " ; \\" ]
+    [ "( cd " <> q ExpandVars ( getSymbolicPath cwd ) <> " ; \\" ]
     ++ mbUpdatePath
     ++ map mkEnvVar extraEnvVars
     ++
@@ -349,7 +360,7 @@     , "  echo -e " <>
         "\"callProcess failed with non-zero exit code. Command:\\n" <>
         "  > " <> unquote cmd <> "\\n" <>
-        "  CWD = " <> unquote (q ExpandVars cwd) <> "\""
+        "  CWD = " <> unquote ( q ExpandVars ( getSymbolicPath cwd ) ) <> "\""
       <> logErr
     ]
     ++ progressReport
@@ -358,9 +369,13 @@     [ "  exit \"${" <> resVar <> "}\""
     , "fi" ]
     where
+      progPath :: FilePath
+      progPath = case prog of
+        AbsPath p -> getAbsolutePath p
+        RelPath p -> getSymbolicPath p
       cmd :: Text
-      cmd = q ExpandVars ( progPath prog ) <> " " <> Text.unwords (map Text.pack args)
-        --         (1)                                         (2)
+      cmd = q ExpandVars progPath <> " " <> Text.unwords (map Text.pack args)
+        --                 (1)                                  (2)
         --
         -- (1)
         --   In shell scripts, we always change directory before running the
@@ -385,7 +400,7 @@         = []
         | otherwise
         = [  "  export PATH=$PATH:"
-          <> Text.intercalate ":" (map Text.pack extraPATH) -- (already quoted)
+          <> Text.intercalate ":" ( map Text.pack extraPATH ) -- (already quoted)
           <> " ; \\" ]
 
       mkEnvVar :: (String, String) -> Text
@@ -401,14 +416,14 @@           Nothing      -> ( [], "", " >&2", [] )
           Just logPath ->
             let stdoutFile, stderrFile :: Text
-                stdoutFile = q ExpandVars ( logPath <.> "stdout" )
-                stderrFile = q ExpandVars ( logPath <.> "stderr" )
+                stdoutFile = q ExpandVars ( getAbsolutePath logPath <.> "stdout" )
+                stderrFile = q ExpandVars ( getAbsolutePath logPath <.> "stderr" )
             in ( [ "echo \"> " <> unquote cmd <> "\" >> " <> stdoutFile ]
-               , " > " <> stdoutFile <> " 2> >( tee -a " <> stderrFile <> " >&2 )"
+               , " 2>&1 >" <> stdoutFile <> " | tee -a " <> stderrFile
                   -- Write stdout to the stdout log file.
                   -- Write stderr both to the terminal and to the stderr log file.
                , " | tee -a " <> stderrFile <> " >&2"
-               , [ "  echo \"Logs are available at: " <> unquote ( q ExpandVars ( logPath <> ".{stdout,stderr}" ) ) <> "\"" ] )
+               , [ "  echo \"Logs are available at: " <> unquote ( q ExpandVars ( getAbsolutePath logPath <> ".{stdout,stderr}" ) ) <> "\"" ] )
 
       progressReport :: [Text]
       progressReport =
src/BuildEnv/Utils.hs view
@@ -1,6 +1,8 @@ {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -18,11 +20,12 @@       ProgPath(..), CallProcess(..), callProcessInIO
 
       -- * Create temporary directories
-    , TempDirPermanence(..), withTempDir
+    , TempDirPermanence(..)
+    , withTempDir
 
       -- * Abstract semaphores
     , AbstractSem(..)
-    , newAbstractSem, noSem, abstractQSem
+    , withNewAbstractSem, noSem, abstractQSem
 
       -- * Other utilities
     , splitOn
@@ -33,11 +36,13 @@ import Control.Concurrent.QSem
   ( QSem, newQSem, signalQSem, waitQSem )
 import Control.Exception
-  ( bracket_ )
+  ( bracket, bracket_ )
+import Data.Kind
+  ( Type )
 import Data.List
   ( intercalate )
 import Data.Maybe
-  ( fromMaybe )
+  ( maybeToList )
 import Data.IORef
   ( readIORef )
 import System.Environment
@@ -61,15 +66,23 @@ 
 -- directory
 import System.Directory
-  ( createDirectoryIfMissing, makeAbsolute )
+  ( createDirectoryIfMissing )
 
 -- filepath
 import System.FilePath
-  ( (</>), (<.>), takeDirectory )
+  ( takeDirectory )
 
 -- process
 import qualified System.Process as Proc
 
+-- semaphore-compat
+import qualified System.Semaphore as System
+  ( Semaphore(..), SemaphoreName(..)
+  , freshSemaphore, openSemaphore
+  , destroySemaphore
+  , waitOnSemaphore, releaseSemaphore
+  )
+
 -- temporary
 import System.IO.Temp
     ( createTempDirectory
@@ -79,35 +92,39 @@ 
 -- build-env
 import BuildEnv.Config
-  ( AsyncSem(..), Args, TempDirPermanence(..), Counter(..)
+  ( Args, AsyncSem(..)
+  , Counter(..)
+  , TempDirPermanence(..)
   , pATHSeparator, hostStyle
   )
+import BuildEnv.Path
 
 --------------------------------------------------------------------------------
 
 -- | The path of a program to run.
-data ProgPath
+type ProgPath :: Type -> Type
+data ProgPath from
   -- | An absolute path, or an executable in @PATH@.
-  = AbsPath { progPath :: !FilePath }
-  -- | A relative path. What it is relative to depends on context.
-  | RelPath { progPath :: !FilePath }
+  = AbsPath { absProgPath :: !( AbsolutePath File ) }
+  -- | A relative path, relative to the @from@ abstract location.
+  | RelPath { relProgPath :: !( SymbolicPath from File ) }
 
 -- | Arguments to 'callProcess'.
-data CallProcess
+data CallProcess dir
   = CP
-  { cwd          :: !FilePath
+  { cwd          :: !( SymbolicPath CWD ( Dir dir ) )
      -- ^ Working directory.
-  , extraPATH    :: ![FilePath]
+  , extraPATH    :: ![ FilePath ]
      -- ^ Absolute filepaths to add to PATH.
-  , extraEnvVars :: ![(String, String)]
-     -- ^ Extra envi!ronment variables to add before running the command.
-  , prog         :: !ProgPath
+  , extraEnvVars :: ![ ( String, String ) ]
+     -- ^ Extra environment variables to add before running the command.
+  , prog         :: !( ProgPath dir )
      -- ^ The program to run.
      --
      -- If it's a relative path, it should be relative to the @cwd@ field.
   , args         :: !Args
      -- ^ Arguments to the program.
-  , logBasePath  :: !( Maybe FilePath )
+  , logBasePath  :: !( Maybe ( AbsolutePath File ) )
      -- ^ Log @stdout@ to @basePath.stdout@ and @stderr@ to @basePath.stderr@.
   , sem          :: !AbstractSem
      -- ^ Lock to take when calling the process
@@ -124,13 +141,13 @@                 => Maybe Counter
                     -- ^ Optional counter. Used when the command fails,
                     -- to report the progress that has been made so far.
-                -> CallProcess
+                -> CallProcess dir
                 -> IO ()
 callProcessInIO mbCounter ( CP { cwd, extraPATH, extraEnvVars, prog, args, logBasePath, sem } ) = do
   absProg <-
     case prog of
       AbsPath p -> return p
-      RelPath p -> makeAbsolute $ cwd </> p
+      RelPath p -> makeAbsolute cwd p
         -- Needs to be an absolute path, as per the @process@ documentation:
         --
         --   If cwd is provided, it is implementation-dependent whether
@@ -144,8 +161,8 @@         | null args = ""
         | otherwise = " " ++ unwords args
       command =
-        [ "  > " ++ absProg ++ argsStr
-        , "  CWD = " ++ cwd ]
+        [ "  > " ++ show absProg ++ argsStr
+        , "  CWD = " ++ show cwd ]
   env <-
     if null extraPATH && null extraEnvVars
     then return Nothing
@@ -159,17 +176,17 @@         Just logPath -> do
           let stdoutFile = logPath <.> "stdout"
               stderrFile = logPath <.> "stderr"
-          createDirectoryIfMissing True $ takeDirectory logPath
-          withFile stdoutFile AppendMode \ stdoutFileHandle ->
-            withFile stderrFile AppendMode \ stderrFileHandle -> do
+          createDirectoryIfMissing True $ takeDirectory $ getAbsolutePath logPath
+          withFile ( getAbsolutePath stdoutFile ) AppendMode \ stdoutFileHandle ->
+            withFile ( getAbsolutePath stderrFile ) AppendMode \ stderrFileHandle -> do
               hDuplicateTo System.Handle.stderr stderrFileHandle
                 -- Write stderr to the log file and to the terminal.
               hPutStrLn stdoutFileHandle ( unlines command )
               action ( Proc.UseHandle stdoutFileHandle, Proc.UseHandle stderrFileHandle )
   withHandles \ ( stdoutStream, stderrStream ) -> do
     let processArgs =
-          ( Proc.proc absProg args )
-            { Proc.cwd     = if cwd == "." then Nothing else Just cwd
+          ( Proc.proc ( getAbsolutePath absProg ) args )
+            { Proc.cwd     = if getSymbolicPath cwd == "." then Nothing else Just ( getSymbolicPath cwd )
             , Proc.env     = env
             , Proc.std_out = stdoutStream
             , Proc.std_err = stderrStream }
@@ -191,7 +208,7 @@         case stderrStream of
           Proc.UseHandle errHandle ->
             hPutStrLn errHandle
-              ( unlines $ msg ++ [ "Logs are available at: " <> fromMaybe "" logBasePath <> ".{stdout, stderr}" ] )
+              ( unlines $ msg ++ [ "Logs are available at: " <> getAbsolutePath logs <> ".{stdout, stderr}" | logs <- maybeToList logBasePath ] )
           _ -> putStrLn (unlines msg)
         exitWith res
 
@@ -208,15 +225,15 @@ withTempDir :: TempDirPermanence  -- ^ whether to delete the temporary directory
                                   -- after the action completes
             -> String             -- ^ directory name template
-            -> (FilePath -> IO a) -- ^ action to perform
+            -> ( AbsolutePath ( Dir Tmp ) -> IO a ) -- ^ action to perform
             -> IO a
 withTempDir del name k =
   case del of
     DeleteTempDirs
-      -> withSystemTempDirectory name k
+      -> withSystemTempDirectory name ( k . mkAbsolutePath )
     Don'tDeleteTempDirs
       -> do root <- getCanonicalTemporaryDirectory
-            createTempDirectory root name >>= k
+            createTempDirectory root name >>= ( k . mkAbsolutePath )
 
 -- | Utility list 'splitOn' function.
 splitOn :: Char -> String -> [String]
@@ -235,19 +252,49 @@   AbstractSem { withAbstractSem :: forall r. IO r -> IO r }
 
 -- | Create a semaphore-based acquire/release mechanism.
-newAbstractSem :: AsyncSem -> IO AbstractSem
-newAbstractSem whatSem =
+withNewAbstractSem :: AsyncSem
+                   -> ( AbstractSem -> Args -> IO r )
+                      -- ^ the abstract semaphore to use, and extra
+                      -- arguments to pass to @Setup configure@ for @ghc@
+                   -> IO r
+withNewAbstractSem whatSem f =
   case whatSem of
-    NoSem -> return noSem
     NewQSem n -> do
       qsem <- newQSem ( fromIntegral n )
-      return $ abstractQSem qsem
+      f ( abstractQSem qsem ) []
+    NewJSem n ->
+      bracket
+        ( System.freshSemaphore "buildEnvSemaphore" ( fromIntegral n ) )
+        System.destroySemaphore
+        $ \ jsem -> do
+          let jsemName = System.semaphoreName jsem
+          f ( abstractJSem jsem ) [ jsemGhcArg jsemName ]
+    ExistingJSem jsemName -> do
+      let jsemNm = System.SemaphoreName jsemName
+      jsem <- System.openSemaphore jsemNm
+      f ( abstractJSem jsem ) [ jsemGhcArg jsemNm ]
+  where
+    jsemGhcArg :: System.SemaphoreName -> String
+    jsemGhcArg ( System.SemaphoreName jsemName ) =
+      "--ghc-option=-jsem=" <> jsemName
 
+-- | No acquire/release mechanism required.
+noSem :: AbstractSem
+noSem = AbstractSem { withAbstractSem = id }
+
 -- | Abstract acquire/release mechanism controlled by the given 'QSem'.
 abstractQSem :: QSem -> AbstractSem
 abstractQSem sem =
-  AbstractSem $ bracket_ (waitQSem sem) (signalQSem sem)
+  AbstractSem $
+    bracket_
+      ( waitQSem   sem )
+      ( signalQSem sem )
 
--- | No acquire/release mechanism required.
-noSem :: AbstractSem
-noSem = AbstractSem { withAbstractSem = id }
+-- | Abstract acquire/release mechanism controlled by the given
+-- system semaphore.
+abstractJSem :: System.Semaphore -> AbstractSem
+abstractJSem sem =
+  AbstractSem $
+    bracket_
+      ( System.waitOnSemaphore  sem )
+      ( System.releaseSemaphore sem 1 )