stackage-curator 0.7.0 → 0.7.0.1
raw patch · 7 files changed
+7/−318 lines, 7 filesdep +stackage-curatordep +stackage-typesdep −stackage
Dependencies added: stackage-curator, stackage-types
Dependencies removed: stackage
Files
- Stackage/BuildConstraints.hs +0/−84
- Stackage/BuildPlan.hs +0/−62
- Stackage/PackageDescription.hs +0/−82
- Stackage/Prelude.hs +1/−46
- Stackage/ServerBundle.hs +1/−40
- app/stackage.hs +1/−1
- stackage-curator.cabal +4/−3
Stackage/BuildConstraints.hs view
@@ -28,57 +28,6 @@ import Stackage.CorePackages import Stackage.Prelude -data TestState = ExpectSuccess- | ExpectFailure- | Don'tBuild -- ^ when the test suite will pull in things we don't want- deriving (Show, Eq, Ord, Bounded, Enum)--testStateToText :: TestState -> Text-testStateToText ExpectSuccess = "expect-success"-testStateToText ExpectFailure = "expect-failure"-testStateToText Don'tBuild = "do-not-build"--instance ToJSON TestState where- toJSON = toJSON . testStateToText-instance FromJSON TestState where- parseJSON = withText "TestState" $ \t ->- case lookup t states of- Nothing -> fail $ "Invalid state: " ++ unpack t- Just v -> return v- where- states = asHashMap $ mapFromList- $ map (\x -> (testStateToText x, x)) [minBound..maxBound]--data SystemInfo = SystemInfo- { siGhcVersion :: Version- , siOS :: OS- , siArch :: Arch- , siCorePackages :: Map PackageName Version- , siCoreExecutables :: Set ExeName- }- deriving (Show, Eq, Ord)-instance ToJSON SystemInfo where- toJSON SystemInfo {..} = object- [ "ghc-version" .= display siGhcVersion- , "os" .= display siOS- , "arch" .= display siArch- , "core-packages" .= Map.mapKeysWith const unPackageName (map display siCorePackages)- , "core-executables" .= siCoreExecutables- ]-instance FromJSON SystemInfo where- parseJSON = withObject "SystemInfo" $ \o -> do- let helper name = (o .: name) >>= either (fail . show) return . simpleParse- siGhcVersion <- helper "ghc-version"- siOS <- helper "os"- siArch <- helper "arch"- siCorePackages <- (o .: "core-packages") >>= goPackages- siCoreExecutables <- o .: "core-executables"- return SystemInfo {..}- where- goPackages = either (fail . show) return- . mapM simpleParse- . Map.mapKeysWith const mkPackageName- data BuildConstraints = BuildConstraints { bcPackages :: Set PackageName -- ^ This does not include core packages.@@ -89,39 +38,6 @@ , bcGithubUsers :: Map Text (Set Text) -- ^ map an account to set of pingees }--data PackageConstraints = PackageConstraints- { pcVersionRange :: VersionRange- , pcMaintainer :: Maybe Maintainer- , pcTests :: TestState- , pcHaddocks :: TestState- , pcBuildBenchmarks :: Bool- , pcFlagOverrides :: Map FlagName Bool- , pcEnableLibProfile :: Bool- }- deriving (Show, Eq)-instance ToJSON PackageConstraints where- toJSON PackageConstraints {..} = object $ addMaintainer- [ "version-range" .= display pcVersionRange- , "tests" .= pcTests- , "haddocks" .= pcHaddocks- , "build-benchmarks" .= pcBuildBenchmarks- , "flags" .= Map.mapKeysWith const unFlagName pcFlagOverrides- , "library-profiling" .= pcEnableLibProfile- ]- where- addMaintainer = maybe id (\m -> (("maintainer" .= m):)) pcMaintainer-instance FromJSON PackageConstraints where- parseJSON = withObject "PackageConstraints" $ \o -> do- pcVersionRange <- (o .: "version-range")- >>= either (fail . show) return . simpleParse- pcTests <- o .: "tests"- pcHaddocks <- o .: "haddocks"- pcBuildBenchmarks <- o .: "build-benchmarks"- pcFlagOverrides <- Map.mapKeysWith const mkFlagName <$> o .: "flags"- pcMaintainer <- o .:? "maintainer"- pcEnableLibProfile <- fmap (fromMaybe True) (o .:? "library-profiling")- return PackageConstraints {..} -- | The proposed plan from the requirements provided by contributors. --
Stackage/BuildPlan.hs view
@@ -29,68 +29,6 @@ import Stackage.PackageIndex import Stackage.Prelude -data BuildPlan = BuildPlan- { bpSystemInfo :: SystemInfo- , bpTools :: Vector (PackageName, Version)- , bpPackages :: Map PackageName PackagePlan- , bpGithubUsers :: Map Text (Set Text)- }- deriving (Show, Eq)--instance ToJSON BuildPlan where- toJSON BuildPlan {..} = object- [ "system-info" .= bpSystemInfo- , "tools" .= map goTool bpTools- , "packages" .= Map.mapKeysWith const unPackageName bpPackages- , "github-users" .= bpGithubUsers- ]- where- goTool (k, v) = object- [ "name" .= display k- , "version" .= display v- ]-instance FromJSON BuildPlan where- parseJSON = withObject "BuildPlan" $ \o -> do- bpSystemInfo <- o .: "system-info"- bpTools <- (o .: "tools") >>= mapM goTool- bpPackages <- Map.mapKeysWith const mkPackageName <$> (o .: "packages")- bpGithubUsers <- o .:? "github-users" .!= mempty- return BuildPlan {..}- where- goTool = withObject "Tool" $ \o -> (,)- <$> ((o .: "name") >>=- either (fail . show) return . simpleParse . asText)- <*> ((o .: "version") >>=- either (fail . show) return . simpleParse . asText)--data PackagePlan = PackagePlan- { ppVersion :: Version- , ppGithubPings :: Set Text- , ppUsers :: Set PackageName- , ppConstraints :: PackageConstraints- , ppDesc :: SimpleDesc- }- deriving (Show, Eq)--instance ToJSON PackagePlan where- toJSON PackagePlan {..} = object- [ "version" .= asText (display ppVersion)- , "github-pings" .= ppGithubPings- , "users" .= map unPackageName (unpack ppUsers)- , "constraints" .= ppConstraints- , "description" .= ppDesc- ]-instance FromJSON PackagePlan where- parseJSON = withObject "PackageBuild" $ \o -> do- 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 {..}- -- | Make a build plan given these package set and build constraints. newBuildPlan :: MonadIO m => Map PackageName PackagePlan -> BuildConstraints -> m BuildPlan newBuildPlan packagesOrig bc@BuildConstraints {..} = liftIO $ do
Stackage/PackageDescription.hs view
@@ -27,88 +27,6 @@ import Distribution.System (Arch, OS) import Stackage.Prelude -data Component = CompLibrary- | CompExecutable- | CompTestSuite- | CompBenchmark- deriving (Show, Read, Eq, Ord, Enum, Bounded)--compToText :: Component -> Text-compToText CompLibrary = "library"-compToText CompExecutable = "executable"-compToText CompTestSuite = "test-suite"-compToText CompBenchmark = "benchmark"--instance ToJSON Component where- toJSON = toJSON . compToText-instance FromJSON Component where- parseJSON = withText "Component" $ \t -> maybe- (fail $ "Invalid component: " ++ unpack t)- return- (lookup t comps)- where- comps = asHashMap $ mapFromList $ map (compToText &&& id) [minBound..maxBound]--data DepInfo = DepInfo- { diComponents :: Set Component- , diRange :: VersionRange- }- deriving (Show, Eq)--instance Semigroup DepInfo where- DepInfo a x <> DepInfo b y = DepInfo- (a <> b)- (intersectVersionRanges x y)-instance ToJSON DepInfo where- toJSON DepInfo {..} = object- [ "components" .= diComponents- , "range" .= display diRange- ]-instance FromJSON DepInfo where- parseJSON = withObject "DepInfo" $ \o -> do- diComponents <- o .: "components"- diRange <- o .: "range" >>= either (fail . show) return . simpleParse- return DepInfo {..}---- | A simplified package description that tracks:------ * Package dependencies------ * Build tool dependencies------ * Provided executables------ It has fully resolved all conditionals-data SimpleDesc = SimpleDesc- { sdPackages :: Map PackageName DepInfo- , sdTools :: Map ExeName DepInfo- , sdProvidedExes :: Set ExeName- , sdModules :: Set Text- -- ^ modules exported by the library- }- deriving (Show, Eq)-instance Monoid SimpleDesc where- mempty = SimpleDesc mempty mempty mempty mempty- mappend (SimpleDesc a b c d) (SimpleDesc w x y z) = SimpleDesc- (unionWith (<>) a w)- (unionWith (<>) b x)- (c ++ y)- (d ++ z)-instance ToJSON SimpleDesc where- toJSON SimpleDesc {..} = object- [ "packages" .= Map.mapKeysWith const unPackageName sdPackages- , "tools" .= Map.mapKeysWith const unExeName sdTools- , "provided-exes" .= sdProvidedExes- , "modules" .= sdModules- ]-instance FromJSON SimpleDesc where- parseJSON = withObject "SimpleDesc" $ \o -> do- sdPackages <- Map.mapKeysWith const mkPackageName <$> (o .: "packages")- sdTools <- Map.mapKeysWith const ExeName <$> (o .: "tools")- sdProvidedExes <- o .: "provided-exes"- sdModules <- o .: "modules"- return SimpleDesc {..}- -- | Convert a 'GenericPackageDescription' into a 'SimpleDesc' by following the -- constraints in the provided 'CheckCond'. toSimpleDesc :: MonadThrow m
Stackage/Prelude.hs view
@@ -23,52 +23,7 @@ import Filesystem (createTree) import Filesystem.Path (parent) import qualified Filesystem.Path as F--unPackageName :: PackageName -> Text-unPackageName (PackageName str) = pack str--unFlagName :: FlagName -> Text-unFlagName (FlagName str) = pack str--mkPackageName :: Text -> PackageName-mkPackageName = PackageName . unpack--mkFlagName :: Text -> FlagName-mkFlagName = FlagName . unpack--display :: DT.Text a => a -> Text-display = fromString . DT.display--simpleParse :: (MonadThrow m, DT.Text a, Typeable a) => Text -> m a-simpleParse orig = withTypeRep $ \rep ->- case DT.simpleParse str of- Nothing -> throwM (ParseFailedException rep (pack str))- Just v -> return v- where- str = unpack orig-- withTypeRep :: Typeable a => (TypeRep -> m a) -> m a- withTypeRep f =- res- where- res = f (typeOf (unwrap res))-- unwrap :: m a -> a- unwrap _ = error "unwrap"--data ParseFailedException = ParseFailedException TypeRep Text- deriving (Show, Typeable)-instance Exception ParseFailedException--newtype Maintainer = Maintainer { unMaintainer :: Text }- deriving (Show, Eq, Ord, Hashable, ToJSON, FromJSON, IsString)---- | Name of an executable.-newtype ExeName = ExeName { unExeName :: Text }- deriving (Show, Eq, Ord, Hashable, ToJSON, FromJSON, IsString)--intersectVersionRanges :: VersionRange -> VersionRange -> VersionRange-intersectVersionRanges x y = C.simplifyVersionRange $ C.intersectVersionRanges x y+import Stackage.Types as X -- | There seems to be a bug in Cabal where serializing and deserializing -- version ranges winds up with different representations. So we have a
Stackage/ServerBundle.hs view
@@ -32,6 +32,7 @@ import qualified Text.XML as X import Text.XML.Cursor import System.PosixCompat.Files (createSymbolicLink)+import Stackage.Types -- | Get current time epochTime :: IO Tar.EpochTime@@ -83,23 +84,6 @@ map (\(PackageName name) -> name) (M.keys $ siCorePackages bpSystemInfo) --- | Package name is key-type DocMap = Map Text PackageDocs-data PackageDocs = PackageDocs- { pdVersion :: Text- , pdModules :: Map Text [Text]- -- ^ module name, path- }-instance ToJSON PackageDocs where- toJSON PackageDocs {..} = object- [ "version" .= pdVersion- , "modules" .= pdModules- ]-instance FromJSON PackageDocs where- parseJSON = withObject "PackageDocs" $ \o -> PackageDocs- <$> o .: "version"- <*> o .: "modules"- docsListing :: BuildPlan -> FilePath -- ^ docs directory -> IO DocMap@@ -139,29 +123,6 @@ , pdModules = m } else return mempty--data SnapshotType = STNightly- | STLTS !Int !Int -- ^ major, minor- deriving (Show, Read, Eq, Ord)--instance ToJSON SnapshotType where- toJSON STNightly = object- [ "type" .= asText "nightly"- ]- toJSON (STLTS major minor) = object- [ "type" .= asText "lts"- , "major" .= major- , "minor" .= minor- ]-instance FromJSON SnapshotType where- parseJSON = withObject "SnapshotType" $ \o -> do- t <- o .: "type"- case asText t of- "nightly" -> return STNightly- "lts" -> STLTS- <$> o .: "major"- <*> o .: "minor"- _ -> fail $ "Unknown type for SnapshotType: " ++ unpack t data CreateBundleV2 = CreateBundleV2 { cb2Plan :: BuildPlan
app/stackage.hs view
@@ -8,7 +8,7 @@ import Data.Version import Options.Applicative import Filesystem.Path.CurrentOS (decodeString)-import Paths_stackage (version)+import Paths_stackage_curator (version) import Stackage.CompleteBuild import Stackage.Upload import Stackage.InstallBuild
stackage-curator.cabal view
@@ -1,5 +1,5 @@ name: stackage-curator-version: 0.7.0+version: 0.7.0.1 synopsis: Tools for curating Stackage bundles description: Please see <http://www.stackage.org/package/stackage-curator> for a description and documentation. homepage: https://github.com/fpco/stackage@@ -66,13 +66,14 @@ , semigroups , xml-conduit , conduit+ , stackage-types executable stackage-curator default-language: Haskell2010 hs-source-dirs: app main-is: stackage.hs build-depends: base- , stackage+ , stackage-curator , optparse-applicative >= 0.11 , system-filepath , http-client@@ -89,7 +90,7 @@ Stackage.PackageIndexSpec Stackage.BuildPlanSpec build-depends: base- , stackage+ , stackage-curator , hspec , QuickCheck , text