{-# LANGUAGE TypeApplications #-}

-- | Copyright: (c) 2020 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <1793913507@qq.com>
-- Stability: experimental
-- Portability: portable
-- This module provides functions operating with 'HackageDB' and 'GenericPackageDescription'.
module Distribution.ArchHs.Hackage
  ( lookupHackagePath,
    loadHackageDB,
    insertDB,
    parseCabalFile,
    getLatestCabal,
    getCabal,
    getPackageFlag,
    traverseHackage,
    getLatestSHA256,
    HackageDB,
  )
where

import qualified Data.ByteString as BS
import qualified Data.Map as Map
import Data.Maybe (fromJust)
import Distribution.ArchHs.Exception
import Distribution.ArchHs.Internal.Prelude
import Distribution.ArchHs.Types
import Distribution.ArchHs.Utils
  ( getPkgName,
    getPkgVersion,
  )
import Distribution.Hackage.DB
  ( HackageDB,
    VersionData (VersionData, cabalFile),
    readTarball,
    tarballHashes,
  )
import Distribution.PackageDescription.Parsec (parseGenericPackageDescriptionMaybe)
import System.Directory
  ( findFile,
    getHomeDirectory,
    listDirectory,
  )

-- | Look up hackage tarball path from @~/.cabal@.
-- Arbitrary hackage mirror is potential to be selected.
-- Preferred to @01-index.tar@, whereas fallback to @00-index.tar@.
lookupHackagePath :: IO FilePath
lookupHackagePath :: IO FilePath
lookupHackagePath = do
  FilePath
home <- (\FilePath
d -> FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
".cabal" FilePath -> FilePath -> FilePath
</> FilePath
"packages") (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getHomeDirectory
  [FilePath]
subs <- (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
home FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
listDirectory FilePath
home
  Maybe FilePath
legacy <- [FilePath] -> FilePath -> IO (Maybe FilePath)
findFile [FilePath]
subs FilePath
"00-index.tar"
  Maybe FilePath
new <- [FilePath] -> FilePath -> IO (Maybe FilePath)
findFile [FilePath]
subs FilePath
"01-index.tar"
  case Maybe FilePath
new Maybe FilePath -> Maybe FilePath -> Maybe FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe FilePath
legacy of
    Just FilePath
x -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
x
    Maybe FilePath
Nothing -> FilePath -> IO FilePath
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Unable to find hackage index tarball from " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
subs

-- | Read and parse hackage index tarball.
loadHackageDB :: FilePath -> IO HackageDB
loadHackageDB :: FilePath -> IO HackageDB
loadHackageDB = Maybe UTCTime -> FilePath -> IO HackageDB
readTarball Maybe UTCTime
forall a. Maybe a
Nothing

-- | Insert a 'GenericPackageDescription' into 'HackageDB'.
insertDB :: GenericPackageDescription -> HackageDB -> HackageDB
insertDB :: GenericPackageDescription -> HackageDB -> HackageDB
insertDB GenericPackageDescription
cabal HackageDB
db = PackageName -> Map Version VersionData -> HackageDB -> HackageDB
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert PackageName
name Map Version VersionData
packageData HackageDB
db
  where
    name :: PackageName
name = PackageDescription -> PackageName
getPkgName (PackageDescription -> PackageName)
-> PackageDescription -> PackageName
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
cabal
    version :: Version
version = PackageDescription -> Version
getPkgVersion (PackageDescription -> Version) -> PackageDescription -> Version
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
cabal
    versionData :: VersionData
versionData = GenericPackageDescription -> Map FilePath FilePath -> VersionData
VersionData GenericPackageDescription
cabal (Map FilePath FilePath -> VersionData)
-> Map FilePath FilePath -> VersionData
forall a b. (a -> b) -> a -> b
$ Map FilePath FilePath
forall k a. Map k a
Map.empty
    packageData :: Map Version VersionData
packageData = Version -> VersionData -> Map Version VersionData
forall k a. k -> a -> Map k a
Map.singleton Version
version VersionData
versionData

-- | Read and parse @.cabal@ file.
parseCabalFile :: FilePath -> IO GenericPackageDescription
parseCabalFile :: FilePath -> IO GenericPackageDescription
parseCabalFile FilePath
path = do
  ByteString
bs <- FilePath -> IO ByteString
BS.readFile FilePath
path
  case ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe ByteString
bs of
    Just GenericPackageDescription
x -> GenericPackageDescription -> IO GenericPackageDescription
forall (m :: * -> *) a. Monad m => a -> m a
return GenericPackageDescription
x
    Maybe GenericPackageDescription
_ -> FilePath -> IO GenericPackageDescription
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO GenericPackageDescription)
-> FilePath -> IO GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to parse .cabal from " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path

withLatestVersion :: Members [HackageEnv, WithMyErr] r => (VersionData -> a) -> PackageName -> Sem r a
withLatestVersion :: (VersionData -> a) -> PackageName -> Sem r a
withLatestVersion VersionData -> a
f PackageName
name = do
  HackageDB
db <- forall (r :: [Effect]).
MemberWithError (Reader HackageDB) r =>
Sem r HackageDB
forall i (r :: [Effect]). MemberWithError (Reader i) r => Sem r i
ask @HackageDB
  case PackageName -> HackageDB -> Maybe (Map Version VersionData)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name HackageDB
db of
    (Just Map Version VersionData
m) -> case Map Version VersionData -> Maybe (Version, VersionData)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax Map Version VersionData
m of
      Just (Version
_, VersionData
vdata) -> a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Sem r a) -> a -> Sem r a
forall a b. (a -> b) -> a -> b
$ VersionData -> a
f VersionData
vdata
      Maybe (Version, VersionData)
Nothing -> MyException -> Sem r a
forall e (r :: [Effect]) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw (MyException -> Sem r a) -> MyException -> Sem r a
forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> MyException
VersionNotFound PackageName
name Version
nullVersion
    Maybe (Map Version VersionData)
Nothing -> MyException -> Sem r a
forall e (r :: [Effect]) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw (MyException -> Sem r a) -> MyException -> Sem r a
forall a b. (a -> b) -> a -> b
$ PackageName -> MyException
forall n. HasMyName n => n -> MyException
PkgNotFound PackageName
name

-- | Get the latest 'GenericPackageDescription'.
getLatestCabal :: Members [HackageEnv, WithMyErr] r => PackageName -> Sem r GenericPackageDescription
getLatestCabal :: PackageName -> Sem r GenericPackageDescription
getLatestCabal = (VersionData -> GenericPackageDescription)
-> PackageName -> Sem r GenericPackageDescription
forall (r :: [Effect]) a.
Members '[Reader HackageDB, WithMyErr] r =>
(VersionData -> a) -> PackageName -> Sem r a
withLatestVersion VersionData -> GenericPackageDescription
cabalFile

-- | Get the latest SHA256 sum of the tarball .
getLatestSHA256 :: Members [HackageEnv, WithMyErr] r => PackageName -> Sem r (Maybe String)
getLatestSHA256 :: PackageName -> Sem r (Maybe FilePath)
getLatestSHA256 = (VersionData -> Maybe FilePath)
-> PackageName -> Sem r (Maybe FilePath)
forall (r :: [Effect]) a.
Members '[Reader HackageDB, WithMyErr] r =>
(VersionData -> a) -> PackageName -> Sem r a
withLatestVersion (\VersionData
vdata -> VersionData -> Map FilePath FilePath
tarballHashes VersionData
vdata Map FilePath FilePath -> FilePath -> Maybe FilePath
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? FilePath
"sha256")

-- | Get 'GenericPackageDescription' with a specific version.
getCabal :: Members [HackageEnv, WithMyErr] r => PackageName -> Version -> Sem r GenericPackageDescription
getCabal :: PackageName -> Version -> Sem r GenericPackageDescription
getCabal PackageName
name Version
version = do
  HackageDB
db <- forall (r :: [Effect]).
MemberWithError (Reader HackageDB) r =>
Sem r HackageDB
forall i (r :: [Effect]). MemberWithError (Reader i) r => Sem r i
ask @HackageDB
  case PackageName -> HackageDB -> Maybe (Map Version VersionData)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name HackageDB
db of
    (Just Map Version VersionData
m) -> case Version -> Map Version VersionData -> Maybe VersionData
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
version Map Version VersionData
m of
      Just VersionData
vdata -> GenericPackageDescription -> Sem r GenericPackageDescription
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericPackageDescription -> Sem r GenericPackageDescription)
-> GenericPackageDescription -> Sem r GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ VersionData
vdata VersionData
-> (VersionData -> GenericPackageDescription)
-> GenericPackageDescription
forall a b. a -> (a -> b) -> b
& VersionData -> GenericPackageDescription
cabalFile
      Maybe VersionData
