stackage-metadata (empty) → 0.1.0.0
raw patch · 8 files changed
+497/−0 lines, 8 filesdep +Cabaldep +aesondep +basesetup-changed
Dependencies added: Cabal, aeson, base, base16-bytestring, bytestring, conduit, containers, cryptohash, directory, filepath, http-client, http-client-tls, pretty, resourcet, stackage-install, stackage-metadata, stackage-update, tar, text, transformers, yaml, zlib
Files
- ChangeLog.md +3/−0
- LICENSE +22/−0
- README.md +6/−0
- Setup.hs +2/−0
- Stackage/Metadata.hs +82/−0
- Stackage/PackageIndex/Conduit.hs +90/−0
- app/all-cabal-metadata-tool.hs +232/−0
- stackage-metadata.cabal +60/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+## 0.1.0.0++* Initial release
+ LICENSE view
@@ -0,0 +1,22 @@+The MIT License (MIT)++Copyright (c) 2015 commercialhaskell++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.+
+ README.md view
@@ -0,0 +1,6 @@+# stackage-metadata++[](https://travis-ci.org/commercialhaskell/all-cabal-metadata-tool)++Tool for extracting metadata on all packages. Mostly used for+[all-cabal-metadata](https://github.com/commercialhaskell/all-cabal-metadata)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Stackage/Metadata.hs view
@@ -0,0 +1,82 @@+{-# 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 Data.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)+ }+ 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)+ ]+ 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)+ 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"
+ Stackage/PackageIndex/Conduit.hs view
@@ -0,0 +1,90 @@+{-# 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.Text.Encoding.Error (lenientDecode)+import qualified Data.Text.Lazy as TL+import Data.Text.Lazy.Encoding (decodeUtf8With)+import Data.Version (Version)+import Distribution.Compat.ReadP (readP_to_S)+import Distribution.Package (PackageName)+import Distribution.PackageDescription (GenericPackageDescription)+import Distribution.PackageDescription.Parse (ParseResult,+ parsePackageDescription)+import Distribution.Text (disp, parse)+import qualified Distribution.Text+import System.IO (IOMode (ReadMode),+ hClose, openBinaryFile)+import Text.PrettyPrint (render)++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+ , 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+ , cfeParsed = parsePackageDescription $ TL.unpack $ decodeUtf8With lenientDecode 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
+ app/all-cabal-metadata-tool.hs view
@@ -0,0 +1,232 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}+import qualified Codec.Archive.Tar as Tar+import Control.Exception (assert)+import Control.Monad (when)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Resource (MonadResource,+ runResourceT, throwM)+import Crypto.Hash.SHA256 (hashlazy)+import qualified Data.ByteString as S+import qualified Data.ByteString.Base16 as B16+import qualified Data.ByteString.Lazy as L+import Data.Conduit (($$), (=$))+import qualified Data.Conduit.List as CL+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Text (Text, pack, toLower,+ unpack)+import Data.Text.Encoding (decodeUtf8With)+import qualified Data.Text.Encoding as TE+import Data.Text.Encoding.Error (lenientDecode)+import Data.Version (Version)+import Data.Yaml (decodeEither',+ decodeFileEither,+ encodeFile)+import Distribution.Package (Dependency (..),+ PackageIdentifier (..),+ PackageName)+import Distribution.PackageDescription (CondTree (..),+ Condition (..),+ ConfVar (..),+ condBenchmarks,+ condExecutables,+ condLibrary,+ condTestSuites,+ description, package,+ packageDescription,+ synopsis)+import Distribution.PackageDescription.Parse (ParseResult (..))+import Distribution.Version (VersionRange,+ intersectVersionRanges,+ simplifyVersionRange)+import Network.HTTP.Client (Manager, brConsume,+ newManager,+ responseBody,+ withResponse)+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Prelude hiding (pi)+import Stackage.Install+import Stackage.Metadata+import Stackage.PackageIndex.Conduit+import Stackage.Update+import System.Directory (createDirectoryIfMissing)+import System.FilePath (splitExtension,+ takeDirectory,+ takeFileName, (<.>),+ (</>))++data Pair x y = Pair !x !y++main :: IO ()+main = do+ stackageUpdate $ setVerify False defaultStackageUpdateSettings++ man <- newManager tlsManagerSettings+ packageLocation <- defaultPackageLocation+ indexLocation <- defaultIndexLocation+ let set = setGetManager (return man)+ $ setPackageLocation (return packageLocation)+ $ setIndexLocation (return indexLocation)+ defaultSettings++ newest <- runResourceT $ sourceAllCabalFiles (return indexLocation)+ $$ flip CL.fold Map.empty+ (\m cfe ->+ let name = cfeName cfe+ version = cfeVersion cfe+ in flip (Map.insert name) m $ case Map.lookup (cfeName cfe) m of+ Nothing -> Pair version (Set.singleton version)+ Just (Pair version' s) -> Pair (max version version') (Set.insert version s))++ let onlyNewest cfe =+ case Map.lookup (cfeName cfe) newest of+ Nothing -> assert False Nothing+ Just (Pair latest allVersions)+ | cfeVersion cfe == latest -> Just (cfe, allVersions)+ | otherwise -> Nothing++ runResourceT+ $ sourceAllCabalFiles (return indexLocation)+ $$ CL.mapMaybe onlyNewest+ =$ (do+ CL.mapMaybeM (updatePackage set packageLocation)+ liftIO $ saveDeprecated man+ )+ =$ CL.isolate 500+ =$ CL.sinkNull++saveDeprecated :: Manager -> IO ()+saveDeprecated man = do+ bss <- withResponse "https://hackage.haskell.org/packages/deprecated.json" man+ $ \res -> brConsume $ responseBody res+ deps <- either throwM return $ decodeEither' $ S.concat bss+ encodeFile "deprecated.yaml" (deps :: [Deprecation])++updatePackage :: MonadResource m+ => Settings+ -> (String -> String -> FilePath)+ -> (CabalFileEntry, Set Version)+ -> m (Maybe ())+updatePackage set packageLocation (cfe, allVersions) = do+ epi <- liftIO $ decodeFileEither fp+ case epi of+ Right pi+ | version == piLatest pi+ && thehash == piHash pi+ -> return Nothing+ _ -> do+ liftIO $ putStrLn $ concat+ [ "Loading "+ , renderDistText name+ , "-"+ , renderDistText version+ ]+ gpd <-+ case mgpd of+ ParseFailed pe -> error $ show (name, version, pe)+ ParseOk _ gpd -> return gpd++ let pd = packageDescription gpd+ when (package pd /= PackageIdentifier name version) $+ error $ show ("mismatch" :: String, name, version, package pd)++ let name'' = renderDistText name+ version' = renderDistText version+ liftIO $ download set [(name'', version')]+ let tarball = packageLocation name'' version'++ (desc, desct, cl, clt) <-+ sourceTarFile True tarball $$ CL.fold goEntry+ (pack $ description pd, "haddock", "", "")++ liftIO $ do+ createDirectoryIfMissing True $ takeDirectory fp+ let checkCond = const True -- FIXME do something intelligent+ getDeps' = getDeps checkCond+ encodeFile fp PackageInfo+ { piLatest = version+ , piHash = thehash+ , piAllVersions = allVersions+ , piSynopsis = pack $ synopsis pd+ , piDescription = desc+ , piDescriptionType = desct+ , piChangeLog = cl+ , piChangeLogType = clt+ , piBasicDeps = combineDeps+ $ maybe id ((:) . getDeps') (condLibrary gpd)+ $ map (getDeps' . snd) (condExecutables gpd)+ , piTestBenchDeps = combineDeps+ $ map (getDeps' . snd) (condTestSuites gpd)+ ++ map (getDeps' . snd) (condBenchmarks gpd)+ }+ return $ Just ()+ where+ name = cfeName cfe+ version = cfeVersion cfe+ lbs = cfeRaw cfe+ mgpd = cfeParsed cfe++ fp = "packages" </> (unpack $ toLower $ pack $ take 2 $ name' ++ "XX") </> name' <.> "yaml"+ name' = renderDistText name++ thehash = TE.decodeUtf8 $ B16.encode $ hashlazy lbs++ goEntry :: (Text, Text, Text, Text) -> Tar.Entry -> (Text, Text, Text, Text)+ goEntry orig@(desc, desct, cl, clt) e =+ case (toEntryType $ Tar.entryPath e, toText $ Tar.entryContent e) of+ (ChangeLog clt', Just cl') -> (desc, desct, cl', clt')+ (Desc desct', Just desc') -> (desc', desct', cl, clt)+ _ -> orig++ toText (Tar.NormalFile lbs' _) = Just $ decodeUtf8With lenientDecode $ L.toStrict lbs'+ toText _ = Nothing++data EntryType = Ignored | ChangeLog Text | Desc Text+ deriving Show++toEntryType :: FilePath -> EntryType+toEntryType fp+ -- Only take things in the root directory of the tarball+ | length (filter (== '/') fp) /= 1 = Ignored++ | name == "changelog" = ChangeLog t+ | name == "changes" = ChangeLog t+ | name == "readme" = Desc t+ | otherwise = Ignored+ where+ (name', ext) = splitExtension fp+ name = unpack $ toLower $ pack $ takeFileName name'+ t =+ case ext of+ ".md" -> "markdown"+ ".markdown" -> "markdown"+ _ -> "text"++-- | FIXME this function should get cleaned up and merged into stackage-common+getDeps :: (Condition ConfVar -> Bool)+ -> CondTree ConfVar [Dependency] a+ -> Map PackageName VersionRange+getDeps checkCond =+ goTree+ where+ goTree (CondNode _data deps comps) = combineDeps+ $ map (\(Dependency name range) -> Map.singleton name range) deps+ ++ map goComp comps++ goComp (cond, yes, no)+ | checkCond cond = goTree yes+ | otherwise = maybe Map.empty goTree no++combineDeps :: [Map PackageName VersionRange] -> Map PackageName VersionRange+combineDeps =+ Map.unionsWith (\x y -> normalize . simplifyVersionRange $ intersectVersionRanges x y)+ where+ normalize vr =+ case parseDistText $ renderDistText vr of+ Nothing -> vr+ Just vr' -> vr'
+ stackage-metadata.cabal view
@@ -0,0 +1,60 @@+name: stackage-metadata+version: 0.1.0.0+synopsis: Grab current metadata for all packages+description: See README.md+homepage: https://github.com/commercialhaskell/all-cabal-metadata-tool+license: MIT+license-file: LICENSE+author: Michael Snoyman+maintainer: michael@snoyman.com+category: Distribution+build-type: Simple+extra-source-files: README.md ChangeLog.md+cabal-version: >=1.10++library+ exposed-modules: Stackage.Metadata+ Stackage.PackageIndex.Conduit+ build-depends: base >=4.7 && < 5+ , text+ , containers+ , aeson >= 0.8+ , conduit >= 1.2 && < 1.3+ , resourcet >= 1.1+ , tar >=0.4+ , bytestring >= 0.10+ , Cabal+ , pretty+ , filepath+ , directory+ , transformers+ , zlib+ default-language: Haskell2010++executable all-cabal-metadata-tool+ main-is: all-cabal-metadata-tool.hs+ hs-source-dirs: app+ build-depends: base+ , stackage-metadata+ , filepath+ , directory+ , stackage-install >= 0.1.1+ , http-client+ , http-client-tls+ , Cabal+ , yaml+ , text+ , containers+ , conduit+ , bytestring+ , base16-bytestring+ , cryptohash+ , transformers+ , resourcet+ , tar+ , stackage-update >= 0.1.2+ default-language: Haskell2010++source-repository head+ type: git+ location: git://github.com/commercialhaskell/all-cabal-metadata-tool