{-# LANGUAGE BangPatterns #-}
module Distribution.Hackage.DB.Builder
( readTarball, parseTarball
, Builder(..)
)
where
import Distribution.Hackage.DB.Errors
import Distribution.Hackage.DB.Utility
import Codec.Archive.Tar as Tar
import Codec.Archive.Tar.Entry as Tar
import Control.Monad.Catch
import qualified Data.ByteString.Lazy as BSL
import Distribution.Types.PackageName
import Distribution.Types.Version
import System.FilePath
readTarball :: FilePath -> IO (Entries FormatError)
readTarball = fmap Tar.read . BSL.readFile
data Builder m a = Builder
{ insertPreferredVersions :: PackageName -> EpochTime -> BSL.ByteString -> a -> m a
, insertCabalFile :: PackageName -> Version -> EpochTime -> BSL.ByteString -> a -> m a
, insertMetaFile :: PackageName -> Version -> EpochTime -> BSL.ByteString -> a -> m a
}
{-# INLINABLE parseTarball #-}
parseTarball :: MonadThrow m => Builder m a -> Maybe EpochTime -> Entries FormatError -> a -> m a
parseTarball b (Just et) (Next e es) !db = if entryTime e > et then return db else insertEntry b e db >>= parseTarball b (Just et) es
parseTarball b Nothing (Next e es) !db = insertEntry b e db >>= parseTarball b Nothing es
parseTarball _ _ (Fail err) _ = throwM err
parseTarball _ _ Done !db = return db
{-# INLINABLE insertEntry #-}
insertEntry :: MonadThrow m => Builder m a -> Entry -> a -> m a
insertEntry b e db =
case (splitDirectories (entryPath e), entryContent e) of
([pn,"preferred-versions"], NormalFile buf _) -> insertPreferredVersions b (mkPackageName pn) (entryTime e) buf db
([pn,v,file], NormalFile buf _)
| takeExtension file == ".cabal" -> insertCabalFile b (mkPackageName pn) (parseText "Version" v) (entryTime e) buf db
| takeExtension file == ".json" -> insertMetaFile b (mkPackageName pn) (parseText "Version" v) (entryTime e) buf db
_ -> throwM (UnsupportedTarEntry e)