Cleanup

2026-01-12 15:28:29 +01:00 · 2014-12-08 14:16:30 +02:00 · 2014-12-08 14:16:30 +02:00 · 17e23a8906
commit 17e23a8906
parent 04f71e69e7
10 changed files with 102 additions and 106 deletions
--- 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

--- 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
--- 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)
--- 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.
--- 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:
 --
--- 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)
--- 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 }
--- 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
--- 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

--- 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