{-# LANGUAGE RecordWildCards #-}

-- |
--
-- The layout of the .\/dist\/ directory where cabal keeps all of its state
-- and build artifacts.
module Distribution.Client.DistDirLayout
  ( -- * 'DistDirLayout'
    DistDirLayout (..)
  , DistDirParams (..)
  , defaultDistDirLayout

    -- * 'ProjectRoot'
  , ProjectRoot (..)
  , defaultProjectFile

    -- * 'StoreDirLayout'
  , StoreDirLayout (..)
  , defaultStoreDirLayout

    -- * 'CabalDirLayout'
  , CabalDirLayout (..)
  , mkCabalDirLayout
  , defaultCabalDirLayout
  ) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import System.FilePath

import Distribution.Client.Config
  ( defaultLogsDir
  , defaultStoreDir
  )
import Distribution.Compiler
import Distribution.Package
  ( ComponentId
  , PackageId
  , PackageIdentifier
  , UnitId
  )
import Distribution.Simple.Compiler
  ( Compiler (..)
  , OptimisationLevel (..)
  , PackageDBCWD
  , PackageDBStackCWD
  , PackageDBX (..)
  )
import Distribution.Simple.Configure (interpretPackageDbFlags)
import Distribution.System
import Distribution.Types.ComponentName
import Distribution.Types.LibraryName

-- | Information which can be used to construct the path to
-- the build directory of a build.  This is LESS fine-grained
-- than what goes into the hashed 'InstalledPackageId',
-- and for good reason: we don't want this path to change if
-- the user, say, adds a dependency to their project.
data DistDirParams = DistDirParams
  { DistDirParams -> UnitId
distParamUnitId :: UnitId
  , DistDirParams -> PackageId
distParamPackageId :: PackageId
  , DistDirParams -> ComponentId
distParamComponentId :: ComponentId
  , DistDirParams -> Maybe ComponentName
distParamComponentName :: Maybe ComponentName
  , DistDirParams -> CompilerId
distParamCompilerId :: CompilerId
  , DistDirParams -> Platform
distParamPlatform :: Platform
  , DistDirParams -> OptimisationLevel
distParamOptimization :: OptimisationLevel
  -- TODO (see #3343):
  --  Flag assignments
  --  Optimization
  }

-- | The layout of the project state directory. Traditionally this has been
-- called the @dist@ directory.
data DistDirLayout = DistDirLayout
  { DistDirLayout -> FilePath
distProjectRootDirectory :: FilePath
  -- ^ The root directory of the project. Many other files are relative to
  -- this location (e.g. the @cabal.project@ file).
  , DistDirLayout -> FilePath -> FilePath
distProjectFile :: String -> FilePath
  -- ^ The @cabal.project@ file and related like @cabal.project.freeze@.
  -- The parameter is for the extension, like \"freeze\", or \"\" for the
  -- main file.
  , DistDirLayout -> FilePath
distDirectory :: FilePath
  -- ^ The \"dist\" directory, which is the root of where cabal keeps all
  -- its state including the build artifacts from each package we build.
  , DistDirLayout -> DistDirParams -> FilePath
distBuildDirectory :: DistDirParams -> FilePath
  -- ^ The directory under dist where we keep the build artifacts for a
  -- package we're building from a local directory.
  --
  -- This uses a 'UnitId' not just a 'PackageName' because technically
  -- we can have multiple instances of the same package in a solution
  -- (e.g. setup deps).
  , DistDirLayout -> FilePath
distBuildRootDirectory :: FilePath
  , DistDirLayout -> FilePath
distDownloadSrcDirectory :: FilePath
  -- ^ The directory under dist where we download tarballs and source
  -- control repos to.
  , DistDirLayout -> PackageId -> FilePath
distUnpackedSrcDirectory :: PackageId -> FilePath
  -- ^ The directory under dist where we put the unpacked sources of
  -- packages, in those cases where it makes sense to keep the build
  -- artifacts to reduce rebuild times.
  , DistDirLayout -> FilePath
distUnpackedSrcRootDirectory :: FilePath
  , DistDirLayout -> FilePath -> FilePath
distProjectCacheFile :: String -> FilePath
  -- ^ The location for project-wide cache files (e.g. state used in
  -- incremental rebuilds).
  , DistDirLayout -> FilePath
distProjectCacheDirectory :: FilePath
  , DistDirLayout -> DistDirParams -> FilePath -> FilePath
distPackageCacheFile :: DistDirParams -> String -> FilePath
  -- ^ The location for package-specific cache files (e.g. state used in
  -- incremental rebuilds).
  , DistDirLayout -> DistDirParams -> FilePath
distPackageCacheDirectory :: DistDirParams -> FilePath
  , DistDirLayout -> PackageId -> FilePath
distSdistFile :: PackageId -> FilePath
  -- ^ The location that sdists are placed by default.
  , DistDirLayout -> FilePath
distSdistDirectory :: FilePath
  , DistDirLayout -> FilePath
distTempDirectory :: FilePath
  , DistDirLayout -> FilePath
distBinDirectory :: FilePath
  , DistDirLayout -> CompilerId -> PackageDBCWD
distPackageDB :: CompilerId -> PackageDBCWD
  , DistDirLayout -> Maybe FilePath
distHaddockOutputDir :: Maybe FilePath
  -- ^ Is needed when `--haddock-output-dir` flag is used.
  }

-- | The layout of a cabal nix-style store.
data StoreDirLayout = StoreDirLayout
  { StoreDirLayout -> Compiler -> FilePath
storeDirectory :: Compiler -> FilePath
  , StoreDirLayout -> Compiler -> UnitId -> FilePath
storePackageDirectory :: Compiler -> UnitId -> FilePath
  , StoreDirLayout -> Compiler -> FilePath
storePackageDBPath :: Compiler -> FilePath
  , StoreDirLayout -> Compiler -> PackageDBCWD
storePackageDB :: Compiler -> PackageDBCWD
  , StoreDirLayout
-> Compiler -> [Maybe PackageDBCWD] -> PackageDBStackCWD
storePackageDBStack :: Compiler -> [Maybe PackageDBCWD] -> PackageDBStackCWD
  , StoreDirLayout -> Compiler -> FilePath
storeIncomingDirectory :: Compiler -> FilePath
  , StoreDirLayout -> Compiler -> UnitId -> FilePath
storeIncomingLock :: Compiler -> UnitId -> FilePath
  }

-- TODO: move to another module, e.g. CabalDirLayout?
-- or perhaps rename this module to DirLayouts.

-- | The layout of the user-wide cabal directory, that is the @~/.cabal@ dir
-- on unix, and equivalents on other systems.
--
-- At the moment this is just a partial specification, but the idea is
-- eventually to cover it all.
data CabalDirLayout = CabalDirLayout
  { CabalDirLayout -> StoreDirLayout
cabalStoreDirLayout :: StoreDirLayout
  , CabalDirLayout -> FilePath
cabalLogsDirectory :: FilePath
  }

-- | Information about the root directory of the project.
--
-- It can either be an implicit project root in the current dir if no
-- @cabal.project@ file is found, or an explicit root if either
-- the file is found or the project root directory was specified.
data ProjectRoot
  = -- | An implicit project root. It contains the absolute project
    -- root dir.
    ProjectRootImplicit FilePath
  | -- | An explicit project root. It contains the absolute project
    -- root dir and the relative @cabal.project@ file (or explicit override)
    ProjectRootExplicit FilePath FilePath
  | -- | An explicit, absolute project root dir and an explicit, absolute
    -- @cabal.project@ file.
    ProjectRootExplicitAbsolute FilePath FilePath
  deriving (ProjectRoot -> ProjectRoot -> Bool
(ProjectRoot -> ProjectRoot -> Bool)
-> (ProjectRoot -> ProjectRoot -> Bool) -> Eq ProjectRoot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProjectRoot -> ProjectRoot -> Bool
== :: ProjectRoot -> ProjectRoot -> Bool
$c/= :: ProjectRoot -> ProjectRoot -> Bool
/= :: ProjectRoot -> ProjectRoot -> Bool
Eq, Int -> ProjectRoot -> FilePath -> FilePath
[ProjectRoot] -> FilePath -> FilePath
ProjectRoot -> FilePath
(Int -> ProjectRoot -> FilePath -> FilePath)
-> (ProjectRoot -> FilePath)
-> ([ProjectRoot] -> FilePath -> FilePath)
-> Show ProjectRoot
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> ProjectRoot -> FilePath -> FilePath
showsPrec :: Int -> ProjectRoot -> FilePath -> FilePath
$cshow :: ProjectRoot -> FilePath
show :: ProjectRoot -> FilePath
$cshowList :: [ProjectRoot] -> FilePath -> FilePath
showList :: [ProjectRoot] -> FilePath -> FilePath
Show)

defaultProjectFile :: FilePath
defaultProjectFile :: FilePath
defaultProjectFile = FilePath
"cabal.project"

-- | Make the default 'DistDirLayout' based on the project root dir and
-- optional overrides for the location of the @dist@ directory, the
-- @cabal.project@ file and the documentation directory.
defaultDistDirLayout
  :: ProjectRoot
  -- ^ the project root
  -> Maybe FilePath
  -- ^ the @dist@ directory (relative to package root)
  -> Maybe FilePath
  -- ^ the documentation directory
  -> DistDirLayout
defaultDistDirLayout :: ProjectRoot -> Maybe FilePath -> Maybe FilePath -> DistDirLayout
defaultDistDirLayout ProjectRoot
projectRoot Maybe FilePath
mdistDirectory Maybe FilePath
haddockOutputDir =
  DistDirLayout{FilePath
Maybe FilePath
FilePath -> FilePath
CompilerId -> PackageDBCWD
PackageId -> FilePath
DistDirParams -> FilePath
DistDirParams -> FilePath -> FilePath
distProjectRootDirectory :: FilePath
distProjectFile :: FilePath -> FilePath
distDirectory :: FilePath
distBuildDirectory :: DistDirParams -> FilePath
distBuildRootDirectory :: FilePath
distDownloadSrcDirectory :: FilePath
distUnpackedSrcDirectory :: PackageId -> FilePath
distUnpackedSrcRootDirectory :: FilePath
distProjectCacheFile :: FilePath -> FilePath
distProjectCacheDirectory :: FilePath
distPackageCacheFile :: DistDirParams -> FilePath -> FilePath
distPackageCacheDirectory :: DistDirParams -> FilePath
distSdistFile :: PackageId -> FilePath
distSdistDirectory :: FilePath
distTempDirectory :: FilePath
distBinDirectory :: FilePath
distPackageDB :: CompilerId -> PackageDBCWD
distHaddockOutputDir :: Maybe FilePath
distProjectRootDirectory :: FilePath
distProjectFile :: FilePath -> FilePath
distDirectory :: FilePath
distBuildRootDirectory :: FilePath
distBuildDirectory :: DistDirParams -> FilePath
distUnpackedSrcRootDirectory :: FilePath
distUnpackedSrcDirectory :: PackageId -> FilePath
distDownloadSrcDirectory :: FilePath
distProjectCacheDirectory :: FilePath
distProjectCacheFile :: FilePath -> FilePath
distPackageCacheDirectory :: DistDirParams -> FilePath
distPackageCacheFile :: DistDirParams -> FilePath -> FilePath
distSdistFile :: PackageId -> FilePath
distSdistDirectory :: FilePath
distTempDirectory :: FilePath
distBinDirectory :: FilePath
distPackageDB :: CompilerId -> PackageDBCWD
distHaddockOutputDir :: Maybe FilePath
..}
  where
    (FilePath
projectRootDir, FilePath
projectFile) = case ProjectRoot
projectRoot of
      ProjectRootImplicit FilePath
dir -> (FilePath
dir, FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
defaultProjectFile)
      ProjectRootExplicit FilePath
dir FilePath
file -> (FilePath
dir, FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
file)
      ProjectRootExplicitAbsolute FilePath
dir FilePath
file -> (FilePath
dir, FilePath
file)

    distProjectRootDirectory :: FilePath
    distProjectRootDirectory :: FilePath
distProjectRootDirectory = FilePath
projectRootDir

    distProjectFile :: String -> FilePath
    distProjectFile :: FilePath -> FilePath
distProjectFile FilePath
ext = FilePath
projectFile FilePath -> FilePath -> FilePath
<.> FilePath
ext

    distDirectory :: FilePath
    distDirectory :: FilePath
distDirectory =
      FilePath
distProjectRootDirectory
        FilePath -> FilePath -> FilePath
</> FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"dist-newstyle" Maybe FilePath
mdistDirectory
    -- TODO: switch to just dist at some point, or some other new name

    distBuildRootDirectory :: FilePath
    distBuildRootDirectory :: FilePath
distBuildRootDirectory = FilePath
distDirectory FilePath -> FilePath -> FilePath
</> FilePath
"build"

    distBuildDirectory :: DistDirParams -> FilePath
    distBuildDirectory :: DistDirParams -> FilePath
distBuildDirectory DistDirParams
params =
      FilePath
distBuildRootDirectory
        FilePath -> FilePath -> FilePath
</> Platform -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (DistDirParams -> Platform
distParamPlatform DistDirParams
params)
        FilePath -> FilePath -> FilePath
</> CompilerId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (DistDirParams -> CompilerId
distParamCompilerId DistDirParams
params)
        FilePath -> FilePath -> FilePath
</> PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (DistDirParams -> PackageId
distParamPackageId DistDirParams
params)
        FilePath -> FilePath -> FilePath
</> ( case DistDirParams -> Maybe ComponentName
distParamComponentName DistDirParams
params of
                Maybe ComponentName
Nothing -> FilePath
""
                Just (CLibName LibraryName
LMainLibName) -> FilePath
""
                Just (CLibName (LSubLibName UnqualComponentName
name)) -> FilePath
"l" FilePath -> FilePath -> FilePath
</> UnqualComponentName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow UnqualComponentName
name
                Just (CFLibName UnqualComponentName
name) -> FilePath
"f" FilePath -> FilePath -> FilePath
</> UnqualComponentName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow UnqualComponentName
name
                Just (CExeName UnqualComponentName
name) -> FilePath
"x" FilePath -> FilePath -> FilePath
</> UnqualComponentName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow UnqualComponentName
name
                Just (CTestName UnqualComponentName
name) -> FilePath
"t" FilePath -> FilePath -> FilePath
</> UnqualComponentName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow UnqualComponentName
name
                Just (CBenchName UnqualComponentName
name) -> FilePath
"b" FilePath -> FilePath -> FilePath
</> UnqualComponentName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow UnqualComponentName
name
            )
        FilePath -> FilePath -> FilePath
</> ( case DistDirParams -> OptimisationLevel
distParamOptimization DistDirParams
params of
                OptimisationLevel
NoOptimisation -> FilePath
"noopt"
                OptimisationLevel
NormalOptimisation -> FilePath
""
                OptimisationLevel
MaximumOptimisation -> FilePath
"opt"
            )
        FilePath -> FilePath -> FilePath
</> ( let uid_str :: FilePath
uid_str = UnitId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (DistDirParams -> UnitId
distParamUnitId DistDirParams
params)
               in if FilePath
uid_str FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== ComponentId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (DistDirParams -> ComponentId
distParamComponentId DistDirParams
params)
                    then FilePath
""
                    else FilePath
uid_str
            )

    distUnpackedSrcRootDirectory :: FilePath
    distUnpackedSrcRootDirectory :: FilePath
distUnpackedSrcRootDirectory = FilePath
distDirectory FilePath -> FilePath -> FilePath
</> FilePath
"src"

    distUnpackedSrcDirectory :: PackageId -> FilePath
    distUnpackedSrcDirectory :: PackageId -> FilePath
distUnpackedSrcDirectory PackageId
pkgid =
      FilePath
distUnpackedSrcRootDirectory
        FilePath -> FilePath -> FilePath
</> PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid
    -- we shouldn't get name clashes so this should be fine:
    distDownloadSrcDirectory :: FilePath
    distDownloadSrcDirectory :: FilePath
distDownloadSrcDirectory = FilePath
distUnpackedSrcRootDirectory

    distProjectCacheDirectory :: FilePath
    distProjectCacheDirectory :: FilePath
distProjectCacheDirectory = FilePath
distDirectory FilePath -> FilePath -> FilePath
</> FilePath
"cache"

    distProjectCacheFile :: FilePath -> FilePath
    distProjectCacheFile :: FilePath -> FilePath
distProjectCacheFile FilePath
name = FilePath
distProjectCacheDirectory FilePath -> FilePath -> FilePath
</> FilePath
name

    distPackageCacheDirectory :: DistDirParams -> FilePath
    distPackageCacheDirectory :: DistDirParams -> FilePath
distPackageCacheDirectory DistDirParams
params = DistDirParams -> FilePath
distBuildDirectory DistDirParams
params FilePath -> FilePath -> FilePath
</> FilePath
"cache"

    distPackageCacheFile :: DistDirParams -> String -> FilePath
    distPackageCacheFile :: DistDirParams -> FilePath -> FilePath
distPackageCacheFile DistDirParams
params FilePath
name = DistDirParams -> FilePath
distPackageCacheDirectory DistDirParams
params FilePath -> FilePath -> FilePath
</> FilePath
name

    distSdistFile :: PackageIdentifier -> FilePath
    distSdistFile :: PackageId -> FilePath
distSdistFile PackageId
pid = FilePath
distSdistDirectory FilePath -> FilePath -> FilePath
</> PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageId
pid FilePath -> FilePath -> FilePath
<.> FilePath
"tar.gz"

    distSdistDirectory :: FilePath
    distSdistDirectory :: FilePath
distSdistDirectory = FilePath
distDirectory FilePath -> FilePath -> FilePath
</> FilePath
"sdist"

    distTempDirectory :: FilePath
    distTempDirectory :: FilePath
distTempDirectory = FilePath
distDirectory FilePath -> FilePath -> FilePath
</> FilePath
"tmp"

    distBinDirectory :: FilePath
    distBinDirectory :: FilePath
distBinDirectory = FilePath
distDirectory FilePath -> FilePath -> FilePath
</> FilePath
"bin"

    distPackageDBPath :: CompilerId -> FilePath
    distPackageDBPath :: CompilerId -> FilePath
distPackageDBPath CompilerId
compid = FilePath
distDirectory FilePath -> FilePath -> FilePath
</> FilePath
"packagedb" FilePath -> FilePath -> FilePath
</> CompilerId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow CompilerId
compid

    distPackageDB :: CompilerId -> PackageDBCWD
    distPackageDB :: CompilerId -> PackageDBCWD
distPackageDB = FilePath -> PackageDBCWD
forall fp. fp -> PackageDBX fp
SpecificPackageDB (FilePath -> PackageDBCWD)
-> (CompilerId -> FilePath) -> CompilerId -> PackageDBCWD
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerId -> FilePath
distPackageDBPath

    distHaddockOutputDir :: Maybe FilePath
    distHaddockOutputDir :: Maybe FilePath
distHaddockOutputDir = Maybe FilePath
haddockOutputDir

defaultStoreDirLayout :: FilePath -> StoreDirLayout
defaultStoreDirLayout :: FilePath -> StoreDirLayout
defaultStoreDirLayout FilePath
storeRoot =
  StoreDirLayout{Compiler -> FilePath
Compiler -> PackageDBCWD
Compiler -> [Maybe PackageDBCWD] -> PackageDBStackCWD
Compiler -> UnitId -> FilePath
storeDirectory :: Compiler -> FilePath
storePackageDirectory :: Compiler -> UnitId -> FilePath
storePackageDBPath :: Compiler -> FilePath
storePackageDB :: Compiler -> PackageDBCWD
storePackageDBStack :: Compiler -> [Maybe PackageDBCWD] -> PackageDBStackCWD
storeIncomingDirectory :: Compiler -> FilePath
storeIncomingLock :: Compiler -> UnitId -> FilePath
storeDirectory :: Compiler -> FilePath
storePackageDirectory :: Compiler -> UnitId -> FilePath
storePackageDBPath :: Compiler -> FilePath
storePackageDB :: Compiler -> PackageDBCWD
storePackageDBStack :: Compiler -> [Maybe PackageDBCWD] -> PackageDBStackCWD
storeIncomingDirectory :: Compiler -> FilePath
storeIncomingLock :: Compiler -> UnitId -> FilePath
..}
  where
    storeDirectory :: Compiler -> FilePath
    storeDirectory :: Compiler -> FilePath
storeDirectory Compiler
compiler =
      FilePath
storeRoot FilePath -> FilePath -> FilePath
</> case Compiler -> AbiTag
compilerAbiTag Compiler
compiler of
        AbiTag
NoAbiTag -> CompilerId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (Compiler -> CompilerId
compilerId Compiler
compiler)
        AbiTag FilePath
tag -> CompilerId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (Compiler -> CompilerId
compilerId Compiler
compiler) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
tag

    storePackageDirectory :: Compiler -> UnitId -> FilePath
    storePackageDirectory :: Compiler -> UnitId -> FilePath
storePackageDirectory Compiler
compiler UnitId
ipkgid =
      Compiler -> FilePath
storeDirectory Compiler
compiler FilePath -> FilePath -> FilePath
</> UnitId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow UnitId
ipkgid

    storePackageDBPath :: Compiler -> FilePath
    storePackageDBPath :: Compiler -> FilePath
storePackageDBPath Compiler
compiler =
      Compiler -> FilePath
storeDirectory Compiler
compiler FilePath -> FilePath -> FilePath
</> FilePath
"package.db"

    storePackageDB :: Compiler -> PackageDBCWD
    storePackageDB :: Compiler -> PackageDBCWD
storePackageDB Compiler
compiler =
      FilePath -> PackageDBCWD
forall fp. fp -> PackageDBX fp
SpecificPackageDB (Compiler -> FilePath
storePackageDBPath Compiler
compiler)

    storePackageDBStack :: Compiler -> [Maybe PackageDBCWD] -> PackageDBStackCWD
    storePackageDBStack :: Compiler -> [Maybe PackageDBCWD] -> PackageDBStackCWD
storePackageDBStack Compiler
compiler [Maybe PackageDBCWD]
extraPackageDB =
      (Bool -> [Maybe PackageDBCWD] -> PackageDBStackCWD
forall fp. Bool -> [Maybe (PackageDBX fp)] -> PackageDBStackX fp
interpretPackageDbFlags Bool
False [Maybe PackageDBCWD]
extraPackageDB)
        PackageDBStackCWD -> PackageDBStackCWD -> PackageDBStackCWD
forall a. [a] -> [a] -> [a]
++ [Compiler -> PackageDBCWD
storePackageDB Compiler
compiler]

    storeIncomingDirectory :: Compiler -> FilePath
    storeIncomingDirectory :: Compiler -> FilePath
storeIncomingDirectory Compiler
compiler =
      Compiler -> FilePath
storeDirectory Compiler
compiler FilePath -> FilePath -> FilePath
</> FilePath
"incoming"

    storeIncomingLock :: Compiler -> UnitId -> FilePath
    storeIncomingLock :: Compiler -> UnitId -> FilePath
storeIncomingLock Compiler
compiler UnitId
unitid =
      Compiler -> FilePath
storeIncomingDirectory Compiler
compiler FilePath -> FilePath -> FilePath
</> UnitId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow UnitId
unitid FilePath -> FilePath -> FilePath
<.> FilePath
"lock"

defaultCabalDirLayout :: IO CabalDirLayout
defaultCabalDirLayout :: IO CabalDirLayout
defaultCabalDirLayout =
  Maybe FilePath -> Maybe FilePath -> IO CabalDirLayout
mkCabalDirLayout Maybe FilePath
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing

mkCabalDirLayout
  :: Maybe FilePath
  -- ^ Store directory. Must be absolute
  -> Maybe FilePath
  -- ^ Log directory
  -> IO CabalDirLayout
mkCabalDirLayout :: Maybe FilePath -> Maybe FilePath -> IO CabalDirLayout
mkCabalDirLayout Maybe FilePath
mstoreDir Maybe FilePath
mlogDir = do
  StoreDirLayout
cabalStoreDirLayout <-
    FilePath -> StoreDirLayout
defaultStoreDirLayout (FilePath -> StoreDirLayout) -> IO FilePath -> IO StoreDirLayout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
-> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO FilePath
defaultStoreDir FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
mstoreDir
  FilePath
cabalLogsDirectory <-
    IO FilePath
-> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO FilePath
defaultLogsDir FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
mlogDir
  CabalDirLayout -> IO CabalDirLayout
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CabalDirLayout -> IO CabalDirLayout)
-> CabalDirLayout -> IO CabalDirLayout
forall a b. (a -> b) -> a -> b
$ CabalDirLayout{FilePath
StoreDirLayout
cabalStoreDirLayout :: StoreDirLayout
cabalLogsDirectory :: FilePath
cabalStoreDirLayout :: StoreDirLayout
cabalLogsDirectory :: FilePath
..}