1{-# LANGUAGE CPP #-} 2{-# LANGUAGE DeriveFunctor #-} 3{-# LANGUAGE DeriveGeneric #-} 4{-# LANGUAGE FlexibleContexts #-} 5{-# LANGUAGE RankNTypes #-} 6 7----------------------------------------------------------------------------- 8-- | 9-- Module : Distribution.Simple.InstallDirs 10-- Copyright : Isaac Jones 2003-2004 11-- License : BSD3 12-- 13-- Maintainer : cabal-devel@haskell.org 14-- Portability : portable 15-- 16-- This manages everything to do with where files get installed (though does 17-- not get involved with actually doing any installation). It provides an 18-- 'InstallDirs' type which is a set of directories for where to install 19-- things. It also handles the fact that we use templates in these install 20-- dirs. For example most install dirs are relative to some @$prefix@ and by 21-- changing the prefix all other dirs still end up changed appropriately. So it 22-- provides a 'PathTemplate' type and functions for substituting for these 23-- templates. 24 25module Distribution.Simple.InstallDirs ( 26 InstallDirs(..), 27 InstallDirTemplates, 28 defaultInstallDirs, 29 defaultInstallDirs', 30 combineInstallDirs, 31 absoluteInstallDirs, 32 CopyDest(..), 33 prefixRelativeInstallDirs, 34 substituteInstallDirTemplates, 35 36 PathTemplate, 37 PathTemplateVariable(..), 38 PathTemplateEnv, 39 toPathTemplate, 40 fromPathTemplate, 41 combinePathTemplate, 42 substPathTemplate, 43 initialPathTemplateEnv, 44 platformTemplateEnv, 45 compilerTemplateEnv, 46 packageTemplateEnv, 47 abiTemplateEnv, 48 installDirsTemplateEnv, 49 ) where 50 51import Prelude () 52import Distribution.Compat.Prelude 53 54import Distribution.Compat.Environment (lookupEnv) 55import Distribution.Pretty 56import Distribution.Package 57import Distribution.System 58import Distribution.Compiler 59import Distribution.Simple.InstallDirs.Internal 60 61import System.Directory (getAppUserDataDirectory) 62import System.FilePath 63 ( (</>), isPathSeparator 64 , pathSeparator, dropDrive 65 , takeDirectory ) 66 67#ifdef mingw32_HOST_OS 68import qualified Prelude 69import Foreign 70import Foreign.C 71#endif 72 73-- --------------------------------------------------------------------------- 74-- Installation directories 75 76 77-- | The directories where we will install files for packages. 78-- 79-- We have several different directories for different types of files since 80-- many systems have conventions whereby different types of files in a package 81-- are installed in different directories. This is particularly the case on 82-- Unix style systems. 83-- 84data InstallDirs dir = InstallDirs { 85 prefix :: dir, 86 bindir :: dir, 87 libdir :: dir, 88 libsubdir :: dir, 89 dynlibdir :: dir, 90 flibdir :: dir, -- ^ foreign libraries 91 libexecdir :: dir, 92 libexecsubdir:: dir, 93 includedir :: dir, 94 datadir :: dir, 95 datasubdir :: dir, 96 docdir :: dir, 97 mandir :: dir, 98 htmldir :: dir, 99 haddockdir :: dir, 100 sysconfdir :: dir 101 } deriving (Eq, Read, Show, Functor, Generic) 102 103instance Binary dir => Binary (InstallDirs dir) 104 105instance (Semigroup dir, Monoid dir) => Monoid (InstallDirs dir) where 106 mempty = gmempty 107 mappend = (<>) 108 109instance Semigroup dir => Semigroup (InstallDirs dir) where 110 (<>) = gmappend 111 112combineInstallDirs :: (a -> b -> c) 113 -> InstallDirs a 114 -> InstallDirs b 115 -> InstallDirs c 116combineInstallDirs combine a b = InstallDirs { 117 prefix = prefix a `combine` prefix b, 118 bindir = bindir a `combine` bindir b, 119 libdir = libdir a `combine` libdir b, 120 libsubdir = libsubdir a `combine` libsubdir b, 121 dynlibdir = dynlibdir a `combine` dynlibdir b, 122 flibdir = flibdir a `combine` flibdir b, 123 libexecdir = libexecdir a `combine` libexecdir b, 124 libexecsubdir= libexecsubdir a `combine` libexecsubdir b, 125 includedir = includedir a `combine` includedir b, 126 datadir = datadir a `combine` datadir b, 127 datasubdir = datasubdir a `combine` datasubdir b, 128 docdir = docdir a `combine` docdir b, 129 mandir = mandir a `combine` mandir b, 130 htmldir = htmldir a `combine` htmldir b, 131 haddockdir = haddockdir a `combine` haddockdir b, 132 sysconfdir = sysconfdir a `combine` sysconfdir b 133 } 134 135appendSubdirs :: (a -> a -> a) -> InstallDirs a -> InstallDirs a 136appendSubdirs append dirs = dirs { 137 libdir = libdir dirs `append` libsubdir dirs, 138 libexecdir = libexecdir dirs `append` libexecsubdir dirs, 139 datadir = datadir dirs `append` datasubdir dirs, 140 libsubdir = error "internal error InstallDirs.libsubdir", 141 libexecsubdir = error "internal error InstallDirs.libexecsubdir", 142 datasubdir = error "internal error InstallDirs.datasubdir" 143 } 144 145-- | The installation directories in terms of 'PathTemplate's that contain 146-- variables. 147-- 148-- The defaults for most of the directories are relative to each other, in 149-- particular they are all relative to a single prefix. This makes it 150-- convenient for the user to override the default installation directory 151-- by only having to specify --prefix=... rather than overriding each 152-- individually. This is done by allowing $-style variables in the dirs. 153-- These are expanded by textual substitution (see 'substPathTemplate'). 154-- 155-- A few of these installation directories are split into two components, the 156-- dir and subdir. The full installation path is formed by combining the two 157-- together with @\/@. The reason for this is compatibility with other Unix 158-- build systems which also support @--libdir@ and @--datadir@. We would like 159-- users to be able to configure @--libdir=\/usr\/lib64@ for example but 160-- because by default we want to support installing multiple versions of 161-- packages and building the same package for multiple compilers we append the 162-- libsubdir to get: @\/usr\/lib64\/$libname\/$compiler@. 163-- 164-- An additional complication is the need to support relocatable packages on 165-- systems which support such things, like Windows. 166-- 167type InstallDirTemplates = InstallDirs PathTemplate 168 169-- --------------------------------------------------------------------------- 170-- Default installation directories 171 172defaultInstallDirs :: CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates 173defaultInstallDirs = defaultInstallDirs' False 174 175defaultInstallDirs' :: Bool {- use external internal deps -} 176 -> CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates 177defaultInstallDirs' True comp userInstall hasLibs = do 178 dflt <- defaultInstallDirs' False comp userInstall hasLibs 179 -- Be a bit more hermetic about per-component installs 180 return dflt { datasubdir = toPathTemplate $ "$abi" </> "$libname", 181 docdir = toPathTemplate $ "$datadir" </> "doc" </> "$abi" </> "$libname" 182 } 183defaultInstallDirs' False comp userInstall _hasLibs = do 184 installPrefix <- 185 if userInstall 186 then do 187 mDir <- lookupEnv "CABAL_DIR" 188 case mDir of 189 Nothing -> getAppUserDataDirectory "cabal" 190 Just dir -> return dir 191 else case buildOS of 192 Windows -> do windowsProgramFilesDir <- getWindowsProgramFilesDir 193 return (windowsProgramFilesDir </> "Haskell") 194 _ -> return "/usr/local" 195 installLibDir <- 196 case buildOS of 197 Windows -> return "$prefix" 198 _ -> return ("$prefix" </> "lib") 199 return $ fmap toPathTemplate $ InstallDirs { 200 prefix = installPrefix, 201 bindir = "$prefix" </> "bin", 202 libdir = installLibDir, 203 libsubdir = case comp of 204 UHC -> "$pkgid" 205 _other -> "$abi" </> "$libname", 206 dynlibdir = "$libdir" </> case comp of 207 UHC -> "$pkgid" 208 _other -> "$abi", 209 libexecsubdir= "$abi" </> "$pkgid", 210 flibdir = "$libdir", 211 libexecdir = case buildOS of 212 Windows -> "$prefix" </> "$libname" 213 _other -> "$prefix" </> "libexec", 214 includedir = "$libdir" </> "$libsubdir" </> "include", 215 datadir = case buildOS of 216 Windows -> "$prefix" 217 _other -> "$prefix" </> "share", 218 datasubdir = "$abi" </> "$pkgid", 219 docdir = "$datadir" </> "doc" </> "$abi" </> "$pkgid", 220 mandir = "$datadir" </> "man", 221 htmldir = "$docdir" </> "html", 222 haddockdir = "$htmldir", 223 sysconfdir = "$prefix" </> "etc" 224 } 225 226-- --------------------------------------------------------------------------- 227-- Converting directories, absolute or prefix-relative 228 229-- | Substitute the install dir templates into each other. 230-- 231-- To prevent cyclic substitutions, only some variables are allowed in 232-- particular dir templates. If out of scope vars are present, they are not 233-- substituted for. Checking for any remaining unsubstituted vars can be done 234-- as a subsequent operation. 235-- 236-- The reason it is done this way is so that in 'prefixRelativeInstallDirs' we 237-- can replace 'prefix' with the 'PrefixVar' and get resulting 238-- 'PathTemplate's that still have the 'PrefixVar' in them. Doing this makes it 239-- each to check which paths are relative to the $prefix. 240-- 241substituteInstallDirTemplates :: PathTemplateEnv 242 -> InstallDirTemplates -> InstallDirTemplates 243substituteInstallDirTemplates env dirs = dirs' 244 where 245 dirs' = InstallDirs { 246 -- So this specifies exactly which vars are allowed in each template 247 prefix = subst prefix [], 248 bindir = subst bindir [prefixVar], 249 libdir = subst libdir [prefixVar, bindirVar], 250 libsubdir = subst libsubdir [], 251 dynlibdir = subst dynlibdir [prefixVar, bindirVar, libdirVar], 252 flibdir = subst flibdir [prefixVar, bindirVar, libdirVar], 253 libexecdir = subst libexecdir prefixBinLibVars, 254 libexecsubdir = subst libexecsubdir [], 255 includedir = subst includedir prefixBinLibVars, 256 datadir = subst datadir prefixBinLibVars, 257 datasubdir = subst datasubdir [], 258 docdir = subst docdir prefixBinLibDataVars, 259 mandir = subst mandir (prefixBinLibDataVars ++ [docdirVar]), 260 htmldir = subst htmldir (prefixBinLibDataVars ++ [docdirVar]), 261 haddockdir = subst haddockdir (prefixBinLibDataVars ++ 262 [docdirVar, htmldirVar]), 263 sysconfdir = subst sysconfdir prefixBinLibVars 264 } 265 subst dir env' = substPathTemplate (env'++env) (dir dirs) 266 267 prefixVar = (PrefixVar, prefix dirs') 268 bindirVar = (BindirVar, bindir dirs') 269 libdirVar = (LibdirVar, libdir dirs') 270 libsubdirVar = (LibsubdirVar, libsubdir dirs') 271 datadirVar = (DatadirVar, datadir dirs') 272 datasubdirVar = (DatasubdirVar, datasubdir dirs') 273 docdirVar = (DocdirVar, docdir dirs') 274 htmldirVar = (HtmldirVar, htmldir dirs') 275 prefixBinLibVars = [prefixVar, bindirVar, libdirVar, libsubdirVar] 276 prefixBinLibDataVars = prefixBinLibVars ++ [datadirVar, datasubdirVar] 277 278-- | Convert from abstract install directories to actual absolute ones by 279-- substituting for all the variables in the abstract paths, to get real 280-- absolute path. 281absoluteInstallDirs :: PackageIdentifier 282 -> UnitId 283 -> CompilerInfo 284 -> CopyDest 285 -> Platform 286 -> InstallDirs PathTemplate 287 -> InstallDirs FilePath 288absoluteInstallDirs pkgId libname compilerId copydest platform dirs = 289 (case copydest of 290 CopyTo destdir -> fmap ((destdir </>) . dropDrive) 291 CopyToDb dbdir -> fmap (substPrefix "${pkgroot}" (takeDirectory dbdir)) 292 _ -> id) 293 . appendSubdirs (</>) 294 . fmap fromPathTemplate 295 $ substituteInstallDirTemplates env dirs 296 where 297 env = initialPathTemplateEnv pkgId libname compilerId platform 298 substPrefix pre root path 299 | pre `isPrefixOf` path = root ++ drop (length pre) path 300 | otherwise = path 301 302 303-- |The location prefix for the /copy/ command. 304data CopyDest 305 = NoCopyDest 306 | CopyTo FilePath 307 | CopyToDb FilePath 308 -- ^ when using the ${pkgroot} as prefix. The CopyToDb will 309 -- adjust the paths to be relative to the provided package 310 -- database when copying / installing. 311 deriving (Eq, Show, Generic) 312 313instance Binary CopyDest 314 315-- | Check which of the paths are relative to the installation $prefix. 316-- 317-- If any of the paths are not relative, ie they are absolute paths, then it 318-- prevents us from making a relocatable package (also known as a \"prefix 319-- independent\" package). 320-- 321prefixRelativeInstallDirs :: PackageIdentifier 322 -> UnitId 323 -> CompilerInfo 324 -> Platform 325 -> InstallDirTemplates 326 -> InstallDirs (Maybe FilePath) 327prefixRelativeInstallDirs pkgId libname compilerId platform dirs = 328 fmap relative 329 . appendSubdirs combinePathTemplate 330 $ -- substitute the path template into each other, except that we map 331 -- \$prefix back to $prefix. We're trying to end up with templates that 332 -- mention no vars except $prefix. 333 substituteInstallDirTemplates env dirs { 334 prefix = PathTemplate [Variable PrefixVar] 335 } 336 where 337 env = initialPathTemplateEnv pkgId libname compilerId platform 338 339 -- If it starts with $prefix then it's relative and produce the relative 340 -- path by stripping off $prefix/ or $prefix 341 relative dir = case dir of 342 PathTemplate cs -> fmap (fromPathTemplate . PathTemplate) (relative' cs) 343 relative' (Variable PrefixVar : Ordinary (s:rest) : rest') 344 | isPathSeparator s = Just (Ordinary rest : rest') 345 relative' (Variable PrefixVar : rest) = Just rest 346 relative' _ = Nothing 347 348-- --------------------------------------------------------------------------- 349-- Path templates 350 351-- | An abstract path, possibly containing variables that need to be 352-- substituted for to get a real 'FilePath'. 353-- 354newtype PathTemplate = PathTemplate [PathComponent] 355 deriving (Eq, Ord, Generic) 356 357instance Binary PathTemplate 358 359type PathTemplateEnv = [(PathTemplateVariable, PathTemplate)] 360 361-- | Convert a 'FilePath' to a 'PathTemplate' including any template vars. 362-- 363toPathTemplate :: FilePath -> PathTemplate 364toPathTemplate fp = PathTemplate 365 . fromMaybe (error $ "panic! toPathTemplate " ++ show fp) 366 . readMaybe -- TODO: eradicateNoParse 367 $ fp 368 369-- | Convert back to a path, any remaining vars are included 370-- 371fromPathTemplate :: PathTemplate -> FilePath 372fromPathTemplate (PathTemplate template) = show template 373 374combinePathTemplate :: PathTemplate -> PathTemplate -> PathTemplate 375combinePathTemplate (PathTemplate t1) (PathTemplate t2) = 376 PathTemplate (t1 ++ [Ordinary [pathSeparator]] ++ t2) 377 378substPathTemplate :: PathTemplateEnv -> PathTemplate -> PathTemplate 379substPathTemplate environment (PathTemplate template) = 380 PathTemplate (concatMap subst template) 381 382 where subst component@(Ordinary _) = [component] 383 subst component@(Variable variable) = 384 case lookup variable environment of 385 Just (PathTemplate components) -> components 386 Nothing -> [component] 387 388-- | The initial environment has all the static stuff but no paths 389initialPathTemplateEnv :: PackageIdentifier 390 -> UnitId 391 -> CompilerInfo 392 -> Platform 393 -> PathTemplateEnv 394initialPathTemplateEnv pkgId libname compiler platform = 395 packageTemplateEnv pkgId libname 396 ++ compilerTemplateEnv compiler 397 ++ platformTemplateEnv platform 398 ++ abiTemplateEnv compiler platform 399 400packageTemplateEnv :: PackageIdentifier -> UnitId -> PathTemplateEnv 401packageTemplateEnv pkgId uid = 402 [(PkgNameVar, PathTemplate [Ordinary $ prettyShow (packageName pkgId)]) 403 ,(PkgVerVar, PathTemplate [Ordinary $ prettyShow (packageVersion pkgId)]) 404 -- Invariant: uid is actually a HashedUnitId. Hard to enforce because 405 -- it's an API change. 406 ,(LibNameVar, PathTemplate [Ordinary $ prettyShow uid]) 407 ,(PkgIdVar, PathTemplate [Ordinary $ prettyShow pkgId]) 408 ] 409 410compilerTemplateEnv :: CompilerInfo -> PathTemplateEnv 411compilerTemplateEnv compiler = 412 [(CompilerVar, PathTemplate [Ordinary $ prettyShow (compilerInfoId compiler)]) 413 ] 414 415platformTemplateEnv :: Platform -> PathTemplateEnv 416platformTemplateEnv (Platform arch os) = 417 [(OSVar, PathTemplate [Ordinary $ prettyShow os]) 418 ,(ArchVar, PathTemplate [Ordinary $ prettyShow arch]) 419 ] 420 421abiTemplateEnv :: CompilerInfo -> Platform -> PathTemplateEnv 422abiTemplateEnv compiler (Platform arch os) = 423 [(AbiVar, PathTemplate [Ordinary $ prettyShow arch ++ '-':prettyShow os ++ 424 '-':prettyShow (compilerInfoId compiler) ++ 425 case compilerInfoAbiTag compiler of 426 NoAbiTag -> "" 427 AbiTag tag -> '-':tag]) 428 ,(AbiTagVar, PathTemplate [Ordinary $ abiTagString (compilerInfoAbiTag compiler)]) 429 ] 430 431installDirsTemplateEnv :: InstallDirs PathTemplate -> PathTemplateEnv 432installDirsTemplateEnv dirs = 433 [(PrefixVar, prefix dirs) 434 ,(BindirVar, bindir dirs) 435 ,(LibdirVar, libdir dirs) 436 ,(LibsubdirVar, libsubdir dirs) 437 ,(DynlibdirVar, dynlibdir dirs) 438 ,(DatadirVar, datadir dirs) 439 ,(DatasubdirVar, datasubdir dirs) 440 ,(DocdirVar, docdir dirs) 441 ,(HtmldirVar, htmldir dirs) 442 ] 443 444 445-- --------------------------------------------------------------------------- 446-- Parsing and showing path templates: 447 448-- The textual format is that of an ordinary Haskell String, eg 449-- "$prefix/bin" 450-- and this gets parsed to the internal representation as a sequence of path 451-- spans which are either strings or variables, eg: 452-- PathTemplate [Variable PrefixVar, Ordinary "/bin" ] 453 454instance Show PathTemplate where 455 show (PathTemplate template) = show (show template) 456 457instance Read PathTemplate where 458 readsPrec p s = [ (PathTemplate template, s') 459 | (path, s') <- readsPrec p s 460 , (template, "") <- reads path ] 461 462-- --------------------------------------------------------------------------- 463-- Internal utilities 464 465getWindowsProgramFilesDir :: NoCallStackIO FilePath 466getWindowsProgramFilesDir = do 467#ifdef mingw32_HOST_OS 468 m <- shGetFolderPath csidl_PROGRAM_FILES 469#else 470 let m = Nothing 471#endif 472 return (fromMaybe "C:\\Program Files" m) 473 474#ifdef mingw32_HOST_OS 475shGetFolderPath :: CInt -> NoCallStackIO (Maybe FilePath) 476shGetFolderPath n = 477 allocaArray long_path_size $ \pPath -> do 478 r <- c_SHGetFolderPath nullPtr n nullPtr 0 pPath 479 if (r /= 0) 480 then return Nothing 481 else do s <- peekCWString pPath; return (Just s) 482 where 483 long_path_size = 1024 -- MAX_PATH is 260, this should be plenty 484 485csidl_PROGRAM_FILES :: CInt 486csidl_PROGRAM_FILES = 0x0026 487-- csidl_PROGRAM_FILES_COMMON :: CInt 488-- csidl_PROGRAM_FILES_COMMON = 0x002b 489 490#ifdef x86_64_HOST_ARCH 491#define CALLCONV ccall 492#else 493#define CALLCONV stdcall 494#endif 495 496foreign import CALLCONV unsafe "shlobj.h SHGetFolderPathW" 497 c_SHGetFolderPath :: Ptr () 498 -> CInt 499 -> Ptr () 500 -> CInt 501 -> CWString 502 -> Prelude.IO CInt 503#endif 504