{-# LANGUAGE DeriveGeneric #-}

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

module Distribution.Hackage.DB.Parsed where

import Distribution.Hackage.DB.Errors
import qualified Distribution.Hackage.DB.MetaData as U
import qualified Distribution.Hackage.DB.Unparsed as U
import Distribution.Hackage.DB.Utility

import Codec.Archive.Tar
import Codec.Archive.Tar.Entry
import Control.Exception
import Control.Monad.Catch
import Data.ByteString as BSS
import Data.ByteString.Lazy as BSL
import Data.ByteString.UTF8 as BSS
import Data.Map as Map
import Data.Maybe
import Data.Time.Clock
import Distribution.Package
import Distribution.PackageDescription
import Distribution.PackageDescription.Parsec
import Distribution.Text
import Distribution.Types.PackageVersionConstraint
import Distribution.Version
import GHC.Generics ( Generic )

type HackageDB = Map PackageName PackageData

type PackageData = Map Version VersionData

data VersionData = VersionData { VersionData -> GenericPackageDescription
cabalFile :: !GenericPackageDescription
                               , VersionData -> Map String String
tarballHashes :: !(Map String String)
                               }
  deriving (Int -> VersionData -> ShowS
[VersionData] -> ShowS
VersionData -> String
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
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. 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HackageDB -> HackageDB
parseDB (Maybe UTCTime -> String -> IO HackageDB
U.readTarball Maybe UTCTime
snapshot String
tarball)

parseTarball :: MonadThrow m => Maybe UTCTime -> Entries FormatError -> m HackageDB
parseTarball :: forall (m :: * -> *).
MonadThrow m =>
Maybe UTCTime -> Entries FormatError -> m HackageDB
parseTarball Maybe UTCTime
snapshot Entries FormatError
es = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HackageDB -> HackageDB
parseDB (forall (m :: * -> *).
MonadThrow m =>
Maybe UTCTime -> Entries FormatError -> HackageDB -> m HackageDB
U.parseTarball Maybe UTCTime
snapshot Entries FormatError
es forall a. Monoid a => a
mempty)

parseDB :: U.HackageDB -> HackageDB
parseDB :: HackageDB -> HackageDB
parseDB = forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey PackageName -> PackageData -> PackageData
parsePackageData

parsePackageData :: PackageName -> U.PackageData -> PackageData
parsePackageData :: PackageName -> PackageData -> PackageData
parsePackageData PackageName
pn (U.PackageData ByteString
pv Map Version VersionData
vs') =
  forall e1 e2 a.
(Exception e1, Exception e2) =>
(e1 -> e2) -> a -> a
mapException (\SomeException
e -> forall a. PackageName -> a -> HackageDBPackageName a
HackageDBPackageName PackageName
pn (SomeException
e :: SomeException)) forall a b. (a -> b) -> a -> b
$
    forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (PackageName -> Version -> VersionData -> VersionData
parseVersionData PackageName
pn) forall a b. (a -> b) -> a -> b
$
      forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Version
v VersionData
_ -> Version
v Version -> VersionRange -> Bool
`withinRange` VersionRange
vr) Map Version VersionData
vs'
  where
    PackageVersionConstraint PackageName
_ VersionRange
vr
      | ByteString -> Bool
BSS.null ByteString
pv = PackageName -> VersionRange -> PackageVersionConstraint
PackageVersionConstraint PackageName
pn VersionRange
anyVersion
      | Bool
otherwise = forall a. Parsec a => String -> String -> a
parseText String
"preferred version range" (ByteString -> String
toString ByteString
pv)

parseVersionData :: PackageName -> Version -> U.VersionData -> VersionData
parseVersionData :: PackageName -> Version -> VersionData -> VersionData
parseVersionData PackageName
pn Version
v (U.VersionData ByteString
cf ByteString
m) =
   forall e1 e2 a.
(Exception e1, Exception e2) =>
(e1 -> e2) -> a -> a
mapException (\SomeException
e -> forall a. Version -> a -> HackageDBPackageVersion a
HackageDBPackageVersion Version
v (SomeException
e :: SomeException)) forall a b. (a -> b) -> a -> b
$
     GenericPackageDescription -> Map String String -> VersionData
VersionData GenericPackageDescription
gpd (PackageName -> Version -> ByteString -> Map String String
parseMetaData PackageName
pn Version
v ByteString
m)
  where
    gpd :: GenericPackageDescription
gpd = forall a. a -> Maybe a -> a
fromMaybe (forall a e. Exception e => e -> a
throw (String -> InvalidCabalFile
InvalidCabalFile (forall a. Show a => a -> String
show (PackageName
pn,Version
v)))) forall a b. (a -> b) -> a -> b
$
            ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe ByteString
cf

parseMetaData :: PackageName -> Version -> BSS.ByteString -> Map String String
parseMetaData :: PackageName -> Version -> ByteString -> Map String String
parseMetaData PackageName
pn Version
v ByteString
buf | ByteString -> Bool
BSS.null ByteString
buf = forall k a. Map k a
Map.empty
                       | Bool
otherwise    = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall k a. Map k a
Map.empty TargetData -> Map String String
U.hashes Maybe TargetData
targetData
  where
    targets :: Map String TargetData
targets = SignedMetaData -> Map String TargetData
U.targets (MetaData -> SignedMetaData
U.signed (ByteString -> MetaData
U.parseMetaData (ByteString -> ByteString
BSL.fromStrict ByteString
buf)))
    target :: String
target  = String
"<repo>/package/" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
display PackageName
pn forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
display Version
v forall a. [a] -> [a] -> [a]
++ String
".tar.gz"
    targetData :: Maybe TargetData
targetData = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
target Map String TargetData
targets