Nothing -> MyException -> Sem r GenericPackageDescription
forall e (r :: [Effect]) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw (MyException -> Sem r GenericPackageDescription)
-> MyException -> Sem r GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> MyException
VersionNotFound PackageName
name Version
version
    Maybe (Map Version VersionData)
Nothing -> MyException -> Sem r GenericPackageDescription
forall e (r :: [Effect]) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw (MyException -> Sem r GenericPackageDescription)
-> MyException -> Sem r GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ PackageName -> MyException
forall n. HasMyName n => n -> MyException
PkgNotFound PackageName
name

-- | Get flags of a package.
getPackageFlag :: Members [HackageEnv, WithMyErr] r => PackageName -> Sem r [Flag]
getPackageFlag :: PackageName -> Sem r [Flag]
getPackageFlag PackageName
name = do
  GenericPackageDescription
cabal <- PackageName -> Sem r GenericPackageDescription
forall (r :: [Effect]).
Members '[Reader HackageDB, WithMyErr] r =>
PackageName -> Sem r GenericPackageDescription
getLatestCabal PackageName
name
  [Flag] -> Sem r [Flag]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Flag] -> Sem r [Flag]) -> [Flag] -> Sem r [Flag]
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
cabal GenericPackageDescription
-> (GenericPackageDescription -> [Flag]) -> [Flag]
forall a b. a -> (a -> b) -> b
& GenericPackageDescription -> [Flag]
genPackageFlags

