DistDirLayout.hs 9.95 KB
Newer Older
Duncan Coutts's avatar
Duncan Coutts committed
1 2
{-# LANGUAGE RecordWildCards #-}

3
-- |
Duncan Coutts's avatar
Duncan Coutts committed
4
--
5
-- The layout of the .\/dist\/ directory where cabal keeps all of its state
Duncan Coutts's avatar
Duncan Coutts committed
6 7
-- and build artifacts.
--
8
module Distribution.Client.DistDirLayout (
9
    -- * 'DistDirLayout'
10 11 12
    DistDirLayout(..),
    DistDirParams(..),
    defaultDistDirLayout,
13
    ProjectRoot(..),
14

15 16 17 18
    -- * 'StoreDirLayout'
    StoreDirLayout(..),
    defaultStoreDirLayout,

19 20
    -- * 'CabalDirLayout'
    CabalDirLayout(..),
21 22
    mkCabalDirLayout,
    defaultCabalDirLayout
23
) where
Duncan Coutts's avatar
Duncan Coutts committed
24

25 26 27
import Distribution.Client.Compat.Prelude
import Prelude ()

Duncan Coutts's avatar
Duncan Coutts committed
28
import System.FilePath
29

Duncan Coutts's avatar
Duncan Coutts committed
30
import Distribution.Package
31
         ( PackageId, ComponentId, UnitId )
Duncan Coutts's avatar
Duncan Coutts committed
32
import Distribution.Compiler
33 34
import Distribution.Simple.Compiler
         ( PackageDB(..), PackageDBStack, OptimisationLevel(..) )
35
import Distribution.Types.ComponentName
36
import Distribution.Types.LibraryName
37
import Distribution.System
38

Duncan Coutts's avatar
Duncan Coutts committed
39

40 41 42 43 44 45 46 47
-- | 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 {
    distParamUnitId         :: UnitId,
    distParamPackageId      :: PackageId,
48
    distParamComponentId    :: ComponentId,
49 50
    distParamComponentName  :: Maybe ComponentName,
    distParamCompilerId     :: CompilerId,
51 52
    distParamPlatform       :: Platform,
    distParamOptimization   :: OptimisationLevel
53 54 55 56
    -- TODO (see #3343):
    --  Flag assignments
    --  Optimization
    }
Duncan Coutts's avatar
Duncan Coutts committed
57 58 59 60 61 62 63


-- | The layout of the project state directory. Traditionally this has been
-- called the @dist@ directory.
--
data DistDirLayout = DistDirLayout {

64 65 66 67 68 69 70 71 72 73 74 75 76
       -- | The root directory of the project. Many other files are relative to
       -- this location. In particular, the @cabal.project@ lives here.
       --
       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.
       --
       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.
Duncan Coutts's avatar
Duncan Coutts committed
77 78 79 80 81 82
       --
       distDirectory                :: FilePath,

       -- | The directory under dist where we keep the build artifacts for a
       -- package we're building from a local directory.
       --
83
       -- This uses a 'UnitId' not just a 'PackageName' because technically
Duncan Coutts's avatar
Duncan Coutts committed
84 85 86
       -- we can have multiple instances of the same package in a solution
       -- (e.g. setup deps).
       --
87
       distBuildDirectory           :: DistDirParams -> FilePath,
Duncan Coutts's avatar
Duncan Coutts committed
88 89
       distBuildRootDirectory       :: FilePath,

90 91 92 93 94
       -- | The directory under dist where we download tarballs and source
       -- control repos to.
       --
       distDownloadSrcDirectory     :: FilePath,

Duncan Coutts's avatar
Duncan Coutts committed
95 96
       -- | The directory under dist where we put the unpacked sources of
       -- packages, in those cases where it makes sense to keep the build
97
       -- artifacts to reduce rebuild times.
Duncan Coutts's avatar
Duncan Coutts committed
98 99 100 101 102 103 104 105 106 107 108 109 110
       --
       distUnpackedSrcDirectory     :: PackageId -> FilePath,
       distUnpackedSrcRootDirectory :: FilePath,

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

       -- | The location for package-specific cache files (e.g. state used in
       -- incremental rebuilds).
       --
111 112
       distPackageCacheFile         :: DistDirParams -> String -> FilePath,
       distPackageCacheDirectory    :: DistDirParams -> FilePath,
Duncan Coutts's avatar
Duncan Coutts committed
113

Alexis Williams's avatar
Alexis Williams committed
114
       -- | The location that sdists are placed by default.
115
       distSdistFile                :: PackageId -> FilePath,
Alexis Williams's avatar
Alexis Williams committed
116 117
       distSdistDirectory           :: FilePath,

Duncan Coutts's avatar
Duncan Coutts committed
118 119 120 121 122 123 124
       distTempDirectory            :: FilePath,
       distBinDirectory             :: FilePath,

       distPackageDB                :: CompilerId -> PackageDB
     }


125 126 127 128 129 130 131
-- | The layout of a cabal nix-style store.
--
data StoreDirLayout = StoreDirLayout {
       storeDirectory         :: CompilerId -> FilePath,
       storePackageDirectory  :: CompilerId -> UnitId -> FilePath,
       storePackageDBPath     :: CompilerId -> FilePath,
       storePackageDB         :: CompilerId -> PackageDB,
132 133 134
       storePackageDBStack    :: CompilerId -> PackageDBStack,
       storeIncomingDirectory :: CompilerId -> FilePath,
       storeIncomingLock      :: CompilerId -> UnitId -> FilePath
135 136
     }

Duncan Coutts's avatar
Duncan Coutts committed
137 138

--TODO: move to another module, e.g. CabalDirLayout?
139 140 141 142 143 144 145 146
-- 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.
--
Duncan Coutts's avatar
Duncan Coutts committed
147
data CabalDirLayout = CabalDirLayout {
148
       cabalStoreDirLayout        :: StoreDirLayout,
Duncan Coutts's avatar
Duncan Coutts committed
149 150 151 152 153

       cabalLogsDirectory         :: FilePath,
       cabalWorldFile             :: FilePath
     }

154 155 156

-- | Information about the root directory of the project.
--
Brian Wignall's avatar
Brian Wignall committed
157
-- It can either be an implicit project root in the current dir if no
158 159 160
-- @cabal.project@ file is found, or an explicit root if the file is found.
--
data ProjectRoot =
Brian Wignall's avatar
Brian Wignall committed
161
       -- | -- ^ An implicit project root. It contains the absolute project
162 163 164 165
       -- root dir.
       ProjectRootImplicit FilePath

       -- | -- ^ An explicit project root. It contains the absolute project
166
       -- root dir and the relative @cabal.project@ file (or explicit override)
167
     | ProjectRootExplicit FilePath FilePath
168
  deriving (Eq, Show)
169

170 171 172 173
-- | 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.
--
174
defaultDistDirLayout :: ProjectRoot    -- ^ the project root
175 176 177
                     -> Maybe FilePath -- ^ the @dist@ directory or default
                                       -- (absolute or relative to the root)
                     -> DistDirLayout
178
defaultDistDirLayout projectRoot mdistDirectory =
Duncan Coutts's avatar
Duncan Coutts committed
179 180
    DistDirLayout {..}
  where
181 182
    (projectRootDir, projectFile) = case projectRoot of
      ProjectRootImplicit dir      -> (dir, dir </> "cabal.project")
183
      ProjectRootExplicit dir file -> (dir, dir </> file)
184

185
    distProjectRootDirectory = projectRootDir
186
    distProjectFile ext      = projectFile <.> ext
187

188 189
    distDirectory = distProjectRootDirectory
                </> fromMaybe "dist-newstyle" mdistDirectory
Duncan Coutts's avatar
Duncan Coutts committed
190 191 192
    --TODO: switch to just dist at some point, or some other new name

    distBuildRootDirectory   = distDirectory </> "build"
193 194
    distBuildDirectory params =
        distBuildRootDirectory </>
Oleg Grenrus's avatar
Oleg Grenrus committed
195 196 197
        prettyShow (distParamPlatform params) </>
        prettyShow (distParamCompilerId params) </>
        prettyShow (distParamPackageId params) </>
198 199
        (case distParamComponentName params of
            Nothing                  -> ""
200
            Just (CLibName LMainLibName) -> ""
Oleg Grenrus's avatar
Oleg Grenrus committed
201 202 203 204 205
            Just (CLibName (LSubLibName name)) -> "l" </> prettyShow name
            Just (CFLibName name)    -> "f" </> prettyShow name
            Just (CExeName name)     -> "x" </> prettyShow name
            Just (CTestName name)    -> "t" </> prettyShow name
            Just (CBenchName name)   -> "b" </> prettyShow name) </>
206 207 208 209
        (case distParamOptimization params of
            NoOptimisation -> "noopt"
            NormalOptimisation -> ""
            MaximumOptimisation -> "opt") </>
Oleg Grenrus's avatar
Oleg Grenrus committed
210 211
        (let uid_str = prettyShow (distParamUnitId params)
         in if uid_str == prettyShow (distParamComponentId params)
212 213
                then ""
                else uid_str)
Duncan Coutts's avatar
Duncan Coutts committed
214 215 216

    distUnpackedSrcRootDirectory   = distDirectory </> "src"
    distUnpackedSrcDirectory pkgid = distUnpackedSrcRootDirectory
Oleg Grenrus's avatar
Oleg Grenrus committed
217
                                      </> prettyShow pkgid
218 219
    -- we shouldn't get name clashes so this should be fine:
    distDownloadSrcDirectory       = distUnpackedSrcRootDirectory
Duncan Coutts's avatar
Duncan Coutts committed
220 221 222 223

    distProjectCacheDirectory = distDirectory </> "cache"
    distProjectCacheFile name = distProjectCacheDirectory </> name

224 225
    distPackageCacheDirectory params = distBuildDirectory params </> "cache"
    distPackageCacheFile params name = distPackageCacheDirectory params </> name
Duncan Coutts's avatar
Duncan Coutts committed
226

227
    distSdistFile pid = distSdistDirectory </> prettyShow pid <.> "tar.gz"
228

Alexis Williams's avatar
Alexis Williams committed
229 230
    distSdistDirectory = distDirectory </> "sdist"

Duncan Coutts's avatar
Duncan Coutts committed
231 232 233 234
    distTempDirectory = distDirectory </> "tmp"

    distBinDirectory = distDirectory </> "bin"

Oleg Grenrus's avatar
Oleg Grenrus committed
235
    distPackageDBPath compid = distDirectory </> "packagedb" </> prettyShow compid
Duncan Coutts's avatar
Duncan Coutts committed
236 237 238
    distPackageDB = SpecificPackageDB . distPackageDBPath


239 240 241 242 243
defaultStoreDirLayout :: FilePath -> StoreDirLayout
defaultStoreDirLayout storeRoot =
    StoreDirLayout {..}
  where
    storeDirectory compid =
Oleg Grenrus's avatar
Oleg Grenrus committed
244
      storeRoot </> prettyShow compid
245 246

    storePackageDirectory compid ipkgid =
Oleg Grenrus's avatar
Oleg Grenrus committed
247
      storeDirectory compid </> prettyShow ipkgid
248 249 250 251 252 253 254 255 256 257

    storePackageDBPath compid =
      storeDirectory compid </> "package.db"

    storePackageDB compid =
      SpecificPackageDB (storePackageDBPath compid)

    storePackageDBStack compid =
      [GlobalPackageDB, storePackageDB compid]

258 259 260 261
    storeIncomingDirectory compid =
      storeDirectory compid </> "incoming"

    storeIncomingLock compid unitid =
Oleg Grenrus's avatar
Oleg Grenrus committed
262
      storeIncomingDirectory compid </> prettyShow unitid <.> "lock"
263

Duncan Coutts's avatar
Duncan Coutts committed
264 265 266

defaultCabalDirLayout :: FilePath -> CabalDirLayout
defaultCabalDirLayout cabalDir =
267 268 269
    mkCabalDirLayout cabalDir Nothing Nothing

mkCabalDirLayout :: FilePath -- ^ Cabal directory
270
                 -> Maybe FilePath -- ^ Store directory. Must be absolute
271 272 273
                 -> Maybe FilePath -- ^ Log directory
                 -> CabalDirLayout
mkCabalDirLayout cabalDir mstoreDir mlogDir =
Duncan Coutts's avatar
Duncan Coutts committed
274 275
    CabalDirLayout {..}
  where
276 277 278
    cabalStoreDirLayout =
        defaultStoreDirLayout (fromMaybe (cabalDir </> "store") mstoreDir)
    cabalLogsDirectory = fromMaybe (cabalDir </> "logs") mlogDir
279
    cabalWorldFile = cabalDir </> "world"