Compute package synopsis directly from Cabal files
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Sun, 20 Aug 2017 16:58:01 +0000 (17:58 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Sun, 20 Aug 2017 16:58:01 +0000 (17:58 +0100)
src/Hadrian/Haskell/Cabal.hs
src/Hadrian/Haskell/Cabal/Parse.hs
src/Hadrian/Utilities.hs
src/Oracles/PackageData.hs
src/Rules/Data.hs
src/Rules/Library.hs
src/Rules/Program.hs
src/Settings/Builders/Haddock.hs

index 23cfdc7..be2b32a 100644 (file)
@@ -10,7 +10,7 @@
 -- @.cabal@ files.
 -----------------------------------------------------------------------------
 module Hadrian.Haskell.Cabal (
-    pkgVersion, pkgIdentifier, pkgDependencies
+    pkgVersion, pkgIdentifier, pkgDependencies, pkgSynopsis
     ) where
 
 import Control.Monad
@@ -32,7 +32,7 @@ pkgVersion pkg = do
 -- e.g. @base-4.10.0.0@. If the @.cabal@ file does not exist return just the
 -- package name, e.g. @rts@. If the @.cabal@ file exists then it is tracked, and
 -- furthermore we check that the recorded package name matches the name of the
--- package passed as the parameter and raise an error otherwise.
+-- package passed as the parameter, and raise an error otherwise.
 pkgIdentifier :: Package -> Action String
 pkgIdentifier pkg = do
     cabalExists <- doesFileExist (pkgCabalFile pkg)
@@ -56,3 +56,15 @@ pkgDependencies :: Package -> Action [PackageName]
 pkgDependencies pkg = do
     cabal <- readCabalFile (pkgCabalFile pkg)
     return (dependencies cabal)
+
+-- | Read the @.cabal@ file of a given package and return the package synopsis
+-- or @Nothing@ if the @.cabal@ file does not exist. The existence and contents
+-- of the @.cabal@ file are tracked.
+pkgSynopsis :: Package -> Action (Maybe String)
+pkgSynopsis pkg = do
+    cabalExists <- doesFileExist (pkgCabalFile pkg)
+    if not cabalExists
+    then return Nothing
+    else do
+        cabal <- readCabalFile (pkgCabalFile pkg)
+        return $ Just (synopsis cabal)
index 609e494..8e9273d 100644 (file)
@@ -27,6 +27,7 @@ import Hadrian.Haskell.Package
 data Cabal = Cabal
     { dependencies :: [PackageName]
     , name         :: PackageName
+    , synopsis     :: String
     , version      :: String
     } deriving (Eq, Read, Show, Typeable)
 
@@ -38,13 +39,14 @@ instance Hashable Cabal where
     hashWithSalt salt = hashWithSalt salt . show
 
 instance NFData Cabal where
-    rnf (Cabal a b c) = a `seq` b `seq` c `seq` ()
+    rnf (Cabal a b c d) = a `seq` b `seq` c `seq` d `seq` ()
 
 -- | Parse a @.cabal@ file.
 parseCabal :: FilePath -> IO Cabal
 parseCabal file = do
     gpd <- liftIO $ C.readGenericPackageDescription C.silent file
-    let pkgId   = C.package (C.packageDescription gpd)
+    let pd      = C.packageDescription gpd
+        pkgId   = C.package pd
         name    = C.unPackageName (C.pkgName pkgId)
         version = C.display (C.pkgVersion pkgId)
         libDeps = collectDeps (C.condLibrary gpd)
@@ -52,7 +54,7 @@ parseCabal file = do
         allDeps = concat (libDeps : exeDeps)
         sorted  = sort [ C.unPackageName p | C.Dependency p _ <- allDeps ]
         deps    = nubOrd sorted \\ [name]
-    return $ Cabal deps name version
+    return $ Cabal deps name (C.synopsis pd) version
 
 collectDeps :: Maybe (C.CondTree v [C.Dependency] a) -> [C.Dependency]
 collectDeps Nothing = []
index 4051347..416399b 100644 (file)
@@ -36,6 +36,7 @@ module Hadrian.Utilities (
     ) where
 
 import Control.Monad.Extra
+import Data.Char
 import Data.Dynamic (Dynamic, fromDynamic, toDyn)
 import Data.HashMap.Strict (HashMap)
 import Data.List.Extra
@@ -302,16 +303,22 @@ renderAction what input output = do
     o = unifyPath output
 
 -- | Render the successful build of a program.
-renderProgram :: String -> String -> String -> String
-renderProgram name bin synopsis = renderBox [ "Successfully built program " ++ name
-                                            , "Executable: " ++ bin
-                                            , "Program synopsis: " ++ synopsis ++ "."]
+renderProgram :: String -> String -> Maybe String -> String
+renderProgram name bin synopsis = renderBox $
+    [ "Successfully built program " ++ name
+    , "Executable: " ++ bin ] ++
+    [ "Program synopsis: " ++ prettySynopsis synopsis | isJust synopsis ]
 
 -- | Render the successful build of a library.
-renderLibrary :: String -> String -> String -> String
-renderLibrary name lib synopsis = renderBox [ "Successfully built library " ++ name
-                                            , "Library: " ++ lib
-                                            , "Library synopsis: " ++ synopsis ++ "."]
+renderLibrary :: String -> String -> Maybe String -> String
+renderLibrary name lib synopsis = renderBox $
+    [ "Successfully built library " ++ name
+    , "Library: " ++ lib ] ++
+    [ "Library synopsis: " ++ prettySynopsis synopsis | isJust synopsis ]
+
+prettySynopsis :: Maybe String -> String
+prettySynopsis Nothing  = ""
+prettySynopsis (Just s) = dropWhileEnd isPunctuation s ++ "."
 
 -- | Render the given set of lines in an ASCII box. The minimum width and
 -- whether to use Unicode symbols are hardcoded in the function's body.
index 7d98c98..1fecb8c 100644 (file)
@@ -7,7 +7,6 @@ import Hadrian.Oracles.TextFile
 import Base
 
 data PackageData = BuildGhciLib FilePath
-                 | Synopsis     FilePath
 
 data PackageDataList = AsmSrcs        FilePath
                      | CcArgs         FilePath
@@ -38,7 +37,6 @@ askPackageData path = lookupValueOrEmpty (path -/- "package-data.mk")
 pkgData :: PackageData -> Action String
 pkgData packageData = case packageData of
     BuildGhciLib path -> askPackageData path "BUILD_GHCI_LIB"
-    Synopsis     path -> askPackageData path "SYNOPSIS"
 
 -- | @PackageDataList path@ is used for multiple string options separated by
 -- spaces, such as @path_MODULES = Data.Array Data.Array.Base ...@.
index 194bf62..7715eff 100644 (file)
@@ -68,8 +68,7 @@ generatePackageData context@Context {..} file = do
         [ "DEP_EXTRA_LIBS = m"                 | package == hp2ps           ] ++
         [ "CC_OPTS = -I" ++ genPath            | package `elem` [hp2ps, rts]] ++
         [ "MODULES = Main"                     | package == ghcCabal        ] ++
-        [ "HS_SRC_DIRS = ."                    | package == ghcCabal        ] ++
-        [ "SYNOPSIS = Bootstrapped ghc-cabal." | package == ghcCabal        ]
+        [ "HS_SRC_DIRS = ."                    | package == ghcCabal        ]
     putSuccess $ "| Successfully generated " ++ file
 
 packageCSources :: Package -> Action [FilePath]
index a6fb14c..d261554 100644 (file)
@@ -2,7 +2,7 @@ module Rules.Library (
     buildPackageLibrary, buildPackageGhciLibrary, buildDynamicLib
     ) where
 
-import Data.Char
+import Hadrian.Haskell.Cabal
 import qualified System.Directory as IO
 
 import Base
@@ -61,10 +61,10 @@ buildPackageLibrary context@Context {..} = do
         if isLib0 then build $ target context (Ar stage) []   [a] -- TODO: Scan for dlls
                   else build $ target context (Ar stage) objs [a]
 
-        synopsis <- interpretInContext context $ getPkgData Synopsis
+        synopsis <- pkgSynopsis package
         unless isLib0 . putSuccess $ renderLibrary
             (quote (pkgName package) ++ " (" ++ show stage ++ ", way "
-            ++ show way ++ ").") a (dropWhileEnd isPunctuation synopsis)
+            ++ show way ++ ").") a synopsis
 
 buildPackageGhciLibrary :: Context -> Rules ()
 buildPackageGhciLibrary context@Context {..} = priority 2 $ do
