{-# LANGUAGE BangPatterns #-}

{- |
   Maintainer:  simons@cryp.to
   Stability:   provisional
   Portability: portable
 -}

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)