{-# 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(..),

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

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

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

import System.FilePath

import Distribution.Package
         ( PackageId, PackageIdentifier, ComponentId, UnitId )
import Distribution.Compiler
import Distribution.Simple.Compiler
         ( PackageDB(..), PackageDBStack, OptimisationLevel(..) )
import Distribution.Types.ComponentName
import Distribution.Types.LibraryName
import Distribution.System


-- | 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 {

       -- | The root directory of the project. Many other files are relative to
       -- this location. In particular, the @cabal.project@ lives here.
       --
       DistDirLayout -> FilePath
distProjectRootDirectory     :: 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 -> FilePath
distProjectFile              :: String -> 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 -> FilePath
distDirectory                :: 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 -> DistDirParams -> FilePath
distBuildDirectory           :: DistDirParams -> FilePath,
       DistDirLayout -> FilePath
distBuildRootDirectory       :: FilePath,

       -- | The directory under dist where we download tarballs and source
       -- control repos to.
       --
       DistDirLayout -> FilePath
distDownloadSrcDirectory     :: 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 -> PackageId -> FilePath
distUnpackedSrcDirectory     :: PackageId -> FilePath,
       DistDirLayout -> FilePath
distUnpackedSrcRootDirectory :: FilePath,

       -- | The location for project-wide cache files (e.g. state used in
       -- incremental rebuilds).
       --
       DistDirLayout -> FilePath -> FilePath
distProjectCacheFile         :: String -> FilePath,
       DistDirLayout -> FilePath
distProjectCacheDirectory    :: FilePath,

       -- | The location for package-specific cache files (e.g. state used in
       -- incremental rebuilds).
       --
       DistDirLayout -> DistDirParams -> FilePath -> FilePath
distPackageCacheFile         :: DistDirParams -> String -> FilePath,
       DistDirLayout -> DistDirParams -> FilePath
distPackageCacheDirectory    :: DistDirParams -> FilePath,

       -- | The location that sdists are placed by default.
       DistDirLayout -> PackageId -> FilePath
distSdistFile                :: PackageId -> FilePath,
       DistDirLayout -> FilePath
distSdistDirectory           :: FilePath,

       DistDirLayout -> FilePath
distTempDirectory            :: FilePath,
       DistDirLayout -> FilePath
distBinDirectory             :: FilePath,

       DistDirLayout -> CompilerId -> PackageDB
distPackageDB                :: CompilerId -> PackageDB
     }


-- | The layout of a cabal nix-style store.
--
data StoreDirLayout = StoreDirLayout {
       StoreDirLayout -> CompilerId -> FilePath
storeDirectory         :: CompilerId -> FilePath,
       StoreDirLayout -> CompilerId -> UnitId -> FilePath
storePackageDirectory  :: CompilerId -> UnitId -> FilePath,
       StoreDirLayout -> CompilerId -> FilePath
storePackageDBPath     :: CompilerId -> FilePath,
       StoreDirLayout -> CompilerId -> PackageDB
storePackageDB         :: CompilerId -> PackageDB,
       StoreDirLayout -> CompilerId -> PackageDBStack
storePackageDBStack    :: CompilerId -> PackageDBStack,
       StoreDirLayout -> CompilerId -> FilePath
storeIncomingDirectory :: CompilerId -> FilePath,
       StoreDirLayout -> CompilerId -> UnitId -> FilePath
storeIncomingLock      :: CompilerId -> 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 the file is found.
--
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
  deriving (ProjectRoot -> ProjectRoot -> Bool
(ProjectRoot -> ProjectRoot -> Bool)
-> (ProjectRoot -> ProjectRoot -> Bool) -> Eq ProjectRoot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectRoot -> ProjectRoot -> Bool
$c/= :: ProjectRoot -> ProjectRoot -> Bool
== :: ProjectRoot -> ProjectRoot -> Bool
$c== :: 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
showList :: [ProjectRoot] -> FilePath -> FilePath
$cshowList :: [ProjectRoot] -> FilePath -> FilePath
show :: ProjectRoot -> FilePath
$cshow :: ProjectRoot -> FilePath
showsPrec :: Int -> ProjectRoot -> FilePath -> FilePath
$cshowsPrec :: Int -> ProjectRoot -> FilePath -> FilePath
Show)

-- | Make the default 'DistDirLayout' based on the project root dir and
-- optional overrides for the location of the @dist@ directory and the
-- @cabal.project@ file.
--
defaultDistDirLayout :: ProjectRoot    -- ^ the project root
                     -> Maybe FilePath -- ^ the @dist@ directory or default
                                       -- (absolute or relative to the root)
                     -> DistDirLayout
defaultDistDirLayout :: ProjectRoot -> Maybe FilePath -> DistDirLayout
defaultDistDirLayout ProjectRoot
projectRoot Maybe FilePath
mdistDirectory =
    DistDirLayout :: FilePath
-> (FilePath -> FilePath)
-> FilePath
-> (DistDirParams -> FilePath)
-> FilePath
-> FilePath
-> (PackageId -> FilePath)
-> FilePath
-> (FilePath -> FilePath)
-> FilePath
-> (DistDirParams -> FilePath -> FilePath)
-> (DistDirParams -> FilePath)
-> (PackageId -> FilePath)
-> FilePath
-> FilePath
-> FilePath
-> (CompilerId -> PackageDB)
-> DistDirLayout
DistDirLayout {FilePath
FilePath -> FilePath
PackageId -> FilePath
CompilerId -> PackageDB
DistDirParams -> FilePath
DistDirParams -> FilePath -> FilePath
distPackageDB :: CompilerId -> PackageDB
distBinDirectory :: FilePath
distTempDirectory :: FilePath
distSdistDirectory :: FilePath
distSdistFile :: PackageId -> FilePath
distPackageCacheFile :: DistDirParams -> FilePath -> FilePath
distPackageCacheDirectory :: DistDirParams -> FilePath
distProjectCacheFile :: FilePath -> FilePath
distProjectCacheDirectory :: FilePath
distDownloadSrcDirectory :: FilePath
distUnpackedSrcDirectory :: PackageId -> FilePath
distUnpackedSrcRootDirectory :: FilePath
distBuildDirectory :: DistDirParams -> FilePath
distBuildRootDirectory :: FilePath
distDirectory :: FilePath
distProjectFile :: FilePath -> FilePath
distProjectRootDirectory :: FilePath
distPackageDB :: CompilerId -> PackageDB
distBinDirectory :: FilePath
distTempDirectory :: FilePath
distSdistDirectory :: FilePath
distSdistFile :: PackageId -> FilePath
distPackageCacheDirectory :: DistDirParams -> FilePath
distPackageCacheFile :: DistDirParams -> FilePath -> FilePath
distProjectCacheDirectory :: FilePath
distProjectCacheFile :: FilePath -> FilePath
distUnpackedSrcRootDirectory :: FilePath
distUnpackedSrcDirectory :: PackageId -> FilePath
distDownloadSrcDirectory :: FilePath
distBuildRootDirectory :: FilePath
distBuildDirectory :: DistDirParams -> FilePath
distDirectory :: FilePath
distProjectFile :: FilePath -> FilePath
distProjectRootDirectory :: FilePath
..}
  where
    (FilePath
projectRootDir, FilePath
projectFile) = case ProjectRoot
projectRoot of
      ProjectRootImplicit FilePath
dir      -> (FilePath
dir, FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"cabal.project")
      ProjectRootExplicit FilePath
dir FilePath
file -> (FilePath
dir, FilePath
dir FilePath -> FilePath -> FilePath
</> 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 -> PackageDB
    distPackageDB :: CompilerId -> PackageDB
distPackageDB = FilePath -> PackageDB
SpecificPackageDB (FilePath -> PackageDB)
-> (CompilerId -> FilePath) -> CompilerId -> PackageDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerId -> FilePath
distPackageDBPath


defaultStoreDirLayout :: FilePath -> StoreDirLayout
defaultStoreDirLayout :: FilePath -> StoreDirLayout
defaultStoreDirLayout FilePath
storeRoot =
    StoreDirLayout :: (CompilerId -> FilePath)
-> (CompilerId -> UnitId -> FilePath)
-> (CompilerId -> FilePath)
-> (CompilerId -> PackageDB)
-> (CompilerId -> PackageDBStack)
-> (CompilerId -> FilePath)
-> (CompilerId -> UnitId -> FilePath)
-> StoreDirLayout
StoreDirLayout {CompilerId -> FilePath
CompilerId -> PackageDBStack
CompilerId -> PackageDB
CompilerId -> UnitId -> FilePath
storeIncomingLock :: CompilerId -> UnitId -> FilePath
storeIncomingDirectory :: CompilerId -> FilePath
storePackageDBStack :: CompilerId -> PackageDBStack
storePackageDB :: CompilerId -> PackageDB
storePackageDBPath :: CompilerId -> FilePath
storePackageDirectory :: CompilerId -> UnitId -> FilePath
storeDirectory :: CompilerId -> FilePath
storeIncomingLock :: CompilerId -> UnitId -> FilePath
storeIncomingDirectory :: CompilerId -> FilePath
storePackageDBStack :: CompilerId -> PackageDBStack
storePackageDB :: CompilerId -> PackageDB
storePackageDBPath :: CompilerId -> FilePath
storePackageDirectory :: CompilerId -> UnitId -> FilePath
storeDirectory :: CompilerId -> FilePath
..}
  where
    storeDirectory :: CompilerId -> FilePath
    storeDirectory :: CompilerId -> FilePath
storeDirectory CompilerId
compid =
      FilePath
storeRoot FilePath -> FilePath -> FilePath
</> CompilerId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow CompilerId
compid

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

    storePackageDBPath :: CompilerId -> FilePath
    storePackageDBPath :: CompilerId -> FilePath
storePackageDBPath CompilerId
compid =
      CompilerId -> FilePath
storeDirectory CompilerId
compid FilePath -> FilePath -> FilePath
</> FilePath
"package.db"

    storePackageDB :: CompilerId -> PackageDB
    storePackageDB :: CompilerId -> PackageDB
storePackageDB CompilerId
compid =
      FilePath -> PackageDB
SpecificPackageDB (CompilerId -> FilePath
storePackageDBPath CompilerId
compid)

    storePackageDBStack :: CompilerId -> PackageDBStack
    storePackageDBStack :: CompilerId -> PackageDBStack
storePackageDBStack CompilerId
compid =
      [PackageDB
GlobalPackageDB, CompilerId -> PackageDB
storePackageDB CompilerId
compid]

    storeIncomingDirectory :: CompilerId -> FilePath
    storeIncomingDirectory :: CompilerId -> FilePath
storeIncomingDirectory CompilerId
compid =
      CompilerId -> FilePath
storeDirectory CompilerId
compid FilePath -> FilePath -> FilePath
</> FilePath
"incoming"

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


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

mkCabalDirLayout :: FilePath -- ^ Cabal directory
                 -> Maybe FilePath -- ^ Store directory. Must be absolute
                 -> Maybe FilePath -- ^ Log directory
                 -> CabalDirLayout
mkCabalDirLayout :: FilePath -> Maybe FilePath -> Maybe FilePath -> CabalDirLayout
mkCabalDirLayout FilePath
cabalDir Maybe FilePath
mstoreDir Maybe FilePath
mlogDir =
    CabalDirLayout :: StoreDirLayout -> FilePath -> CabalDirLayout
CabalDirLayout {FilePath
StoreDirLayout
cabalLogsDirectory :: FilePath
cabalStoreDirLayout :: StoreDirLayout
cabalLogsDirectory :: FilePath
cabalStoreDirLayout :: StoreDirLayout
..}
  where
    cabalStoreDirLayout :: StoreDirLayout
    cabalStoreDirLayout :: StoreDirLayout
cabalStoreDirLayout =
        FilePath -> StoreDirLayout
defaultStoreDirLayout (FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (FilePath
cabalDir FilePath -> FilePath -> FilePath
</> FilePath
"store") Maybe FilePath
mstoreDir)
    cabalLogsDirectory :: FilePath
    cabalLogsDirectory :: FilePath
cabalLogsDirectory = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (FilePath
cabalDir FilePath -> FilePath -> FilePath
</> FilePath
"logs") Maybe FilePath
mlogDir