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