{-# 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 :: FilePath -> IO (Entries FormatError)
readTarball = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Entries FormatError
Tar.read forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
BSL.readFile
data Builder m a = Builder
{ forall (m :: * -> *) a.
Builder m a -> PackageName -> EpochTime -> ByteString -> a -> m a
insertPreferredVersions :: PackageName -> EpochTime -> BSL.ByteString -> a -> m a
, forall (m :: * -> *) a.
Builder m a
-> PackageName -> Version -> EpochTime -> ByteString -> a -> m a
insertCabalFile :: PackageName -> Version -> EpochTime -> BSL.ByteString -> a -> m a
, forall (m :: * -> *) a.
Builder m a
-> PackageName -> Version -> EpochTime -> 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 :: forall (m :: * -> *) a.
MonadThrow m =>
Builder m a -> Maybe EpochTime -> Entries FormatError -> a -> m a
parseTarball Builder m a
b (Just EpochTime
et) (Next Entry
e Entries FormatError
es) !a
db = if Entry -> EpochTime
entryTime Entry
e forall a. Ord a => a -> a -> Bool
> EpochTime
et then forall (m :: * -> *) a. Monad m => a -> m a
return a
db else forall (m :: * -> *) a.
MonadThrow m =>
Builder m a -> Entry -> a -> m a
insertEntry Builder m a
b Entry
e a
db forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
MonadThrow m =>
Builder m a -> Maybe EpochTime -> Entries FormatError -> a -> m a
parseTarball Builder m a
b (forall a. a -> Maybe a
Just EpochTime
et) Entries FormatError
es
parseTarball Builder m a
b Maybe EpochTime
Nothing (Next Entry
e Entries FormatError
es) !a
db = forall (m :: * -> *) a.
MonadThrow m =>
Builder m a -> Entry -> a -> m a
insertEntry Builder m a
b Entry
e a
db forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
MonadThrow m =>
Builder m a -> Maybe EpochTime -> Entries FormatError -> a -> m a
parseTarball Builder m a
b forall a. Maybe a
Nothing Entries FormatError
es
parseTarball Builder m a
_ Maybe EpochTime
_ (Fail FormatError
err) a
_ = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM FormatError
err
parseTarball Builder m a
_ Maybe EpochTime
_ Entries FormatError
Done !a
db = forall (m :: * -> *) a. Monad m => a -> m a
return a
db
{-# INLINABLE insertEntry #-}
insertEntry :: MonadThrow m => Builder m a -> Entry -> a -> m a
insertEntry :: forall (m :: * -> *) a.
MonadThrow m =>
Builder m a -> Entry -> a -> m a
insertEntry Builder m a
b Entry
e a
db =
case (FilePath -> [FilePath]
splitDirectories (Entry -> FilePath
entryPath Entry
e), Entry -> EntryContent
entryContent Entry
e) of
([FilePath
pn,FilePath
"preferred-versions"], NormalFile ByteString
buf EpochTime
_) -> forall (m :: * -> *) a.
Builder m a -> PackageName -> EpochTime -> ByteString -> a -> m a
insertPreferredVersions Builder m a
b (FilePath -> PackageName
mkPackageName FilePath
pn) (Entry -> EpochTime
entryTime Entry
e) ByteString
buf a
db
([FilePath
pn,FilePath
v,FilePath
file], NormalFile ByteString
buf EpochTime
_)
| FilePath -> FilePath
takeExtension FilePath
file forall a. Eq a => a -> a -> Bool
== FilePath
".cabal" -> forall (m :: * -> *) a.
Builder m a
-> PackageName -> Version -> EpochTime -> ByteString -> a -> m a
insertCabalFile Builder m a
b (FilePath -> PackageName
mkPackageName FilePath
pn) (forall a. Parsec a => FilePath -> FilePath -> a
parseText FilePath
"Version" FilePath
v) (Entry -> EpochTime
entryTime Entry
e) ByteString
buf a
db
| FilePath -> FilePath
takeExtension FilePath
file forall a. Eq a => a -> a -> Bool
== FilePath
".json" -> forall (m :: * -> *) a.
Builder m a
-> PackageName -> Version -> EpochTime -> ByteString -> a -> m a
insertMetaFile Builder m a
b (FilePath -> PackageName
mkPackageName FilePath
pn) (forall a. Parsec a => FilePath -> FilePath -> a
parseText FilePath
"Version" FilePath
v) (Entry -> EpochTime
entryTime Entry
e) ByteString
buf a
db
([FilePath], EntryContent)
_ -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Entry -> UnsupportedTarEntry
UnsupportedTarEntry Entry
e)