{-# LANGUAGE DeriveGeneric #-}

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

module Distribution.Hackage.DB.Unparsed
  ( HackageDB, PackageData(..), VersionData(..)
  , readTarball, parseTarball
  , builder
  )
  where

import qualified Distribution.Hackage.DB.Builder as Build
import Distribution.Hackage.DB.Builder ( Builder(..) )
import Distribution.Hackage.DB.Utility

import Codec.Archive.Tar as Tar
import Codec.Archive.Tar.Entry as Tar
import Control.Exception
import Control.Monad.Catch
import Data.ByteString ( ByteString )
import Data.ByteString.Lazy ( toStrict )
import Data.Map.Strict as Map
import Data.Time.Clock
import Distribution.Types.PackageName
import Distribution.Types.Version
import GHC.Generics ( Generic )
import System.FilePath

type HackageDB = Map PackageName PackageData

data PackageData = PackageData { PackageData -> ByteString
preferredVersions :: !ByteString
                               , PackageData -> Map Version VersionData
versions          :: !(Map Version VersionData)
                               }
  deriving (Int -> PackageData -> ShowS
[PackageData] -> ShowS
PackageData -> String
(Int -> PackageData -> ShowS)
-> (PackageData -> String)
-> ([PackageData] -> ShowS)
-> Show PackageData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageData] -> ShowS
$cshowList :: [PackageData] -> ShowS
show :: PackageData -> String
$cshow :: PackageData -> String
showsPrec :: Int -> PackageData -> ShowS
$cshowsPrec :: Int -> PackageData -> ShowS
Show, PackageData -> PackageData -> Bool
(PackageData -> PackageData -> Bool)
-> (PackageData -> PackageData -> Bool) -> Eq PackageData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageData -> PackageData -> Bool
$c/= :: PackageData -> PackageData -> Bool
== :: PackageData -> PackageData -> Bool
$c== :: PackageData -> PackageData -> Bool
Eq, (forall x. PackageData -> Rep PackageData x)
-> (forall x. Rep PackageData x -> PackageData)
-> Generic PackageData
forall x. Rep PackageData x -> PackageData
forall x. PackageData -> Rep PackageData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PackageData x -> PackageData
$cfrom :: forall x. PackageData -> Rep PackageData x
Generic)

data VersionData = VersionData { VersionData -> ByteString
cabalFile :: !ByteString
                               , VersionData -> ByteString
metaFile  :: !ByteString
                               }
  deriving (Int -> VersionData -> ShowS
[VersionData] -> ShowS
VersionData -> String
(Int -> VersionData -> ShowS)
-> (VersionData -> String)
-> ([VersionData] -> ShowS)
-> Show VersionData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionData] -> ShowS
$cshowList :: [VersionData] -> ShowS
show :: VersionData -> String
$cshow :: VersionData -> String
showsPrec :: Int -> VersionData -> ShowS
$cshowsPrec :: Int -> VersionData -> ShowS
Show, VersionData -> VersionData -> Bool
(VersionData -> VersionData -> Bool)
-> (VersionData -> VersionData -> Bool) -> Eq VersionData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionData -> VersionData -> Bool
$c/= :: VersionData -> VersionData -> Bool
== :: VersionData -> VersionData -> Bool
$c== :: VersionData -> VersionData -> Bool
Eq, (forall x. VersionData -> Rep VersionData x)
-> (forall x. Rep VersionData x -> VersionData)
-> Generic VersionData
forall x. Rep VersionData x -> VersionData
forall x. VersionData -> Rep VersionData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VersionData x -> VersionData
$cfrom :: forall x. VersionData -> Rep VersionData x
Generic)

readTarball :: Maybe UTCTime -> FilePath -> IO HackageDB
readTarball :: Maybe UTCTime -> String -> IO HackageDB
readTarball Maybe UTCTime
snapshot String
tarball = String -> IO (Entries FormatError)
Build.readTarball String
tarball IO (Entries FormatError)
-> (Entries FormatError -> IO HackageDB) -> IO HackageDB
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Entries FormatError
es -> Maybe UTCTime -> Entries FormatError -> HackageDB -> IO HackageDB
forall (m :: * -> *).
MonadThrow m =>
Maybe UTCTime -> Entries FormatError -> HackageDB -> m HackageDB
parseTarball Maybe UTCTime
snapshot Entries FormatError
es HackageDB
forall a. Monoid a => a
mempty

parseTarball :: MonadThrow m => Maybe UTCTime -> Entries FormatError -> HackageDB -> m HackageDB
parseTarball :: Maybe UTCTime -> Entries FormatError -> HackageDB -> m HackageDB
parseTarball = Builder m HackageDB
-> Maybe EpochTime
-> Entries FormatError
-> HackageDB
-> m HackageDB
forall (m :: * -> *) a.
MonadThrow m =>
Builder m a -> Maybe EpochTime -> Entries FormatError -> a -> m a
Build.parseTarball Builder m HackageDB
forall (m :: * -> *). Applicative m => Builder m HackageDB
builder (Maybe EpochTime
 -> Entries FormatError -> HackageDB -> m HackageDB)
-> (Maybe UTCTime -> Maybe EpochTime)
-> Maybe UTCTime
-> Entries FormatError
-> HackageDB
-> m HackageDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTCTime -> EpochTime) -> Maybe UTCTime -> Maybe EpochTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> EpochTime
toEpochTime

