{-# 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 [])