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