builder :: Applicative m => Builder m HackageDB
builder :: Builder m HackageDB
builder = Builder :: forall (m :: * -> *) a.
(PackageName -> EpochTime -> ByteString -> a -> m a)
-> (PackageName -> Version -> EpochTime -> ByteString -> a -> m a)
-> (PackageName -> Version -> EpochTime -> ByteString -> a -> m a)
-> Builder m a
Builder
  { insertPreferredVersions :: PackageName -> EpochTime -> ByteString -> HackageDB -> m HackageDB
insertPreferredVersions = \PackageName
pn EpochTime
_ ByteString
buf   -> let new :: PackageData
new     = ByteString -> Map Version VersionData -> PackageData
PackageData (ByteString -> ByteString
toStrict ByteString
buf) Map Version VersionData
forall a. Monoid a => a
mempty
                                                 f :: p -> PackageData -> PackageData
f p
_ PackageData
old = PackageData
old { preferredVersions :: ByteString
preferredVersions = PackageData -> ByteString
preferredVersions PackageData
new }
                                             in HackageDB -> m HackageDB
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HackageDB -> m HackageDB)
-> (HackageDB -> HackageDB) -> HackageDB -> m HackageDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageData -> PackageData -> PackageData)
-> PackageName -> PackageData -> HackageDB -> HackageDB
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith PackageData -> PackageData -> PackageData
forall p. p -> PackageData -> PackageData
f PackageName
pn PackageData
new

  , insertCabalFile :: PackageName
-> Version -> EpochTime -> ByteString -> HackageDB -> m HackageDB
insertCabalFile         = \PackageName
pn Version
v EpochTime
_ ByteString
buf -> let f :: Maybe PackageData -> PackageData
f Maybe PackageData
Nothing   = ByteString -> Map Version VersionData -> PackageData
PackageData ByteString
forall a. Monoid a => a
mempty (Version -> VersionData -> Map Version VersionData
forall k a. k -> a -> Map k a
Map.singleton Version
v VersionData
new)
                                                 f (Just PackageData
pd) = PackageData
pd { versions :: Map Version VersionData
versions = (VersionData -> VersionData -> VersionData)
-> Version
-> VersionData
-> Map Version VersionData
-> Map Version VersionData
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith VersionData -> VersionData -> VersionData
forall p. p -> VersionData -> VersionData
g Version
v VersionData
new (PackageData -> Map Version VersionData
versions PackageData
pd) }
                                                 new :: VersionData
new         = ByteString -> ByteString -> VersionData
VersionData (ByteString -> ByteString
toStrict ByteString
buf) ByteString
forall a. Monoid a => a
mempty
                                                 g :: p -> VersionData -> VersionData
g p
_ VersionData
old     = VersionData
old { cabalFile :: ByteString
cabalFile = VersionData -> ByteString
cabalFile VersionData
new }
                                             in HackageDB -> m HackageDB
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HackageDB -> m HackageDB)
-> (HackageDB -> HackageDB) -> HackageDB -> m HackageDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe PackageData -> Maybe PackageData)
-> PackageName -> HackageDB -> HackageDB
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (PackageData -> Maybe PackageData
forall a. a -> Maybe a
Just (PackageData -> Maybe PackageData)
-> (Maybe PackageData -> PackageData)
-> Maybe PackageData
-> Maybe PackageData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PackageData -> PackageData
f) PackageName
pn

  , insertMetaFile :: PackageName
-> Version -> EpochTime -> ByteString -> HackageDB -> m HackageDB
insertMetaFile          = \PackageName
pn Version
v EpochTime
_ ByteString
buf -> let f :: Maybe PackageData -> PackageData
f Maybe PackageData
Nothing   = ByteString -> Map Version VersionData -> PackageData
PackageData ByteString
forall a. Monoid a => a
mempty (Version -> VersionData -> Map Version VersionData
forall k a. k -> a -> Map k a
Map.singleton Version
v VersionData
new)
                                                 f (Just PackageData
pd) = PackageData
pd { versions :: Map Version VersionData
versions = (VersionData -> VersionData -> VersionData)
-> Version
-> VersionData
-> Map Version VersionData
-> Map Version VersionData
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith VersionData -> VersionData -> VersionData
forall p. p -> VersionData -> VersionData
g Version
v VersionData
new (PackageData -> Map Version VersionData
versions PackageData
pd) }

                                                 new :: VersionData
new         = ByteString -> ByteString -> VersionData
VersionData ByteString
forall a. Monoid a => a
mempty (ByteString -> ByteString
toStrict ByteString
buf)
                                                 g :: p -> VersionData -> VersionData
g p
_ VersionData
old     = VersionData
old { metaFile :: ByteString
metaFile = VersionData -> ByteString
metaFile VersionData
new }
                                             in HackageDB -> m HackageDB
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HackageDB -> m HackageDB)
-> (HackageDB -> HackageDB) -> HackageDB -> m HackageDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe PackageData -> Maybe PackageData)
-> PackageName -> HackageDB -> HackageDB
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (PackageData -> Maybe PackageData
forall a. a -> Maybe a
Just (PackageData -> Maybe PackageData)
-> (Maybe PackageData -> PackageData)
-> Maybe PackageData
-> Maybe PackageData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PackageData -> PackageData
f) PackageName
pn
  }