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