module Distribution.ArchHs.Hackage
( lookupHackagePath,
loadHackageDB,
insertDB,
parseCabalFile,
getLatestCabal,
getCabal,
getPackageFlag,
traverseHackage,
getLatestSHA256,
)
where
import Control.Applicative (Alternative ((<|>)))
import qualified Data.ByteString as BS
import qualified Data.Map as Map
import Data.Maybe (fromJust)
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 Distribution.Types.Flag (Flag)
import Distribution.Types.GenericPackageDescription (GenericPackageDescription, genPackageFlags, packageDescription)
import Distribution.Types.PackageName (PackageName)
import Distribution.Version (Version, nullVersion)
import System.Directory (findFile, getHomeDirectory, listDirectory)
import System.FilePath ((</>))
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
VersionError 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
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 String
getLatestSHA256 :: PackageName -> Sem r FilePath
getLatestSHA256 = (VersionData -> FilePath) -> PackageName -> Sem r 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 -> FilePath
forall k a. Ord k => Map k a -> k -> 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
VersionError 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
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