-- | Traverse hackage packages.
traverseHackage :: (Member HackageEnv r, Applicative f) => ((PackageName, GenericPackageDescription) -> f b) -> Sem r (f [b])
traverseHackage :: ((PackageName, GenericPackageDescription) -> f b) -> Sem r (f [b])
traverseHackage (PackageName, GenericPackageDescription) -> f b
f = do
  HackageDB
db <- forall (r :: [Effect]).
MemberWithError (Reader HackageDB) r =>
Sem r HackageDB
forall i (r :: [Effect]). MemberWithError (Reader i) r => Sem r i
ask @HackageDB
  let x :: [(PackageName, GenericPackageDescription)]
x =
        Map PackageName GenericPackageDescription
-> [(PackageName, GenericPackageDescription)]
forall k a. Map k a -> [(k, a)]
Map.toList
          (Map PackageName GenericPackageDescription
 -> [(PackageName, GenericPackageDescription)])
-> (Map PackageName (Maybe (Version, VersionData))
    -> Map PackageName GenericPackageDescription)
-> Map PackageName (Maybe (Version, VersionData))
-> [(PackageName, GenericPackageDescription)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Version, VersionData) -> GenericPackageDescription)
-> Map PackageName (Maybe (Version, VersionData))
-> Map PackageName GenericPackageDescription
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (VersionData -> GenericPackageDescription
cabalFile (VersionData -> GenericPackageDescription)
-> (Maybe (Version, VersionData) -> VersionData)
-> Maybe (Version, VersionData)
-> GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Version, VersionData)
-> Getting VersionData (Version, VersionData) VersionData
-> VersionData
forall s a. s -> Getting a s a -> a
^. Getting VersionData (Version, VersionData) VersionData
forall s t a b. Field2 s t a b => Lens s t a b
_2) ((Version, VersionData) -> VersionData)
-> (Maybe (Version, VersionData) -> (Version, VersionData))
-> Maybe (Version, VersionData)
-> VersionData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Version, VersionData) -> (Version, VersionData)
forall a. HasCallStack => Maybe a -> a
fromJust)
          (Map PackageName (Maybe (Version, VersionData))
 -> Map PackageName GenericPackageDescription)
-> (Map PackageName (Maybe (Version, VersionData))
    -> Map PackageName (Maybe (Version, VersionData)))
-> Map PackageName (Maybe (Version, VersionData))
-> Map PackageName GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Version, VersionData) -> Bool)
-> Map PackageName (Maybe (Version, VersionData))
-> Map PackageName (Maybe (Version, VersionData))
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Maybe (Version, VersionData)
-> Maybe (Version, VersionData) -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe (Version, VersionData)
forall a. Maybe a
Nothing)
          (Map PackageName (Maybe (Version, VersionData))
 -> [(PackageName, GenericPackageDescription)])
-> Map PackageName (Maybe (Version, VersionData))
-> [(PackageName, GenericPackageDescription)]
forall a b. (a -> b) -> a -> b
$ (Map Version VersionData -> Maybe (Version, VersionData))
-> HackageDB -> Map PackageName (Maybe (Version, VersionData))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Map Version VersionData -> Maybe (Version, VersionData)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax HackageDB
db
  f [b] -> Sem r (f [b])
forall (m :: * -> *) a. Monad m => a -> m a
return (f [b] -> Sem r (f [b])) -> f [b] -> Sem r (f [b])
forall a b. (a -> b) -> a -> b
$ ((PackageName, GenericPackageDescription) -> f b)
-> [(PackageName, GenericPackageDescription)] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (PackageName, GenericPackageDescription) -> f b
f [(PackageName, GenericPackageDescription)]
x