1-----------------------------------------------------------------------------
2-- |
3-- Module      :  Distribution.Simple.Build.Macros
4-- Copyright   :  Simon Marlow 2008
5--
6-- Maintainer  :  cabal-devel@haskell.org
7-- Portability :  portable
8--
9-- Generate cabal_macros.h - CPP macros for package version testing
10--
11-- When using CPP you get
12--
13-- > VERSION_<package>
14-- > MIN_VERSION_<package>(A,B,C)
15--
16-- for each /package/ in @build-depends@, which is true if the version of
17-- /package/ in use is @>= A.B.C@, using the normal ordering on version
18-- numbers.
19--
20-- TODO Figure out what to do about backpack and internal libraries. It is very
21-- suspecious that this stuff works with munged package identifiers
22module Distribution.Simple.Build.Macros (
23    generateCabalMacrosHeader,
24    generatePackageVersionMacros,
25  ) where
26
27import Prelude ()
28import Distribution.Compat.Prelude
29
30import Distribution.Version
31import Distribution.PackageDescription
32import Distribution.Simple.LocalBuildInfo
33import Distribution.Simple.Program.Db
34import Distribution.Simple.Program.Types
35import Distribution.Types.MungedPackageId
36import Distribution.Types.MungedPackageName
37import Distribution.Types.PackageId
38import Distribution.Pretty
39
40-- ------------------------------------------------------------
41-- * Generate cabal_macros.h
42-- ------------------------------------------------------------
43
44-- Invariant: HeaderLines always has a trailing newline
45type HeaderLines = String
46
47line :: String -> HeaderLines
48line str = str ++ "\n"
49
50ifndef :: String -> HeaderLines -> HeaderLines
51ifndef macro body =
52    line ("#ifndef " ++ macro) ++
53    body ++
54    line ("#endif /* " ++ macro ++ " */")
55
56define :: String -> Maybe [String] -> String -> HeaderLines
57define macro params val =
58    line ("#define " ++ macro ++ f params ++ " " ++ val)
59  where
60    f Nothing = ""
61    f (Just xs) = "(" ++ intercalate "," xs ++ ")"
62
63defineStr :: String -> String -> HeaderLines
64defineStr macro str = define macro Nothing (show str)
65
66ifndefDefine :: String -> Maybe [String] -> String -> HeaderLines
67ifndefDefine macro params str =
68    ifndef macro (define macro params str)
69
70ifndefDefineStr :: String -> String -> HeaderLines
71ifndefDefineStr macro str =
72    ifndef macro (defineStr macro str)
73
74-- | The contents of the @cabal_macros.h@ for the given configured package.
75--
76generateCabalMacrosHeader :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> String
77generateCabalMacrosHeader pkg_descr lbi clbi =
78  "/* DO NOT EDIT: This file is automatically generated by Cabal */\n\n" ++
79  generatePackageVersionMacros
80    (package pkg_descr : map getPid (componentPackageDeps clbi)) ++
81  generateToolVersionMacros (configuredPrograms . withPrograms $ lbi) ++
82  generateComponentIdMacro lbi clbi ++
83  generateCurrentPackageVersion pkg_descr
84 where
85  getPid (_, MungedPackageId (MungedPackageName pn _) v) =
86    -- NB: Drop the library name! We're just reporting package versions.
87    -- This would have to be revisited if you are allowed to depend
88    -- on different versions of the same package
89    PackageIdentifier pn v
90
91-- | Helper function that generates just the @VERSION_pkg@ and @MIN_VERSION_pkg@
92-- macros for a list of package ids (usually used with the specific deps of
93-- a configured package).
94--
95generatePackageVersionMacros :: [PackageId] -> String
96generatePackageVersionMacros pkgids = concat
97  [ line ("/* package " ++ prettyShow pkgid ++ " */")
98  ++ generateMacros "" pkgname version
99  | pkgid@(PackageIdentifier name version) <- pkgids
100  , let pkgname = map fixchar (prettyShow name)
101  ]
102
103-- | Helper function that generates just the @TOOL_VERSION_pkg@ and
104-- @MIN_TOOL_VERSION_pkg@ macros for a list of configured programs.
105--
106generateToolVersionMacros :: [ConfiguredProgram] -> String
107generateToolVersionMacros progs = concat
108  [ line ("/* tool " ++ progid ++ " */")
109  ++ generateMacros "TOOL_" progname version
110  | prog <- progs
111  , isJust . programVersion $ prog
112  , let progid   = programId prog ++ "-" ++ prettyShow version
113        progname = map fixchar (programId prog)
114        version  = fromMaybe version0 (programVersion prog)
115  ]
116
117-- | Common implementation of 'generatePackageVersionMacros' and
118-- 'generateToolVersionMacros'.
119--
120generateMacros :: String -> String -> Version -> String
121generateMacros macro_prefix name version =
122  concat
123  [ifndefDefineStr (macro_prefix ++ "VERSION_" ++ name) (prettyShow version)
124  ,ifndefDefine ("MIN_" ++ macro_prefix ++ "VERSION_" ++ name)
125                (Just ["major1","major2","minor"])
126    $ concat [
127       "(\\\n"
128      ,"  (major1) <  ",major1," || \\\n"
129      ,"  (major1) == ",major1," && (major2) <  ",major2," || \\\n"
130      ,"  (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")"
131    ]
132  ,"\n"]
133  where
134    (major1,major2,minor) = case map show (versionNumbers version) of
135        []        -> ("0", "0", "0")
136        [x]       -> (x,   "0", "0")
137        [x,y]     -> (x,   y,   "0")
138        (x:y:z:_) -> (x,   y,   z)
139
140-- | Generate the @CURRENT_COMPONENT_ID@ definition for the component ID
141--   of the current package.
142generateComponentIdMacro :: LocalBuildInfo -> ComponentLocalBuildInfo -> String
143generateComponentIdMacro _lbi clbi =
144  concat $
145      [case clbi of
146        LibComponentLocalBuildInfo{} ->
147          ifndefDefineStr "CURRENT_PACKAGE_KEY" (componentCompatPackageKey clbi)
148        _ -> ""
149      ,ifndefDefineStr "CURRENT_COMPONENT_ID" (prettyShow (componentComponentId clbi))
150      ]
151
152-- | Generate the @CURRENT_PACKAGE_VERSION@ definition for the declared version
153--   of the current package.
154generateCurrentPackageVersion :: PackageDescription -> String
155generateCurrentPackageVersion pd =
156  ifndefDefineStr "CURRENT_PACKAGE_VERSION" (prettyShow (pkgVersion (package pd)))
157
158fixchar :: Char -> Char
159fixchar '-' = '_'
160fixchar c   = c
161