1{-# LANGUAGE CPP #-}
2
3-- | Note [Base Dir]
4-- ~~~~~~~~~~~~~~~~~
5--
6-- GHC's base directory or top directory containers miscellaneous settings and
7-- the package database.  The main compiler of course needs this directory to
8-- read those settings and read and write packages. ghc-pkg uses it to find the
9-- global package database too.
10--
11-- In the interest of making GHC builds more relocatable, many settings also
12-- will expand `${top_dir}` inside strings so GHC doesn't need to know it's on
13-- installation location at build time. ghc-pkg also can expand those variables
14-- and so needs the top dir location to do that too.
15module GHC.BaseDir where
16
17import Prelude -- See Note [Why do we import Prelude here?]
18
19import Data.List
20import System.FilePath
21
22-- Windows
23#if defined(mingw32_HOST_OS)
24import System.Environment (getExecutablePath)
25-- POSIX
26#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
27import System.Environment (getExecutablePath)
28#endif
29
30-- | Expand occurrences of the @$topdir@ interpolation in a string.
31expandTopDir :: FilePath -> String -> String
32expandTopDir = expandPathVar "topdir"
33
34-- | @expandPathVar var value str@
35--
36--   replaces occurences of variable @$var@ with @value@ in str.
37expandPathVar :: String -> FilePath -> String -> String
38expandPathVar var value str
39  | Just str' <- stripPrefix ('$':var) str
40  , null str' || isPathSeparator (head str')
41  = value ++ expandPathVar var value str'
42expandPathVar var value (x:xs) = x : expandPathVar var value xs
43expandPathVar _ _ [] = []
44
45-- | Calculate the location of the base dir
46getBaseDir :: IO (Maybe String)
47#if defined(mingw32_HOST_OS)
48getBaseDir = Just . (\p -> p </> "lib") . rootDir <$> getExecutablePath
49  where
50    -- locate the "base dir" when given the path
51    -- to the real ghc executable (as opposed to symlink)
52    -- that is running this function.
53    rootDir :: FilePath -> FilePath
54    rootDir = takeDirectory . takeDirectory . normalise
55#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
56-- on unix, this is a bit more confusing.
57-- The layout right now is something like
58--
59--   /bin/ghc-X.Y.Z <- wrapper script (1)
60--   /bin/ghc       <- symlink to wrapper script (2)
61--   /lib/ghc-X.Y.Z/bin/ghc <- ghc executable (3)
62--   /lib/ghc-X.Y.Z <- $topdir (4)
63--
64-- As such, we first need to find the absolute location to the
65-- binary.
66--
67-- getExecutablePath will return (3). One takeDirectory will
68-- give use /lib/ghc-X.Y.Z/bin, and another will give us (4).
69--
70-- This of course only works due to the current layout. If
71-- the layout is changed, such that we have ghc-X.Y.Z/{bin,lib}
72-- this would need to be changed accordingly.
73--
74getBaseDir = Just . (\p -> p </> "lib") . takeDirectory . takeDirectory <$> getExecutablePath
75#else
76getBaseDir = return Nothing
77#endif
78