Commit af7bb537 authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Generalize HookedBuildInfo to work with any type of component.


Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 8f3902bd
......@@ -90,6 +90,8 @@ module Distribution.PackageDescription (
hcSharedOptions,
-- ** Supplementary build information
ComponentName(..),
defaultLibName,
HookedBuildInfo,
emptyHookedBuildInfo,
updatePackageDescription,
......@@ -958,10 +960,22 @@ usedExtensions :: BuildInfo -> [Extension]
usedExtensions bi = oldExtensions bi
++ defaultExtensions bi
type HookedBuildInfo = ([(String, BuildInfo)], [(String, BuildInfo)])
-- Libraries live in a separate namespace, so must distinguish
data ComponentName = CLibName String
| CExeName String
| CTestName String
| CBenchName String
deriving (Eq, Generic, Ord, Read, Show)
instance Binary ComponentName
defaultLibName :: PackageIdentifier -> ComponentName
defaultLibName pid = CLibName (display (pkgName pid))
type HookedBuildInfo = [(ComponentName, BuildInfo)]
emptyHookedBuildInfo :: HookedBuildInfo
emptyHookedBuildInfo = ([], [])
emptyHookedBuildInfo = []
-- |Select options for a particular Haskell compiler.
hcOptions :: CompilerFlavor -> BuildInfo -> [String]
......@@ -1117,21 +1131,22 @@ lowercase = map Char.toLower
-- ------------------------------------------------------------
updatePackageDescription :: HookedBuildInfo -> PackageDescription -> PackageDescription
updatePackageDescription (lib_bi, exe_bi) p
= p{ executables = updateMany exeName updateExecutable exe_bi (executables p)
, libraries = updateMany libName updateLibrary lib_bi (libraries p)
}
updatePackageDescription hooked_bis p
= p{ executables = updateMany (CExeName . exeName) updateExecutable (executables p)
, libraries = updateMany (CLibName . libName) updateLibrary (libraries p)
, benchmarks = updateMany (CBenchName . benchmarkName) updateBenchmark (benchmarks p)
, testSuites = updateMany (CTestName . testName) updateTestSuite (testSuites p)
}
where
updateMany :: (a -> String) -- ^ @exeName@ or @libName@
-> (BuildInfo -> a -> a) -- ^ @updateExecutable@ or @updateLibrary@
-> [(String, BuildInfo)] -- ^[(name, new buildinfo)]
updateMany :: (a -> ComponentName) -- ^ get 'ComponentName' from @a@
-> (BuildInfo -> a -> a) -- ^ @updateExecutable@, @updateLibrary@, etc
-> [a] -- ^list of components to update
-> [a] -- ^list with updated components
updateMany name update hooked_bi' cs' = foldr (updateOne name update) cs' hooked_bi'
updateMany name update cs' = foldr (updateOne name update) cs' hooked_bis
updateOne :: (a -> String) -- ^ @exeName@ or @libName@
-> (BuildInfo -> a -> a) -- ^ @updateExecutable@ or @updateLibrary@
-> (String, BuildInfo) -- ^(name, new buildinfo)
updateOne :: (a -> ComponentName) -- ^ get 'ComponentName' from @a@
-> (BuildInfo -> a -> a) -- ^ @updateExecutable@, @updateLibrary@, etc
-> (ComponentName, BuildInfo) -- ^(name, new buildinfo)
-> [a] -- ^list of components to update
-> [a] -- ^list with name component updated
updateOne _ _ _ [] = []
......@@ -1140,12 +1155,14 @@ updatePackageDescription (lib_bi, exe_bi) p
-- Special case: an empty name means "please update the BuildInfo for
-- the public library, i.e. the one with the same name as the
-- package." See 'parseHookedBuildInfo'.
(name == "" && name_sel c == display (pkgName (package p)))
name == CLibName "" && name_sel c == defaultLibName (package p)
= update bi c : cs
| otherwise = c : updateOne name_sel update hooked_bi' cs
updateExecutable bi exe = exe{buildInfo = bi `mappend` buildInfo exe}
updateLibrary bi lib = lib{libBuildInfo = bi `mappend` libBuildInfo lib}
updateBenchmark bi ben = ben{benchmarkBuildInfo = bi `mappend` benchmarkBuildInfo ben}
updateTestSuite bi test = test{testBuildInfo = bi `mappend` testBuildInfo test}
-- ---------------------------------------------------------------------------
-- The GenericPackageDescription type
......
{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
......@@ -1203,31 +1204,35 @@ parseHookedBuildInfo inp = do
fields <- readFields inp
let (mLibFields:rest) = stanzas fields
mLib <- parseLib mLibFields
foldM parseStanza (mLib, []) rest
foldM parseStanza mLib rest
where
-- For backwards compatibility, if you have a bare stanza,
-- we assume it's part of the public library. We don't
-- know what the name is, so the people using the HookedBuildInfo
-- have to handle this carefully.
parseLib :: [Field] -> ParseResult [(String, BuildInfo)]
parseLib :: [Field] -> ParseResult [(ComponentName, BuildInfo)]
parseLib (bi@(F _ inFieldName _:_))
| lowercase inFieldName /= "executable" &&
lowercase inFieldName /= "library"
= liftM (\bis -> [("", bis)]) (parseBI bi)
lowercase inFieldName /= "library" &&
lowercase inFieldName /= "benchmark" &&
lowercase inFieldName /= "test-suite"
= liftM (\bis -> [(CLibName "", bis)]) (parseBI bi)
parseLib _ = return []
parseStanza :: HookedBuildInfo -> [Field] -> ParseResult HookedBuildInfo
parseStanza (lib_bis, exe_bis) (F line inFieldName mName:bi)
| lowercase inFieldName == "executable"
= do bis <- parseBI bi
return (lib_bis, (mName, bis):exe_bis)
| lowercase inFieldName == "library"
= do bis <- parseBI bi
return ((mName, bis):lib_bis, exe_bis)
parseStanza bis (F line inFieldName mName:bi)
| Just k <- case lowercase inFieldName of
"executable" -> Just CExeName
"library" -> Just CLibName
"benchmark" -> Just CBenchName
"test-suite" -> Just CTestName
_ -> Nothing
= do bi' <- parseBI bi
return ((k mName, bi'):bis)
| otherwise
= syntaxError line $
"expecting 'executable' or 'library' at top of stanza, " ++
"but got '" ++ inFieldName ++ "'"
"expecting 'executable', 'library', 'benchmark' or 'test-suite' " ++
"at top of stanza, but got '" ++ inFieldName ++ "'"
parseStanza _ (_:_) = cabalBug "`parseStanza' called on a non-field"
parseStanza _ [] = syntaxError 0 "error in parsing buildinfo file. Expected stanza"
......@@ -1263,16 +1268,16 @@ writeHookedBuildInfo fpath = writeFileAtomic fpath . BS.Char8.pack
. showHookedBuildInfo
showHookedBuildInfo :: HookedBuildInfo -> String
showHookedBuildInfo (lib_bis, ex_bis) = render $
showHookedBuildInfo bis = render $
vcat [ space
$$ text "library:" <+> text name
$$ ppName name
$$ ppBuildInfo bi
| (name, bi) <- lib_bis ]
$$ vcat [ space
$$ text "executable:" <+> text name
$$ ppBuildInfo bi
| (name, bi) <- ex_bis ]
| (name, bi) <- bis ]
where
ppName (CLibName name) = text "library:" <+> text name
ppName (CExeName name) = text "executable:" <+> text name
ppName (CTestName name) = text "test-suite:" <+> text name
ppName (CBenchName name) = text "benchmark:" <+> text name
ppBuildInfo bi = ppFields binfoFieldDescrs bi
$$ ppCustomFields (customFieldsBI bi)
......
......@@ -96,7 +96,7 @@ import Distribution.Compat.Environment (getEnvironment)
import Control.Monad (when)
import Data.Foldable (traverse_)
import Data.List (unionBy, nub, (\\))
import Data.List (unionBy)
-- | A simple implementation of @main@ for a Cabal setup script.
-- It reads the package description file using IO, and performs the
......@@ -407,24 +407,15 @@ hookedActionWithArgs pre_hook cmd_hook post_hook get_build_config hooks flags ar
post_hook hooks args flags pkg_descr localbuildinfo
sanityCheckHookedBuildInfo :: PackageDescription -> HookedBuildInfo -> IO ()
sanityCheckHookedBuildInfo pkg_descr (hookLibs, hookExes)
| not (null nonExistantLibs)
= die $ "The buildinfo contains info for an library called '"
++ head nonExistantLibs ++ "' but the package does not have a "
++ "library with that name."
| not (null nonExistantExes)
= die $ "The buildinfo contains info for an executable called '"
++ head nonExistantExes ++ "' but the package does not have a "
++ "executable with that name."
sanityCheckHookedBuildInfo pkg_descr hooked_bis
| not (null nonExistentComponents)
= die $ "The buildinfo contains info for these non-existent components:"
++ intercalate ", " (map showComponentName nonExistentComponents)
where
pkgExeNames = nub (map exeName (executables pkg_descr))
hookExeNames = nub (map fst hookExes)
nonExistantExes = hookExeNames \\ pkgExeNames
-- Blank refers to the default, public library
pkgLibNames = "" : nub (map libName (libraries pkg_descr))
hookLibNames = nub (map fst hookLibs)
nonExistantLibs = hookLibNames \\ pkgLibNames
nonExistentComponents =
[ cname
| (cname, _) <- hooked_bis
, Nothing <- [lookupComponent pkg_descr cname] ]
sanityCheckHookedBuildInfo _ _ = return ()
......
......@@ -207,18 +207,6 @@ data Component = CLib Library
| CBench Benchmark
deriving (Show, Eq, Read)
-- Libraries live in a separate namespace, so must distinguish
data ComponentName = CLibName String
| CExeName String
| CTestName String
| CBenchName String
deriving (Eq, Generic, Ord, Read, Show)
defaultLibName :: PackageIdentifier -> ComponentName
defaultLibName pid = CLibName (display (pkgName pid))
instance Binary ComponentName
-- | This gets the 'String' component name. In fact, it is
-- guaranteed to uniquely identify a component, returning
-- @Nothing@ if the 'ComponentName' was for the public
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment