{-# 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
(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 = (HackageDB -> HackageDB) -> IO HackageDB -> IO HackageDB
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 :: Maybe UTCTime -> Entries FormatError -> m HackageDB
parseTarball Maybe UTCTime
snapshot Entries FormatError
es = (HackageDB -> HackageDB) -> m HackageDB -> m HackageDB
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HackageDB -> HackageDB
parseDB (Maybe UTCTime -> Entries FormatError -> HackageDB -> m HackageDB
forall (m :: * -> *).
MonadThrow m =>
Maybe UTCTime -> Entries FormatError -> HackageDB -> m HackageDB
U.parseTarball Maybe UTCTime
snapshot Entries FormatError
es HackageDB
forall a. Monoid a => a
mempty)

parseDB :: U.HackageDB -> HackageDB
parseDB :: HackageDB -> HackageDB
parseDB = (PackageName -> PackageData -> PackageData)
-> HackageDB -> HackageDB
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') =
  (SomeException -> HackageDBPackageName SomeException)
-> PackageData -> PackageData
forall e1 e2 a.
(Exception e1, Exception e2) =>
(e1 -> e2) -> a -> a
mapException (\SomeException
e -> PackageName -> SomeException -> HackageDBPackageName SomeException
forall a. PackageName -> a -> HackageDBPackageName a
HackageDBPackageName PackageName
pn (SomeException
e :: SomeException)) (PackageData -> PackageData) -> PackageData -> PackageData
forall a b. (a -> b) -> a -> b
$
    (Version -> VersionData -> VersionData)
-> Map Version VersionData -> PackageData
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (PackageName -> Version -> VersionData -> VersionData
parseVersionData PackageName
pn) (Map Version VersionData -> PackageData)
-> Map Version VersionData -> PackageData
forall a b. (a -> b) -> a -> b
$
      (Version -> VersionData -> Bool)
-> Map Version VersionData -> Map Version VersionData
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 = String -> String -> PackageVersionConstraint
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) =
   (SomeException -> HackageDBPackageVersion SomeException)
-> VersionData -> VersionData
forall e1 e2 a.
(Exception e1, Exception e2) =>
(e1 -> e2) -> a -> a
mapException (\SomeException
e -> Version -> SomeException -> HackageDBPackageVersion SomeException
forall a. Version -> a -> HackageDBPackageVersion a
HackageDBPackageVersion Version
v (SomeException
e :: SomeException)) (VersionData -> VersionData) -> VersionData -> VersionData
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 = GenericPackageDescription
-> Maybe GenericPackageDescription -> GenericPackageDescription
forall a. a -> Maybe a -> a
fromMaybe (InvalidCabalFile -> GenericPackageDescription
forall a e. Exception e => e -> a
throw (String -> InvalidCabalFile
InvalidCabalFile ((PackageName, Version) -> String
forall a. Show a => a -> String
show (PackageName
pn,Version
v)))) (Maybe GenericPackageDescription -> GenericPackageDescription)
-> Maybe GenericPackageDescription -> GenericPackageDescription
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 = Map String String
forall k a. Map k a
Map.empty
                       | Bool
otherwise    = Map String String
-> (TargetData -> Map String String)
-> Maybe TargetData
-> Map String String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map String String
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/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Pretty a => a -> String
display PackageName
pn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Pretty a => a -> String
display Version
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".tar.gz"
    targetData :: Maybe TargetData
targetData = String -> Map String TargetData -> Maybe TargetData
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
target Map String TargetData
targets