{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GADTs #-}
module Distribution.Client.IndexUtils (
getIndexFileAge,
getInstalledPackages,
indexBaseName,
Configure.getInstalledPackagesMonitorFiles,
getSourcePackages,
getSourcePackagesMonitorFiles,
TotalIndexState,
getSourcePackagesAtIndexState,
ActiveRepos,
filterSkippedActiveRepos,
Index(..),
RepoIndexState (..),
PackageEntry(..),
parsePackageIndex,
updateRepoIndexCache,
updatePackageIndexCacheFile,
writeIndexTimestamp,
currentIndexTimestamp,
BuildTreeRefType(..), refTypeFromTypeCode, typeCodeFromRefType,
preferredVersions, isPreferredVersions, parsePreferredVersionsWarnings,
PreferredVersionsParseError(..)
) where
import Prelude ()
import Distribution.Client.Compat.Prelude
import qualified Codec.Archive.Tar as Tar
import qualified Codec.Archive.Tar.Entry as Tar
import qualified Codec.Archive.Tar.Index as Tar
import qualified Distribution.Client.Tar as Tar
import Distribution.Client.IndexUtils.ActiveRepos
import Distribution.Client.IndexUtils.IndexState
import Distribution.Client.IndexUtils.Timestamp
import Distribution.Client.Types
import Distribution.Verbosity
import Distribution.Parsec (simpleParsecBS)
import Distribution.Package
( PackageId, PackageIdentifier(..), mkPackageName
, Package(..), packageVersion, packageName )
import Distribution.Types.Dependency
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import Distribution.PackageDescription
( GenericPackageDescription(..)
, PackageDescription(..), emptyPackageDescription )
import Distribution.Simple.Compiler
( Compiler, PackageDBStack )
import Distribution.Simple.Program
( ProgramDb )
import qualified Distribution.Simple.Configure as Configure
( getInstalledPackages, getInstalledPackagesMonitorFiles )
import Distribution.Types.PackageName (PackageName)
import Distribution.Version
( Version, VersionRange, mkVersion, intersectVersionRanges )
import Distribution.Simple.Utils
( die', warn, info, createDirectoryIfMissingVerbose, fromUTF8LBS )
import Distribution.Client.Setup
( RepoContext(..) )
import Distribution.PackageDescription.Parsec
( parseGenericPackageDescription, parseGenericPackageDescriptionMaybe )
import qualified Distribution.PackageDescription.Parsec as PackageDesc.Parse
import qualified Distribution.Simple.PackageDescription as PackageDesc.Parse
import Distribution.Solver.Types.PackageIndex (PackageIndex)
import qualified Distribution.Solver.Types.PackageIndex as PackageIndex
import Distribution.Solver.Types.SourcePackage
import Data.Either
( rights )
import qualified Data.Map as Map
import qualified Data.Set as Set
import Control.Exception
import Data.List (stripPrefix)
import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Char8 as BSS
import Data.ByteString.Lazy (ByteString)
import Distribution.Client.GZipUtils (maybeDecompress)
import Distribution.Client.Utils ( byteStringToFilePath
, tryFindAddSourcePackageDesc )
import Distribution.Utils.Structured (Structured (..), nominalStructure, structuredEncodeFile, structuredDecodeFileOrFail)
import Distribution.Compat.Time (getFileAge, getModTime)
import System.Directory (doesFileExist, doesDirectoryExist)
import System.FilePath
( (</>), (<.>), takeFileName, takeExtension, replaceExtension, splitDirectories, normalise, takeDirectory )
import qualified System.FilePath.Posix as FilePath.Posix
import System.IO
import System.IO.Unsafe (unsafeInterleaveIO)
import System.IO.Error (isDoesNotExistError)
import Distribution.Compat.Directory (listDirectory)
import Distribution.Utils.Generic (fstOf3)
import qualified Codec.Compression.GZip as GZip
import qualified Hackage.Security.Client as Sec
import qualified Hackage.Security.Util.Some as Sec
getInstalledPackages :: Verbosity -> Compiler
-> PackageDBStack -> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages :: Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity Compiler
comp PackageDBStack
packageDbs ProgramDb
progdb =
Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
Configure.getInstalledPackages Verbosity
verbosity' Compiler
comp PackageDBStack
packageDbs ProgramDb
progdb
where
verbosity' :: Verbosity
verbosity' = Verbosity -> Verbosity
lessVerbose Verbosity
verbosity
indexBaseName :: Repo -> FilePath
indexBaseName :: Repo -> FilePath
indexBaseName Repo
repo = Repo -> FilePath
repoLocalDir Repo
repo FilePath -> FilePath -> FilePath
</> FilePath
fn
where
fn :: FilePath
fn = case Repo
repo of
RepoSecure {} -> FilePath
"01-index"
RepoRemote {} -> FilePath
"00-index"
RepoLocalNoIndex {} -> FilePath
"noindex"
data IndexStateInfo = IndexStateInfo
{ IndexStateInfo -> Timestamp
isiMaxTime :: !Timestamp
, IndexStateInfo -> Timestamp
isiHeadTime :: !Timestamp
}
emptyStateInfo :: IndexStateInfo
emptyStateInfo :: IndexStateInfo
emptyStateInfo = Timestamp -> Timestamp -> IndexStateInfo
IndexStateInfo Timestamp
nullTimestamp Timestamp
nullTimestamp
filterCache :: RepoIndexState -> Cache -> (Cache, IndexStateInfo)
filterCache :: RepoIndexState -> Cache -> (Cache, IndexStateInfo)
filterCache RepoIndexState
IndexStateHead Cache
cache = (Cache
cache, IndexStateInfo :: Timestamp -> Timestamp -> IndexStateInfo
IndexStateInfo{Timestamp
isiHeadTime :: Timestamp
isiMaxTime :: Timestamp
isiHeadTime :: Timestamp
isiMaxTime :: Timestamp
..})
where
isiMaxTime :: Timestamp
isiMaxTime = Cache -> Timestamp
cacheHeadTs Cache
cache
isiHeadTime :: Timestamp
isiHeadTime = Cache -> Timestamp
cacheHeadTs Cache
cache
filterCache (IndexStateTime Timestamp
ts0) Cache
cache0 = (Cache
cache, IndexStateInfo :: Timestamp -> Timestamp -> IndexStateInfo
IndexStateInfo{Timestamp
isiMaxTime :: Timestamp
isiHeadTime :: Timestamp
isiHeadTime :: Timestamp
isiMaxTime :: Timestamp
..})
where
cache :: Cache
cache = Cache :: Timestamp -> [IndexCacheEntry] -> Cache
Cache { cacheEntries :: [IndexCacheEntry]
cacheEntries = [IndexCacheEntry]
ents, cacheHeadTs :: Timestamp
cacheHeadTs = Timestamp
isiMaxTime }
isiHeadTime :: Timestamp
isiHeadTime = Cache -> Timestamp
cacheHeadTs Cache
cache0
isiMaxTime :: Timestamp
isiMaxTime = [Timestamp] -> Timestamp
maximumTimestamp ((IndexCacheEntry -> Timestamp) -> [IndexCacheEntry] -> [Timestamp]
forall a b. (a -> b) -> [a] -> [b]
map IndexCacheEntry -> Timestamp
cacheEntryTimestamp [IndexCacheEntry]
ents)
ents :: [IndexCacheEntry]
ents = (IndexCacheEntry -> Bool) -> [IndexCacheEntry] -> [IndexCacheEntry]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Timestamp -> Timestamp -> Bool
forall a. Ord a => a -> a -> Bool
<= Timestamp
ts0) (Timestamp -> Bool)
-> (IndexCacheEntry -> Timestamp) -> IndexCacheEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexCacheEntry -> Timestamp
cacheEntryTimestamp) (Cache -> [IndexCacheEntry]
cacheEntries Cache
cache0)
getSourcePackages :: Verbosity -> RepoContext -> IO SourcePackageDb
getSourcePackages :: Verbosity -> RepoContext -> IO SourcePackageDb
getSourcePackages Verbosity
verbosity RepoContext
repoCtxt =
(SourcePackageDb, TotalIndexState, ActiveRepos) -> SourcePackageDb
forall a b c. (a, b, c) -> a
fstOf3 ((SourcePackageDb, TotalIndexState, ActiveRepos)
-> SourcePackageDb)
-> IO (SourcePackageDb, TotalIndexState, ActiveRepos)
-> IO SourcePackageDb
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity
-> RepoContext
-> Maybe TotalIndexState
-> Maybe ActiveRepos
-> IO (SourcePackageDb, TotalIndexState, ActiveRepos)
getSourcePackagesAtIndexState Verbosity
verbosity RepoContext
repoCtxt Maybe TotalIndexState
forall a. Maybe a
Nothing Maybe ActiveRepos
forall a. Maybe a
Nothing
getSourcePackagesAtIndexState
:: Verbosity
-> RepoContext
-> Maybe TotalIndexState
-> Maybe ActiveRepos
-> IO (SourcePackageDb, TotalIndexState, ActiveRepos)
getSourcePackagesAtIndexState :: Verbosity
-> RepoContext
-> Maybe TotalIndexState
-> Maybe ActiveRepos
-> IO (SourcePackageDb, TotalIndexState, ActiveRepos)
getSourcePackagesAtIndexState Verbosity
verbosity RepoContext
repoCtxt Maybe TotalIndexState
_ Maybe ActiveRepos
_
| [Repo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (RepoContext -> [Repo]
repoContextRepos RepoContext
repoCtxt) = do
Verbosity -> FilePath -> IO ()
warn (Verbosity -> Verbosity
verboseUnmarkOutput Verbosity
verbosity) (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"No remote package servers have been specified. Usually " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
"you would have one specified in the config file."
(SourcePackageDb, TotalIndexState, ActiveRepos)
-> IO (SourcePackageDb, TotalIndexState, ActiveRepos)
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePackageDb :: PackageIndex UnresolvedSourcePackage
-> Map PackageName VersionRange -> SourcePackageDb
SourcePackageDb {
packageIndex :: PackageIndex UnresolvedSourcePackage
packageIndex = PackageIndex UnresolvedSourcePackage
forall a. Monoid a => a
mempty,
packagePreferences :: Map PackageName VersionRange
packagePreferences = Map PackageName VersionRange
forall a. Monoid a => a
mempty
}, TotalIndexState
headTotalIndexState, [ActiveRepoEntry] -> ActiveRepos
ActiveRepos [])
getSourcePackagesAtIndexState Verbosity
verbosity RepoContext
repoCtxt Maybe TotalIndexState
mb_idxState Maybe ActiveRepos
mb_activeRepos = do
let describeState :: RepoIndexState -> FilePath
describeState RepoIndexState
IndexStateHead = FilePath
"most recent state"
describeState (IndexStateTime Timestamp
time) = FilePath
"historical state as of " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Timestamp -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Timestamp
time
[RepoData]
pkgss <- [Repo] -> (Repo -> IO RepoData) -> IO [RepoData]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (RepoContext -> [Repo]
repoContextRepos RepoContext
repoCtxt) ((Repo -> IO RepoData) -> IO [RepoData])
-> (Repo -> IO RepoData) -> IO [RepoData]
forall a b. (a -> b) -> a -> b
$ \Repo
r -> do
let rname :: RepoName
rname :: RepoName
rname = Repo -> RepoName
repoName Repo
r
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath
"Reading available packages of " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ RepoName -> FilePath
unRepoName RepoName
rname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"...")
RepoIndexState
idxState <- case Maybe TotalIndexState
mb_idxState of
Just TotalIndexState
totalIdxState -> do
let idxState :: RepoIndexState
idxState = RepoName -> TotalIndexState -> RepoIndexState
lookupIndexState RepoName
rname TotalIndexState
totalIdxState
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Using " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ RepoIndexState -> FilePath
describeState RepoIndexState
idxState FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" as explicitly requested (via command line / project configuration)"
RepoIndexState -> IO RepoIndexState
forall (m :: * -> *) a. Monad m => a -> m a
return RepoIndexState
idxState
Maybe TotalIndexState
Nothing -> do
Maybe RepoIndexState
mb_idxState' <- Verbosity -> Index -> IO (Maybe RepoIndexState)
readIndexTimestamp Verbosity
verbosity (RepoContext -> Repo -> Index
RepoIndex RepoContext
repoCtxt Repo
r)
case Maybe RepoIndexState
mb_idxState' of
Maybe RepoIndexState
Nothing -> do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"Using most recent state (could not read timestamp file)"
RepoIndexState -> IO RepoIndexState
forall (m :: * -> *) a. Monad m => a -> m a
return RepoIndexState
IndexStateHead
Just RepoIndexState
idxState -> do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Using " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ RepoIndexState -> FilePath
describeState RepoIndexState
idxState FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" specified from most recent cabal update"
RepoIndexState -> IO RepoIndexState
forall (m :: * -> *) a. Monad m => a -> m a
return RepoIndexState
idxState
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RepoIndexState
idxState RepoIndexState -> RepoIndexState -> Bool
forall a. Eq a => a -> a -> Bool
== RepoIndexState
IndexStateHead) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
case Repo
r of
RepoLocalNoIndex {} -> Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity FilePath
"index-state ignored for file+noindex repositories"
RepoRemote {} -> Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath
"index-state ignored for old-format (remote repository '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ RepoName -> FilePath
unRepoName RepoName
rname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"')")
RepoSecure {} -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
let idxState' :: RepoIndexState
idxState' = case Repo
r of
RepoSecure {} -> RepoIndexState
idxState
Repo
_ -> RepoIndexState
IndexStateHead
(PackageIndex UnresolvedSourcePackage
pis,[Dependency]
deps,IndexStateInfo
isi) <- Verbosity
-> RepoContext
-> Repo
-> RepoIndexState
-> IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo)
readRepoIndex Verbosity
verbosity RepoContext
repoCtxt Repo
r RepoIndexState
idxState'
case RepoIndexState
idxState' of
RepoIndexState
IndexStateHead -> do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath
"index-state("FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ RepoName -> FilePath
unRepoName RepoName
rname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
") = " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Timestamp -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (IndexStateInfo -> Timestamp
isiHeadTime IndexStateInfo
isi))
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IndexStateTime Timestamp
ts0 -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IndexStateInfo -> Timestamp
isiMaxTime IndexStateInfo
isi Timestamp -> Timestamp -> Bool
forall a. Eq a => a -> a -> Bool
/= Timestamp
ts0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
if Timestamp
ts0 Timestamp -> Timestamp -> Bool
forall a. Ord a => a -> a -> Bool
> IndexStateInfo -> Timestamp
isiMaxTime IndexStateInfo
isi
then Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"Requested index-state " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Timestamp -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Timestamp
ts0
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is newer than '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ RepoName -> FilePath
unRepoName RepoName
rname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"'!"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" Falling back to older state ("
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Timestamp -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (IndexStateInfo -> Timestamp
isiMaxTime IndexStateInfo
isi) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")."
else Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"Requested index-state " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Timestamp -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Timestamp
ts0
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" does not exist in '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ RepoName -> FilePath
unRepoName RepoName
rname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'!"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" Falling back to older state ("
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Timestamp -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (IndexStateInfo -> Timestamp
isiMaxTime IndexStateInfo
isi) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")."
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath
"index-state("FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ RepoName -> FilePath
unRepoName RepoName
rname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
") = " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
Timestamp -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (IndexStateInfo -> Timestamp
isiMaxTime IndexStateInfo
isi) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" (HEAD = " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
Timestamp -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (IndexStateInfo -> Timestamp
isiHeadTime IndexStateInfo
isi) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")")
RepoData -> IO RepoData
forall (f :: * -> *) a. Applicative f => a -> f a
pure RepoData :: RepoName
-> Timestamp
-> PackageIndex UnresolvedSourcePackage
-> [Dependency]
-> RepoData
RepoData
{ rdRepoName :: RepoName
rdRepoName = RepoName
rname
, rdTimeStamp :: Timestamp
rdTimeStamp = IndexStateInfo -> Timestamp
isiMaxTime IndexStateInfo
isi
, rdIndex :: PackageIndex UnresolvedSourcePackage
rdIndex = PackageIndex UnresolvedSourcePackage
pis
, rdPreferences :: [Dependency]
rdPreferences = [Dependency]
deps
}
let activeRepos :: ActiveRepos
activeRepos :: ActiveRepos
activeRepos = ActiveRepos -> Maybe ActiveRepos -> ActiveRepos
forall a. a -> Maybe a -> a
fromMaybe ActiveRepos
defaultActiveRepos Maybe ActiveRepos
mb_activeRepos
[(RepoData, CombineStrategy)]
pkgss' <- case ActiveRepos
-> (RepoData -> RepoName)
-> [RepoData]
-> Either FilePath [(RepoData, CombineStrategy)]
forall a.
ActiveRepos
-> (a -> RepoName) -> [a] -> Either FilePath [(a, CombineStrategy)]
organizeByRepos ActiveRepos
activeRepos RepoData -> RepoName
rdRepoName [RepoData]
pkgss of
Right [(RepoData, CombineStrategy)]
x -> [(RepoData, CombineStrategy)] -> IO [(RepoData, CombineStrategy)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(RepoData, CombineStrategy)]
x
Left FilePath
err -> Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity FilePath
err IO ()
-> IO [(RepoData, CombineStrategy)]
-> IO [(RepoData, CombineStrategy)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(RepoData, CombineStrategy)] -> IO [(RepoData, CombineStrategy)]
forall (m :: * -> *) a. Monad m => a -> m a
return ((RepoData -> (RepoData, CombineStrategy))
-> [RepoData] -> [(RepoData, CombineStrategy)]
forall a b. (a -> b) -> [a] -> [b]
map (\RepoData
x -> (RepoData
x, CombineStrategy
CombineStrategyMerge)) [RepoData]
pkgss)
let activeRepos' :: ActiveRepos
activeRepos' :: ActiveRepos
activeRepos' = [ActiveRepoEntry] -> ActiveRepos
ActiveRepos
[ RepoName -> CombineStrategy -> ActiveRepoEntry
ActiveRepo (RepoData -> RepoName
rdRepoName RepoData
rd) CombineStrategy
strategy
| (RepoData
rd, CombineStrategy
strategy) <- [(RepoData, CombineStrategy)]
pkgss'
]
let totalIndexState :: TotalIndexState
totalIndexState :: TotalIndexState
totalIndexState = RepoIndexState -> Map RepoName RepoIndexState -> TotalIndexState
makeTotalIndexState RepoIndexState
IndexStateHead (Map RepoName RepoIndexState -> TotalIndexState)
-> Map RepoName RepoIndexState -> TotalIndexState
forall a b. (a -> b) -> a -> b
$ [(RepoName, RepoIndexState)] -> Map RepoName RepoIndexState
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (RepoName
n, Timestamp -> RepoIndexState
IndexStateTime Timestamp
ts)
| (RepoData RepoName
n Timestamp
ts PackageIndex UnresolvedSourcePackage
_idx [Dependency]
_prefs, CombineStrategy
_strategy) <- [(RepoData, CombineStrategy)]
pkgss'
, Timestamp
ts Timestamp -> Timestamp -> Bool
forall a. Eq a => a -> a -> Bool
/= Timestamp
nullTimestamp
]
let addIndex
:: PackageIndex UnresolvedSourcePackage
-> (RepoData, CombineStrategy)
-> PackageIndex UnresolvedSourcePackage
addIndex :: PackageIndex UnresolvedSourcePackage
-> (RepoData, CombineStrategy)
-> PackageIndex UnresolvedSourcePackage
addIndex PackageIndex UnresolvedSourcePackage
acc (RepoData RepoName
_ Timestamp
_ PackageIndex UnresolvedSourcePackage
_ [Dependency]
_, CombineStrategy
CombineStrategySkip) = PackageIndex UnresolvedSourcePackage
acc
addIndex PackageIndex UnresolvedSourcePackage
acc (RepoData RepoName
_ Timestamp
_ PackageIndex UnresolvedSourcePackage
idx [Dependency]
_, CombineStrategy
CombineStrategyMerge) = PackageIndex UnresolvedSourcePackage
-> PackageIndex UnresolvedSourcePackage
-> PackageIndex UnresolvedSourcePackage
forall pkg.
Package pkg =>
PackageIndex pkg -> PackageIndex pkg -> PackageIndex pkg
PackageIndex.merge PackageIndex UnresolvedSourcePackage
acc PackageIndex UnresolvedSourcePackage
idx
addIndex PackageIndex UnresolvedSourcePackage
acc (RepoData RepoName
_ Timestamp
_ PackageIndex UnresolvedSourcePackage
idx [Dependency]
_, CombineStrategy
CombineStrategyOverride) = PackageIndex UnresolvedSourcePackage
-> PackageIndex UnresolvedSourcePackage
-> PackageIndex UnresolvedSourcePackage
forall pkg.
Package pkg =>
PackageIndex pkg -> PackageIndex pkg -> PackageIndex pkg
PackageIndex.override PackageIndex UnresolvedSourcePackage
acc PackageIndex UnresolvedSourcePackage
idx
let pkgs :: PackageIndex UnresolvedSourcePackage
pkgs :: PackageIndex UnresolvedSourcePackage
pkgs = (PackageIndex UnresolvedSourcePackage
-> (RepoData, CombineStrategy)
-> PackageIndex UnresolvedSourcePackage)
-> PackageIndex UnresolvedSourcePackage
-> [(RepoData, CombineStrategy)]
-> PackageIndex UnresolvedSourcePackage
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' PackageIndex UnresolvedSourcePackage
-> (RepoData, CombineStrategy)
-> PackageIndex UnresolvedSourcePackage
addIndex PackageIndex UnresolvedSourcePackage
forall a. Monoid a => a
mempty [(RepoData, CombineStrategy)]
pkgss'
let prefs :: Map PackageName VersionRange
prefs :: Map PackageName VersionRange
prefs = (VersionRange -> VersionRange -> VersionRange)
-> [(PackageName, VersionRange)] -> Map PackageName VersionRange
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith VersionRange -> VersionRange -> VersionRange
intersectVersionRanges
[ (PackageName
name, VersionRange
range)
| (RepoData RepoName
_n Timestamp
_ts PackageIndex UnresolvedSourcePackage
_idx [Dependency]
prefs', CombineStrategy
_strategy) <- [(RepoData, CombineStrategy)]
pkgss'
, Dependency PackageName
name VersionRange
range NonEmptySet LibraryName
_ <- [Dependency]
prefs'
]
PackageIndex UnresolvedSourcePackage
_ <- PackageIndex UnresolvedSourcePackage
-> IO (PackageIndex UnresolvedSourcePackage)
forall a. a -> IO a
evaluate PackageIndex UnresolvedSourcePackage
pkgs
Map PackageName VersionRange
_ <- Map PackageName VersionRange -> IO (Map PackageName VersionRange)
forall a. a -> IO a
evaluate Map PackageName VersionRange
prefs
TotalIndexState
_ <- TotalIndexState -> IO TotalIndexState
forall a. a -> IO a
evaluate TotalIndexState
totalIndexState
(SourcePackageDb, TotalIndexState, ActiveRepos)
-> IO (SourcePackageDb, TotalIndexState, ActiveRepos)
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePackageDb :: PackageIndex UnresolvedSourcePackage
-> Map PackageName VersionRange -> SourcePackageDb
SourcePackageDb {
packageIndex :: PackageIndex UnresolvedSourcePackage
packageIndex = PackageIndex UnresolvedSourcePackage
pkgs,
packagePreferences :: Map PackageName VersionRange
packagePreferences = Map PackageName VersionRange
prefs
}, TotalIndexState
totalIndexState, ActiveRepos
activeRepos')
data RepoData = RepoData
{ RepoData -> RepoName
rdRepoName :: RepoName
, RepoData -> Timestamp
rdTimeStamp :: Timestamp
, RepoData -> PackageIndex UnresolvedSourcePackage
rdIndex :: PackageIndex UnresolvedSourcePackage
, RepoData -> [Dependency]
rdPreferences :: [Dependency]
}
readRepoIndex :: Verbosity -> RepoContext -> Repo -> RepoIndexState
-> IO (PackageIndex UnresolvedSourcePackage, [Dependency], IndexStateInfo)
readRepoIndex :: Verbosity
-> RepoContext
-> Repo
-> RepoIndexState
-> IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo)
readRepoIndex Verbosity
verbosity RepoContext
repoCtxt Repo
repo RepoIndexState
idxState =
IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo)
-> IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo)
handleNotFound (IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo)
-> IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo))
-> IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo)
-> IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo)
forall a b. (a -> b) -> a -> b
$ do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Repo -> Bool
isRepoRemote Repo
repo) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> IO ()
warnIfIndexIsOld (Double -> IO ()) -> IO Double -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Repo -> IO Double
getIndexFileAge Repo
repo
Verbosity -> Index -> IO ()
updateRepoIndexCache Verbosity
verbosity (RepoContext -> Repo -> Index
RepoIndex RepoContext
repoCtxt Repo
repo) IO () -> (IOException -> IO ()) -> IO ()
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO`
(\IOException
e -> Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"unable to update the repo index cache -- " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ IOException -> FilePath
forall e. Exception e => e -> FilePath
displayException IOException
e)
Verbosity
-> (PackageEntry -> UnresolvedSourcePackage)
-> Index
-> RepoIndexState
-> IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo)
forall pkg.
Package pkg =>
Verbosity
-> (PackageEntry -> pkg)
-> Index
-> RepoIndexState
-> IO (PackageIndex pkg, [Dependency], IndexStateInfo)
readPackageIndexCacheFile Verbosity
verbosity PackageEntry -> UnresolvedSourcePackage
mkAvailablePackage
(RepoContext -> Repo -> Index
RepoIndex RepoContext
repoCtxt Repo
repo)
RepoIndexState
idxState
where
mkAvailablePackage :: PackageEntry -> UnresolvedSourcePackage
mkAvailablePackage PackageEntry
pkgEntry = SourcePackage :: forall loc.
PackageId
-> GenericPackageDescription
-> loc
-> PackageDescriptionOverride
-> SourcePackage loc
SourcePackage
{ srcpkgPackageId :: PackageId
srcpkgPackageId = PackageId
pkgid
, srcpkgDescription :: GenericPackageDescription
srcpkgDescription = GenericPackageDescription
pkgdesc
, srcpkgSource :: PackageLocation (Maybe FilePath)
srcpkgSource = case PackageEntry
pkgEntry of
NormalPackage PackageId
_ GenericPackageDescription
_ ByteString
_ BlockNo
_ -> Repo
-> PackageId -> Maybe FilePath -> PackageLocation (Maybe FilePath)
forall local. Repo -> PackageId -> local -> PackageLocation local
RepoTarballPackage Repo
repo PackageId
pkgid Maybe FilePath
forall a. Maybe a
Nothing
BuildTreeRef BuildTreeRefType
_ PackageId
_ GenericPackageDescription
_ FilePath
path BlockNo
_ -> FilePath -> PackageLocation (Maybe FilePath)
forall local. FilePath -> PackageLocation local
LocalUnpackedPackage FilePath
path
, srcpkgDescrOverride :: PackageDescriptionOverride
srcpkgDescrOverride = case PackageEntry
pkgEntry of
NormalPackage PackageId
_ GenericPackageDescription
_ ByteString
pkgtxt BlockNo
_ -> ByteString -> PackageDescriptionOverride
forall a. a -> Maybe a
Just ByteString
pkgtxt
PackageEntry
_ -> PackageDescriptionOverride
forall a. Maybe a
Nothing
}
where
pkgdesc :: GenericPackageDescription
pkgdesc = PackageEntry -> GenericPackageDescription
packageDesc PackageEntry
pkgEntry
pkgid :: PackageId
pkgid = PackageEntry -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId PackageEntry
pkgEntry
handleNotFound :: IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo)
-> IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo)
handleNotFound IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo)
action = IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo)
-> (IOException
-> IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo))
-> IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo)
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo)
action ((IOException
-> IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo))
-> IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo))
-> (IOException
-> IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo))
-> IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo)
forall a b. (a -> b) -> a -> b
$ \IOException
e -> if IOException -> Bool
isDoesNotExistError IOException
e
then do
case Repo
repo of
RepoRemote{FilePath
RemoteRepo
repoRemote :: Repo -> RemoteRepo
repoLocalDir :: FilePath
repoRemote :: RemoteRepo
repoLocalDir :: Repo -> FilePath
..} -> Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ RemoteRepo -> FilePath
errMissingPackageList RemoteRepo
repoRemote
RepoSecure{FilePath
RemoteRepo
repoLocalDir :: FilePath
repoRemote :: RemoteRepo
repoRemote :: Repo -> RemoteRepo
repoLocalDir :: Repo -> FilePath
..} -> Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ RemoteRepo -> FilePath
errMissingPackageList RemoteRepo
repoRemote
RepoLocalNoIndex LocalRepo
local FilePath
_ -> Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"Error during construction of local+noindex "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ RepoName -> FilePath
unRepoName (LocalRepo -> RepoName
localRepoName LocalRepo
local) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" repository index: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ IOException -> FilePath
forall a. Show a => a -> FilePath
show IOException
e
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo)
-> IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageIndex UnresolvedSourcePackage
forall a. Monoid a => a
mempty,[Dependency]
forall a. Monoid a => a
mempty,IndexStateInfo
emptyStateInfo)
else IOException
-> IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo)
forall a. IOException -> IO a
ioError IOException
e
isOldThreshold :: Double
isOldThreshold = Double
15
warnIfIndexIsOld :: Double -> IO ()
warnIfIndexIsOld Double
dt = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
dt Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
isOldThreshold) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ case Repo
repo of
RepoRemote{FilePath
RemoteRepo
repoLocalDir :: FilePath
repoRemote :: RemoteRepo
repoRemote :: Repo -> RemoteRepo
repoLocalDir :: Repo -> FilePath
..} -> Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ RemoteRepo -> Double -> FilePath
forall a. RealFrac a => RemoteRepo -> a -> FilePath
errOutdatedPackageList RemoteRepo
repoRemote Double
dt
RepoSecure{FilePath
RemoteRepo
repoLocalDir :: FilePath
repoRemote :: RemoteRepo
repoRemote :: Repo -> RemoteRepo
repoLocalDir :: Repo -> FilePath
..} -> Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ RemoteRepo -> Double -> FilePath
forall a. RealFrac a => RemoteRepo -> a -> FilePath
errOutdatedPackageList RemoteRepo
repoRemote Double
dt
RepoLocalNoIndex {} -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
errMissingPackageList :: RemoteRepo -> FilePath
errMissingPackageList RemoteRepo
repoRemote =
FilePath
"The package list for '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ RepoName -> FilePath
unRepoName (RemoteRepo -> RepoName
remoteRepoName RemoteRepo
repoRemote)
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' does not exist. Run 'cabal update' to download it."
errOutdatedPackageList :: RemoteRepo -> a -> FilePath
errOutdatedPackageList RemoteRepo
repoRemote a
dt =
FilePath
"The package list for '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ RepoName -> FilePath
unRepoName (RemoteRepo -> RepoName
remoteRepoName RemoteRepo
repoRemote)
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' is " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath -> FilePath
forall a. Show a => a -> FilePath -> FilePath
shows (a -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor a
dt :: Int) FilePath
" days old.\nRun "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"'cabal update' to get the latest list of available packages."
getIndexFileAge :: Repo -> IO Double
getIndexFileAge :: Repo -> IO Double
getIndexFileAge Repo
repo = FilePath -> IO Double
getFileAge (FilePath -> IO Double) -> FilePath -> IO Double
forall a b. (a -> b) -> a -> b
$ Repo -> FilePath
indexBaseName Repo
repo FilePath -> FilePath -> FilePath
<.> FilePath
"tar"
getSourcePackagesMonitorFiles :: [Repo] -> [FilePath]
getSourcePackagesMonitorFiles :: [Repo] -> [FilePath]
getSourcePackagesMonitorFiles [Repo]
repos =
[[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ Repo -> FilePath
indexBaseName Repo
repo FilePath -> FilePath -> FilePath
<.> FilePath
"cache"
, Repo -> FilePath
indexBaseName Repo
repo FilePath -> FilePath -> FilePath
<.> FilePath
"timestamp" ]
| Repo
repo <- [Repo]
repos ]
updateRepoIndexCache :: Verbosity -> Index -> IO ()
updateRepoIndexCache :: Verbosity -> Index -> IO ()
updateRepoIndexCache Verbosity
verbosity Index
index =
Index -> IO () -> IO ()
whenCacheOutOfDate Index
index (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> Index -> IO ()
updatePackageIndexCacheFile Verbosity
verbosity Index
index
whenCacheOutOfDate :: Index -> IO () -> IO ()
whenCacheOutOfDate :: Index -> IO () -> IO ()
whenCacheOutOfDate Index
index IO ()
action = do
Bool
exists <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ Index -> FilePath
cacheFile Index
index
if Bool -> Bool
not Bool
exists
then IO ()
action
else if Index -> Bool
localNoIndex Index
index
then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
ModTime
indexTime <- FilePath -> IO ModTime
getModTime (FilePath -> IO ModTime) -> FilePath -> IO ModTime
forall a b. (a -> b) -> a -> b
$ Index -> FilePath
indexFile Index
index
ModTime
cacheTime <- FilePath -> IO ModTime
getModTime (FilePath -> IO ModTime) -> FilePath -> IO ModTime
forall a b. (a -> b) -> a -> b
$ Index -> FilePath
cacheFile Index
index
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ModTime
indexTime ModTime -> ModTime -> Bool
forall a. Ord a => a -> a -> Bool
> ModTime
cacheTime) IO ()
action
localNoIndex :: Index -> Bool
localNoIndex :: Index -> Bool
localNoIndex (RepoIndex RepoContext
_ (RepoLocalNoIndex {})) = Bool
True
localNoIndex Index
_ = Bool
False
data PackageEntry
= NormalPackage PackageId GenericPackageDescription ByteString BlockNo
| BuildTreeRef BuildTreeRefType
PackageId GenericPackageDescription FilePath BlockNo
data BuildTreeRefType = SnapshotRef | LinkRef
deriving (BuildTreeRefType -> BuildTreeRefType -> Bool
(BuildTreeRefType -> BuildTreeRefType -> Bool)
-> (BuildTreeRefType -> BuildTreeRefType -> Bool)
-> Eq BuildTreeRefType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuildTreeRefType -> BuildTreeRefType -> Bool
$c/= :: BuildTreeRefType -> BuildTreeRefType -> Bool
== :: BuildTreeRefType -> BuildTreeRefType -> Bool
$c== :: BuildTreeRefType -> BuildTreeRefType -> Bool
Eq,Int -> BuildTreeRefType -> FilePath -> FilePath
[BuildTreeRefType] -> FilePath -> FilePath
BuildTreeRefType -> FilePath
(Int -> BuildTreeRefType -> FilePath -> FilePath)
-> (BuildTreeRefType -> FilePath)
-> ([BuildTreeRefType] -> FilePath -> FilePath)
-> Show BuildTreeRefType
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [BuildTreeRefType] -> FilePath -> FilePath
$cshowList :: [BuildTreeRefType] -> FilePath -> FilePath
show :: BuildTreeRefType -> FilePath
$cshow :: BuildTreeRefType -> FilePath
showsPrec :: Int -> BuildTreeRefType -> FilePath -> FilePath
$cshowsPrec :: Int -> BuildTreeRefType -> FilePath -> FilePath
Show,(forall x. BuildTreeRefType -> Rep BuildTreeRefType x)
-> (forall x. Rep BuildTreeRefType x -> BuildTreeRefType)
-> Generic BuildTreeRefType
forall x. Rep BuildTreeRefType x -> BuildTreeRefType
forall x. BuildTreeRefType -> Rep BuildTreeRefType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BuildTreeRefType x -> BuildTreeRefType
$cfrom :: forall x. BuildTreeRefType -> Rep BuildTreeRefType x
Generic)
instance Binary BuildTreeRefType
instance Structured BuildTreeRefType
refTypeFromTypeCode :: Tar.TypeCode -> BuildTreeRefType
refTypeFromTypeCode :: TypeCode -> BuildTreeRefType
refTypeFromTypeCode TypeCode
t
| TypeCode
t TypeCode -> TypeCode -> Bool
forall a. Eq a => a -> a -> Bool
== TypeCode
Tar.buildTreeRefTypeCode = BuildTreeRefType
LinkRef
| TypeCode
t TypeCode -> TypeCode -> Bool
forall a. Eq a => a -> a -> Bool
== TypeCode
Tar.buildTreeSnapshotTypeCode = BuildTreeRefType
SnapshotRef
| Bool
otherwise =
FilePath -> BuildTreeRefType
forall a. HasCallStack => FilePath -> a
error FilePath
"Distribution.Client.IndexUtils.refTypeFromTypeCode: unknown type code"
typeCodeFromRefType :: BuildTreeRefType -> Tar.TypeCode
typeCodeFromRefType :: BuildTreeRefType -> TypeCode
typeCodeFromRefType BuildTreeRefType
LinkRef = TypeCode
Tar.buildTreeRefTypeCode
typeCodeFromRefType BuildTreeRefType
SnapshotRef = TypeCode
Tar.buildTreeSnapshotTypeCode
instance Package PackageEntry where
packageId :: PackageEntry -> PackageId
packageId (NormalPackage PackageId
pkgid GenericPackageDescription
_ ByteString
_ BlockNo
_) = PackageId
pkgid
packageId (BuildTreeRef BuildTreeRefType
_ PackageId
pkgid GenericPackageDescription
_ FilePath
_ BlockNo
_) = PackageId
pkgid
packageDesc :: PackageEntry -> GenericPackageDescription
packageDesc :: PackageEntry -> GenericPackageDescription
packageDesc (NormalPackage PackageId
_ GenericPackageDescription
descr ByteString
_ BlockNo
_) = GenericPackageDescription
descr
packageDesc (BuildTreeRef BuildTreeRefType
_ PackageId
_ GenericPackageDescription
descr FilePath
_ BlockNo
_) = GenericPackageDescription
descr
data PackageOrDep = Pkg PackageEntry | Dep Dependency
parsePackageIndex :: Verbosity -> ByteString -> [IO (Maybe PackageOrDep)]
parsePackageIndex :: Verbosity -> ByteString -> [IO (Maybe PackageOrDep)]
parsePackageIndex Verbosity
verbosity = ((BlockNo, Entry) -> [IO (Maybe PackageOrDep)])
-> [(BlockNo, Entry)] -> [IO (Maybe PackageOrDep)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((BlockNo -> Entry -> [IO (Maybe PackageOrDep)])
-> (BlockNo, Entry) -> [IO (Maybe PackageOrDep)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry BlockNo -> Entry -> [IO (Maybe PackageOrDep)]
extract) ([(BlockNo, Entry)] -> [IO (Maybe PackageOrDep)])
-> (ByteString -> [(BlockNo, Entry)])
-> ByteString
-> [IO (Maybe PackageOrDep)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entries FormatError -> [(BlockNo, Entry)]
forall e. Show e => Entries e -> [(BlockNo, Entry)]
tarEntriesList (Entries FormatError -> [(BlockNo, Entry)])
-> (ByteString -> Entries FormatError)
-> ByteString
-> [(BlockNo, Entry)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Entries FormatError
Tar.read
where
extract :: BlockNo -> Tar.Entry -> [IO (Maybe PackageOrDep)]
extract :: BlockNo -> Entry -> [IO (Maybe PackageOrDep)]
extract BlockNo
blockNo Entry
entry = [IO (Maybe PackageOrDep)]
tryExtractPkg [IO (Maybe PackageOrDep)]
-> [IO (Maybe PackageOrDep)] -> [IO (Maybe PackageOrDep)]
forall a. [a] -> [a] -> [a]
++ [IO (Maybe PackageOrDep)]
tryExtractPrefs
where
tryExtractPkg :: [IO (Maybe PackageOrDep)]
tryExtractPkg = do
IO (Maybe PackageEntry)
mkPkgEntry <- Maybe (IO (Maybe PackageEntry)) -> [IO (Maybe PackageEntry)]
forall a. Maybe a -> [a]
maybeToList (Maybe (IO (Maybe PackageEntry)) -> [IO (Maybe PackageEntry)])
-> Maybe (IO (Maybe PackageEntry)) -> [IO (Maybe PackageEntry)]
forall a b. (a -> b) -> a -> b
$ Verbosity -> Entry -> BlockNo -> Maybe (IO (Maybe PackageEntry))
extractPkg Verbosity
verbosity Entry
entry BlockNo
blockNo
IO (Maybe PackageOrDep) -> [IO (Maybe PackageOrDep)]
forall (m :: * -> *) a. Monad m => a -> m a
return (IO (Maybe PackageOrDep) -> [IO (Maybe PackageOrDep)])
-> IO (Maybe PackageOrDep) -> [IO (Maybe PackageOrDep)]
forall a b. (a -> b) -> a -> b
$ (Maybe PackageEntry -> Maybe PackageOrDep)
-> IO (Maybe PackageEntry) -> IO (Maybe PackageOrDep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PackageEntry -> PackageOrDep)
-> Maybe PackageEntry -> Maybe PackageOrDep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PackageEntry -> PackageOrDep
Pkg) IO (Maybe PackageEntry)
mkPkgEntry
tryExtractPrefs :: [IO (Maybe PackageOrDep)]
tryExtractPrefs = do
[Dependency]
prefs' <- Maybe [Dependency] -> [[Dependency]]
forall a. Maybe a -> [a]
maybeToList (Maybe [Dependency] -> [[Dependency]])
-> Maybe [Dependency] -> [[Dependency]]
forall a b. (a -> b) -> a -> b
$ Entry -> Maybe [Dependency]
extractPrefs Entry
entry
(Dependency -> IO (Maybe PackageOrDep))
-> [Dependency] -> [IO (Maybe PackageOrDep)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe PackageOrDep -> IO (Maybe PackageOrDep)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PackageOrDep -> IO (Maybe PackageOrDep))
-> (Dependency -> Maybe PackageOrDep)
-> Dependency
-> IO (Maybe PackageOrDep)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageOrDep -> Maybe PackageOrDep
forall a. a -> Maybe a
Just (PackageOrDep -> Maybe PackageOrDep)
-> (Dependency -> PackageOrDep) -> Dependency -> Maybe PackageOrDep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> PackageOrDep
Dep) [Dependency]
prefs'
tarEntriesList :: Show e => Tar.Entries e -> [(BlockNo, Tar.Entry)]
tarEntriesList :: Entries e -> [(BlockNo, Entry)]
tarEntriesList = BlockNo -> Entries e -> [(BlockNo, Entry)]
forall a. Show a => BlockNo -> Entries a -> [(BlockNo, Entry)]
go BlockNo
0
where
go :: BlockNo -> Entries a -> [(BlockNo, Entry)]
go !BlockNo
_ Entries a
Tar.Done = []
go !BlockNo
_ (Tar.Fail a
e) = FilePath -> [(BlockNo, Entry)]
forall a. HasCallStack => FilePath -> a
error (FilePath
"tarEntriesList: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
e)
go !BlockNo
n (Tar.Next Entry
e Entries a
es') = (BlockNo
n, Entry
e) (BlockNo, Entry) -> [(BlockNo, Entry)] -> [(BlockNo, Entry)]
forall a. a -> [a] -> [a]
: BlockNo -> Entries a -> [(BlockNo, Entry)]
go (Entry -> BlockNo -> BlockNo
Tar.nextEntryOffset Entry
e BlockNo
n) Entries a
es'
extractPkg :: Verbosity -> Tar.Entry -> BlockNo -> Maybe (IO (Maybe PackageEntry))
Verbosity
verbosity Entry
entry BlockNo
blockNo = case Entry -> EntryContent
Tar.entryContent Entry
entry of
Tar.NormalFile ByteString
content FileSize
_
| FilePath -> FilePath
takeExtension FilePath
fileName FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".cabal"
-> case FilePath -> [FilePath]
splitDirectories (FilePath -> FilePath
normalise FilePath
fileName) of
[FilePath
pkgname,FilePath
vers,FilePath
_] -> case FilePath -> Maybe Version
forall a. Parsec a => FilePath -> Maybe a
simpleParsec FilePath
vers of
Just Version
ver -> IO (Maybe PackageEntry) -> Maybe (IO (Maybe PackageEntry))
forall a. a -> Maybe a
Just (IO (Maybe PackageEntry) -> Maybe (IO (Maybe PackageEntry)))
-> (Maybe PackageEntry -> IO (Maybe PackageEntry))
-> Maybe PackageEntry
-> Maybe (IO (Maybe PackageEntry))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PackageEntry -> IO (Maybe PackageEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PackageEntry -> Maybe (IO (Maybe PackageEntry)))
-> Maybe PackageEntry -> Maybe (IO (Maybe PackageEntry))
forall a b. (a -> b) -> a -> b
$ PackageEntry -> Maybe PackageEntry
forall a. a -> Maybe a
Just (PackageId
-> GenericPackageDescription
-> ByteString
-> BlockNo
-> PackageEntry
NormalPackage PackageId
pkgid GenericPackageDescription
descr ByteString
content BlockNo
blockNo)
where
pkgid :: PackageId
pkgid = PackageName -> Version -> PackageId
PackageIdentifier (FilePath -> PackageName
mkPackageName FilePath
pkgname) Version
ver
parsed :: Maybe GenericPackageDescription
parsed = ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe (ByteString -> ByteString
BS.toStrict ByteString
content)
descr :: GenericPackageDescription
descr = case Maybe GenericPackageDescription
parsed of
Just GenericPackageDescription
d -> GenericPackageDescription
d
Maybe GenericPackageDescription
Nothing -> FilePath -> GenericPackageDescription
forall a. HasCallStack => FilePath -> a
error (FilePath -> GenericPackageDescription)
-> FilePath -> GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ FilePath
"Couldn't read cabal file "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
fileName
Maybe Version
_ -> Maybe (IO (Maybe PackageEntry))
forall a. Maybe a
Nothing
[FilePath]
_ -> Maybe (IO (Maybe PackageEntry))
forall a. Maybe a
Nothing
Tar.OtherEntryType TypeCode
typeCode ByteString
content FileSize
_
| TypeCode -> Bool
Tar.isBuildTreeRefTypeCode TypeCode
typeCode ->
IO (Maybe PackageEntry) -> Maybe (IO (Maybe PackageEntry))
forall a. a -> Maybe a
Just (IO (Maybe PackageEntry) -> Maybe (IO (Maybe PackageEntry)))
-> IO (Maybe PackageEntry) -> Maybe (IO (Maybe PackageEntry))
forall a b. (a -> b) -> a -> b
$ do
let path :: FilePath
path = ByteString -> FilePath
byteStringToFilePath ByteString
content
Bool
dirExists <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
Maybe PackageEntry
result <- if Bool -> Bool
not Bool
dirExists then Maybe PackageEntry -> IO (Maybe PackageEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PackageEntry
forall a. Maybe a
Nothing
else do
FilePath
cabalFile <- Verbosity -> FilePath -> FilePath -> IO FilePath
tryFindAddSourcePackageDesc Verbosity
verbosity FilePath
path FilePath
"Error reading package index."
GenericPackageDescription
descr <- Verbosity -> FilePath -> IO GenericPackageDescription
PackageDesc.Parse.readGenericPackageDescription Verbosity
normal FilePath
cabalFile
Maybe PackageEntry -> IO (Maybe PackageEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PackageEntry -> IO (Maybe PackageEntry))
-> (PackageEntry -> Maybe PackageEntry)
-> PackageEntry
-> IO (Maybe PackageEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageEntry -> Maybe PackageEntry
forall a. a -> Maybe a
Just (PackageEntry -> IO (Maybe PackageEntry))
-> PackageEntry -> IO (Maybe PackageEntry)
forall a b. (a -> b) -> a -> b
$ BuildTreeRefType
-> PackageId
-> GenericPackageDescription
-> FilePath
-> BlockNo
-> PackageEntry
BuildTreeRef (TypeCode -> BuildTreeRefType
refTypeFromTypeCode TypeCode
typeCode) (GenericPackageDescription -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId GenericPackageDescription
descr)
GenericPackageDescription
descr FilePath
path BlockNo
blockNo
Maybe PackageEntry -> IO (Maybe PackageEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PackageEntry
result
EntryContent
_ -> Maybe (IO (Maybe PackageEntry))
forall a. Maybe a
Nothing
where
fileName :: FilePath
fileName = Entry -> FilePath
Tar.entryPath Entry
entry
extractPrefs :: Tar.Entry -> Maybe [Dependency]
Entry
entry = case Entry -> EntryContent
Tar.entryContent Entry
entry of
Tar.NormalFile ByteString
content FileSize
_
| FilePath -> Bool
isPreferredVersions FilePath
entrypath
-> [Dependency] -> Maybe [Dependency]
forall a. a -> Maybe a
Just [Dependency]
prefs
where
entrypath :: FilePath
entrypath = Entry -> FilePath
Tar.entryPath Entry
entry
prefs :: [Dependency]
prefs = ByteString -> [Dependency]
parsePreferredVersions ByteString
content
EntryContent
_ -> Maybe [Dependency]
forall a. Maybe a
Nothing
preferredVersions :: FilePath
preferredVersions :: FilePath
preferredVersions = FilePath
"preferred-versions"
isPreferredVersions :: FilePath -> Bool
isPreferredVersions :: FilePath -> Bool
isPreferredVersions = (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
preferredVersions) (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeFileName
parsePreferredVersions :: ByteString -> [Dependency]
parsePreferredVersions :: ByteString -> [Dependency]
parsePreferredVersions = [Either PreferredVersionsParseError Dependency] -> [Dependency]
forall a b. [Either a b] -> [b]
rights ([Either PreferredVersionsParseError Dependency] -> [Dependency])
-> (ByteString -> [Either PreferredVersionsParseError Dependency])
-> ByteString
-> [Dependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Either PreferredVersionsParseError Dependency]
parsePreferredVersionsWarnings
data PreferredVersionsParseError = PreferredVersionsParseError
{ PreferredVersionsParseError -> FilePath
preferredVersionsParsecError :: String
, PreferredVersionsParseError -> FilePath
preferredVersionsOriginalDependency :: String
}
deriving ((forall x.
PreferredVersionsParseError -> Rep PreferredVersionsParseError x)
-> (forall x.
Rep PreferredVersionsParseError x -> PreferredVersionsParseError)
-> Generic PreferredVersionsParseError
forall x.
Rep PreferredVersionsParseError x -> PreferredVersionsParseError
forall x.
PreferredVersionsParseError -> Rep PreferredVersionsParseError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PreferredVersionsParseError x -> PreferredVersionsParseError
$cfrom :: forall x.
PreferredVersionsParseError -> Rep PreferredVersionsParseError x
Generic, ReadPrec [PreferredVersionsParseError]
ReadPrec PreferredVersionsParseError
Int -> ReadS PreferredVersionsParseError
ReadS [PreferredVersionsParseError]
(Int -> ReadS PreferredVersionsParseError)
-> ReadS [PreferredVersionsParseError]
-> ReadPrec PreferredVersionsParseError
-> ReadPrec [PreferredVersionsParseError]
-> Read PreferredVersionsParseError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PreferredVersionsParseError]
$creadListPrec :: ReadPrec [PreferredVersionsParseError]
readPrec :: ReadPrec PreferredVersionsParseError
$creadPrec :: ReadPrec PreferredVersionsParseError
readList :: ReadS [PreferredVersionsParseError]
$creadList :: ReadS [PreferredVersionsParseError]
readsPrec :: Int -> ReadS PreferredVersionsParseError
$creadsPrec :: Int -> ReadS PreferredVersionsParseError
Read, Int -> PreferredVersionsParseError -> FilePath -> FilePath
[PreferredVersionsParseError] -> FilePath -> FilePath
PreferredVersionsParseError -> FilePath
(Int -> PreferredVersionsParseError -> FilePath -> FilePath)
-> (PreferredVersionsParseError -> FilePath)
-> ([PreferredVersionsParseError] -> FilePath -> FilePath)
-> Show PreferredVersionsParseError
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [PreferredVersionsParseError] -> FilePath -> FilePath
$cshowList :: [PreferredVersionsParseError] -> FilePath -> FilePath
show :: PreferredVersionsParseError -> FilePath
$cshow :: PreferredVersionsParseError -> FilePath
showsPrec :: Int -> PreferredVersionsParseError -> FilePath -> FilePath
$cshowsPrec :: Int -> PreferredVersionsParseError -> FilePath -> FilePath
Show, PreferredVersionsParseError -> PreferredVersionsParseError -> Bool
(PreferredVersionsParseError
-> PreferredVersionsParseError -> Bool)
-> (PreferredVersionsParseError
-> PreferredVersionsParseError -> Bool)
-> Eq PreferredVersionsParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PreferredVersionsParseError -> PreferredVersionsParseError -> Bool
$c/= :: PreferredVersionsParseError -> PreferredVersionsParseError -> Bool
== :: PreferredVersionsParseError -> PreferredVersionsParseError -> Bool
$c== :: PreferredVersionsParseError -> PreferredVersionsParseError -> Bool
Eq, Eq PreferredVersionsParseError
Eq PreferredVersionsParseError
-> (PreferredVersionsParseError
-> PreferredVersionsParseError -> Ordering)
-> (PreferredVersionsParseError
-> PreferredVersionsParseError -> Bool)
-> (PreferredVersionsParseError
-> PreferredVersionsParseError -> Bool)
-> (PreferredVersionsParseError
-> PreferredVersionsParseError -> Bool)
-> (PreferredVersionsParseError
-> PreferredVersionsParseError -> Bool)
-> (PreferredVersionsParseError
-> PreferredVersionsParseError -> PreferredVersionsParseError)
-> (PreferredVersionsParseError
-> PreferredVersionsParseError -> PreferredVersionsParseError)
-> Ord PreferredVersionsParseError
PreferredVersionsParseError -> PreferredVersionsParseError -> Bool
PreferredVersionsParseError
-> PreferredVersionsParseError -> Ordering
PreferredVersionsParseError
-> PreferredVersionsParseError -> PreferredVersionsParseError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PreferredVersionsParseError
-> PreferredVersionsParseError -> PreferredVersionsParseError
$cmin :: PreferredVersionsParseError
-> PreferredVersionsParseError -> PreferredVersionsParseError
max :: PreferredVersionsParseError
-> PreferredVersionsParseError -> PreferredVersionsParseError
$cmax :: PreferredVersionsParseError
-> PreferredVersionsParseError -> PreferredVersionsParseError
>= :: PreferredVersionsParseError -> PreferredVersionsParseError -> Bool
$c>= :: PreferredVersionsParseError -> PreferredVersionsParseError -> Bool
> :: PreferredVersionsParseError -> PreferredVersionsParseError -> Bool
$c> :: PreferredVersionsParseError -> PreferredVersionsParseError -> Bool
<= :: PreferredVersionsParseError -> PreferredVersionsParseError -> Bool
$c<= :: PreferredVersionsParseError -> PreferredVersionsParseError -> Bool
< :: PreferredVersionsParseError -> PreferredVersionsParseError -> Bool
$c< :: PreferredVersionsParseError -> PreferredVersionsParseError -> Bool
compare :: PreferredVersionsParseError
-> PreferredVersionsParseError -> Ordering
$ccompare :: PreferredVersionsParseError
-> PreferredVersionsParseError -> Ordering
$cp1Ord :: Eq PreferredVersionsParseError
Ord, Typeable)
parsePreferredVersionsWarnings :: ByteString
-> [Either PreferredVersionsParseError Dependency]
parsePreferredVersionsWarnings :: ByteString -> [Either PreferredVersionsParseError Dependency]
parsePreferredVersionsWarnings =
(FilePath -> Either PreferredVersionsParseError Dependency)
-> [FilePath] -> [Either PreferredVersionsParseError Dependency]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Either PreferredVersionsParseError Dependency
parsePreference
([FilePath] -> [Either PreferredVersionsParseError Dependency])
-> (ByteString -> [FilePath])
-> ByteString
-> [Either PreferredVersionsParseError Dependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
"--")
([FilePath] -> [FilePath])
-> (ByteString -> [FilePath]) -> ByteString -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines
(FilePath -> [FilePath])
-> (ByteString -> FilePath) -> ByteString -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
fromUTF8LBS
where
parsePreference :: String -> Either PreferredVersionsParseError Dependency
parsePreference :: FilePath -> Either PreferredVersionsParseError Dependency
parsePreference FilePath
s = case FilePath -> Either FilePath Dependency
forall a. Parsec a => FilePath -> Either FilePath a
eitherParsec FilePath
s of
Left FilePath
err -> PreferredVersionsParseError
-> Either PreferredVersionsParseError Dependency
forall a b. a -> Either a b
Left (PreferredVersionsParseError
-> Either PreferredVersionsParseError Dependency)
-> PreferredVersionsParseError
-> Either PreferredVersionsParseError Dependency
forall a b. (a -> b) -> a -> b
$ PreferredVersionsParseError :: FilePath -> FilePath -> PreferredVersionsParseError
PreferredVersionsParseError
{ preferredVersionsParsecError :: FilePath
preferredVersionsParsecError = FilePath
err
, preferredVersionsOriginalDependency :: FilePath
preferredVersionsOriginalDependency = FilePath
s
}
Right Dependency
dep -> Dependency -> Either PreferredVersionsParseError Dependency
forall a b. b -> Either a b
Right Dependency
dep
lazySequence :: [IO a] -> IO [a]
lazySequence :: [IO a] -> IO [a]
lazySequence = IO [a] -> IO [a]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [a] -> IO [a]) -> ([IO a] -> IO [a]) -> [IO a] -> IO [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IO a] -> IO [a]
forall a. [IO a] -> IO [a]
go
where
go :: [IO a] -> IO [a]
go [] = [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go (IO a
x:[IO a]
xs) = do a
x' <- IO a
x
[a]
xs' <- [IO a] -> IO [a]
forall a. [IO a] -> IO [a]
lazySequence [IO a]
xs
[a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs')
lazyUnfold :: (k -> IO (v, Maybe k)) -> k -> IO [(k,v)]
lazyUnfold :: (k -> IO (v, Maybe k)) -> k -> IO [(k, v)]
lazyUnfold k -> IO (v, Maybe k)
step = Maybe k -> IO [(k, v)]
goLazy (Maybe k -> IO [(k, v)]) -> (k -> Maybe k) -> k -> IO [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Maybe k
forall a. a -> Maybe a
Just
where
goLazy :: Maybe k -> IO [(k, v)]
goLazy Maybe k
s = IO [(k, v)] -> IO [(k, v)]
forall a. IO a -> IO a
unsafeInterleaveIO (Maybe k -> IO [(k, v)]
go Maybe k
s)
go :: Maybe k -> IO [(k, v)]
go Maybe k
Nothing = [(k, v)] -> IO [(k, v)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go (Just k
k) = do
(v
v, Maybe k
mk') <- k -> IO (v, Maybe k)
step k
k
[(k, v)]
vs' <- Maybe k -> IO [(k, v)]
goLazy Maybe k
mk'
[(k, v)] -> IO [(k, v)]
forall (m :: * -> *) a. Monad m => a -> m a
return ((k
k,v
v)(k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
:[(k, v)]
vs')
data Index =
RepoIndex RepoContext Repo
| SandboxIndex FilePath
indexFile :: Index -> FilePath
indexFile :: Index -> FilePath
indexFile (RepoIndex RepoContext
_ctxt Repo
repo) = Repo -> FilePath
indexBaseName Repo
repo FilePath -> FilePath -> FilePath
<.> FilePath
"tar"
indexFile (SandboxIndex FilePath
index) = FilePath
index
cacheFile :: Index -> FilePath
cacheFile :: Index -> FilePath
cacheFile (RepoIndex RepoContext
_ctxt Repo
repo) = Repo -> FilePath
indexBaseName Repo
repo FilePath -> FilePath -> FilePath
<.> FilePath
"cache"
cacheFile (SandboxIndex FilePath
index) = FilePath
index FilePath -> FilePath -> FilePath
`replaceExtension` FilePath
"cache"
timestampFile :: Index -> FilePath
timestampFile :: Index -> FilePath
timestampFile (RepoIndex RepoContext
_ctxt Repo
repo) = Repo -> FilePath
indexBaseName Repo
repo FilePath -> FilePath -> FilePath
<.> FilePath
"timestamp"
timestampFile (SandboxIndex FilePath
index) = FilePath
index FilePath -> FilePath -> FilePath
`replaceExtension` FilePath
"timestamp"
is01Index :: Index -> Bool
is01Index :: Index -> Bool
is01Index (RepoIndex RepoContext
_ Repo
repo) = case Repo
repo of
RepoSecure {} -> Bool
True
RepoRemote {} -> Bool
False
RepoLocalNoIndex {} -> Bool
True
is01Index (SandboxIndex FilePath
_) = Bool
False
updatePackageIndexCacheFile :: Verbosity -> Index -> IO ()
updatePackageIndexCacheFile :: Verbosity -> Index -> IO ()
updatePackageIndexCacheFile Verbosity
verbosity Index
index = do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath
"Updating index cache file " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Index -> FilePath
cacheFile Index
index FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" ...")
Verbosity
-> Index
-> ([IndexCacheEntry] -> IO ())
-> ([NoIndexCacheEntry] -> IO ())
-> IO ()
forall a.
Verbosity
-> Index
-> ([IndexCacheEntry] -> IO a)
-> ([NoIndexCacheEntry] -> IO a)
-> IO a
withIndexEntries Verbosity
verbosity Index
index [IndexCacheEntry] -> IO ()
callback [NoIndexCacheEntry] -> IO ()
callbackNoIndex
where
callback :: [IndexCacheEntry] -> IO ()
callback [IndexCacheEntry]
entries = do
let !maxTs :: Timestamp
maxTs = [Timestamp] -> Timestamp
maximumTimestamp ((IndexCacheEntry -> Timestamp) -> [IndexCacheEntry] -> [Timestamp]
forall a b. (a -> b) -> [a] -> [b]
map IndexCacheEntry -> Timestamp
cacheEntryTimestamp [IndexCacheEntry]
entries)
cache :: Cache
cache = Cache :: Timestamp -> [IndexCacheEntry] -> Cache
Cache { cacheHeadTs :: Timestamp
cacheHeadTs = Timestamp
maxTs
, cacheEntries :: [IndexCacheEntry]
cacheEntries = [IndexCacheEntry]
entries
}
Index -> Cache -> IO ()
writeIndexCache Index
index Cache
cache
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath
"Index cache updated to index-state "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Timestamp -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (Cache -> Timestamp
cacheHeadTs Cache
cache))
callbackNoIndex :: [NoIndexCacheEntry] -> IO ()
callbackNoIndex [NoIndexCacheEntry]
entries = do
Verbosity -> Index -> NoIndexCache -> IO ()
writeNoIndexCache Verbosity
verbosity Index
index (NoIndexCache -> IO ()) -> NoIndexCache -> IO ()
forall a b. (a -> b) -> a -> b
$ [NoIndexCacheEntry] -> NoIndexCache
NoIndexCache [NoIndexCacheEntry]
entries
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"Index cache updated"
withIndexEntries
:: Verbosity -> Index
-> ([IndexCacheEntry] -> IO a)
-> ([NoIndexCacheEntry] -> IO a)
-> IO a
withIndexEntries :: Verbosity
-> Index
-> ([IndexCacheEntry] -> IO a)
-> ([NoIndexCacheEntry] -> IO a)
-> IO a
withIndexEntries Verbosity
_ (RepoIndex RepoContext
repoCtxt repo :: Repo
repo@RepoSecure{}) [IndexCacheEntry] -> IO a
callback [NoIndexCacheEntry] -> IO a
_ =
RepoContext
-> Repo
-> (forall (down :: * -> *). Repository down -> IO a)
-> IO a
RepoContext
-> forall a.
Repo -> (forall (down :: * -> *). Repository down -> IO a) -> IO a
repoContextWithSecureRepo RepoContext
repoCtxt Repo
repo ((forall (down :: * -> *). Repository down -> IO a) -> IO a)
-> (forall (down :: * -> *). Repository down -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Repository down
repoSecure ->
Repository down -> (IndexCallbacks -> IO a) -> IO a
forall (down :: * -> *) a.
Repository down -> (IndexCallbacks -> IO a) -> IO a
Sec.withIndex Repository down
repoSecure ((IndexCallbacks -> IO a) -> IO a)
-> (IndexCallbacks -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Sec.IndexCallbacks{Directory
DirectoryEntry -> IO (Some IndexEntry, Maybe DirectoryEntry)
Throws InvalidPackageException =>
PackageId -> IO (Trusted ByteString)
Throws InvalidPackageException => PackageId -> IO (Trusted Targets)
(Throws InvalidPackageException, Throws VerificationError) =>
PackageId -> IO (Trusted FileInfo)
(Throws InvalidPackageException, Throws VerificationError) =>
PackageId -> IO (Trusted Hash)
forall dec. DirectoryEntry -> IndexFile dec -> IO (IndexEntry dec)
forall dec. IndexFile dec -> IO (Maybe (IndexEntry dec))
indexLookupEntry :: IndexCallbacks
-> DirectoryEntry -> IO (Some IndexEntry, Maybe DirectoryEntry)
indexLookupFile :: IndexCallbacks
-> forall dec. IndexFile dec -> IO (Maybe (IndexEntry dec))
indexLookupFileEntry :: IndexCallbacks
-> forall dec.
DirectoryEntry -> IndexFile dec -> IO (IndexEntry dec)
indexLookupCabal :: IndexCallbacks
-> Throws InvalidPackageException =>
PackageId -> IO (Trusted ByteString)
indexLookupMetadata :: IndexCallbacks
-> Throws InvalidPackageException =>
PackageId -> IO (Trusted Targets)
indexLookupFileInfo :: IndexCallbacks
-> (Throws InvalidPackageException, Throws VerificationError) =>
PackageId -> IO (Trusted FileInfo)
indexLookupHash :: IndexCallbacks
-> (Throws InvalidPackageException, Throws VerificationError) =>
PackageId -> IO (Trusted Hash)
indexDirectory :: IndexCallbacks -> Directory
indexDirectory :: Directory
indexLookupHash :: (Throws InvalidPackageException, Throws VerificationError) =>
PackageId -> IO (Trusted Hash)
indexLookupFileInfo :: (Throws InvalidPackageException, Throws VerificationError) =>
PackageId -> IO (Trusted FileInfo)
indexLookupMetadata :: Throws InvalidPackageException => PackageId -> IO (Trusted Targets)
indexLookupCabal :: Throws InvalidPackageException =>
PackageId -> IO (Trusted ByteString)
indexLookupFileEntry :: forall dec. DirectoryEntry -> IndexFile dec -> IO (IndexEntry dec)
indexLookupFile :: forall dec. IndexFile dec -> IO (Maybe (IndexEntry dec))
indexLookupEntry :: DirectoryEntry -> IO (Some IndexEntry, Maybe DirectoryEntry)
..} -> do
[(DirectoryEntry, Some IndexEntry)]
indexEntries <- (DirectoryEntry -> IO (Some IndexEntry, Maybe DirectoryEntry))
-> DirectoryEntry -> IO [(DirectoryEntry, Some IndexEntry)]
forall k v. (k -> IO (v, Maybe k)) -> k -> IO [(k, v)]
lazyUnfold DirectoryEntry -> IO (Some IndexEntry, Maybe DirectoryEntry)
indexLookupEntry (Directory -> DirectoryEntry
Sec.directoryFirst Directory
indexDirectory)
[IndexCacheEntry] -> IO a
callback [ IndexCacheEntry
cacheEntry
| (DirectoryEntry
dirEntry, Some IndexEntry
indexEntry) <- [(DirectoryEntry, Some IndexEntry)]
indexEntries
, IndexCacheEntry
cacheEntry <- DirectoryEntry -> Some IndexEntry -> [IndexCacheEntry]
toCacheEntries DirectoryEntry
dirEntry Some IndexEntry
indexEntry ]
where
toCacheEntries :: Sec.DirectoryEntry -> Sec.Some Sec.IndexEntry
-> [IndexCacheEntry]
toCacheEntries :: DirectoryEntry -> Some IndexEntry -> [IndexCacheEntry]
toCacheEntries DirectoryEntry
dirEntry (Sec.Some IndexEntry a
sie) =
case IndexEntry a -> Maybe (IndexFile a)
forall dec. IndexEntry dec -> Maybe (IndexFile dec)
Sec.indexEntryPathParsed IndexEntry a
sie of
Maybe (IndexFile a)
Nothing -> []
Just (Sec.IndexPkgMetadata PackageId
_pkgId) -> []
Just (Sec.IndexPkgCabal PackageId
pkgId) -> [IndexCacheEntry] -> [IndexCacheEntry]
forall a. NFData a => a -> a
force
[PackageId -> BlockNo -> Timestamp -> IndexCacheEntry
CachePackageId PackageId
pkgId BlockNo
blockNo Timestamp
timestamp]
Just (Sec.IndexPkgPrefs PackageName
_pkgName) -> [IndexCacheEntry] -> [IndexCacheEntry]
forall a. NFData a => a -> a
force
[ Dependency -> BlockNo -> Timestamp -> IndexCacheEntry
CachePreference Dependency
dep BlockNo
blockNo Timestamp
timestamp
| Dependency
dep <- ByteString -> [Dependency]
parsePreferredVersions (IndexEntry a -> ByteString
forall dec. IndexEntry dec -> ByteString
Sec.indexEntryContent IndexEntry a
sie)
]
where
blockNo :: BlockNo
blockNo = DirectoryEntry -> BlockNo
Sec.directoryEntryBlockNo DirectoryEntry
dirEntry
timestamp :: Timestamp
timestamp = Timestamp -> Maybe Timestamp -> Timestamp
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Timestamp
forall a. HasCallStack => FilePath -> a
error FilePath
"withIndexEntries: invalid timestamp") (Maybe Timestamp -> Timestamp) -> Maybe Timestamp -> Timestamp
forall a b. (a -> b) -> a -> b
$
FileSize -> Maybe Timestamp
epochTimeToTimestamp (FileSize -> Maybe Timestamp) -> FileSize -> Maybe Timestamp
forall a b. (a -> b) -> a -> b
$ IndexEntry a -> FileSize
forall dec. IndexEntry dec -> FileSize
Sec.indexEntryTime IndexEntry a
sie
withIndexEntries Verbosity
verbosity (RepoIndex RepoContext
_repoCtxt (RepoLocalNoIndex (LocalRepo RepoName
name FilePath
localDir Bool
_) FilePath
_cacheDir)) [IndexCacheEntry] -> IO a
_ [NoIndexCacheEntry] -> IO a
callback = do
[FilePath]
dirContents <- FilePath -> IO [FilePath]
listDirectory FilePath
localDir
let contentSet :: Set FilePath
contentSet = [FilePath] -> Set FilePath
forall a. Ord a => [a] -> Set a
Set.fromList [FilePath]
dirContents
[NoIndexCacheEntry]
entries <- (IOException -> IO [NoIndexCacheEntry])
-> IO [NoIndexCacheEntry] -> IO [NoIndexCacheEntry]
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle IOException -> IO [NoIndexCacheEntry]
forall a. IOException -> IO a
handler (IO [NoIndexCacheEntry] -> IO [NoIndexCacheEntry])
-> IO [NoIndexCacheEntry] -> IO [NoIndexCacheEntry]
forall a b. (a -> b) -> a -> b
$ ([Maybe NoIndexCacheEntry] -> [NoIndexCacheEntry])
-> IO [Maybe NoIndexCacheEntry] -> IO [NoIndexCacheEntry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe NoIndexCacheEntry] -> [NoIndexCacheEntry]
forall a. [Maybe a] -> [a]
catMaybes (IO [Maybe NoIndexCacheEntry] -> IO [NoIndexCacheEntry])
-> IO [Maybe NoIndexCacheEntry] -> IO [NoIndexCacheEntry]
forall a b. (a -> b) -> a -> b
$ [FilePath]
-> (FilePath -> IO (Maybe NoIndexCacheEntry))
-> IO [Maybe NoIndexCacheEntry]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [FilePath]
dirContents ((FilePath -> IO (Maybe NoIndexCacheEntry))
-> IO [Maybe NoIndexCacheEntry])
-> (FilePath -> IO (Maybe NoIndexCacheEntry))
-> IO [Maybe NoIndexCacheEntry]
forall a b. (a -> b) -> a -> b
$ \FilePath
file -> do
case FilePath -> Maybe PackageId
isTarGz FilePath
file of
Maybe PackageId
Nothing
| FilePath -> Bool
isPreferredVersions FilePath
file -> do
ByteString
contents <- FilePath -> IO ByteString
BS.readFile (FilePath
localDir FilePath -> FilePath -> FilePath
</> FilePath
file)
let versionPreferencesParsed :: [Either PreferredVersionsParseError Dependency]
versionPreferencesParsed = ByteString -> [Either PreferredVersionsParseError Dependency]
parsePreferredVersionsWarnings ByteString
contents
let ([PreferredVersionsParseError]
warnings, [Dependency]
versionPreferences) = [Either PreferredVersionsParseError Dependency]
-> ([PreferredVersionsParseError], [Dependency])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either PreferredVersionsParseError Dependency]
versionPreferencesParsed
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PreferredVersionsParseError] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PreferredVersionsParseError]
warnings) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"withIndexEntries: failed to parse some entries of \"preferred-versions\" found at: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath
localDir FilePath -> FilePath -> FilePath
</> FilePath
file)
[PreferredVersionsParseError]
-> (PreferredVersionsParseError -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [PreferredVersionsParseError]
warnings ((PreferredVersionsParseError -> IO ()) -> IO ())
-> (PreferredVersionsParseError -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PreferredVersionsParseError
err -> do
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"* \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PreferredVersionsParseError -> FilePath
preferredVersionsOriginalDependency PreferredVersionsParseError
err
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Parser Error: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PreferredVersionsParseError -> FilePath
preferredVersionsParsecError PreferredVersionsParseError
err
Maybe NoIndexCacheEntry -> IO (Maybe NoIndexCacheEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe NoIndexCacheEntry -> IO (Maybe NoIndexCacheEntry))
-> Maybe NoIndexCacheEntry -> IO (Maybe NoIndexCacheEntry)
forall a b. (a -> b) -> a -> b
$ NoIndexCacheEntry -> Maybe NoIndexCacheEntry
forall a. a -> Maybe a
Just (NoIndexCacheEntry -> Maybe NoIndexCacheEntry)
-> NoIndexCacheEntry -> Maybe NoIndexCacheEntry
forall a b. (a -> b) -> a -> b
$ [Dependency] -> NoIndexCacheEntry
NoIndexCachePreference [Dependency]
versionPreferences
| Bool
otherwise -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FilePath -> FilePath
takeFileName FilePath
file FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"noindex.cache" Bool -> Bool -> Bool
|| FilePath
".cabal" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
file) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Skipping " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
Maybe NoIndexCacheEntry -> IO (Maybe NoIndexCacheEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe NoIndexCacheEntry
forall a. Maybe a
Nothing
Just PackageId
pkgid | FilePath
cabalPath FilePath -> Set FilePath -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set FilePath
contentSet -> do
ByteString
contents <- FilePath -> IO ByteString
BSS.readFile (FilePath
localDir FilePath -> FilePath -> FilePath
</> FilePath
cabalPath)
Maybe GenericPackageDescription
-> (GenericPackageDescription -> IO NoIndexCacheEntry)
-> IO (Maybe NoIndexCacheEntry)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe ByteString
contents) ((GenericPackageDescription -> IO NoIndexCacheEntry)
-> IO (Maybe NoIndexCacheEntry))
-> (GenericPackageDescription -> IO NoIndexCacheEntry)
-> IO (Maybe NoIndexCacheEntry)
forall a b. (a -> b) -> a -> b
$ \GenericPackageDescription
gpd ->
NoIndexCacheEntry -> IO NoIndexCacheEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericPackageDescription -> ByteString -> NoIndexCacheEntry
CacheGPD GenericPackageDescription
gpd ByteString
contents)
where
cabalPath :: FilePath
cabalPath = PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".cabal"
Just PackageId
pkgId -> do
ByteString
tarGz <- FilePath -> IO ByteString
BS.readFile (FilePath
localDir FilePath -> FilePath -> FilePath
</> FilePath
file)
let tar :: ByteString
tar = ByteString -> ByteString
GZip.decompress ByteString
tarGz
entries :: Entries FormatError
entries = ByteString -> Entries FormatError
Tar.read ByteString
tar
case (Entry -> Maybe NoIndexCacheEntry -> Maybe NoIndexCacheEntry)
-> Maybe NoIndexCacheEntry
-> (FormatError -> Maybe NoIndexCacheEntry)
-> Entries FormatError
-> Maybe NoIndexCacheEntry
forall a e. (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
Tar.foldEntries (PackageId
-> Entry -> Maybe NoIndexCacheEntry -> Maybe NoIndexCacheEntry
readCabalEntry PackageId
pkgId) Maybe NoIndexCacheEntry
forall a. Maybe a
Nothing (Maybe NoIndexCacheEntry -> FormatError -> Maybe NoIndexCacheEntry
forall a b. a -> b -> a
const Maybe NoIndexCacheEntry
forall a. Maybe a
Nothing) Entries FormatError
entries of
Just NoIndexCacheEntry
ce -> Maybe NoIndexCacheEntry -> IO (Maybe NoIndexCacheEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return (NoIndexCacheEntry -> Maybe NoIndexCacheEntry
forall a. a -> Maybe a
Just NoIndexCacheEntry
ce)
Maybe NoIndexCacheEntry
Nothing -> Verbosity -> FilePath -> IO (Maybe NoIndexCacheEntry)
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO (Maybe NoIndexCacheEntry))
-> FilePath -> IO (Maybe NoIndexCacheEntry)
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot read .cabal file inside " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
let ([[Dependency]]
prefs, [GenericPackageDescription]
gpds) = [Either [Dependency] GenericPackageDescription]
-> ([[Dependency]], [GenericPackageDescription])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either [Dependency] GenericPackageDescription]
-> ([[Dependency]], [GenericPackageDescription]))
-> [Either [Dependency] GenericPackageDescription]
-> ([[Dependency]], [GenericPackageDescription])
forall a b. (a -> b) -> a -> b
$ (NoIndexCacheEntry
-> Either [Dependency] GenericPackageDescription)
-> [NoIndexCacheEntry]
-> [Either [Dependency] GenericPackageDescription]
forall a b. (a -> b) -> [a] -> [b]
map
(\case
NoIndexCachePreference [Dependency]
deps -> [Dependency] -> Either [Dependency] GenericPackageDescription
forall a b. a -> Either a b
Left [Dependency]
deps
CacheGPD GenericPackageDescription
gpd ByteString
_ -> GenericPackageDescription
-> Either [Dependency] GenericPackageDescription
forall a b. b -> Either a b
Right GenericPackageDescription
gpd
)
[NoIndexCacheEntry]
entries
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Entries in file+noindex repository " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ RepoName -> FilePath
unRepoName RepoName
name
[GenericPackageDescription]
-> (GenericPackageDescription -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [GenericPackageDescription]
gpds ((GenericPackageDescription -> IO ()) -> IO ())
-> (GenericPackageDescription -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \GenericPackageDescription
gpd ->
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"- " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageDescription -> PackageId
package (PackageDescription -> PackageId)
-> PackageDescription -> PackageId
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> PackageDescription
Distribution.PackageDescription.packageDescription GenericPackageDescription
gpd)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([[Dependency]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Dependency]]
prefs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Preferred versions in file+noindex repository " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ RepoName -> FilePath
unRepoName RepoName
name
[Dependency] -> (Dependency -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([[Dependency]] -> [Dependency]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Dependency]]
prefs) ((Dependency -> IO ()) -> IO ()) -> (Dependency -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Dependency
pref ->
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath
"* " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Dependency -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Dependency
pref)
[NoIndexCacheEntry] -> IO a
callback [NoIndexCacheEntry]
entries
where
handler :: IOException -> IO a
handler :: IOException -> IO a
handler IOException
e = Verbosity -> FilePath -> IO a
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO a) -> FilePath -> IO a
forall a b. (a -> b) -> a -> b
$ FilePath
"Error while updating index for " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ RepoName -> FilePath
unRepoName RepoName
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" repository " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ IOException -> FilePath
forall a. Show a => a -> FilePath
show IOException
e
isTarGz :: FilePath -> Maybe PackageIdentifier
isTarGz :: FilePath -> Maybe PackageId
isTarGz FilePath
fp = do
FilePath
pfx <- FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix FilePath
".tar.gz" FilePath
fp
FilePath -> Maybe PackageId
forall a. Parsec a => FilePath -> Maybe a
simpleParsec FilePath
pfx
stripSuffix :: [a] -> [a] -> Maybe [a]
stripSuffix [a]
sfx [a]
str = ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
sfx) ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
str))
readCabalEntry :: PackageIdentifier -> Tar.Entry -> Maybe NoIndexCacheEntry -> Maybe NoIndexCacheEntry
readCabalEntry :: PackageId
-> Entry -> Maybe NoIndexCacheEntry -> Maybe NoIndexCacheEntry
readCabalEntry PackageId
pkgId Entry
entry Maybe NoIndexCacheEntry
Nothing
| FilePath
filename FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== Entry -> FilePath
Tar.entryPath Entry
entry
, Tar.NormalFile ByteString
contents FileSize
_ <- Entry -> EntryContent
Tar.entryContent Entry
entry
= let bs :: ByteString
bs = ByteString -> ByteString
BS.toStrict ByteString
contents
in (GenericPackageDescription -> NoIndexCacheEntry)
-> Maybe GenericPackageDescription -> Maybe NoIndexCacheEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\GenericPackageDescription
gpd -> GenericPackageDescription -> ByteString -> NoIndexCacheEntry
CacheGPD GenericPackageDescription
gpd ByteString
bs) (Maybe GenericPackageDescription -> Maybe NoIndexCacheEntry)
-> Maybe GenericPackageDescription -> Maybe NoIndexCacheEntry
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe ByteString
bs
where
filename :: FilePath
filename = PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgId FilePath -> FilePath -> FilePath
FilePath.Posix.</> PackageName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageId -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pkgId) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".cabal"
readCabalEntry PackageId
_ Entry
_ Maybe NoIndexCacheEntry
x = Maybe NoIndexCacheEntry
x
withIndexEntries Verbosity
verbosity Index
index [IndexCacheEntry] -> IO a
callback [NoIndexCacheEntry] -> IO a
_ = do
FilePath -> IOMode -> (Handle -> IO a) -> IO a
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile (Index -> FilePath
indexFile Index
index) IOMode
ReadMode ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
ByteString
bs <- ByteString -> ByteString
maybeDecompress (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Handle -> IO ByteString
BS.hGetContents Handle
h
[Maybe PackageOrDep]
pkgsOrPrefs <- [IO (Maybe PackageOrDep)] -> IO [Maybe PackageOrDep]
forall a. [IO a] -> IO [a]
lazySequence ([IO (Maybe PackageOrDep)] -> IO [Maybe PackageOrDep])
-> [IO (Maybe PackageOrDep)] -> IO [Maybe PackageOrDep]
forall a b. (a -> b) -> a -> b
$ Verbosity -> ByteString -> [IO (Maybe PackageOrDep)]
parsePackageIndex Verbosity
verbosity ByteString
bs
[IndexCacheEntry] -> IO a
callback ([IndexCacheEntry] -> IO a) -> [IndexCacheEntry] -> IO a
forall a b. (a -> b) -> a -> b
$ (PackageOrDep -> IndexCacheEntry)
-> [PackageOrDep] -> [IndexCacheEntry]
forall a b. (a -> b) -> [a] -> [b]
map PackageOrDep -> IndexCacheEntry
toCache ([Maybe PackageOrDep] -> [PackageOrDep]
forall a. [Maybe a] -> [a]
catMaybes [Maybe PackageOrDep]
pkgsOrPrefs)
where
toCache :: PackageOrDep -> IndexCacheEntry
toCache :: PackageOrDep -> IndexCacheEntry
toCache (Pkg (NormalPackage PackageId
pkgid GenericPackageDescription
_ ByteString
_ BlockNo
blockNo)) = PackageId -> BlockNo -> Timestamp -> IndexCacheEntry
CachePackageId PackageId
pkgid BlockNo
blockNo Timestamp
nullTimestamp
toCache (Pkg (BuildTreeRef BuildTreeRefType
refType PackageId
_ GenericPackageDescription
_ FilePath
_ BlockNo
blockNo)) = BuildTreeRefType -> BlockNo -> IndexCacheEntry
CacheBuildTreeRef BuildTreeRefType
refType BlockNo
blockNo
toCache (Dep Dependency
d) = Dependency -> BlockNo -> Timestamp -> IndexCacheEntry
CachePreference Dependency
d BlockNo
0 Timestamp
nullTimestamp
readPackageIndexCacheFile :: Package pkg
=> Verbosity
-> (PackageEntry -> pkg)
-> Index
-> RepoIndexState
-> IO (PackageIndex pkg, [Dependency], IndexStateInfo)
readPackageIndexCacheFile :: Verbosity
-> (PackageEntry -> pkg)
-> Index
-> RepoIndexState
-> IO (PackageIndex pkg, [Dependency], IndexStateInfo)
readPackageIndexCacheFile Verbosity
verbosity PackageEntry -> pkg
mkPkg Index
index RepoIndexState
idxState
| Index -> Bool
localNoIndex Index
index = do
NoIndexCache
cache0 <- Verbosity -> Index -> IO NoIndexCache
readNoIndexCache Verbosity
verbosity Index
index
(PackageIndex pkg
pkgs, [Dependency]
prefs) <- Verbosity
-> (PackageEntry -> pkg)
-> NoIndexCache
-> IO (PackageIndex pkg, [Dependency])
forall pkg.
Package pkg =>
Verbosity
-> (PackageEntry -> pkg)
-> NoIndexCache
-> IO (PackageIndex pkg, [Dependency])
packageNoIndexFromCache Verbosity
verbosity PackageEntry -> pkg
mkPkg NoIndexCache
cache0
(PackageIndex pkg, [Dependency], IndexStateInfo)
-> IO (PackageIndex pkg, [Dependency], IndexStateInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageIndex pkg
pkgs, [Dependency]
prefs, IndexStateInfo
emptyStateInfo)
| Bool
otherwise = do
Cache
cache0 <- Verbosity -> Index -> IO Cache
readIndexCache Verbosity
verbosity Index
index
Handle
indexHnd <- FilePath -> IOMode -> IO Handle
openFile (Index -> FilePath
indexFile Index
index) IOMode
ReadMode
let (Cache
cache,IndexStateInfo
isi) = RepoIndexState -> Cache -> (Cache, IndexStateInfo)
filterCache RepoIndexState
idxState Cache
cache0
(PackageIndex pkg
pkgs,[Dependency]
deps) <- Verbosity
-> (PackageEntry -> pkg)
-> Handle
-> Cache
-> IO (PackageIndex pkg, [Dependency])
forall pkg.
Package pkg =>
Verbosity
-> (PackageEntry -> pkg)
-> Handle
-> Cache
-> IO (PackageIndex pkg, [Dependency])
packageIndexFromCache Verbosity
verbosity PackageEntry -> pkg
mkPkg Handle
indexHnd Cache
cache
(PackageIndex pkg, [Dependency], IndexStateInfo)
-> IO (PackageIndex pkg, [Dependency], IndexStateInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageIndex pkg
pkgs,[Dependency]
deps,IndexStateInfo
isi)
packageIndexFromCache :: Package pkg
=> Verbosity
-> (PackageEntry -> pkg)
-> Handle
-> Cache
-> IO (PackageIndex pkg, [Dependency])
packageIndexFromCache :: Verbosity
-> (PackageEntry -> pkg)
-> Handle
-> Cache
-> IO (PackageIndex pkg, [Dependency])
packageIndexFromCache Verbosity
verbosity PackageEntry -> pkg
mkPkg Handle
hnd Cache
cache = do
([pkg]
pkgs, [Dependency]
prefs) <- Verbosity
-> (PackageEntry -> pkg)
-> Handle
-> Cache
-> IO ([pkg], [Dependency])
forall pkg.
Verbosity
-> (PackageEntry -> pkg)
-> Handle
-> Cache
-> IO ([pkg], [Dependency])
packageListFromCache Verbosity
verbosity PackageEntry -> pkg
mkPkg Handle
hnd Cache
cache
PackageIndex pkg
pkgIndex <- PackageIndex pkg -> IO (PackageIndex pkg)
forall a. a -> IO a
evaluate (PackageIndex pkg -> IO (PackageIndex pkg))
-> PackageIndex pkg -> IO (PackageIndex pkg)
forall a b. (a -> b) -> a -> b
$ [pkg] -> PackageIndex pkg
forall pkg. Package pkg => [pkg] -> PackageIndex pkg
PackageIndex.fromList [pkg]
pkgs
(PackageIndex pkg, [Dependency])
-> IO (PackageIndex pkg, [Dependency])
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageIndex pkg
pkgIndex, [Dependency]
prefs)
packageNoIndexFromCache
:: forall pkg. Package pkg
=> Verbosity
-> (PackageEntry -> pkg)
-> NoIndexCache
-> IO (PackageIndex pkg, [Dependency])
packageNoIndexFromCache :: Verbosity
-> (PackageEntry -> pkg)
-> NoIndexCache
-> IO (PackageIndex pkg, [Dependency])
packageNoIndexFromCache Verbosity
_verbosity PackageEntry -> pkg
mkPkg NoIndexCache
cache = do
let ([pkg]
pkgs, [Dependency]
prefs) = ([pkg], [Dependency])
packageListFromNoIndexCache
PackageIndex pkg
pkgIndex <- PackageIndex pkg -> IO (PackageIndex pkg)
forall a. a -> IO a
evaluate (PackageIndex pkg -> IO (PackageIndex pkg))
-> PackageIndex pkg -> IO (PackageIndex pkg)
forall a b. (a -> b) -> a -> b
$ [pkg] -> PackageIndex pkg
forall pkg. Package pkg => [pkg] -> PackageIndex pkg
PackageIndex.fromList [pkg]
pkgs
(PackageIndex pkg, [Dependency])
-> IO (PackageIndex pkg, [Dependency])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageIndex pkg
pkgIndex, [Dependency]
prefs)
where
packageListFromNoIndexCache :: ([pkg], [Dependency])
packageListFromNoIndexCache :: ([pkg], [Dependency])
packageListFromNoIndexCache = (NoIndexCacheEntry
-> ([pkg], [Dependency]) -> ([pkg], [Dependency]))
-> ([pkg], [Dependency])
-> [NoIndexCacheEntry]
-> ([pkg], [Dependency])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr NoIndexCacheEntry -> ([pkg], [Dependency]) -> ([pkg], [Dependency])
go ([pkg], [Dependency])
forall a. Monoid a => a
mempty (NoIndexCache -> [NoIndexCacheEntry]
noIndexCacheEntries NoIndexCache
cache)
go :: NoIndexCacheEntry -> ([pkg], [Dependency]) -> ([pkg], [Dependency])
go :: NoIndexCacheEntry -> ([pkg], [Dependency]) -> ([pkg], [Dependency])
go (CacheGPD GenericPackageDescription
gpd ByteString
bs) ([pkg]
pkgs, [Dependency]
prefs) =
let pkgId :: PackageId
pkgId = PackageDescription -> PackageId
package (PackageDescription -> PackageId)
-> PackageDescription -> PackageId
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> PackageDescription
Distribution.PackageDescription.packageDescription GenericPackageDescription
gpd
in (PackageEntry -> pkg
mkPkg (PackageId
-> GenericPackageDescription
-> ByteString
-> BlockNo
-> PackageEntry
NormalPackage PackageId
pkgId GenericPackageDescription
gpd (ByteString -> ByteString
BS.fromStrict ByteString
bs) BlockNo
0) pkg -> [pkg] -> [pkg]
forall a. a -> [a] -> [a]
: [pkg]
pkgs, [Dependency]
prefs)
go (NoIndexCachePreference [Dependency]
deps) ([pkg]
pkgs, [Dependency]
prefs) =
([pkg]
pkgs, [Dependency]
deps [Dependency] -> [Dependency] -> [Dependency]
forall a. [a] -> [a] -> [a]
++ [Dependency]
prefs)
packageListFromCache :: Verbosity
-> (PackageEntry -> pkg)
-> Handle
-> Cache
-> IO ([pkg], [Dependency])
packageListFromCache :: Verbosity
-> (PackageEntry -> pkg)
-> Handle
-> Cache
-> IO ([pkg], [Dependency])
packageListFromCache Verbosity
verbosity PackageEntry -> pkg
mkPkg Handle
hnd Cache{[IndexCacheEntry]
Timestamp
cacheEntries :: [IndexCacheEntry]
cacheHeadTs :: Timestamp
cacheEntries :: Cache -> [IndexCacheEntry]
cacheHeadTs :: Cache -> Timestamp
..} = Map PackageId pkg
-> [pkg]
-> Map PackageName Dependency
-> [IndexCacheEntry]
-> IO ([pkg], [Dependency])
accum Map PackageId pkg
forall a. Monoid a => a
mempty [] Map PackageName Dependency
forall a. Monoid a => a
mempty [IndexCacheEntry]
cacheEntries
where
accum :: Map PackageId pkg
-> [pkg]
-> Map PackageName Dependency
-> [IndexCacheEntry]
-> IO ([pkg], [Dependency])
accum !Map PackageId pkg
srcpkgs [pkg]
btrs !Map PackageName Dependency
prefs [] = ([pkg], [Dependency]) -> IO ([pkg], [Dependency])
forall (m :: * -> *) a. Monad m => a -> m a
return (Map PackageId pkg -> [pkg]
forall k a. Map k a -> [a]
Map.elems Map PackageId pkg
srcpkgs [pkg] -> [pkg] -> [pkg]
forall a. [a] -> [a] -> [a]
++ [pkg]
btrs, Map PackageName Dependency -> [Dependency]
forall k a. Map k a -> [a]
Map.elems Map PackageName Dependency
prefs)
accum Map PackageId pkg
srcpkgs [pkg]
btrs Map PackageName Dependency
prefs (CachePackageId PackageId
pkgid BlockNo
blockno Timestamp
_ : [IndexCacheEntry]
entries) = do
~(GenericPackageDescription
pkg, ByteString
pkgtxt) <- IO (GenericPackageDescription, ByteString)
-> IO (GenericPackageDescription, ByteString)
forall a. IO a -> IO a
unsafeInterleaveIO (IO (GenericPackageDescription, ByteString)
-> IO (GenericPackageDescription, ByteString))
-> IO (GenericPackageDescription, ByteString)
-> IO (GenericPackageDescription, ByteString)
forall a b. (a -> b) -> a -> b
$ do
ByteString
pkgtxt <- BlockNo -> IO ByteString
getEntryContent BlockNo
blockno
GenericPackageDescription
pkg <- PackageId -> ByteString -> IO GenericPackageDescription
readPackageDescription PackageId
pkgid ByteString
pkgtxt
(GenericPackageDescription, ByteString)
-> IO (GenericPackageDescription, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericPackageDescription
pkg, ByteString
pkgtxt)
let srcpkg :: pkg
srcpkg = PackageEntry -> pkg
mkPkg (PackageId
-> GenericPackageDescription
-> ByteString
-> BlockNo
-> PackageEntry
NormalPackage PackageId
pkgid GenericPackageDescription
pkg ByteString
pkgtxt BlockNo
blockno)
Map PackageId pkg
-> [pkg]
-> Map PackageName Dependency
-> [IndexCacheEntry]
-> IO ([pkg], [Dependency])
accum (PackageId -> pkg -> Map PackageId pkg -> Map PackageId pkg
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert PackageId
pkgid pkg
srcpkg Map PackageId pkg
srcpkgs) [pkg]
btrs Map PackageName Dependency
prefs [IndexCacheEntry]
entries
accum Map PackageId pkg
srcpkgs [pkg]
btrs Map PackageName Dependency
prefs (CacheBuildTreeRef BuildTreeRefType
refType BlockNo
blockno : [IndexCacheEntry]
entries) = do
FilePath
path <- (ByteString -> FilePath) -> IO ByteString -> IO FilePath
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteString -> FilePath
byteStringToFilePath (IO ByteString -> IO FilePath)
-> (BlockNo -> IO ByteString) -> BlockNo -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNo -> IO ByteString
getEntryContent (BlockNo -> IO FilePath) -> BlockNo -> IO FilePath
forall a b. (a -> b) -> a -> b
$ BlockNo
blockno
GenericPackageDescription
pkg <- do let err :: FilePath
err = FilePath
"Error reading package index from cache."
FilePath
file <- Verbosity -> FilePath -> FilePath -> IO FilePath
tryFindAddSourcePackageDesc Verbosity
verbosity FilePath
path FilePath
err
Verbosity -> FilePath -> IO GenericPackageDescription
PackageDesc.Parse.readGenericPackageDescription Verbosity
normal FilePath
file
let srcpkg :: pkg
srcpkg = PackageEntry -> pkg
mkPkg (BuildTreeRefType
-> PackageId
-> GenericPackageDescription
-> FilePath
-> BlockNo
-> PackageEntry
BuildTreeRef BuildTreeRefType
refType (GenericPackageDescription -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId GenericPackageDescription
pkg) GenericPackageDescription
pkg FilePath
path BlockNo
blockno)
Map PackageId pkg
-> [pkg]
-> Map PackageName Dependency
-> [IndexCacheEntry]
-> IO ([pkg], [Dependency])
accum Map PackageId pkg
srcpkgs (pkg
srcpkgpkg -> [pkg] -> [pkg]
forall a. a -> [a] -> [a]
:[pkg]
btrs) Map PackageName Dependency
prefs [IndexCacheEntry]
entries
accum Map PackageId pkg
srcpkgs [pkg]
btrs Map PackageName Dependency
prefs (CachePreference pref :: Dependency
pref@(Dependency PackageName
pn VersionRange
_ NonEmptySet LibraryName
_) BlockNo
_ Timestamp
_ : [IndexCacheEntry]
entries) =
Map PackageId pkg
-> [pkg]
-> Map PackageName Dependency
-> [IndexCacheEntry]
-> IO ([pkg], [Dependency])
accum Map PackageId pkg
srcpkgs [pkg]
btrs (PackageName
-> Dependency
-> Map PackageName Dependency
-> Map PackageName Dependency
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert PackageName
pn Dependency
pref Map PackageName Dependency
prefs) [IndexCacheEntry]
entries
getEntryContent :: BlockNo -> IO ByteString
getEntryContent :: BlockNo -> IO ByteString
getEntryContent BlockNo
blockno = do
Entry
entry <- Handle -> BlockNo -> IO Entry
Tar.hReadEntry Handle
hnd BlockNo
blockno
case Entry -> EntryContent
Tar.entryContent Entry
entry of
Tar.NormalFile ByteString
content FileSize
_size -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
content
Tar.OtherEntryType TypeCode
typecode ByteString
content FileSize
_size
| TypeCode -> Bool
Tar.isBuildTreeRefTypeCode TypeCode
typecode
-> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
content
EntryContent
_ -> FilePath -> IO ByteString
forall a. FilePath -> IO a
interror FilePath
"unexpected tar entry type"
readPackageDescription :: PackageIdentifier -> ByteString -> IO GenericPackageDescription
readPackageDescription :: PackageId -> ByteString -> IO GenericPackageDescription
readPackageDescription PackageId
pkgid ByteString
content =
case ([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
-> Either
(Maybe Version, NonEmpty PError) GenericPackageDescription
forall a b. (a, b) -> b
snd (([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
-> Either
(Maybe Version, NonEmpty PError) GenericPackageDescription)
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
-> Either
(Maybe Version, NonEmpty PError) GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ ParseResult GenericPackageDescription
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
PackageDesc.Parse.runParseResult (ParseResult GenericPackageDescription
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription))
-> ParseResult GenericPackageDescription
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
forall a b. (a -> b) -> a -> b
$ ByteString -> ParseResult GenericPackageDescription
parseGenericPackageDescription (ByteString -> ParseResult GenericPackageDescription)
-> ByteString -> ParseResult GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.toStrict ByteString
content of
Right GenericPackageDescription
gpd -> GenericPackageDescription -> IO GenericPackageDescription
forall (m :: * -> *) a. Monad m => a -> m a
return GenericPackageDescription
gpd
Left (Just Version
specVer, NonEmpty PError
_) | Version
specVer Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
2,Int
2] -> GenericPackageDescription -> IO GenericPackageDescription
forall (m :: * -> *) a. Monad m => a -> m a
return (Version -> GenericPackageDescription
dummyPackageDescription Version
specVer)
Left (Maybe Version, NonEmpty PError)
_ -> FilePath -> IO GenericPackageDescription
forall a. FilePath -> IO a
interror FilePath
"failed to parse .cabal file"
where
dummyPackageDescription :: Version -> GenericPackageDescription
dummyPackageDescription :: Version -> GenericPackageDescription
dummyPackageDescription Version
specVer = GenericPackageDescription :: PackageDescription
-> Maybe Version
-> [PackageFlag]
-> Maybe (CondTree ConfVar [Dependency] Library)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] ForeignLib)]
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> GenericPackageDescription
GenericPackageDescription
{ packageDescription :: PackageDescription
packageDescription = PackageDescription
emptyPackageDescription
{ package :: PackageId
package = PackageId
pkgid
, synopsis :: ShortText
synopsis = ShortText
dummySynopsis
}
, gpdScannedVersion :: Maybe Version
gpdScannedVersion = Version -> Maybe Version
forall a. a -> Maybe a
Just Version
specVer
, genPackageFlags :: [PackageFlag]
genPackageFlags = []
, condLibrary :: Maybe (CondTree ConfVar [Dependency] Library)
condLibrary = Maybe (CondTree ConfVar [Dependency] Library)
forall a. Maybe a
Nothing
, condSubLibraries :: [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries = []
, condForeignLibs :: [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
condForeignLibs = []
, condExecutables :: [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
condExecutables = []
, condTestSuites :: [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites = []
, condBenchmarks :: [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks = []
}
dummySynopsis :: ShortText
dummySynopsis = ShortText
"<could not be parsed due to unsupported CABAL spec-version>"
interror :: String -> IO a
interror :: FilePath -> IO a
interror FilePath
msg = Verbosity -> FilePath -> IO a
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO a) -> FilePath -> IO a
forall a b. (a -> b) -> a -> b
$ FilePath
"internal error when reading package index: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
msg
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"The package index or index cache is probably "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"corrupt. Running cabal update might fix it."
readIndexCache :: Verbosity -> Index -> IO Cache
readIndexCache :: Verbosity -> Index -> IO Cache
readIndexCache Verbosity
verbosity Index
index = do
Either FilePath Cache
cacheOrFail <- Index -> IO (Either FilePath Cache)
readIndexCache' Index
index
case Either FilePath Cache
cacheOrFail of
Left FilePath
msg -> do
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ FilePath
"Parsing the index cache failed (", FilePath
msg, FilePath
"). "
, FilePath
"Trying to regenerate the index cache..."
]
Verbosity -> Index -> IO ()
updatePackageIndexCacheFile Verbosity
verbosity Index
index
(FilePath -> IO Cache)
-> (Cache -> IO Cache) -> Either FilePath Cache -> IO Cache
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Verbosity -> FilePath -> IO Cache
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity) (Cache -> IO Cache
forall (m :: * -> *) a. Monad m => a -> m a
return (Cache -> IO Cache) -> (Cache -> Cache) -> Cache -> IO Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cache -> Cache
hashConsCache) (Either FilePath Cache -> IO Cache)
-> IO (Either FilePath Cache) -> IO Cache
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Index -> IO (Either FilePath Cache)
readIndexCache' Index
index
Right Cache
res -> Cache -> IO Cache
forall (m :: * -> *) a. Monad m => a -> m a
return (Cache -> Cache
hashConsCache Cache
res)
readNoIndexCache :: Verbosity -> Index -> IO NoIndexCache
readNoIndexCache :: Verbosity -> Index -> IO NoIndexCache
readNoIndexCache Verbosity
verbosity Index
index = do
Either FilePath NoIndexCache
cacheOrFail <- Index -> IO (Either FilePath NoIndexCache)
readNoIndexCache' Index
index
case Either FilePath NoIndexCache
cacheOrFail of
Left FilePath
msg -> do
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ FilePath
"Parsing the index cache failed (", FilePath
msg, FilePath
"). "
, FilePath
"Trying to regenerate the index cache..."
]
Verbosity -> Index -> IO ()
updatePackageIndexCacheFile Verbosity
verbosity Index
index
(FilePath -> IO NoIndexCache)
-> (NoIndexCache -> IO NoIndexCache)
-> Either FilePath NoIndexCache
-> IO NoIndexCache
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Verbosity -> FilePath -> IO NoIndexCache
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity) NoIndexCache -> IO NoIndexCache
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath NoIndexCache -> IO NoIndexCache)
-> IO (Either FilePath NoIndexCache) -> IO NoIndexCache
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Index -> IO (Either FilePath NoIndexCache)
readNoIndexCache' Index
index
Right NoIndexCache
res -> NoIndexCache -> IO NoIndexCache
forall (m :: * -> *) a. Monad m => a -> m a
return NoIndexCache
res
readIndexCache' :: Index -> IO (Either String Cache)
readIndexCache' :: Index -> IO (Either FilePath Cache)
readIndexCache' Index
index
| Index -> Bool
is01Index Index
index = FilePath -> IO (Either FilePath Cache)
forall a.
(Binary a, Structured a) =>
FilePath -> IO (Either FilePath a)
structuredDecodeFileOrFail (Index -> FilePath
cacheFile Index
index)
| Bool
otherwise = (ByteString -> Either FilePath Cache)
-> IO ByteString -> IO (Either FilePath Cache)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Cache -> Either FilePath Cache
forall a b. b -> Either a b
Right (Cache -> Either FilePath Cache)
-> (ByteString -> Cache) -> ByteString -> Either FilePath Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ByteString -> Cache
read00IndexCache) (IO ByteString -> IO (Either FilePath Cache))
-> IO ByteString -> IO (Either FilePath Cache)
forall a b. (a -> b) -> a -> b
$
FilePath -> IO ByteString
BSS.readFile (Index -> FilePath
cacheFile Index
index)
readNoIndexCache' :: Index -> IO (Either String NoIndexCache)
readNoIndexCache' :: Index -> IO (Either FilePath NoIndexCache)
readNoIndexCache' Index
index = FilePath -> IO (Either FilePath NoIndexCache)
forall a.
(Binary a, Structured a) =>
FilePath -> IO (Either FilePath a)
structuredDecodeFileOrFail (Index -> FilePath
cacheFile Index
index)
writeIndexCache :: Index -> Cache -> IO ()
writeIndexCache :: Index -> Cache -> IO ()
writeIndexCache Index
index Cache
cache
| Index -> Bool
is01Index Index
index = FilePath -> Cache -> IO ()
forall a. (Binary a, Structured a) => FilePath -> a -> IO ()
structuredEncodeFile (Index -> FilePath
cacheFile Index
index) Cache
cache
| Bool
otherwise = FilePath -> FilePath -> IO ()
writeFile (Index -> FilePath
cacheFile Index
index) (Cache -> FilePath
show00IndexCache Cache
cache)
writeNoIndexCache :: Verbosity -> Index -> NoIndexCache -> IO ()
writeNoIndexCache :: Verbosity -> Index -> NoIndexCache -> IO ()
writeNoIndexCache Verbosity
verbosity Index
index NoIndexCache
cache = do
let path :: FilePath
path = Index -> FilePath
cacheFile Index
index
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True (FilePath -> FilePath
takeDirectory FilePath
path)
FilePath -> NoIndexCache -> IO ()
forall a. (Binary a, Structured a) => FilePath -> a -> IO ()
structuredEncodeFile FilePath
path NoIndexCache
cache
writeIndexTimestamp :: Index -> RepoIndexState -> IO ()
writeIndexTimestamp :: Index -> RepoIndexState -> IO ()
writeIndexTimestamp Index
index RepoIndexState
st
= FilePath -> FilePath -> IO ()
writeFile (Index -> FilePath
timestampFile Index
index) (RepoIndexState -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow RepoIndexState
st)
currentIndexTimestamp :: Verbosity -> RepoContext -> Repo -> IO Timestamp
currentIndexTimestamp :: Verbosity -> RepoContext -> Repo -> IO Timestamp
currentIndexTimestamp Verbosity
verbosity RepoContext
repoCtxt Repo
r = do
Maybe RepoIndexState
mb_is <- Verbosity -> Index -> IO (Maybe RepoIndexState)
readIndexTimestamp Verbosity
verbosity (RepoContext -> Repo -> Index
RepoIndex RepoContext
repoCtxt Repo
r)
case Maybe RepoIndexState
mb_is of
Just (IndexStateTime Timestamp
ts) -> Timestamp -> IO Timestamp
forall (m :: * -> *) a. Monad m => a -> m a
return Timestamp
ts
Maybe RepoIndexState
_ -> do
(PackageIndex UnresolvedSourcePackage
_,[Dependency]
_,IndexStateInfo
isi) <- Verbosity
-> RepoContext
-> Repo
-> RepoIndexState
-> IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo)
readRepoIndex Verbosity
verbosity RepoContext
repoCtxt Repo
r RepoIndexState
IndexStateHead
Timestamp -> IO Timestamp
forall (m :: * -> *) a. Monad m => a -> m a
return (IndexStateInfo -> Timestamp
isiHeadTime IndexStateInfo
isi)
readIndexTimestamp :: Verbosity -> Index -> IO (Maybe RepoIndexState)
readIndexTimestamp :: Verbosity -> Index -> IO (Maybe RepoIndexState)
readIndexTimestamp Verbosity
verbosity Index
index
= (FilePath -> Maybe RepoIndexState)
-> IO FilePath -> IO (Maybe RepoIndexState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Maybe RepoIndexState
forall a. Parsec a => FilePath -> Maybe a
simpleParsec (FilePath -> IO FilePath
readFile (Index -> FilePath
timestampFile Index
index))
IO (Maybe RepoIndexState)
-> (IOException -> IO (Maybe RepoIndexState))
-> IO (Maybe RepoIndexState)
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
e ->
if IOException -> Bool
isDoesNotExistError IOException
e
then Maybe RepoIndexState -> IO (Maybe RepoIndexState)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RepoIndexState
forall a. Maybe a
Nothing
else do
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Warning: could not read current index timestamp: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ IOException -> FilePath
forall e. Exception e => e -> FilePath
displayException IOException
e
Maybe RepoIndexState -> IO (Maybe RepoIndexState)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RepoIndexState
forall a. Maybe a
Nothing
hashConsCache :: Cache -> Cache
hashConsCache :: Cache -> Cache
hashConsCache Cache
cache0
= Cache
cache0 { cacheEntries :: [IndexCacheEntry]
cacheEntries = Map PackageName PackageName
-> Map Version Version -> [IndexCacheEntry] -> [IndexCacheEntry]
go Map PackageName PackageName
forall a. Monoid a => a
mempty Map Version Version
forall a. Monoid a => a
mempty (Cache -> [IndexCacheEntry]
cacheEntries Cache
cache0) }
where
go :: Map PackageName PackageName
-> Map Version Version -> [IndexCacheEntry] -> [IndexCacheEntry]
go Map PackageName PackageName
_ Map Version Version
_ [] = []
go !Map PackageName PackageName
pns !Map Version Version
pvs (CachePackageId PackageId
pid BlockNo
bno Timestamp
ts : [IndexCacheEntry]
rest)
= PackageId -> BlockNo -> Timestamp -> IndexCacheEntry
CachePackageId PackageId
pid' BlockNo
bno Timestamp
ts IndexCacheEntry -> [IndexCacheEntry] -> [IndexCacheEntry]
forall a. a -> [a] -> [a]
: Map PackageName PackageName
-> Map Version Version -> [IndexCacheEntry] -> [IndexCacheEntry]
go Map PackageName PackageName
pns' Map Version Version
pvs' [IndexCacheEntry]
rest
where
!pid' :: PackageId
pid' = PackageName -> Version -> PackageId
PackageIdentifier PackageName
pn' Version
pv'
(!PackageName
pn',!Map PackageName PackageName
pns') = PackageName
-> Map PackageName PackageName
-> (PackageName, Map PackageName PackageName)
forall k. Ord k => k -> Map k k -> (k, Map k k)
mapIntern PackageName
pn Map PackageName PackageName
pns
(!Version
pv',!Map Version Version
pvs') = Version -> Map Version Version -> (Version, Map Version Version)
forall k. Ord k => k -> Map k k -> (k, Map k k)
mapIntern Version
pv Map Version Version
pvs
PackageIdentifier PackageName
pn Version
pv = PackageId
pid
go Map PackageName PackageName
pns Map Version Version
pvs (IndexCacheEntry
x:[IndexCacheEntry]
xs) = IndexCacheEntry
x IndexCacheEntry -> [IndexCacheEntry] -> [IndexCacheEntry]
forall a. a -> [a] -> [a]
: Map PackageName PackageName
-> Map Version Version -> [IndexCacheEntry] -> [IndexCacheEntry]
go Map PackageName PackageName
pns Map Version Version
pvs [IndexCacheEntry]
xs
mapIntern :: Ord k => k -> Map.Map k k -> (k,Map.Map k k)
mapIntern :: k -> Map k k -> (k, Map k k)
mapIntern k
k Map k k
m = (k, Map k k) -> (k -> (k, Map k k)) -> Maybe k -> (k, Map k k)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (k
k,k -> k -> Map k k -> Map k k
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k k
k Map k k
m) (\k
k' -> (k
k',Map k k
m)) (k -> Map k k -> Maybe k
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k k
m)
data Cache = Cache
{ Cache -> Timestamp
cacheHeadTs :: Timestamp
, Cache -> [IndexCacheEntry]
cacheEntries :: [IndexCacheEntry]
}
deriving (Int -> Cache -> FilePath -> FilePath
[Cache] -> FilePath -> FilePath
Cache -> FilePath
(Int -> Cache -> FilePath -> FilePath)
-> (Cache -> FilePath)
-> ([Cache] -> FilePath -> FilePath)
-> Show Cache
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Cache] -> FilePath -> FilePath
$cshowList :: [Cache] -> FilePath -> FilePath
show :: Cache -> FilePath
$cshow :: Cache -> FilePath
showsPrec :: Int -> Cache -> FilePath -> FilePath
$cshowsPrec :: Int -> Cache -> FilePath -> FilePath
Show, (forall x. Cache -> Rep Cache x)
-> (forall x. Rep Cache x -> Cache) -> Generic Cache
forall x. Rep Cache x -> Cache
forall x. Cache -> Rep Cache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cache x -> Cache
$cfrom :: forall x. Cache -> Rep Cache x
Generic)
instance NFData Cache where
rnf :: Cache -> ()
rnf = [IndexCacheEntry] -> ()
forall a. NFData a => a -> ()
rnf ([IndexCacheEntry] -> ())
-> (Cache -> [IndexCacheEntry]) -> Cache -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cache -> [IndexCacheEntry]
cacheEntries
newtype NoIndexCache = NoIndexCache
{ NoIndexCache -> [NoIndexCacheEntry]
noIndexCacheEntries :: [NoIndexCacheEntry]
}
deriving (Int -> NoIndexCache -> FilePath -> FilePath
[NoIndexCache] -> FilePath -> FilePath
NoIndexCache -> FilePath
(Int -> NoIndexCache -> FilePath -> FilePath)
-> (NoIndexCache -> FilePath)
-> ([NoIndexCache] -> FilePath -> FilePath)
-> Show NoIndexCache
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [NoIndexCache] -> FilePath -> FilePath
$cshowList :: [NoIndexCache] -> FilePath -> FilePath
show :: NoIndexCache -> FilePath
$cshow :: NoIndexCache -> FilePath
showsPrec :: Int -> NoIndexCache -> FilePath -> FilePath
$cshowsPrec :: Int -> NoIndexCache -> FilePath -> FilePath
Show, (forall x. NoIndexCache -> Rep NoIndexCache x)
-> (forall x. Rep NoIndexCache x -> NoIndexCache)
-> Generic NoIndexCache
forall x. Rep NoIndexCache x -> NoIndexCache
forall x. NoIndexCache -> Rep NoIndexCache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NoIndexCache x -> NoIndexCache
$cfrom :: forall x. NoIndexCache -> Rep NoIndexCache x
Generic)
instance NFData NoIndexCache where
rnf :: NoIndexCache -> ()
rnf = [NoIndexCacheEntry] -> ()
forall a. NFData a => a -> ()
rnf ([NoIndexCacheEntry] -> ())
-> (NoIndexCache -> [NoIndexCacheEntry]) -> NoIndexCache -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoIndexCache -> [NoIndexCacheEntry]
noIndexCacheEntries
type BlockNo = Word32
data IndexCacheEntry
= CachePackageId PackageId !BlockNo !Timestamp
| CachePreference Dependency !BlockNo !Timestamp
| CacheBuildTreeRef !BuildTreeRefType !BlockNo
deriving (IndexCacheEntry -> IndexCacheEntry -> Bool
(IndexCacheEntry -> IndexCacheEntry -> Bool)
-> (IndexCacheEntry -> IndexCacheEntry -> Bool)
-> Eq IndexCacheEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexCacheEntry -> IndexCacheEntry -> Bool
$c/= :: IndexCacheEntry -> IndexCacheEntry -> Bool
== :: IndexCacheEntry -> IndexCacheEntry -> Bool
$c== :: IndexCacheEntry -> IndexCacheEntry -> Bool
Eq,Int -> IndexCacheEntry -> FilePath -> FilePath
[IndexCacheEntry] -> FilePath -> FilePath
IndexCacheEntry -> FilePath
(Int -> IndexCacheEntry -> FilePath -> FilePath)
-> (IndexCacheEntry -> FilePath)
-> ([IndexCacheEntry] -> FilePath -> FilePath)
-> Show IndexCacheEntry
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [IndexCacheEntry] -> FilePath -> FilePath
$cshowList :: [IndexCacheEntry] -> FilePath -> FilePath
show :: IndexCacheEntry -> FilePath
$cshow :: IndexCacheEntry -> FilePath
showsPrec :: Int -> IndexCacheEntry -> FilePath -> FilePath
$cshowsPrec :: Int -> IndexCacheEntry -> FilePath -> FilePath
Show,(forall x. IndexCacheEntry -> Rep IndexCacheEntry x)
-> (forall x. Rep IndexCacheEntry x -> IndexCacheEntry)
-> Generic IndexCacheEntry
forall x. Rep IndexCacheEntry x -> IndexCacheEntry
forall x. IndexCacheEntry -> Rep IndexCacheEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IndexCacheEntry x -> IndexCacheEntry
$cfrom :: forall x. IndexCacheEntry -> Rep IndexCacheEntry x
Generic)
data NoIndexCacheEntry
= CacheGPD GenericPackageDescription !BSS.ByteString
| NoIndexCachePreference [Dependency]
deriving (NoIndexCacheEntry -> NoIndexCacheEntry -> Bool
(NoIndexCacheEntry -> NoIndexCacheEntry -> Bool)
-> (NoIndexCacheEntry -> NoIndexCacheEntry -> Bool)
-> Eq NoIndexCacheEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoIndexCacheEntry -> NoIndexCacheEntry -> Bool
$c/= :: NoIndexCacheEntry -> NoIndexCacheEntry -> Bool
== :: NoIndexCacheEntry -> NoIndexCacheEntry -> Bool
$c== :: NoIndexCacheEntry -> NoIndexCacheEntry -> Bool
Eq,Int -> NoIndexCacheEntry -> FilePath -> FilePath
[NoIndexCacheEntry] -> FilePath -> FilePath
NoIndexCacheEntry -> FilePath
(Int -> NoIndexCacheEntry -> FilePath -> FilePath)
-> (NoIndexCacheEntry -> FilePath)
-> ([NoIndexCacheEntry] -> FilePath -> FilePath)
-> Show NoIndexCacheEntry
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [NoIndexCacheEntry] -> FilePath -> FilePath
$cshowList :: [NoIndexCacheEntry] -> FilePath -> FilePath
show :: NoIndexCacheEntry -> FilePath
$cshow :: NoIndexCacheEntry -> FilePath
showsPrec :: Int -> NoIndexCacheEntry -> FilePath -> FilePath
$cshowsPrec :: Int -> NoIndexCacheEntry -> FilePath -> FilePath
Show,(forall x. NoIndexCacheEntry -> Rep NoIndexCacheEntry x)
-> (forall x. Rep NoIndexCacheEntry x -> NoIndexCacheEntry)
-> Generic NoIndexCacheEntry
forall x. Rep NoIndexCacheEntry x -> NoIndexCacheEntry
forall x. NoIndexCacheEntry -> Rep NoIndexCacheEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NoIndexCacheEntry x -> NoIndexCacheEntry
$cfrom :: forall x. NoIndexCacheEntry -> Rep NoIndexCacheEntry x
Generic)
instance NFData IndexCacheEntry where
rnf :: IndexCacheEntry -> ()
rnf (CachePackageId PackageId
pkgid BlockNo
_ Timestamp
_) = PackageId -> ()
forall a. NFData a => a -> ()
rnf PackageId
pkgid
rnf (CachePreference Dependency
dep BlockNo
_ Timestamp
_) = Dependency -> ()
forall a. NFData a => a -> ()
rnf Dependency
dep
rnf (CacheBuildTreeRef BuildTreeRefType
_ BlockNo
_) = ()
instance NFData NoIndexCacheEntry where
rnf :: NoIndexCacheEntry -> ()
rnf (CacheGPD GenericPackageDescription
gpd ByteString
bs) = GenericPackageDescription -> ()
forall a. NFData a => a -> ()
rnf GenericPackageDescription
gpd () -> () -> ()
`seq` ByteString -> ()
forall a. NFData a => a -> ()
rnf ByteString
bs
rnf (NoIndexCachePreference [Dependency]
dep) = [Dependency] -> ()
forall a. NFData a => a -> ()
rnf [Dependency]
dep
cacheEntryTimestamp :: IndexCacheEntry -> Timestamp
cacheEntryTimestamp :: IndexCacheEntry -> Timestamp
cacheEntryTimestamp (CacheBuildTreeRef BuildTreeRefType
_ BlockNo
_) = Timestamp
nullTimestamp
cacheEntryTimestamp (CachePreference Dependency
_ BlockNo
_ Timestamp
ts) = Timestamp
ts
cacheEntryTimestamp (CachePackageId PackageId
_ BlockNo
_ Timestamp
ts) = Timestamp
ts
instance Binary Cache
instance Binary IndexCacheEntry
instance Binary NoIndexCache
instance Structured Cache
instance Structured IndexCacheEntry
instance Structured NoIndexCache
instance Binary NoIndexCacheEntry where
put :: NoIndexCacheEntry -> Put
put (CacheGPD GenericPackageDescription
_ ByteString
bs) = do
Word8 -> Put
forall t. Binary t => t -> Put
put (Word8
0 :: Word8)
ByteString -> Put
forall t. Binary t => t -> Put
put ByteString
bs
put (NoIndexCachePreference [Dependency]
dep) = do
Word8 -> Put
forall t. Binary t => t -> Put
put (Word8
1 :: Word8)
[Dependency] -> Put
forall t. Binary t => t -> Put
put [Dependency]
dep
get :: Get NoIndexCacheEntry
get = do
Word8
t :: Word8 <- Get Word8
forall t. Binary t => Get t
get
case Word8
t of
Word8
0 -> do
ByteString
bs <- Get ByteString
forall t. Binary t => Get t
get
case ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe ByteString
bs of
Just GenericPackageDescription
gpd -> NoIndexCacheEntry -> Get NoIndexCacheEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericPackageDescription -> ByteString -> NoIndexCacheEntry
CacheGPD GenericPackageDescription
gpd ByteString
bs)
Maybe GenericPackageDescription
Nothing -> FilePath -> Get NoIndexCacheEntry
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Failed to parse GPD"
Word8
1 -> do
[Dependency]
dep <- Get [Dependency]
forall t. Binary t => Get t
get
NoIndexCacheEntry -> Get NoIndexCacheEntry
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NoIndexCacheEntry -> Get NoIndexCacheEntry)
-> NoIndexCacheEntry -> Get NoIndexCacheEntry
forall a b. (a -> b) -> a -> b
$ [Dependency] -> NoIndexCacheEntry
NoIndexCachePreference [Dependency]
dep
Word8
_ -> FilePath -> Get NoIndexCacheEntry
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Failed to parse NoIndexCacheEntry"
instance Structured NoIndexCacheEntry where
structure :: Proxy NoIndexCacheEntry -> Structure
structure = Proxy NoIndexCacheEntry -> Structure
forall k (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
packageKey, blocknoKey, buildTreeRefKey, preferredVersionKey :: String
packageKey :: FilePath
packageKey = FilePath
"pkg:"
blocknoKey :: FilePath
blocknoKey = FilePath
"b#"
buildTreeRefKey :: FilePath
buildTreeRefKey = FilePath
"build-tree-ref:"
preferredVersionKey :: FilePath
preferredVersionKey = FilePath
"pref-ver:"
read00IndexCache :: BSS.ByteString -> Cache
read00IndexCache :: ByteString -> Cache
read00IndexCache ByteString
bs = Cache :: Timestamp -> [IndexCacheEntry] -> Cache
Cache
{ cacheHeadTs :: Timestamp
cacheHeadTs = Timestamp
nullTimestamp
, cacheEntries :: [IndexCacheEntry]
cacheEntries = (ByteString -> Maybe IndexCacheEntry)
-> [ByteString] -> [IndexCacheEntry]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ByteString -> Maybe IndexCacheEntry
read00IndexCacheEntry ([ByteString] -> [IndexCacheEntry])
-> [ByteString] -> [IndexCacheEntry]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BSS.lines ByteString
bs
}
read00IndexCacheEntry :: BSS.ByteString -> Maybe IndexCacheEntry
read00IndexCacheEntry :: ByteString -> Maybe IndexCacheEntry
read00IndexCacheEntry = \ByteString
line ->
case ByteString -> [ByteString]
BSS.words ByteString
line of
[ByteString
key, ByteString
pkgnamestr, ByteString
pkgverstr, ByteString
sep, ByteString
blocknostr]
| ByteString
key ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> ByteString
BSS.pack FilePath
packageKey Bool -> Bool -> Bool
&& ByteString
sep ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> ByteString
BSS.pack FilePath
blocknoKey ->
case (ByteString -> Maybe PackageName
parseName ByteString
pkgnamestr, ByteString -> [Int] -> Maybe Version
parseVer ByteString
pkgverstr [],
ByteString -> Maybe BlockNo
forall a. Num a => ByteString -> Maybe a
parseBlockNo ByteString
blocknostr) of
(Just PackageName
pkgname, Just Version
pkgver, Just BlockNo
blockno)
-> IndexCacheEntry -> Maybe IndexCacheEntry
forall a. a -> Maybe a
Just (PackageId -> BlockNo -> Timestamp -> IndexCacheEntry
CachePackageId (PackageName -> Version -> PackageId
PackageIdentifier PackageName
pkgname Version
pkgver)
BlockNo
blockno Timestamp
nullTimestamp)
(Maybe PackageName, Maybe Version, Maybe BlockNo)
_ -> Maybe IndexCacheEntry
forall a. Maybe a
Nothing
[ByteString
key, ByteString
typecodestr, ByteString
blocknostr] | ByteString
key ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> ByteString
BSS.pack FilePath
buildTreeRefKey ->
case (ByteString -> Maybe BuildTreeRefType
parseRefType ByteString
typecodestr, ByteString -> Maybe BlockNo
forall a. Num a => ByteString -> Maybe a
parseBlockNo ByteString
blocknostr) of
(Just BuildTreeRefType
refType, Just BlockNo
blockno)
-> IndexCacheEntry -> Maybe IndexCacheEntry
forall a. a -> Maybe a
Just (BuildTreeRefType -> BlockNo -> IndexCacheEntry
CacheBuildTreeRef BuildTreeRefType
refType BlockNo
blockno)
(Maybe BuildTreeRefType, Maybe BlockNo)
_ -> Maybe IndexCacheEntry
forall a. Maybe a
Nothing
(ByteString
key: [ByteString]
remainder) | ByteString
key ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> ByteString
BSS.pack FilePath
preferredVersionKey -> do
Dependency
pref <- ByteString -> Maybe Dependency
forall a. Parsec a => ByteString -> Maybe a
simpleParsecBS ([ByteString] -> ByteString
BSS.unwords [ByteString]
remainder)
IndexCacheEntry -> Maybe IndexCacheEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (IndexCacheEntry -> Maybe IndexCacheEntry)
-> IndexCacheEntry -> Maybe IndexCacheEntry
forall a b. (a -> b) -> a -> b
$ Dependency -> BlockNo -> Timestamp -> IndexCacheEntry
CachePreference Dependency
pref BlockNo
0 Timestamp
nullTimestamp
[ByteString]
_ -> Maybe IndexCacheEntry
forall a. Maybe a
Nothing
where
parseName :: ByteString -> Maybe PackageName
parseName ByteString
str
| (TypeCode -> Bool) -> ByteString -> Bool
BSS.all (\TypeCode
c -> TypeCode -> Bool
isAlphaNum TypeCode
c Bool -> Bool -> Bool
|| TypeCode
c TypeCode -> TypeCode -> Bool
forall a. Eq a => a -> a -> Bool
== TypeCode
'-') ByteString
str
= PackageName -> Maybe PackageName
forall a. a -> Maybe a
Just (FilePath -> PackageName
mkPackageName (ByteString -> FilePath
BSS.unpack ByteString
str))
| Bool
otherwise = Maybe PackageName
forall a. Maybe a
Nothing
parseVer :: ByteString -> [Int] -> Maybe Version
parseVer ByteString
str [Int]
vs =
case ByteString -> Maybe (Int, ByteString)
BSS.readInt ByteString
str of
Maybe (Int, ByteString)
Nothing -> Maybe Version
forall a. Maybe a
Nothing
Just (Int
v, ByteString
str') -> case ByteString -> Maybe (TypeCode, ByteString)
BSS.uncons ByteString
str' of
Just (TypeCode
'.', ByteString
str'') -> ByteString -> [Int] -> Maybe Version
parseVer ByteString
str'' (Int
vInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
vs)
Just (TypeCode, ByteString)
_ -> Maybe Version
forall a. Maybe a
Nothing
Maybe (TypeCode, ByteString)
Nothing -> Version -> Maybe Version
forall a. a -> Maybe a
Just ([Int] -> Version
mkVersion ([Int] -> [Int]
forall a. [a] -> [a]
reverse (Int
vInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
vs)))
parseBlockNo :: ByteString -> Maybe a
parseBlockNo ByteString
str =
case ByteString -> Maybe (Int, ByteString)
BSS.readInt ByteString
str of
Just (Int
blockno, ByteString
remainder)
| ByteString -> Bool
BSS.null ByteString
remainder -> a -> Maybe a
forall a. a -> Maybe a
Just (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
blockno)
Maybe (Int, ByteString)
_ -> Maybe a
forall a. Maybe a
Nothing
parseRefType :: ByteString -> Maybe BuildTreeRefType
parseRefType ByteString
str =
case ByteString -> Maybe (TypeCode, ByteString)
BSS.uncons ByteString
str of
Just (TypeCode
typeCode, ByteString
remainder)
| ByteString -> Bool
BSS.null ByteString
remainder Bool -> Bool -> Bool
&& TypeCode -> Bool
Tar.isBuildTreeRefTypeCode TypeCode
typeCode
-> BuildTreeRefType -> Maybe BuildTreeRefType
forall a. a -> Maybe a
Just (TypeCode -> BuildTreeRefType
refTypeFromTypeCode TypeCode
typeCode)
Maybe (TypeCode, ByteString)
_ -> Maybe BuildTreeRefType
forall a. Maybe a
Nothing
show00IndexCache :: Cache -> String
show00IndexCache :: Cache -> FilePath
show00IndexCache Cache{[IndexCacheEntry]
Timestamp
cacheEntries :: [IndexCacheEntry]
cacheHeadTs :: Timestamp
cacheEntries :: Cache -> [IndexCacheEntry]
cacheHeadTs :: Cache -> Timestamp
..} = [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (IndexCacheEntry -> FilePath) -> [IndexCacheEntry] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map IndexCacheEntry -> FilePath
show00IndexCacheEntry [IndexCacheEntry]
cacheEntries
show00IndexCacheEntry :: IndexCacheEntry -> String
show00IndexCacheEntry :: IndexCacheEntry -> FilePath
show00IndexCacheEntry IndexCacheEntry
entry = [FilePath] -> FilePath
unwords ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ case IndexCacheEntry
entry of
CachePackageId PackageId
pkgid BlockNo
b Timestamp
_ ->
[ FilePath
packageKey
, PackageName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageId -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pkgid)
, Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageId -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageId
pkgid)
, FilePath
blocknoKey
, BlockNo -> FilePath
forall a. Show a => a -> FilePath
show BlockNo
b
]
CacheBuildTreeRef BuildTreeRefType
tr BlockNo
b ->
[ FilePath
buildTreeRefKey
, [BuildTreeRefType -> TypeCode
typeCodeFromRefType BuildTreeRefType
tr]
, BlockNo -> FilePath
forall a. Show a => a -> FilePath
show BlockNo
b
]
CachePreference Dependency
dep BlockNo
_ Timestamp
_ ->
[ FilePath
preferredVersionKey
, Dependency -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Dependency
dep
]