1{-# LANGUAGE FlexibleContexts #-} 2{-# LANGUAGE RankNTypes #-} 3 4----------------------------------------------------------------------------- 5-- | 6-- Module : Distribution.Simple.Install 7-- Copyright : Isaac Jones 2003-2004 8-- License : BSD3 9-- 10-- Maintainer : cabal-devel@haskell.org 11-- Portability : portable 12-- 13-- This is the entry point into installing a built package. Performs the 14-- \"@.\/setup install@\" and \"@.\/setup copy@\" actions. It moves files into 15-- place based on the prefix argument. It does the generic bits and then calls 16-- compiler-specific functions to do the rest. 17 18module Distribution.Simple.Install ( 19 install, 20 ) where 21 22import Prelude () 23import Distribution.Compat.Prelude 24 25import Distribution.Types.TargetInfo 26import Distribution.Types.LocalBuildInfo 27import Distribution.Types.ForeignLib 28import Distribution.Types.PackageDescription 29import Distribution.Types.UnqualComponentName 30import Distribution.Types.ExecutableScope 31 32import Distribution.Package 33import Distribution.PackageDescription 34import Distribution.Simple.LocalBuildInfo 35import Distribution.Simple.BuildPaths (haddockName, haddockPref) 36import Distribution.Simple.Glob (matchDirFileGlob) 37import Distribution.Simple.Utils 38 ( createDirectoryIfMissingVerbose 39 , installDirectoryContents, installOrdinaryFile, isInSearchPath 40 , die', info, noticeNoWrap, warn ) 41import Distribution.Simple.Compiler 42 ( CompilerFlavor(..), compilerFlavor ) 43import Distribution.Simple.Setup 44 ( CopyFlags(..), fromFlag, HaddockTarget(ForDevelopment) ) 45import Distribution.Simple.BuildTarget 46import Distribution.Utils.Path (getSymbolicPath) 47 48import qualified Distribution.Simple.GHC as GHC 49import qualified Distribution.Simple.GHCJS as GHCJS 50import qualified Distribution.Simple.UHC as UHC 51import qualified Distribution.Simple.HaskellSuite as HaskellSuite 52import Distribution.Compat.Graph (IsNode(..)) 53 54import System.Directory 55 ( doesDirectoryExist, doesFileExist ) 56import System.FilePath 57 ( takeFileName, takeDirectory, (</>), isRelative ) 58 59import Distribution.Verbosity 60import Distribution.Pretty 61 ( prettyShow ) 62 63-- |Perform the \"@.\/setup install@\" and \"@.\/setup copy@\" 64-- actions. Move files into place based on the prefix argument. 65-- 66-- This does NOT register libraries, you should call 'register' 67-- to do that. 68 69install :: PackageDescription -- ^information from the .cabal file 70 -> LocalBuildInfo -- ^information from the configure step 71 -> CopyFlags -- ^flags sent to copy or install 72 -> IO () 73install pkg_descr lbi flags = do 74 checkHasLibsOrExes 75 targets <- readTargetInfos verbosity pkg_descr lbi (copyArgs flags) 76 77 copyPackage verbosity pkg_descr lbi distPref copydest 78 79 -- It's not necessary to do these in build-order, but it's harmless 80 withNeededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets) $ \target -> 81 let comp = targetComponent target 82 clbi = targetCLBI target 83 in copyComponent verbosity pkg_descr lbi comp clbi copydest 84 where 85 distPref = fromFlag (copyDistPref flags) 86 verbosity = fromFlag (copyVerbosity flags) 87 copydest = fromFlag (copyDest flags) 88 89 checkHasLibsOrExes = 90 unless (hasLibs pkg_descr || hasForeignLibs pkg_descr || hasExes pkg_descr) $ 91 die' verbosity "No executables and no library found. Nothing to do." 92 93-- | Copy package global files. 94copyPackage :: Verbosity -> PackageDescription 95 -> LocalBuildInfo -> FilePath -> CopyDest -> IO () 96copyPackage verbosity pkg_descr lbi distPref copydest = do 97 let -- This is a bit of a hack, to handle files which are not 98 -- per-component (data files and Haddock files.) 99 InstallDirs { 100 datadir = dataPref, 101 docdir = docPref, 102 htmldir = htmlPref, 103 haddockdir = interfacePref 104 } = absoluteInstallCommandDirs pkg_descr lbi (localUnitId lbi) copydest 105 106 -- Install (package-global) data files 107 installDataFiles verbosity pkg_descr dataPref 108 109 -- Install (package-global) Haddock files 110 -- TODO: these should be done per-library 111 docExists <- doesDirectoryExist $ haddockPref ForDevelopment distPref pkg_descr 112 info verbosity ("directory " ++ haddockPref ForDevelopment distPref pkg_descr ++ 113 " does exist: " ++ show docExists) 114 115 -- TODO: this is a bit questionable, Haddock files really should 116 -- be per library (when there are convenience libraries.) 117 when docExists $ do 118 createDirectoryIfMissingVerbose verbosity True htmlPref 119 installDirectoryContents verbosity 120 (haddockPref ForDevelopment distPref pkg_descr) htmlPref 121 -- setPermissionsRecursive [Read] htmlPref 122 -- The haddock interface file actually already got installed 123 -- in the recursive copy, but now we install it where we actually 124 -- want it to be (normally the same place). We could remove the 125 -- copy in htmlPref first. 126 let haddockInterfaceFileSrc = haddockPref ForDevelopment distPref pkg_descr 127 </> haddockName pkg_descr 128 haddockInterfaceFileDest = interfacePref </> haddockName pkg_descr 129 -- We only generate the haddock interface file for libs, So if the 130 -- package consists only of executables there will not be one: 131 exists <- doesFileExist haddockInterfaceFileSrc 132 when exists $ do 133 createDirectoryIfMissingVerbose verbosity True interfacePref 134 installOrdinaryFile verbosity haddockInterfaceFileSrc 135 haddockInterfaceFileDest 136 137 let lfiles = licenseFiles pkg_descr 138 unless (null lfiles) $ do 139 createDirectoryIfMissingVerbose verbosity True docPref 140 for_ lfiles $ \lfile' -> do 141 let lfile :: FilePath 142 lfile = getSymbolicPath lfile' 143 installOrdinaryFile verbosity lfile (docPref </> takeFileName lfile) 144 145-- | Copy files associated with a component. 146copyComponent :: Verbosity -> PackageDescription 147 -> LocalBuildInfo -> Component -> ComponentLocalBuildInfo 148 -> CopyDest 149 -> IO () 150copyComponent verbosity pkg_descr lbi (CLib lib) clbi copydest = do 151 let InstallDirs{ 152 libdir = libPref, 153 dynlibdir = dynlibPref, 154 includedir = incPref 155 } = absoluteInstallCommandDirs pkg_descr lbi (componentUnitId clbi) copydest 156 buildPref = componentBuildDir lbi clbi 157 158 case libName lib of 159 LMainLibName -> noticeNoWrap verbosity ("Installing library in " ++ libPref) 160 LSubLibName n -> noticeNoWrap verbosity ("Installing internal library " ++ prettyShow n ++ " in " ++ libPref) 161 162 -- install include files for all compilers - they may be needed to compile 163 -- haskell files (using the CPP extension) 164 installIncludeFiles verbosity (libBuildInfo lib) lbi buildPref incPref 165 166 case compilerFlavor (compiler lbi) of 167 GHC -> GHC.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr lib clbi 168 GHCJS -> GHCJS.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr lib clbi 169 UHC -> UHC.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr lib clbi 170 HaskellSuite _ -> HaskellSuite.installLib 171 verbosity lbi libPref dynlibPref buildPref pkg_descr lib clbi 172 _ -> die' verbosity $ "installing with " 173 ++ prettyShow (compilerFlavor (compiler lbi)) 174 ++ " is not implemented" 175 176copyComponent verbosity pkg_descr lbi (CFLib flib) clbi copydest = do 177 let InstallDirs{ 178 flibdir = flibPref, 179 includedir = incPref 180 } = absoluteComponentInstallDirs pkg_descr lbi (componentUnitId clbi) copydest 181 buildPref = componentBuildDir lbi clbi 182 183 noticeNoWrap verbosity ("Installing foreign library " ++ unUnqualComponentName (foreignLibName flib) ++ " in " ++ flibPref) 184 installIncludeFiles verbosity (foreignLibBuildInfo flib) lbi buildPref incPref 185 186 case compilerFlavor (compiler lbi) of 187 GHC -> GHC.installFLib verbosity lbi flibPref buildPref pkg_descr flib 188 GHCJS -> GHCJS.installFLib verbosity lbi flibPref buildPref pkg_descr flib 189 _ -> die' verbosity $ "installing foreign lib with " 190 ++ prettyShow (compilerFlavor (compiler lbi)) 191 ++ " is not implemented" 192 193copyComponent verbosity pkg_descr lbi (CExe exe) clbi copydest = do 194 let installDirs = absoluteComponentInstallDirs pkg_descr lbi (componentUnitId clbi) copydest 195 -- the installers know how to find the actual location of the 196 -- binaries 197 buildPref = buildDir lbi 198 uid = componentUnitId clbi 199 pkgid = packageId pkg_descr 200 binPref | ExecutablePrivate <- exeScope exe = libexecdir installDirs 201 | otherwise = bindir installDirs 202 progPrefixPref = substPathTemplate pkgid lbi uid (progPrefix lbi) 203 progSuffixPref = substPathTemplate pkgid lbi uid (progSuffix lbi) 204 progFix = (progPrefixPref, progSuffixPref) 205 noticeNoWrap verbosity ("Installing executable " ++ prettyShow (exeName exe) 206 ++ " in " ++ binPref) 207 inPath <- isInSearchPath binPref 208 when (not inPath) $ 209 warn verbosity ("The directory " ++ binPref 210 ++ " is not in the system search path.") 211 case compilerFlavor (compiler lbi) of 212 GHC -> GHC.installExe verbosity lbi binPref buildPref progFix pkg_descr exe 213 GHCJS -> GHCJS.installExe verbosity lbi binPref buildPref progFix pkg_descr exe 214 UHC -> return () 215 HaskellSuite {} -> return () 216 _ -> die' verbosity $ "installing with " 217 ++ prettyShow (compilerFlavor (compiler lbi)) 218 ++ " is not implemented" 219 220-- Nothing to do for benchmark/testsuite 221copyComponent _ _ _ (CBench _) _ _ = return () 222copyComponent _ _ _ (CTest _) _ _ = return () 223 224-- | Install the files listed in data-files 225-- 226installDataFiles :: Verbosity -> PackageDescription -> FilePath -> IO () 227installDataFiles verbosity pkg_descr destDataDir = 228 flip traverse_ (dataFiles pkg_descr) $ \ glob -> do 229 let srcDataDirRaw = dataDir pkg_descr 230 srcDataDir = if null srcDataDirRaw 231 then "." 232 else srcDataDirRaw 233 files <- matchDirFileGlob verbosity (specVersion pkg_descr) srcDataDir glob 234 for_ files $ \ file' -> do 235 let src = srcDataDir </> file' 236 dst = destDataDir </> file' 237 createDirectoryIfMissingVerbose verbosity True (takeDirectory dst) 238 installOrdinaryFile verbosity src dst 239 240-- | Install the files listed in install-includes for a library 241-- 242installIncludeFiles :: Verbosity -> BuildInfo -> LocalBuildInfo -> FilePath -> FilePath -> IO () 243installIncludeFiles verbosity libBi lbi buildPref destIncludeDir = do 244 let relincdirs = "." : filter isRelative (includeDirs libBi) 245 incdirs = [ baseDir lbi </> dir | dir <- relincdirs ] 246 ++ [ buildPref </> dir | dir <- relincdirs ] 247 incs <- traverse (findInc incdirs) (installIncludes libBi) 248 sequence_ 249 [ do createDirectoryIfMissingVerbose verbosity True destDir 250 installOrdinaryFile verbosity srcFile destFile 251 | (relFile, srcFile) <- incs 252 , let destFile = destIncludeDir </> relFile 253 destDir = takeDirectory destFile ] 254 where 255 baseDir lbi' = fromMaybe "" (takeDirectory <$> cabalFilePath lbi') 256 findInc [] file = die' verbosity ("can't find include file " ++ file) 257 findInc (dir:dirs) file = do 258 let path = dir </> file 259 exists <- doesFileExist path 260 if exists then return (file, path) else findInc dirs file 261