Skip Haddocks when no modules present

This commit is contained in:
Michael Snoyman 2014-12-11 23:23:13 +02:00
parent 827c6748c8
commit 670966d40c
2 changed files with 43 additions and 36 deletions

View File

@ -83,25 +83,30 @@ data SimpleDesc = SimpleDesc
{ sdPackages :: Map PackageName DepInfo { sdPackages :: Map PackageName DepInfo
, sdTools :: Map ExeName DepInfo , sdTools :: Map ExeName DepInfo
, sdProvidedExes :: Set ExeName , sdProvidedExes :: Set ExeName
, sdModules :: Set Text
-- ^ modules exported by the library
} }
deriving (Show, Eq) deriving (Show, Eq)
instance Monoid SimpleDesc where instance Monoid SimpleDesc where
mempty = SimpleDesc mempty mempty mempty mempty = SimpleDesc mempty mempty mempty mempty
mappend (SimpleDesc a b c) (SimpleDesc x y z) = SimpleDesc mappend (SimpleDesc a b c d) (SimpleDesc w x y z) = SimpleDesc
(unionWith (<>) a x) (unionWith (<>) a w)
(unionWith (<>) b y) (unionWith (<>) b x)
(c ++ z) (c ++ y)
(d ++ z)
instance ToJSON SimpleDesc where instance ToJSON SimpleDesc where
toJSON SimpleDesc {..} = object toJSON SimpleDesc {..} = object
[ "packages" .= Map.mapKeysWith const unPackageName sdPackages [ "packages" .= Map.mapKeysWith const unPackageName sdPackages
, "tools" .= Map.mapKeysWith const unExeName sdTools , "tools" .= Map.mapKeysWith const unExeName sdTools
, "provided-exes" .= sdProvidedExes , "provided-exes" .= sdProvidedExes
, "modules" .= sdModules
] ]
instance FromJSON SimpleDesc where instance FromJSON SimpleDesc where
parseJSON = withObject "SimpleDesc" $ \o -> do parseJSON = withObject "SimpleDesc" $ \o -> do
sdPackages <- Map.mapKeysWith const mkPackageName <$> (o .: "packages") sdPackages <- Map.mapKeysWith const mkPackageName <$> (o .: "packages")
sdTools <- Map.mapKeysWith const ExeName <$> (o .: "tools") sdTools <- Map.mapKeysWith const ExeName <$> (o .: "tools")
sdProvidedExes <- o .: "provided-exes" sdProvidedExes <- o .: "provided-exes"
sdModules <- o .: "modules"
return SimpleDesc {..} return SimpleDesc {..}
-- | Convert a 'GenericPackageDescription' into a 'SimpleDesc' by following the -- | Convert a 'GenericPackageDescription' into a 'SimpleDesc' by following the
@ -111,46 +116,54 @@ toSimpleDesc :: MonadThrow m
-> GenericPackageDescription -> GenericPackageDescription
-> m SimpleDesc -> m SimpleDesc
toSimpleDesc cc gpd = execWriterT $ do toSimpleDesc cc gpd = execWriterT $ do
forM_ (condLibrary gpd) $ tellTree cc CompLibrary libBuildInfo forM_ (condLibrary gpd) $ tellTree cc CompLibrary libBuildInfo getModules
forM_ (condExecutables gpd) $ tellTree cc CompExecutable buildInfo . snd forM_ (condExecutables gpd) $ tellTree cc CompExecutable buildInfo noModules . snd
tell mempty { sdProvidedExes = setFromList tell mempty { sdProvidedExes = setFromList
$ map (fromString . fst) $ map (fromString . fst)
$ condExecutables gpd $ condExecutables gpd
} }
when (ccIncludeTests cc) $ forM_ (condTestSuites gpd) when (ccIncludeTests cc) $ forM_ (condTestSuites gpd)
$ tellTree cc CompTestSuite testBuildInfo . snd $ tellTree cc CompTestSuite testBuildInfo noModules . snd
when (ccIncludeBenchmarks cc) $ forM_ (condBenchmarks gpd) when (ccIncludeBenchmarks cc) $ forM_ (condBenchmarks gpd)
$ tellTree cc CompBenchmark benchmarkBuildInfo . snd $ tellTree cc CompBenchmark benchmarkBuildInfo noModules . snd
where
noModules = const mempty
getModules = setFromList . map display . exposedModules
-- | Convert a single CondTree to a 'SimpleDesc'. -- | Convert a single CondTree to a 'SimpleDesc'.
tellTree :: (MonadWriter SimpleDesc m, MonadThrow m) tellTree :: (MonadWriter SimpleDesc m, MonadThrow m)
=> CheckCond => CheckCond
-> Component -> Component
-> (a -> BuildInfo) -> (a -> BuildInfo)
-> (a -> Set Text) -- ^ get module names
-> CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a
-> m () -> m ()
tellTree cc component getBI (CondNode dat deps comps) = do tellTree cc component getBI getModules =
tell mempty loop
{ sdPackages = unionsWith (<>) $ flip map deps where
$ \(Dependency x y) -> singletonMap x DepInfo loop (CondNode dat deps comps) = do
{ diComponents = singletonSet component tell mempty
, diRange = simplifyVersionRange y { sdPackages = unionsWith (<>) $ flip map deps
} $ \(Dependency x y) -> singletonMap x DepInfo
, sdTools = unionsWith (<>) $ flip map (buildTools $ getBI dat)
$ \(Dependency name range) -> singletonMap
-- In practice, cabal files refer to the exe name, not the
-- package name.
(ExeName $ unPackageName name)
DepInfo
{ diComponents = singletonSet component { diComponents = singletonSet component
, diRange = simplifyVersionRange range , diRange = simplifyVersionRange y
} }
} , sdTools = unionsWith (<>) $ flip map (buildTools $ getBI dat)
forM_ comps $ \(cond, ontrue, onfalse) -> do $ \(Dependency name range) -> singletonMap
b <- checkCond cc cond -- In practice, cabal files refer to the exe name, not the
if b -- package name.
then tellTree cc component getBI ontrue (ExeName $ unPackageName name)
else maybe (return ()) (tellTree cc component getBI) onfalse DepInfo
{ diComponents = singletonSet component
, diRange = simplifyVersionRange range
}
, sdModules = getModules dat
}
forM_ comps $ \(cond, ontrue, onfalse) -> do
b <- checkCond cc cond
if b
then loop ontrue
else maybe (return ()) loop onfalse
-- | Resolve a condition to a boolean based on the provided 'CheckCond'. -- | Resolve a condition to a boolean based on the provided 'CheckCond'.
checkCond :: MonadThrow m => CheckCond -> Condition ConfVar -> m Bool checkCond :: MonadThrow m => CheckCond -> Condition ConfVar -> m Bool

