From 17e23a8906a4a009c41f3770dcab69a830b712e4 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Mon, 8 Dec 2014 14:16:30 +0200 Subject: [PATCH] Cleanup --- Stackage2/BuildConstraints.hs | 48 ++++++++++++------------ Stackage2/BuildPlan.hs | 60 ++++++++++++++---------------- Stackage2/CheckBuildPlan.hs | 20 +++++----- Stackage2/GithubPings.hs | 9 +++-- Stackage2/PackageDescription.hs | 6 --- Stackage2/PackageIndex.hs | 4 +- Stackage2/Prelude.hs | 44 +++++++++++++--------- Stackage2/UpdateBuildPlan.hs | 14 +++---- test/Stackage2/BuildPlanSpec.hs | 1 - test/Stackage2/PackageIndexSpec.hs | 2 +- 10 files changed, 102 insertions(+), 106 deletions(-) diff --git a/Stackage2/BuildConstraints.hs b/Stackage2/BuildConstraints.hs index 82ce4d15..4503e510 100644 --- a/Stackage2/BuildConstraints.hs +++ b/Stackage2/BuildConstraints.hs @@ -1,7 +1,7 @@ {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} -- | The constraints on package selection for a new build plan. module Stackage2.BuildConstraints ( BuildConstraints (..) @@ -11,16 +11,16 @@ module Stackage2.BuildConstraints , defaultBuildConstraints ) where -import Stackage2.Prelude -import Stackage2.CorePackages -import qualified Stackage.Config as Old -import qualified Stackage.Types as Old -import qualified Stackage.Select as Old -import Data.Aeson -import Distribution.System (OS, Arch) -import Distribution.Version (anyVersion) +import Data.Aeson +import qualified Data.Map as Map +import Distribution.System (Arch, OS) import qualified Distribution.System -import qualified Data.Map as Map +import Distribution.Version (anyVersion) +import qualified Stackage.Config as Old +import qualified Stackage.Select as Old +import qualified Stackage.Types as Old +import Stackage2.CorePackages +import Stackage2.Prelude data TestState = ExpectSuccess | ExpectFailure @@ -44,10 +44,10 @@ instance FromJSON TestState where $ map (\x -> (testStateToText x, x)) [minBound..maxBound] data SystemInfo = SystemInfo - { siGhcVersion :: Version - , siOS :: OS - , siArch :: Arch - , siCorePackages :: Map PackageName Version + { siGhcVersion :: Version + , siOS :: OS + , siArch :: Arch + , siCorePackages :: Map PackageName Version , siCoreExecutables :: Set ExeName } deriving (Show, Eq, Ord) @@ -74,20 +74,20 @@ instance FromJSON SystemInfo where . Map.mapKeysWith const mkPackageName data BuildConstraints = BuildConstraints - { bcPackages :: Set PackageName + { bcPackages :: Set PackageName -- ^ This does not include core packages. , bcPackageConstraints :: PackageName -> PackageConstraints - , bcSystemInfo :: SystemInfo + , bcSystemInfo :: SystemInfo } data PackageConstraints = PackageConstraints - { pcVersionRange :: VersionRange - , pcMaintainer :: Maybe Maintainer - , pcTests :: TestState - , pcHaddocks :: TestState + { pcVersionRange :: VersionRange + , pcMaintainer :: Maybe Maintainer + , pcTests :: TestState + , pcHaddocks :: TestState , pcBuildBenchmarks :: Bool - , pcFlagOverrides :: Map FlagName Bool + , pcFlagOverrides :: Map FlagName Bool } deriving (Show, Eq) instance ToJSON PackageConstraints where @@ -128,8 +128,6 @@ defaultBuildConstraints = do defaultGlobalFlags = asMap $ mapFromList $ map (, True) (map FlagName $ setToList $ Old.flags oldSettings mempty) ++ map (, False) (map FlagName $ setToList $ Old.disabledFlags oldSettings) - tryBuildTest (PackageName name) = pack name `notMember` skippedTests - tryBuildBenchmark (PackageName name) = pack name `notMember` skippedBenchs expectedFailures = Old.defaultExpectedFailures oldGhcVer False skippedTests = old ++ extraSkippedTests @@ -145,7 +143,7 @@ defaultBuildConstraints = do pcVersionRange = simplifyVersionRange $ maybe anyVersion fst mold pcMaintainer = (Maintainer . pack . Old.unMaintainer . snd) <$> mold pcTests - | not $ tryBuildTest name = Don'tBuild + | unPackageName name `member` skippedTests = Don'tBuild | name `member` expectedFailures = ExpectFailure | otherwise = ExpectSuccess diff --git a/Stackage2/BuildPlan.hs b/Stackage2/BuildPlan.hs index 32834904..cb6cdb83 100644 --- a/Stackage2/BuildPlan.hs +++ b/Stackage2/BuildPlan.hs @@ -1,12 +1,12 @@ -{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} -- | Representation of a concrete build plan, and how to generate a new one -- based on constraints. module Stackage2.BuildPlan @@ -15,25 +15,22 @@ module Stackage2.BuildPlan , newBuildPlan ) where -import Distribution.Package (Dependency (..)) -import Distribution.PackageDescription -import Distribution.Version (withinRange, anyVersion, simplifyVersionRange) -import Stackage2.BuildConstraints -import Stackage2.PackageIndex -import Stackage2.Prelude -import Stackage2.GithubPings -import Control.Monad.State.Strict (execState, get, put) -import qualified Data.Map as Map -import qualified Data.Set as Set -import Data.Aeson -import Stackage2.PackageDescription -import qualified Distribution.System +import Control.Monad.State.Strict (execState, get, put) +import Data.Aeson +import qualified Data.Map as Map +import qualified Data.Set as Set import qualified Distribution.Compiler +import Distribution.PackageDescription +import Stackage2.BuildConstraints +import Stackage2.GithubPings +import Stackage2.PackageDescription +import Stackage2.PackageIndex +import Stackage2.Prelude data BuildPlan = BuildPlan { bpSystemInfo :: SystemInfo - , bpTools :: Vector (PackageName, Version) - , bpPackages :: Map PackageName PackagePlan + , bpTools :: Vector (PackageName, Version) + , bpPackages :: Map PackageName PackagePlan } deriving (Show, Eq) @@ -62,11 +59,11 @@ instance FromJSON BuildPlan where either (fail . show) return . simpleParse . asText) data PackagePlan = PackagePlan - { ppVersion :: Version - , ppGithubPings :: Set Text - , ppUsers :: Set PackageName - , ppConstraints :: PackageConstraints - , ppDesc :: SimpleDesc + { ppVersion :: Version + , ppGithubPings :: Set Text + , ppUsers :: Set PackageName + , ppConstraints :: PackageConstraints + , ppDesc :: SimpleDesc } deriving (Show, Eq) @@ -80,15 +77,14 @@ instance ToJSON PackagePlan where ] instance FromJSON PackagePlan where parseJSON = withObject "PackageBuild" $ \o -> do - ppVersion <- o .: "version" >>= efail . simpleParse . asText + ppVersion <- o .: "version" + >>= either (fail . show) return + . simpleParse . asText ppGithubPings <- o .:? "github-pings" .!= mempty ppUsers <- Set.map PackageName <$> (o .:? "users" .!= mempty) ppConstraints <- o .: "constraints" ppDesc <- o .: "description" return PackagePlan {..} - where - pbDesc = () - efail = either (fail . show) return newBuildPlan :: MonadIO m => BuildConstraints -> m BuildPlan newBuildPlan bc@BuildConstraints {..} = liftIO $ do diff --git a/Stackage2/CheckBuildPlan.hs b/Stackage2/CheckBuildPlan.hs index 8ac0ecdb..54722d9f 100644 --- a/Stackage2/CheckBuildPlan.hs +++ b/Stackage2/CheckBuildPlan.hs @@ -1,18 +1,18 @@ -{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} -- | Confirm that a build plan has a consistent set of dependencies. module Stackage2.CheckBuildPlan ( checkBuildPlan ) where -import Stackage2.Prelude -import Stackage2.BuildPlan +import Control.Monad.Writer.Strict (Writer, execWriter, tell) import Stackage2.BuildConstraints +import Stackage2.BuildPlan import Stackage2.PackageDescription -import Control.Monad.Writer.Strict (execWriter, Writer, tell) +import Stackage2.Prelude checkBuildPlan :: MonadThrow m => BuildPlan -> m () checkBuildPlan BuildPlan {..} @@ -47,9 +47,9 @@ checkDeps allPackages (user, pb) = } data PkgUser = PkgUser - { puName :: PackageName - , puVersion :: Version - , puMaintainer :: Maybe Maintainer + { puName :: PackageName + , puVersion :: Version + , puMaintainer :: Maybe Maintainer , puGithubPings :: Set Text } deriving (Eq, Ord) diff --git a/Stackage2/GithubPings.hs b/Stackage2/GithubPings.hs index 8891518d..53456443 100644 --- a/Stackage2/GithubPings.hs +++ b/Stackage2/GithubPings.hs @@ -1,11 +1,12 @@ -{-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} module Stackage2.GithubPings ( getGithubPings ) where -import Stackage2.Prelude -import Distribution.PackageDescription -import qualified Stackage.Config as Old +import Distribution.PackageDescription +import qualified Stackage.Config as Old +import Stackage2.Prelude -- | Determine accounts to be pinged on Github based on various metadata in the -- package description. diff --git a/Stackage2/PackageDescription.hs b/Stackage2/PackageDescription.hs index 406008ff..11ecf824 100644 --- a/Stackage2/PackageDescription.hs +++ b/Stackage2/PackageDescription.hs @@ -15,21 +15,15 @@ module Stackage2.PackageDescription , CheckCond (..) ) where -import Control.Monad.State.Strict (execState, get, put) import Control.Monad.Writer.Strict (MonadWriter, execWriterT, tell) import Data.Aeson import qualified Data.Map as Map -import qualified Data.Set as Set import Distribution.Compiler (CompilerFlavor) import Distribution.Package (Dependency (..)) import Distribution.PackageDescription import Distribution.System (Arch, OS) -import Stackage2.CorePackages -import Stackage2.GithubPings -import Stackage2.PackageIndex import Stackage2.Prelude -import Data.Aeson -- | A simplified package description that tracks: -- diff --git a/Stackage2/PackageIndex.hs b/Stackage2/PackageIndex.hs index bda2e18f..14702ea3 100644 --- a/Stackage2/PackageIndex.hs +++ b/Stackage2/PackageIndex.hs @@ -12,11 +12,11 @@ module Stackage2.PackageIndex ) where import qualified Codec.Archive.Tar as Tar -import qualified Codec.Archive.Tar.Entry as TarEntry import Data.Conduit.Lazy (MonadActive, lazyConsume) import qualified Data.Text as T -import Distribution.PackageDescription (GenericPackageDescription, packageDescription, package) +import Distribution.PackageDescription (package, + packageDescription) import Distribution.PackageDescription.Parse (ParseResult (..), parsePackageDescription) import Distribution.ParseUtils (PError) diff --git a/Stackage2/Prelude.hs b/Stackage2/Prelude.hs index 4a4c3227..773a674e 100644 --- a/Stackage2/Prelude.hs +++ b/Stackage2/Prelude.hs @@ -1,26 +1,26 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} module Stackage2.Prelude ( module X , module Stackage2.Prelude ) where -import ClassyPrelude.Conduit as X -import Data.Conduit.Process as X -import Data.Typeable (TypeRep, typeOf) -import Distribution.Package as X (PackageIdentifier (..), - PackageName (PackageName)) -import Distribution.PackageDescription as X (FlagName (..), GenericPackageDescription) -import qualified Distribution.Text as DT -import Distribution.Version as X (Version (..), VersionRange) -import System.Exit (ExitCode (ExitSuccess)) -import Data.Aeson (ToJSON, FromJSON) -import qualified Distribution.Version as C -import Distribution.Version as X (withinRange) -import qualified Data.Map as Map +import ClassyPrelude.Conduit as X +import Data.Aeson (FromJSON, ToJSON) +import Data.Conduit.Process as X +import qualified Data.Map as Map +import Data.Typeable (TypeRep, typeOf) +import Distribution.Package as X (PackageIdentifier (..), PackageName (PackageName)) +import Distribution.PackageDescription as X (FlagName (..), GenericPackageDescription) +import qualified Distribution.Text as DT +import Distribution.Version as X (Version (..), + VersionRange) +import Distribution.Version as X (withinRange) +import qualified Distribution.Version as C +import System.Exit (ExitCode (ExitSuccess)) unPackageName :: PackageName -> Text unPackageName (PackageName str) = pack str @@ -77,11 +77,19 @@ checkExitCode _ ExitSuccess = return () checkExitCode cp ec = throwM $ ProcessExitedUnsuccessfully cp ec -- FIXME move into streaming-commons? +withCheckedProcess :: ( InputSource stdin + , OutputSink stderr + , OutputSink stdout + , MonadIO m + ) + => CreateProcess + -> (stdin -> stdout -> stderr -> m b) + -> m b withCheckedProcess cp f = do (x, y, z, sph) <- streamingProcess cp res <- f x y z ec <- waitForStreamingProcess sph - checkExitCode cp ec + liftIO $ checkExitCode cp ec return res newtype Maintainer = Maintainer { unMaintainer :: Text } diff --git a/Stackage2/UpdateBuildPlan.hs b/Stackage2/UpdateBuildPlan.hs index 6acadba5..8cd7a0c6 100644 --- a/Stackage2/UpdateBuildPlan.hs +++ b/Stackage2/UpdateBuildPlan.hs @@ -1,6 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordWildCards #-} -- | Take an existing build plan and bump all packages to the newest version in -- the same major version number. module Stackage2.UpdateBuildPlan @@ -8,12 +8,12 @@ module Stackage2.UpdateBuildPlan , updateBuildPlan ) where -import Stackage2.Prelude -import Stackage2.BuildPlan -import Stackage2.BuildConstraints -import Stackage2.PackageDescription -import Distribution.Version (orLaterVersion, earlierVersion, anyVersion) -import qualified Data.Map as Map +import qualified Data.Map as Map +import Distribution.Version (anyVersion, earlierVersion, + orLaterVersion) +import Stackage2.BuildConstraints +import Stackage2.BuildPlan +import Stackage2.Prelude updateBuildPlan :: BuildPlan -> IO BuildPlan updateBuildPlan = newBuildPlan . updateBuildConstraints diff --git a/test/Stackage2/BuildPlanSpec.hs b/test/Stackage2/BuildPlanSpec.hs index 4802db35..5f650db6 100644 --- a/test/Stackage2/BuildPlanSpec.hs +++ b/test/Stackage2/BuildPlanSpec.hs @@ -7,7 +7,6 @@ import Stackage2.BuildConstraints import Stackage2.UpdateBuildPlan import Test.Hspec import qualified Data.Yaml as Y -import Control.Exception (evaluate) import Distribution.Version (anyVersion) import qualified Data.Map as Map diff --git a/test/Stackage2/PackageIndexSpec.hs b/test/Stackage2/PackageIndexSpec.hs index b9cf863b..18f64319 100644 --- a/test/Stackage2/PackageIndexSpec.hs +++ b/test/Stackage2/PackageIndexSpec.hs @@ -4,7 +4,7 @@ module Stackage2.PackageIndexSpec (spec) where import Stackage2.PackageIndex import Stackage2.Prelude import Test.Hspec -import Distribution.Package (packageId, pkgVersion) +import Distribution.Package (packageId) spec :: Spec spec = do