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

Cabal/Distribution/PackageDescription/Parse.hs

@@ -1,5 +1,4 @@
 {-# 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
 

Cabal/Distribution/PackageDescription/PrettyPrint.hs

@@ -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)

Cabal/Distribution/Simple.hs

@@ -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 ()
 

Cabal/Distribution/Types/HookedBuildInfo.hs

@@ -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, [])

Cabal/Distribution/Types/PackageDescription.hs

@@ -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