index efdd7f4..5fad4b2 100644 (file)
@@ -1,6 +1,6 @@
 module Rules.Program (buildProgram) where
 
-import Data.Char
+import Hadrian.Haskell.Cabal
 
 import Base
 import Context
@@ -105,8 +105,6 @@ buildBinary rs context@Context {..} bin = do
                   ++ [ path -/- "Paths_haddock.o" | package == haddock ]
     need binDeps
     buildWithResources rs $ target context (Ghc LinkHs stage) binDeps [bin]
-    synopsis <- interpretInContext context $ getPkgData Synopsis
+    synopsis <- pkgSynopsis package
     putSuccess $ renderProgram
-        (quote (pkgName package) ++ " (" ++ show stage ++ ").")
-        bin
-        (dropWhileEnd isPunctuation synopsis)
+        (quote (pkgName package) ++ " (" ++ show stage ++ ").") bin synopsis
index bc3ebf4..834190e 100644 (file)
@@ -19,7 +19,7 @@ haddockBuilderArgs = builder Haddock ? do
     pkg      <- getPackage
     path     <- getBuildPath
     version  <- expr $ pkgVersion pkg
-    synopsis <- getPkgData Synopsis
+    synopsis <- fromMaybe "" <$> expr (pkgSynopsis pkg)
     deps     <- getPkgDataList Deps
     haddocks <- expr . haddockDependencies =<< getContext
     hVersion <- expr $ pkgVersion haddock