{-# LANGUAGE ScopedTypeVariables #-} module Split4 where -- | Get the contents of a package index getPackages :: RepoKey -> Release -> PackageIndex -> IO (Either SomeException [BinaryPackage]) getPackages repo release index = fileFromURIStrict uri' >>= readControl . either (Left . SomeException) Right where readControl :: Either SomeException L.ByteString -> IO (Either SomeException [BinaryPackage]) readControl (Left e) = return (Left e) readControl (Right s) = try (case controlFromIndex Uncompressed (show uri') s of Left e -> return $ Left (SomeException (ErrorCall (show uri' ++ ": " ++ show e))) Right (B.Control control) -> return (Right $ List.map (toBinaryPackage release index) control)) >>= return . either (\ (e :: SomeException) -> Left . SomeException . ErrorCall . ((show uri' ++ ":") ++) . show $ e) id uri' = uri {uriPath = uriPath uri packageIndexPath release index} uri = repoKeyURI repo --toLazy s = L.fromChunks [s] --showStream :: Either Exception L.ByteString -> IO (Either Exception L.ByteString) --showStream x@(Left e) = hPutStrLn stderr (show uri' ++ " - exception: " ++ show e) >> return x --showStream x@(Right s) = hPutStrLn stderr (show uri' ++ " - stream length: " ++ show (L.length s)) >> return x -- | Get the contents of a package index binaryPackagesOfIndex :: MonadRepoCache m => RepoKey -> Release -> PackageIndex -> m (Either SomeException [BinaryPackage]) binaryPackagesOfIndex repo release index = case packageIndexArch index of Source -> return (Right []) _ -> liftIO $ getPackages repo release index -- >>= return . either Left (Right . List.map (toBinaryPackage index . packageInfo)) -- | Get the contents of a package index sourcePackagesOfIndex :: MonadRepoCache m => RepoKey -> Release -> PackageIndex -> m (Either SomeException [SourcePackage]) sourcePackagesOfIndex repo release index = case packageIndexArch index of Source -> liftIO (getPackages repo release index) >>= return . either Left (Right . List.map (toSourcePackage index . packageInfo)) _ -> return (Right [])