{-# 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.Client.Config
         ( defaultStoreDir, defaultLogsDir)
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 -> String
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 -> String -> String
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 -> String
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 -> String
distBuildDirectory           :: DistDirParams -> FilePath,
       DistDirLayout -> String
distBuildRootDirectory       :: FilePath,

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

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

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

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

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

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


-- | The layout of a cabal nix-style store.
--
data StoreDirLayout = StoreDirLayout {
       StoreDirLayout -> CompilerId -> String
storeDirectory         :: CompilerId -> FilePath,
       StoreDirLayout -> CompilerId -> UnitId -> String
storePackageDirectory  :: CompilerId -> UnitId -> FilePath,
       StoreDirLayout -> CompilerId -> String
storePackageDBPath     :: CompilerId -> FilePath,
       StoreDirLayout -> CompilerId -> PackageDB
storePackageDB         :: CompilerId -> PackageDB,
       StoreDirLayout -> CompilerId -> PackageDBStack
storePackageDBStack    :: CompilerId -> PackageDBStack,
       StoreDirLayout -> CompilerId -> String
storeIncomingDirectory :: CompilerId -> FilePath,
       StoreDirLayout -> CompilerId -> UnitId -> String
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 -> String
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
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 -> String -> String
[ProjectRoot] -> String -> String
ProjectRoot -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ProjectRoot] -> String -> String
$cshowList :: [ProjectRoot] -> String -> String
show :: ProjectRoot -> String
$cshow :: ProjectRoot -> String
showsPrec :: Int -> ProjectRoot -> String -> String
$cshowsPrec :: Int -> ProjectRoot -> String -> String
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 String -> DistDirLayout
defaultDistDirLayout ProjectRoot
projectRoot Maybe String
mdistDirectory =
    DistDirLayout {String
String -> String
PackageId -> String
CompilerId -> PackageDB
DistDirParams -> String
DistDirParams -> String -> String
distPackageDB :: CompilerId -> PackageDB
distBinDirectory :: String
distTempDirectory :: String
distSdistDirectory :: String
distSdistFile :: PackageId -> String
distPackageCacheFile :: DistDirParams -> String -> String
distPackageCacheDirectory :: DistDirParams -> String
distProjectCacheFile :: String -> String
distProjectCacheDirectory :: String
distDownloadSrcDirectory :: String
distUnpackedSrcDirectory :: PackageId -> String
distUnpackedSrcRootDirectory :: String
distBuildDirectory :: DistDirParams -> String
distBuildRootDirectory :: String
distDirectory :: String
distProjectFile :: String -> String
distProjectRootDirectory :: String
distPackageDB :: CompilerId -> PackageDB
distBinDirectory :: String
distTempDirectory :: String
distSdistDirectory :: String
distSdistFile :: PackageId -> String
distPackageCacheDirectory :: DistDirParams -> String
distPackageCacheFile :: DistDirParams -> String -> String
distProjectCacheDirectory :: String
distProjectCacheFile :: String -> String
distUnpackedSrcRootDirectory :: String
distUnpackedSrcDirectory :: PackageId -> String
distDownloadSrcDirectory :: String
distBuildRootDirectory :: String
distBuildDirectory :: DistDirParams -> String
distDirectory :: String
distProjectFile :: String -> String
distProjectRootDirectory :: String
..}
  where
    (String
projectRootDir, String
projectFile) = case ProjectRoot
projectRoot of
      ProjectRootImplicit String
dir      -> (String
dir, String
dir String -> String -> String
</> String
"cabal.project")
      ProjectRootExplicit String
dir String
file -> (String
dir, String
dir String -> String -> String
</> String
file)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    distPackageDB :: CompilerId -> PackageDB
    distPackageDB :: CompilerId -> PackageDB
distPackageDB = String -> PackageDB
SpecificPackageDB forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerId -> String
distPackageDBPath


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

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

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

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

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

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

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


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

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