From f7328993035610ea0567f413f2d4757722f291d8 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Sun, 11 Mar 2018 20:09:19 +0200 Subject: [PATCH] Upgrade to GHC 8.2/Cabal 2.2 Inlines stackage-metadata as well --- package.yaml | 4 +- src/Stackage/Metadata.hs | 94 ++++++++++++++++++++++++++++ src/Stackage/PackageIndex/Conduit.hs | 89 ++++++++++++++++++++++++++ stack.yaml | 31 +++++---- 4 files changed, 199 insertions(+), 19 deletions(-) create mode 100644 src/Stackage/Metadata.hs create mode 100644 src/Stackage/PackageIndex/Conduit.hs diff --git a/package.yaml b/package.yaml index 7abcca3..84d5ee0 100644 --- a/package.yaml +++ b/package.yaml @@ -87,7 +87,6 @@ dependencies: - async - yesod-gitrepo - hoogle -- spoon - deepseq - deepseq-generics - auto-update @@ -97,7 +96,6 @@ dependencies: - classy-prelude-conduit - path-pieces - persistent-postgresql -- stackage-metadata - filepath - http-client - http-types @@ -107,6 +105,8 @@ dependencies: - lens - file-embed - resource-pool +- containers +- pretty default-extensions: - TemplateHaskell diff --git a/src/Stackage/Metadata.hs b/src/Stackage/Metadata.hs new file mode 100644 index 0000000..d5696c9 --- /dev/null +++ b/src/Stackage/Metadata.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} +module Stackage.Metadata + ( PackageInfo (..) + , Deprecation (..) + ) where + +import Control.Applicative ((<$>), (<*>)) +import Data.Aeson (FromJSON (..), ToJSON (..), + object, withObject, (.:), (.=)) +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Text (Text) +import Data.Typeable (Typeable) +import Distribution.Types.Version (Version) +import Distribution.Package (PackageName) +import Distribution.Version (VersionRange) +import Prelude hiding (pi) +import Stackage.PackageIndex.Conduit (parseDistText, renderDistText) + +data PackageInfo = PackageInfo + { piLatest :: !Version + , piHash :: !Text + , piAllVersions :: !(Set Version) + , piSynopsis :: !Text + , piDescription :: !Text + , piDescriptionType :: !Text + , piChangeLog :: !Text + , piChangeLogType :: !Text + , piBasicDeps :: !(Map PackageName VersionRange) + , piTestBenchDeps :: !(Map PackageName VersionRange) + , piAuthor :: !Text + , piMaintainer :: !Text + , piHomepage :: !Text + , piLicenseName :: !Text + } + deriving (Show, Eq, Typeable) +instance ToJSON PackageInfo where + toJSON pi = object + [ "latest" .= renderDistText (piLatest pi) + , "hash" .= piHash pi + , "all-versions" .= map renderDistText (Set.toList $ piAllVersions pi) + , "synopsis" .= piSynopsis pi + , "description" .= piDescription pi + , "description-type" .= piDescriptionType pi + , "changelog" .= piChangeLog pi + , "changelog-type" .= piChangeLogType pi + , "basic-deps" .= showM (piBasicDeps pi) + , "test-bench-deps" .= showM (piTestBenchDeps pi) + , "author" .= piAuthor pi + , "maintainer" .= piMaintainer pi + , "homepage" .= piHomepage pi + , "license-name" .= piLicenseName pi + ] + where + showM = Map.mapKeysWith const renderDistText . Map.map renderDistText +instance FromJSON PackageInfo where + parseJSON = withObject "PackageInfo" $ \o -> PackageInfo + <$> (o .: "latest" >>= parseDistText) + <*> o .: "hash" + <*> (o .: "all-versions" >>= fmap Set.fromList . mapM parseDistText) + <*> o .: "synopsis" + <*> o .: "description" + <*> o .: "description-type" + <*> o .: "changelog" + <*> o .: "changelog-type" + <*> (o .: "basic-deps" >>= parseM) + <*> (o .: "test-bench-deps" >>= parseM) + <*> o .: "author" + <*> o .: "maintainer" + <*> o .: "homepage" + <*> o .: "license-name" + where + parseM = fmap Map.fromList . mapM go . Map.toList + go (name, range) = do + name' <- parseDistText name + range' <- parseDistText range + return (name', range') + +data Deprecation = Deprecation + { depPackage :: !Text + , depInFavourOf :: !(Set Text) + } +instance ToJSON Deprecation where + toJSON d = object + [ "deprecated-package" .= depPackage d + , "in-favour-of" .= depInFavourOf d + ] +instance FromJSON Deprecation where + parseJSON = withObject "Deprecation" $ \o -> Deprecation + <$> o .: "deprecated-package" + <*> o .: "in-favour-of" diff --git a/src/Stackage/PackageIndex/Conduit.hs b/src/Stackage/PackageIndex/Conduit.hs new file mode 100644 index 0000000..846f68a --- /dev/null +++ b/src/Stackage/PackageIndex/Conduit.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE RankNTypes #-} +module Stackage.PackageIndex.Conduit + ( sourceTarFile + , sourceAllCabalFiles + , parseDistText + , renderDistText + , CabalFileEntry (..) + ) where + +import qualified Codec.Archive.Tar as Tar +import Codec.Compression.GZip (decompress) +import Control.Monad (guard) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Resource (MonadResource, throwM) +import qualified Data.ByteString.Lazy as L +import Data.Conduit (Producer, bracketP, + yield, (=$=)) +import qualified Data.Conduit.List as CL +import Data.Version (Version) +import Distribution.Compat.ReadP (readP_to_S) +import Distribution.Package (PackageName) +import Distribution.PackageDescription (GenericPackageDescription) +import Distribution.PackageDescription.Parsec (ParseResult, parseGenericPackageDescription) +import Distribution.Text (disp, parse) +import qualified Distribution.Text +import System.IO (IOMode (ReadMode), + hClose, openBinaryFile) +import Text.PrettyPrint (render) +import Prelude + +sourceTarFile :: MonadResource m + => Bool -- ^ ungzip? + -> FilePath + -> Producer m Tar.Entry +sourceTarFile toUngzip fp = do + bracketP (openBinaryFile fp ReadMode) hClose $ \h -> do + lbs <- liftIO $ L.hGetContents h + loop $ Tar.read $ ungzip' lbs + where + ungzip' + | toUngzip = decompress + | otherwise = id + loop Tar.Done = return () + loop (Tar.Fail e) = throwM e + loop (Tar.Next e es) = yield e >> loop es + +data CabalFileEntry = CabalFileEntry + { cfeName :: !PackageName + , cfeVersion :: !Version + , cfeRaw :: L.ByteString + , cfeEntry :: Tar.Entry + , cfeParsed :: ParseResult GenericPackageDescription + } + +sourceAllCabalFiles + :: MonadResource m + => IO FilePath + -> Producer m CabalFileEntry +sourceAllCabalFiles getIndexTar = do + tarball <- liftIO $ getIndexTar + sourceTarFile False tarball =$= CL.mapMaybe go + where + go e = + case (toPkgVer $ Tar.entryPath e, Tar.entryContent e) of + (Just (name, version), Tar.NormalFile lbs _) -> Just CabalFileEntry + { cfeName = name + , cfeVersion = version + , cfeRaw = lbs + , cfeEntry = e + , cfeParsed = parseGenericPackageDescription $ L.toStrict lbs + } + _ -> Nothing + + toPkgVer s0 = do + (name', '/':s1) <- Just $ break (== '/') s0 + (version', '/':s2) <- Just $ break (== '/') s1 + guard $ s2 == (name' ++ ".cabal") + name <- parseDistText name' + version <- parseDistText version' + Just (name, version) + +parseDistText :: (Monad m, Distribution.Text.Text t) => String -> m t +parseDistText s = + case map fst $ filter (null . snd) $ readP_to_S parse s of + [x] -> return x + _ -> fail $ "Could not parse: " ++ s + +renderDistText :: Distribution.Text.Text t => t -> String +renderDistText = render . disp diff --git a/stack.yaml b/stack.yaml index 53c82d2..415aae6 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,18 +1,15 @@ -resolver: lts-9.13 -packages: -- . -- location: - git: https://github.com/chrisdone/tagstream-conduit.git - commit: bacd7444596b2391b0ac302ad649b994b258d271 - extra-dep: true -- location: - git: https://github.com/commercialhaskell/all-cabal-metadata-tool - commit: ea541be73238a5ce14ad26f4e2a94e63981242a4 - extra-dep: true -- location: - git: https://github.com/snoyberg/gitrev.git - commit: 6a1a639f493ac08959eb5ddf540ca1937baaaaf9 - extra-dep: true +resolver: lts-10.5 extra-deps: -- barrier-0.1.1 -- spoon-0.3.1 +- archive: https://github.com/chrisdone/tagstream-conduit/archive/bacd7444596b2391b0ac302ad649b994b258d271.tar.gz +- archive: https://github.com/snoyberg/gitrev/archive/6a1a639f493ac08959eb5ddf540ca1937baaaaf9.tar.gz + +- Cabal-2.2.0.0@rev:1 +- cryptohash-conduit-0.1.1@rev:0 +- lens-4.16@rev:3 +- cabal-doctest-1.0.6@rev:1 +- entropy-0.4.1.1@rev:0 +- nonce-1.0.7@rev:0 +- stackage-curator-0.16.0.0@rev:0 + +# https://github.com/fizruk/http-api-data/issues/72 +- archive: https://github.com/snoyberg/http-api-data/archive/659dc4689355a5881acc2e037090d75391c673bb.tar.gz