1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE RankNTypes #-}
3-----------------------------------------------------------------------------
4-- |
5-- Module      :  Distribution.Simple.BuildPaths
6-- Copyright   :  Isaac Jones 2003-2004,
7--                Duncan Coutts 2008
8-- License     :  BSD3
9--
10-- Maintainer  :  cabal-devel@haskell.org
11-- Portability :  portable
12--
13-- A bunch of dirs, paths and file names used for intermediate build steps.
14--
15
16module Distribution.Simple.BuildPaths (
17    defaultDistPref, srcPref,
18    haddockDirName, hscolourPref, haddockPref,
19    autogenPackageModulesDir,
20    autogenComponentModulesDir,
21
22    autogenPathsModuleName,
23    cppHeaderName,
24    haddockName,
25
26    mkGenericStaticLibName,
27    mkLibName,
28    mkProfLibName,
29    mkGenericSharedLibName,
30    mkSharedLibName,
31    mkStaticLibName,
32    mkGenericSharedBundledLibName,
33
34    exeExtension,
35    objExtension,
36    dllExtension,
37    staticLibExtension,
38    -- * Source files & build directories
39    getSourceFiles, getLibSourceFiles, getExeSourceFiles,
40    getFLibSourceFiles, exeBuildDir, flibBuildDir,
41  ) where
42
43import Prelude ()
44import Distribution.Compat.Prelude
45
46import Distribution.Package
47import Distribution.ModuleName as ModuleName
48import Distribution.Compiler
49import Distribution.PackageDescription
50import Distribution.Simple.LocalBuildInfo
51import Distribution.Simple.Setup
52import Distribution.Pretty
53import Distribution.System
54import Distribution.Verbosity
55import Distribution.Simple.Utils
56import Distribution.Utils.Path
57
58import Data.List (stripPrefix)
59import System.FilePath ((</>), (<.>), normalise)
60
61-- ---------------------------------------------------------------------------
62-- Build directories and files
63
64srcPref :: FilePath -> FilePath
65srcPref distPref = distPref </> "src"
66
67hscolourPref :: HaddockTarget -> FilePath -> PackageDescription -> FilePath
68hscolourPref = haddockPref
69
70-- | This is the name of the directory in which the generated haddocks
71-- should be stored. It does not include the @<dist>/doc/html@ prefix.
72haddockDirName :: HaddockTarget -> PackageDescription -> FilePath
73haddockDirName ForDevelopment = prettyShow . packageName
74haddockDirName ForHackage = (++ "-docs") . prettyShow . packageId
75
76-- | The directory to which generated haddock documentation should be written.
77haddockPref :: HaddockTarget -> FilePath -> PackageDescription -> FilePath
78haddockPref haddockTarget distPref pkg_descr
79    = distPref </> "doc" </> "html" </> haddockDirName haddockTarget pkg_descr
80
81-- | The directory in which we put auto-generated modules for EVERY
82-- component in the package.
83autogenPackageModulesDir :: LocalBuildInfo -> String
84autogenPackageModulesDir lbi = buildDir lbi </> "global-autogen"
85
86-- | The directory in which we put auto-generated modules for a
87-- particular component.
88autogenComponentModulesDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> String
89autogenComponentModulesDir lbi clbi = componentBuildDir lbi clbi </> "autogen"
90-- NB: Look at 'checkForeignDeps' for where a simplified version of this
91-- has been copy-pasted.
92
93cppHeaderName :: String
94cppHeaderName = "cabal_macros.h"
95
96-- | The name of the auto-generated Paths_* module associated with a package
97autogenPathsModuleName :: PackageDescription -> ModuleName
98autogenPathsModuleName pkg_descr =
99  ModuleName.fromString $
100    "Paths_" ++ map fixchar (prettyShow (packageName pkg_descr))
101  where fixchar '-' = '_'
102        fixchar c   = c
103
104haddockName :: PackageDescription -> FilePath
105haddockName pkg_descr = prettyShow (packageName pkg_descr) <.> "haddock"
106
107-- -----------------------------------------------------------------------------
108-- Source File helper
109
110getLibSourceFiles :: Verbosity
111                     -> LocalBuildInfo
112                     -> Library
113                     -> ComponentLocalBuildInfo
114                     -> IO [(ModuleName.ModuleName, FilePath)]
115getLibSourceFiles verbosity lbi lib clbi = getSourceFiles verbosity searchpaths modules
116  where
117    bi               = libBuildInfo lib
118    modules          = allLibModules lib clbi
119    searchpaths      = componentBuildDir lbi clbi : map getSymbolicPath (hsSourceDirs bi) ++
120                     [ autogenComponentModulesDir lbi clbi
121                     , autogenPackageModulesDir lbi ]
122
123getExeSourceFiles :: Verbosity
124                     -> LocalBuildInfo
125                     -> Executable
126                     -> ComponentLocalBuildInfo
127                     -> IO [(ModuleName.ModuleName, FilePath)]
128getExeSourceFiles verbosity lbi exe clbi = do
129    moduleFiles <- getSourceFiles verbosity searchpaths modules
130    srcMainPath <- findFileEx verbosity (map getSymbolicPath $ hsSourceDirs bi) (modulePath exe)
131    return ((ModuleName.main, srcMainPath) : moduleFiles)
132  where
133    bi          = buildInfo exe
134    modules     = otherModules bi
135    searchpaths = autogenComponentModulesDir lbi clbi
136                : autogenPackageModulesDir lbi
137                : exeBuildDir lbi exe : map getSymbolicPath (hsSourceDirs bi)
138
139getFLibSourceFiles :: Verbosity
140                   -> LocalBuildInfo
141                   -> ForeignLib
142                   -> ComponentLocalBuildInfo
143                   -> IO [(ModuleName.ModuleName, FilePath)]
144getFLibSourceFiles verbosity lbi flib clbi = getSourceFiles verbosity searchpaths modules
145  where
146    bi          = foreignLibBuildInfo flib
147    modules     = otherModules bi
148    searchpaths = autogenComponentModulesDir lbi clbi
149                : autogenPackageModulesDir lbi
150                : flibBuildDir lbi flib : map getSymbolicPath (hsSourceDirs bi)
151
152getSourceFiles :: Verbosity -> [FilePath]
153                  -> [ModuleName.ModuleName]
154                  -> IO [(ModuleName.ModuleName, FilePath)]
155getSourceFiles verbosity dirs modules = flip traverse modules $ \m -> fmap ((,) m) $
156    findFileWithExtension ["hs", "lhs", "hsig", "lhsig"] dirs (ModuleName.toFilePath m)
157      >>= maybe (notFound m) (return . normalise)
158  where
159    notFound module_ = die' verbosity $ "can't find source for module " ++ prettyShow module_
160
161-- | The directory where we put build results for an executable
162exeBuildDir :: LocalBuildInfo -> Executable -> FilePath
163exeBuildDir lbi exe = buildDir lbi </> nm </> nm ++ "-tmp"
164  where
165    nm = unUnqualComponentName $ exeName exe
166
167-- | The directory where we put build results for a foreign library
168flibBuildDir :: LocalBuildInfo -> ForeignLib -> FilePath
169flibBuildDir lbi flib = buildDir lbi </> nm </> nm ++ "-tmp"
170  where
171    nm = unUnqualComponentName $ foreignLibName flib
172
173-- ---------------------------------------------------------------------------
174-- Library file names
175
176-- | Create a library name for a static library from a given name.
177-- Prepends @lib@ and appends the static library extension (@.a@).
178mkGenericStaticLibName :: String -> String
179mkGenericStaticLibName lib = "lib" ++ lib <.> "a"
180
181mkLibName :: UnitId -> String
182mkLibName lib = mkGenericStaticLibName (getHSLibraryName lib)
183
184mkProfLibName :: UnitId -> String
185mkProfLibName lib =  mkGenericStaticLibName (getHSLibraryName lib ++ "_p")
186
187-- | Create a library name for a shared library from a given name.
188-- Prepends @lib@ and appends the @-\<compilerFlavour\>\<compilerVersion\>@
189-- as well as the shared library extension.
190mkGenericSharedLibName :: Platform -> CompilerId -> String -> String
191mkGenericSharedLibName platform (CompilerId compilerFlavor compilerVersion) lib
192  = mconcat [ "lib", lib, "-", comp <.> dllExtension platform ]
193  where comp = prettyShow compilerFlavor ++ prettyShow compilerVersion
194
195-- Implement proper name mangling for dynamical shared objects
196-- @libHS\<packagename\>-\<compilerFlavour\>\<compilerVersion\>@
197-- e.g. @libHSbase-2.1-ghc6.6.1.so@
198mkSharedLibName :: Platform -> CompilerId -> UnitId -> String
199mkSharedLibName platform comp lib
200  = mkGenericSharedLibName platform comp (getHSLibraryName lib)
201
202-- Static libs are named the same as shared libraries, only with
203-- a different extension.
204mkStaticLibName :: Platform -> CompilerId -> UnitId -> String
205mkStaticLibName platform (CompilerId compilerFlavor compilerVersion) lib
206  = "lib" ++ getHSLibraryName lib ++ "-" ++ comp <.> staticLibExtension platform
207  where comp = prettyShow compilerFlavor ++ prettyShow compilerVersion
208
209-- | Create a library name for a bundled shared library from a given name.
210-- This matches the naming convention for shared libraries as implemented in
211-- GHC's packageHsLibs function in the Packages module.
212-- If the given name is prefixed with HS, then this prepends 'lib' and appends
213-- the compiler flavour/version and shared library extension e.g.:
214--     "HSrts-1.0" -> "libHSrts-1.0-ghc8.7.20190109.so"
215-- Otherwise the given name should be prefixed with 'C', then this strips the
216-- 'C', prepends 'lib' and appends the shared library extension e.g.:
217--     "Cffi" -> "libffi.so"
218mkGenericSharedBundledLibName :: Platform -> CompilerId -> String -> String
219mkGenericSharedBundledLibName platform comp lib
220  | "HS" `isPrefixOf` lib
221    = mkGenericSharedLibName platform comp lib
222  | Just lib' <- stripPrefix "C" lib
223    = "lib" ++ lib' <.> dllExtension platform
224  | otherwise
225    = error ("Don't understand library name " ++ lib)
226
227-- ------------------------------------------------------------
228-- * Platform file extensions
229-- ------------------------------------------------------------
230
231-- | Default extension for executable files on the current platform.
232-- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
233exeExtension :: Platform -> String
234exeExtension (Platform _arch os) = case os of
235                   Windows -> "exe"
236                   _       -> ""
237
238-- | Extension for object files. For GHC the extension is @\"o\"@.
239objExtension :: String
240objExtension = "o"
241
242-- | Extension for dynamically linked (or shared) libraries
243-- (typically @\"so\"@ on Unix and @\"dll\"@ on Windows)
244dllExtension :: Platform -> String
245dllExtension (Platform _arch os)= case os of
246                   Windows -> "dll"
247                   OSX     -> "dylib"
248                   _       -> "so"
249
250-- | Extension for static libraries
251--
252-- TODO: Here, as well as in dllExtension, it's really the target OS that we're
253-- interested in, not the build OS.
254staticLibExtension :: Platform -> String
255staticLibExtension (Platform _arch os) = case os of
256                       Windows -> "lib"
257                       _       -> "a"
258