{-# 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 String
lookupHackagePath = do
String
home <- (\String
d -> String
d String -> String -> String
</> String
".cabal" String -> String -> String
</> String
"packages") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getHomeDirectory
[String]
subs <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
home String -> String -> String
</>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
listDirectory String
home
Maybe String
legacy <- [String] -> String -> IO (Maybe String)
findFile [String]
subs String
"00-index.tar"
Maybe String
new <- [String] -> String -> IO (Maybe String)
findFile [String]
subs String
"01-index.tar"
case Maybe String
new forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
legacy of
Just String
x -> forall (m :: * -> *) a. Monad m => a -> m a
return String
x
Maybe String
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unable to find hackage index tarball from " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show [String]
subs
loadHackageDB :: FilePath -> IO HackageDB
loadHackageDB :: String -> IO HackageDB
loadHackageDB = Maybe UTCTime -> String -> IO HackageDB
readTarball forall a. Maybe a
Nothing
insertDB :: GenericPackageDescription -> HackageDB -> HackageDB
insertDB :: GenericPackageDescription -> HackageDB -> HackageDB
insertDB GenericPackageDescription
cabal = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert PackageName
name Map Version VersionData
packageData
where
name :: PackageName
name = PackageDescription -> PackageName
getPkgName forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
cabal
version :: Version
version = PackageDescription -> Version
getPkgVersion forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
cabal
versionData :: VersionData
versionData = GenericPackageDescription -> Map String String -> VersionData
VersionData GenericPackageDescription
cabal forall k a. Map k a
Map.empty
packageData :: Map Version VersionData
packageData = forall k a. k -> a -> Map k a
Map.singleton Version
version VersionData
versionData
parseCabalFile :: FilePath -> IO GenericPackageDescription
parseCabalFile :: String -> IO GenericPackageDescription
parseCabalFile String
path = do
ByteString
bs <- String -> IO ByteString
BS.readFile String
path
case ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe ByteString
bs of
Just GenericPackageDescription
x -> forall (m :: * -> *) a. Monad m => a -> m a
return GenericPackageDescription
x
Maybe GenericPackageDescription
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failed to parse .cabal from " forall a. Semigroup a => a -> a -> a
<> String
path
withLatestVersion :: Members [HackageEnv, WithMyErr] r => (VersionData -> a) -> PackageName -> Sem r a
withLatestVersion :: forall (r :: EffectRow) a.
Members '[HackageEnv, WithMyErr] r =>
(VersionData -> a) -> PackageName -> Sem r a
withLatestVersion VersionData -> a
f PackageName
name = do
HackageDB
db <- forall i (r :: EffectRow). Member (Reader i) r => Sem r i
ask @HackageDB
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name HackageDB
db of
(Just Map Version VersionData
m) -> case forall k a. Map k a -> Maybe (k, a)
Map.lookupMax Map Version VersionData
m of
Just (Version
_, VersionData
vdata) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ VersionData -> a
f VersionData
vdata
Maybe (Version, VersionData)
Nothing -> forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> MyException
VersionNotFound PackageName
name Version
nullVersion
Maybe (Map Version VersionData)
Nothing -> forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw forall a b. (a -> b) -> a -> b
$ forall n. HasMyName n => n -> MyException
PkgNotFound PackageName
name
getLatestCabal :: Members [HackageEnv, WithMyErr] r => PackageName -> Sem r GenericPackageDescription
getLatestCabal :: forall (r :: EffectRow).
Members '[HackageEnv, WithMyErr] r =>
PackageName -> Sem r GenericPackageDescription
getLatestCabal = forall (r :: EffectRow) a.
Members '[HackageEnv, WithMyErr] r =>
(VersionData -> a) -> PackageName -> Sem r a
withLatestVersion VersionData -> GenericPackageDescription
cabalFile
getLatestSHA256 :: Members [HackageEnv, WithMyErr] r => PackageName -> Sem r (Maybe String)
getLatestSHA256 :: forall (r :: EffectRow).
Members '[HackageEnv, WithMyErr] r =>
PackageName -> Sem r (Maybe String)
getLatestSHA256 = forall (r :: EffectRow) a.
Members '[HackageEnv, WithMyErr] r =>
(VersionData -> a) -> PackageName -> Sem r a
withLatestVersion (\VersionData
vdata -> VersionData -> Map String String
tarballHashes VersionData
vdata forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? String
"sha256")
getCabal :: Members [HackageEnv, WithMyErr] r => PackageName -> Version -> Sem r GenericPackageDescription
getCabal :: forall (r :: EffectRow).
Members '[HackageEnv, WithMyErr] r =>
PackageName -> Version -> Sem r GenericPackageDescription
getCabal PackageName
name Version
version = do
HackageDB
db <- forall i (r :: EffectRow). Member (Reader i) r => Sem r i
ask @HackageDB
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name HackageDB
db of
(Just Map Version VersionData
m) -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
version Map Version VersionData
m of
Just VersionData
vdata -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ VersionData
vdata forall a b. a -> (a -> b) -> b
& VersionData -> GenericPackageDescription
cabalFile
Maybe VersionData
Nothing -> forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> MyException
VersionNotFound PackageName
name Version
version
Maybe (Map Version VersionData)
Nothing -> forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw forall a b. (a -> b) -> a -> b
$ forall n. HasMyName n => n -> MyException
PkgNotFound PackageName
name
getPackageFlag :: Members [HackageEnv, WithMyErr] r => PackageName -> Sem r [PkgFlag]
getPackageFlag :: forall (r :: EffectRow).
Members '[HackageEnv, WithMyErr] r =>
PackageName -> Sem r [PkgFlag]
getPackageFlag PackageName
name = do
GenericPackageDescription
cabal <- forall (r :: EffectRow).
Members '[HackageEnv, WithMyErr] r =>
PackageName -> Sem r GenericPackageDescription
getLatestCabal PackageName
name
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
cabal forall a b. a -> (a -> b) -> b
& GenericPackageDescription -> [PkgFlag]
genPackageFlags
traverseHackage :: (Member HackageEnv r, Applicative f) => ((PackageName, GenericPackageDescription) -> f b) -> Sem r (f [b])
traverseHackage :: forall (r :: EffectRow) (f :: * -> *) b.
(Member HackageEnv r, Applicative f) =>
((PackageName, GenericPackageDescription) -> f b) -> Sem r (f [b])
traverseHackage (PackageName, GenericPackageDescription) -> f b
f = do
HackageDB
db <- forall i (r :: EffectRow). Member (Reader i) r => Sem r i
ask @HackageDB
let x :: [(PackageName, GenericPackageDescription)]
x =
forall k a. Map k a -> [(k, a)]
Map.toList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (VersionData -> GenericPackageDescription
cabalFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. forall s t a b. Field2 s t a b => Lens s t a b
_2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (forall a. Eq a => a -> a -> Bool
/= forall a. Maybe a
Nothing)
forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall k a. Map k a -> Maybe (k, a)
Map.lookupMax HackageDB
db
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> 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