{-# LANGUAGE TypeApplications #-}
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,
)
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
loadHackageDB :: FilePath -> IO HackageDB
loadHackageDB :: FilePath -> IO HackageDB
loadHackageDB = Maybe UTCTime -> FilePath -> IO HackageDB
readTarball Maybe UTCTime
forall a. Maybe a
Nothing
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
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
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
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")
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
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
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