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

Revert "Generalize HookedBuildInfo to work with any type of component."

This reverts commit af7bb537,
restoring 'HookedBuildInfo' backwards compatibility.
parent 44f16179
{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
......@@ -56,6 +55,7 @@ import Distribution.Compat.ReadP hiding (get)
import Data.List (partition, (\\))
import System.Directory (doesFileExist)
import Control.Monad (mapM)
import Text.PrettyPrint
(vcat, ($$), (<+>), text, render,
......@@ -1201,42 +1201,24 @@ deprecField _ = cabalBug "'deprecField' called on a non-field"
parseHookedBuildInfo :: String -> ParseResult HookedBuildInfo
parseHookedBuildInfo inp = do
fields <- readFields inp
let (mLibFields:rest) = stanzas fields
let ss@(mLibFields:exes) = stanzas fields
mLib <- parseLib mLibFields
foldM parseStanza mLib rest
biExes <- mapM parseExe (maybe ss (const exes) mLib)
return (mLib, biExes)
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 [(ComponentName, BuildInfo)]
parseLib :: [Field] -> ParseResult (Maybe BuildInfo)
parseLib (bi@(F _ inFieldName _:_))
| lowercase inFieldName /= "executable" &&
lowercase inFieldName /= "library" &&
lowercase inFieldName /= "benchmark" &&
lowercase inFieldName /= "test-suite"
= liftM (\bis -> [(CLibName, bis)]) (parseBI bi)
parseLib _ = return []
parseStanza :: HookedBuildInfo -> [Field] -> ParseResult HookedBuildInfo
parseStanza bis (F line inFieldName mName:bi)
| Just k <- case lowercase inFieldName of
"executable" -> Just CExeName
-- An *explicit* library indicates a
-- sub-library; only way to get main
-- library is to have a bare section.
"library" -> Just CSubLibName
"benchmark" -> Just CBenchName
"test-suite" -> Just CTestName
_ -> Nothing
= do bi' <- parseBI bi
return ((k mName, bi'):bis)
| otherwise
= syntaxError line $
"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"
| lowercase inFieldName /= "executable" = liftM Just (parseBI bi)
parseLib _ = return Nothing
parseExe :: [Field] -> ParseResult (String, BuildInfo)
parseExe (F line inFieldName mName:bi)
| lowercase inFieldName == "executable"
= do bis <- parseBI bi
return (mName, bis)
| otherwise = syntaxError line "expecting 'executable' at top of stanza"
parseExe (_:_) = cabalBug "`parseExe' called on a non-field"
parseExe [] = syntaxError 0 "error in parsing buildinfo file. Expected executable stanza"
parseBI st = parseFields binfoFieldDescrs storeXFieldsBI emptyBuildInfo st
......
......@@ -299,16 +299,14 @@ writeHookedBuildInfo fpath = writeFileAtomic fpath . BS.Char8.pack
-- | @since 1.26.0.0@
showHookedBuildInfo :: HookedBuildInfo -> String
showHookedBuildInfo bis = render $
vcat [ space
$$ ppName name
$$ ppBuildInfo bi
| (name, bi) <- bis ]
showHookedBuildInfo (mb_lib_bi, ex_bis) = render $
(case mb_lib_bi of
Nothing -> mempty
Just bi -> ppBuildInfo bi)
$$ vcat [ space
$$ text "executable:" <+> text name
$$ ppBuildInfo bi
| (name, bi) <- ex_bis ]
where
ppName CLibName = text "library"
ppName (CSubLibName 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)
ppBuildInfo bi = ppFields binfoFieldDescrs bi
$$ ppCustomFields (customFieldsBI bi)
......@@ -98,7 +98,7 @@ import System.FilePath (searchPathSeparator)
import Distribution.Compat.Environment (getEnvironment)
import Distribution.Compat.GetShortPathName (getShortPathName)
import Data.List (unionBy)
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
......@@ -434,15 +434,18 @@ hookedActionWithArgs pre_hook cmd_hook post_hook get_build_config hooks flags ar
post_hook hooks args flags pkg_descr lbi
sanityCheckHookedBuildInfo :: PackageDescription -> HookedBuildInfo -> IO ()
sanityCheckHookedBuildInfo pkg_descr hooked_bis
| not (null nonExistentComponents)
= die $ "The buildinfo contains info for these non-existent components:"
++ intercalate ", " (map showComponentName nonExistentComponents)
sanityCheckHookedBuildInfo PackageDescription { library = Nothing } (Just _,_)
= die $ "The buildinfo contains info for a library, "
++ "but the package does not have a library."
sanityCheckHookedBuildInfo pkg_descr (_, hookExes)
| not (null nonExistant)
= die $ "The buildinfo contains info for an executable called '"
++ "executable with that name."
where
nonExistentComponents =
[ cname
| (cname, _) <- hooked_bis
, Nothing <- [lookupComponent pkg_descr cname] ]
pkgExeNames = nub (map exeName (executables pkg_descr))
hookExeNames = nub (map fst hookExes)
nonExistant = hookExeNames \\ pkgExeNames
sanityCheckHookedBuildInfo _ _ = return ()
......
......@@ -6,10 +6,7 @@ module Distribution.Types.HookedBuildInfo (
emptyHookedBuildInfo,
) where
import Prelude ()
--import Distribution.Compat.Prelude
import Distribution.Types.ComponentName
-- import Distribution.Compat.Prelude
import Distribution.Types.BuildInfo
-- | 'HookedBuildInfo' is mechanism that hooks can use to
......@@ -62,7 +59,7 @@ import Distribution.Types.BuildInfo
-- are obligated to apply any new 'HookedBuildInfo' and then we'd
-- get the effect twice. But this does mean we have to re-apply
-- it every time. Hey, it's more flexibility.
type HookedBuildInfo = [(ComponentName, BuildInfo)]
type HookedBuildInfo = (Maybe BuildInfo, [(String, BuildInfo)])
emptyHookedBuildInfo :: HookedBuildInfo
emptyHookedBuildInfo = []
emptyHookedBuildInfo = (Nothing, [])
......@@ -302,39 +302,27 @@ allBuildInfo pkg_descr = [ bi | lib <- allLibraries pkg_descr
-- ------------------------------------------------------------
updatePackageDescription :: HookedBuildInfo -> PackageDescription -> PackageDescription
updatePackageDescription hooked_bis p
= p{ executables = updateMany (CExeName . exeName) updateExecutable (executables p)
, library = fmap (updateLibrary lib_bi) (library p)
, subLibraries = updateMany (maybe CLibName CSubLibName . libName) updateLibrary (subLibraries p)
, benchmarks = updateMany (CBenchName . benchmarkName) updateBenchmark (benchmarks p)
, testSuites = updateMany (CTestName . testName) updateTestSuite (testSuites p)
}
updatePackageDescription (mb_lib_bi, exe_bi) p
= p{ executables = updateExecutables exe_bi (executables p)
, library = updateLibrary mb_lib_bi (library p) }
where
lib_bi = case find ((== CLibName) . fst) hooked_bis of
Nothing -> mempty
Just (_, bi) -> bi
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 cs' = foldr (updateOne name update) cs' hooked_bis
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 _ _ _ [] = []
updateOne name_sel update hooked_bi'@(name,bi) (c:cs)
| name_sel c == name
= 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}
updateLibrary :: Maybe BuildInfo -> Maybe Library -> Maybe Library
updateLibrary (Just bi) (Just lib) = Just (lib{libBuildInfo = bi `mappend` libBuildInfo lib})
updateLibrary Nothing mb_lib = mb_lib
updateLibrary (Just _) Nothing = Nothing
updateExecutables :: [(String, BuildInfo)] -- ^[(exeName, new buildinfo)]
-> [Executable] -- ^list of executables to update
-> [Executable] -- ^list with exeNames updated
updateExecutables exe_bi' executables' = foldr updateExecutable executables' exe_bi'
updateExecutable :: (String, BuildInfo) -- ^(exeName, new buildinfo)
-> [Executable] -- ^list of executables to update
-> [Executable] -- ^list with exeName updated
updateExecutable _ [] = []
updateExecutable exe_bi'@(name,bi) (exe:exes)
| exeName exe == name = exe{buildInfo = bi `mappend` buildInfo exe} : exes
| otherwise = exe : updateExecutable exe_bi' exes
-- -----------------------------------------------------------------------------
-- Source-representation of buildable components
......
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