View File

@ -288,7 +288,7 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =
-- on top of our successful results -- on top of our successful results
atomically $ putTMVar (piResult sbPackageInfo) True atomically $ putTMVar (piResult sbPackageInfo) True
when (pcHaddocks /= Don'tBuild && hasLibrary (ppDesc $ piPlan sbPackageInfo)) $ do when (pcHaddocks /= Don'tBuild && not (null $ sdModules $ ppDesc $ piPlan sbPackageInfo)) $ do
log' $ "Haddocks " ++ namever log' $ "Haddocks " ++ namever
hfs <- readTVarIO sbHaddockFiles hfs <- readTVarIO sbHaddockFiles
let hfsOpts = flip map (mapToList hfs) $ \(pkgVer, hf) -> concat let hfsOpts = flip map (mapToList hfs) $ \(pkgVer, hf) -> concat
@ -362,12 +362,6 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =
Just bf -> bf Just bf -> bf
Nothing -> BuildFailureException exc Nothing -> BuildFailureException exc
hasLibrary :: SimpleDesc -> Bool
hasLibrary sd =
any go (sdPackages sd) || any go (sdTools sd)
where
go = (CompLibrary `member`) . diComponents
renameOrCopy :: FilePath -> FilePath -> IO () renameOrCopy :: FilePath -> FilePath -> IO ()
renameOrCopy src dest = rename src dest `catchIO` \_ -> copyDir src dest renameOrCopy src dest = rename src dest `catchIO` \_ -> copyDir src dest