Commit 9105fc6a authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Compute package synopsis directly from Cabal files

parent 4ce85874
......@@ -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)
......@@ -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 = []
......
......@@ -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.
......
......@@ -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 ...@.
......
......@@ -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]
......
......@@ -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
......
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
......@@ -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
......
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