{-# 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 -> [Char]
indexBaseName Repo
repo = Repo -> [Char]
repoLocalDir Repo
repo [Char] -> [Char] -> [Char]
</> [Char]
fn
where
fn :: [Char]
fn = case Repo
repo of
RepoSecure {} -> [Char]
"01-index"
RepoRemote {} -> [Char]
"00-index"
RepoLocalNoIndex {} -> [Char]
"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
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
isiMaxTime :: Timestamp
isiHeadTime :: Timestamp
isiHeadTime :: Timestamp
isiMaxTime :: Timestamp
..})
where
cache :: Cache
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 (forall a b. (a -> b) -> [a] -> [b]
map IndexCacheEntry -> Timestamp
cacheEntryTimestamp [IndexCacheEntry]
ents)
ents :: [IndexCacheEntry]
ents = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
<= Timestamp
ts0) 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 =
forall a b c. (a, b, c) -> a
fstOf3 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 forall a. Maybe a
Nothing 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
_
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null (RepoContext -> [Repo]
repoContextRepos RepoContext
repoCtxt) = do
Verbosity -> [Char] -> IO ()
warn (Verbosity -> Verbosity
verboseUnmarkOutput Verbosity
verbosity) forall a b. (a -> b) -> a -> b
$
[Char]
"No remote package servers have been specified. Usually " forall a. [a] -> [a] -> [a]
++
[Char]
"you would have one specified in the config file."
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePackageDb {
packageIndex :: PackageIndex UnresolvedSourcePackage
packageIndex = forall a. Monoid a => a
mempty,
packagePreferences :: Map PackageName VersionRange
packagePreferences = 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 -> [Char]
describeState RepoIndexState
IndexStateHead = [Char]
"most recent state"
describeState (IndexStateTime Timestamp
time) = [Char]
"historical state as of " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow Timestamp
time
[RepoData]
pkgss <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (RepoContext -> [Repo]
repoContextRepos RepoContext
repoCtxt) forall a b. (a -> b) -> a -> b
$ \Repo
r -> do
let rname :: RepoName
rname :: RepoName
rname = Repo -> RepoName
repoName Repo
r
Verbosity -> [Char] -> IO ()
info Verbosity
verbosity ([Char]
"Reading available packages of " forall a. [a] -> [a] -> [a]
++ RepoName -> [Char]
unRepoName RepoName
rname forall a. [a] -> [a] -> [a]
++ [Char]
"...")
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 -> [Char] -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"Using " forall a. [a] -> [a] -> [a]
++ RepoIndexState -> [Char]
describeState RepoIndexState
idxState forall a. [a] -> [a] -> [a]
++
[Char]
" as explicitly requested (via command line / project configuration)"
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 -> [Char] -> IO ()
info Verbosity
verbosity [Char]
"Using most recent state (could not read timestamp file)"
forall (m :: * -> *) a. Monad m => a -> m a
return RepoIndexState
IndexStateHead
Just RepoIndexState
idxState -> do
Verbosity -> [Char] -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"Using " forall a. [a] -> [a] -> [a]
++ RepoIndexState -> [Char]
describeState RepoIndexState
idxState forall a. [a] -> [a] -> [a]
++
[Char]
" specified from most recent cabal update"
forall (m :: * -> *) a. Monad m => a -> m a
return RepoIndexState
idxState
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RepoIndexState
idxState forall a. Eq a => a -> a -> Bool
== RepoIndexState
IndexStateHead) forall a b. (a -> b) -> a -> b
$
case Repo
r of
RepoLocalNoIndex {} -> Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity [Char]
"index-state ignored for file+noindex repositories"
RepoRemote {} -> Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity ([Char]
"index-state ignored for old-format (remote repository '" forall a. [a] -> [a] -> [a]
++ RepoName -> [Char]
unRepoName RepoName
rname forall a. [a] -> [a] -> [a]
++ [Char]
"')")
RepoSecure {} -> 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 -> [Char] -> IO ()
info Verbosity
verbosity ([Char]
"index-state("forall a. [a] -> [a] -> [a]
++ RepoName -> [Char]
unRepoName RepoName
rname forall a. [a] -> [a] -> [a]
++[Char]
") = " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow (IndexStateInfo -> Timestamp
isiHeadTime IndexStateInfo
isi))
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IndexStateTime Timestamp
ts0 -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IndexStateInfo -> Timestamp
isiMaxTime IndexStateInfo
isi forall a. Eq a => a -> a -> Bool
/= Timestamp
ts0) forall a b. (a -> b) -> a -> b
$
if Timestamp
ts0 forall a. Ord a => a -> a -> Bool
> IndexStateInfo -> Timestamp
isiMaxTime IndexStateInfo
isi
then Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
[Char]
"Requested index-state " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow Timestamp
ts0
forall a. [a] -> [a] -> [a]
++ [Char]
" is newer than '" forall a. [a] -> [a] -> [a]
++ RepoName -> [Char]
unRepoName RepoName
rname forall a. [a] -> [a] -> [a]
++ [Char]
"'!"
forall a. [a] -> [a] -> [a]
++ [Char]
" Falling back to older state ("
forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow (IndexStateInfo -> Timestamp
isiMaxTime IndexStateInfo
isi) forall a. [a] -> [a] -> [a]
++ [Char]
")."
else Verbosity -> [Char] -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
[Char]
"Requested index-state " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow Timestamp
ts0
forall a. [a] -> [a] -> [a]
++ [Char]
" does not exist in '"forall a. [a] -> [a] -> [a]
++ RepoName -> [Char]
unRepoName RepoName
rname forall a. [a] -> [a] -> [a]
++[Char]
"'!"
forall a. [a] -> [a] -> [a]
++ [Char]
" Falling back to older state ("
forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow (IndexStateInfo -> Timestamp
isiMaxTime IndexStateInfo
isi) forall a. [a] -> [a] -> [a]
++ [Char]
")."
Verbosity -> [Char] -> IO ()
info Verbosity
verbosity ([Char]
"index-state("forall a. [a] -> [a] -> [a]
++ RepoName -> [Char]
unRepoName RepoName
rname forall a. [a] -> [a] -> [a]
++[Char]
") = " forall a. [a] -> [a] -> [a]
++
forall a. Pretty a => a -> [Char]
prettyShow (IndexStateInfo -> Timestamp
isiMaxTime IndexStateInfo
isi) forall a. [a] -> [a] -> [a]
++ [Char]
" (HEAD = " forall a. [a] -> [a] -> [a]
++
forall a. Pretty a => a -> [Char]
prettyShow (IndexStateInfo -> Timestamp
isiHeadTime IndexStateInfo
isi) forall a. [a] -> [a] -> [a]
++ [Char]
")")
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall a. a -> Maybe a -> a
fromMaybe ActiveRepos
defaultActiveRepos Maybe ActiveRepos
mb_activeRepos
[(RepoData, CombineStrategy)]
pkgss' <- case forall a.
ActiveRepos
-> (a -> RepoName) -> [a] -> Either [Char] [(a, CombineStrategy)]
organizeByRepos ActiveRepos
activeRepos RepoData -> RepoName
rdRepoName [RepoData]
pkgss of
Right [(RepoData, CombineStrategy)]
x -> forall (m :: * -> *) a. Monad m => a -> m a
return [(RepoData, CombineStrategy)]
x
Left [Char]
err -> Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity [Char]
err forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (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 forall a b. (a -> b) -> a -> b
$ 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 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) = 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) = 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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' PackageIndex UnresolvedSourcePackage
-> (RepoData, CombineStrategy)
-> PackageIndex UnresolvedSourcePackage
addIndex forall a. Monoid a => a
mempty [(RepoData, CombineStrategy)]
pkgss'
let prefs :: Map PackageName VersionRange
prefs :: Map PackageName VersionRange
prefs = 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
_ <- forall a. a -> IO a
evaluate PackageIndex UnresolvedSourcePackage
pkgs
Map PackageName VersionRange
_ <- forall a. a -> IO a
evaluate Map PackageName VersionRange
prefs
TotalIndexState
_ <- forall a. a -> IO a
evaluate TotalIndexState
totalIndexState
forall (m :: * -> *) a. Monad m => a -> m a
return (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 forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Repo -> Bool
isRepoRemote Repo
repo) forall a b. (a -> b) -> a -> b
$ Double -> IO ()
warnIfIndexIsOld 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) forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO`
(\IOException
e -> Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"unable to update the repo index cache -- " forall a. [a] -> [a] -> [a]
++ forall e. Exception e => e -> [Char]
displayException IOException
e)
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
{ srcpkgPackageId :: PackageId
srcpkgPackageId = PackageId
pkgid
, srcpkgDescription :: GenericPackageDescription
srcpkgDescription = GenericPackageDescription
pkgdesc
, srcpkgSource :: PackageLocation (Maybe [Char])
srcpkgSource = case PackageEntry
pkgEntry of
NormalPackage PackageId
_ GenericPackageDescription
_ ByteString
_ BlockNo
_ -> forall local. Repo -> PackageId -> local -> PackageLocation local
RepoTarballPackage Repo
repo PackageId
pkgid forall a. Maybe a
Nothing
BuildTreeRef BuildTreeRefType
_ PackageId
_ GenericPackageDescription
_ [Char]
path BlockNo
_ -> forall local. [Char] -> PackageLocation local
LocalUnpackedPackage [Char]
path
, srcpkgDescrOverride :: PackageDescriptionOverride
srcpkgDescrOverride = case PackageEntry
pkgEntry of
NormalPackage PackageId
_ GenericPackageDescription
_ ByteString
pkgtxt BlockNo
_ -> forall a. a -> Maybe a
Just ByteString
pkgtxt
PackageEntry
_ -> forall a. Maybe a
Nothing
}
where
pkgdesc :: GenericPackageDescription
pkgdesc = PackageEntry -> GenericPackageDescription
packageDesc PackageEntry
pkgEntry
pkgid :: PackageId
pkgid = 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 = forall a. IO a -> (IOException -> IO a) -> IO a
catchIO IO
(PackageIndex UnresolvedSourcePackage, [Dependency],
IndexStateInfo)
action forall a b. (a -> b) -> a -> b
$ \IOException
e -> if IOException -> Bool
isDoesNotExistError IOException
e
then do
case Repo
repo of
RepoRemote{[Char]
RemoteRepo
repoRemote :: Repo -> RemoteRepo
repoLocalDir :: [Char]
repoRemote :: RemoteRepo
repoLocalDir :: Repo -> [Char]
..} -> Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ RemoteRepo -> [Char]
errMissingPackageList RemoteRepo
repoRemote
RepoSecure{[Char]
RemoteRepo
repoLocalDir :: [Char]
repoRemote :: RemoteRepo
repoRemote :: Repo -> RemoteRepo
repoLocalDir :: Repo -> [Char]
..} -> Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ RemoteRepo -> [Char]
errMissingPackageList RemoteRepo
repoRemote
RepoLocalNoIndex LocalRepo
local [Char]
_ -> Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
[Char]
"Error during construction of local+noindex "
forall a. [a] -> [a] -> [a]
++ RepoName -> [Char]
unRepoName (LocalRepo -> RepoName
localRepoName LocalRepo
local) forall a. [a] -> [a] -> [a]
++ [Char]
" repository index: "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show IOException
e
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => a
mempty,forall a. Monoid a => a
mempty,IndexStateInfo
emptyStateInfo)
else forall a. IOException -> IO a
ioError IOException
e
isOldThreshold :: Double
isOldThreshold = Double
15
warnIfIndexIsOld :: Double -> IO ()
warnIfIndexIsOld Double
dt = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
dt forall a. Ord a => a -> a -> Bool
>= Double
isOldThreshold) forall a b. (a -> b) -> a -> b
$ case Repo
repo of
RepoRemote{[Char]
RemoteRepo
repoLocalDir :: [Char]
repoRemote :: RemoteRepo
repoRemote :: Repo -> RemoteRepo
repoLocalDir :: Repo -> [Char]
..} -> Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ forall {a}. RealFrac a => RemoteRepo -> a -> [Char]
errOutdatedPackageList RemoteRepo
repoRemote Double
dt
RepoSecure{[Char]
RemoteRepo
repoLocalDir :: [Char]
repoRemote :: RemoteRepo
repoRemote :: Repo -> RemoteRepo
repoLocalDir :: Repo -> [Char]
..} -> Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ forall {a}. RealFrac a => RemoteRepo -> a -> [Char]
errOutdatedPackageList RemoteRepo
repoRemote Double
dt
RepoLocalNoIndex {} -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
errMissingPackageList :: RemoteRepo -> [Char]
errMissingPackageList RemoteRepo
repoRemote =
[Char]
"The package list for '" forall a. [a] -> [a] -> [a]
++ RepoName -> [Char]
unRepoName (RemoteRepo -> RepoName
remoteRepoName RemoteRepo
repoRemote)
forall a. [a] -> [a] -> [a]
++ [Char]
"' does not exist. Run 'cabal update' to download it."
errOutdatedPackageList :: RemoteRepo -> a -> [Char]
errOutdatedPackageList RemoteRepo
repoRemote a
dt =
[Char]
"The package list for '" forall a. [a] -> [a] -> [a]
++ RepoName -> [Char]
unRepoName (RemoteRepo -> RepoName
remoteRepoName RemoteRepo
repoRemote)
forall a. [a] -> [a] -> [a]
++ [Char]
"' is " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char] -> [Char]
shows (forall a b. (RealFrac a, Integral b) => a -> b
floor a
dt :: Int) [Char]
" days old.\nRun "
forall a. [a] -> [a] -> [a]
++ [Char]
"'cabal update' to get the latest list of available packages."
getIndexFileAge :: Repo -> IO Double
getIndexFileAge :: Repo -> IO Double
getIndexFileAge Repo
repo = [Char] -> IO Double
getFileAge forall a b. (a -> b) -> a -> b
$ Repo -> [Char]
indexBaseName Repo
repo [Char] -> [Char] -> [Char]
<.> [Char]
"tar"
getSourcePackagesMonitorFiles :: [Repo] -> [FilePath]
getSourcePackagesMonitorFiles :: [Repo] -> [[Char]]
getSourcePackagesMonitorFiles [Repo]
repos =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ Repo -> [Char]
indexBaseName Repo
repo [Char] -> [Char] -> [Char]
<.> [Char]
"cache"
, Repo -> [Char]
indexBaseName Repo
repo [Char] -> [Char] -> [Char]
<.> [Char]
"timestamp" ]
| Repo
repo <- [Repo]
repos ]
updateRepoIndexCache :: Verbosity -> Index -> IO ()
updateRepoIndexCache :: Verbosity -> Index -> IO ()
updateRepoIndexCache Verbosity
verbosity Index
index =
Index -> IO () -> IO ()
whenCacheOutOfDate Index
index 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 <- [Char] -> IO Bool
doesFileExist forall a b. (a -> b) -> a -> b
$ Index -> [Char]
cacheFile Index
index
if Bool -> Bool
not Bool
exists
then IO ()
action
else if Index -> Bool
localNoIndex Index
index
then forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
ModTime
indexTime <- [Char] -> IO ModTime
getModTime forall a b. (a -> b) -> a -> b
$ Index -> [Char]
indexFile Index
index
ModTime
cacheTime <- [Char] -> IO ModTime
getModTime forall a b. (a -> b) -> a -> b
$ Index -> [Char]
cacheFile Index
index
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ModTime
indexTime 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
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 -> [Char] -> [Char]
[BuildTreeRefType] -> [Char] -> [Char]
BuildTreeRefType -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [BuildTreeRefType] -> [Char] -> [Char]
$cshowList :: [BuildTreeRefType] -> [Char] -> [Char]
show :: BuildTreeRefType -> [Char]
$cshow :: BuildTreeRefType -> [Char]
showsPrec :: Int -> BuildTreeRefType -> [Char] -> [Char]
$cshowsPrec :: Int -> BuildTreeRefType -> [Char] -> [Char]
Show,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 :: Char -> BuildTreeRefType
refTypeFromTypeCode Char
t
| Char
t forall a. Eq a => a -> a -> Bool
== Char
Tar.buildTreeRefTypeCode = BuildTreeRefType
LinkRef
| Char
t forall a. Eq a => a -> a -> Bool
== Char
Tar.buildTreeSnapshotTypeCode = BuildTreeRefType
SnapshotRef
| Bool
otherwise =
forall a. HasCallStack => [Char] -> a
error [Char]
"Distribution.Client.IndexUtils.refTypeFromTypeCode: unknown type code"
typeCodeFromRefType :: BuildTreeRefType -> Tar.TypeCode
typeCodeFromRefType :: BuildTreeRefType -> Char
typeCodeFromRefType BuildTreeRefType
LinkRef = Char
Tar.buildTreeRefTypeCode
typeCodeFromRefType BuildTreeRefType
SnapshotRef = Char
Tar.buildTreeSnapshotTypeCode
instance Package PackageEntry where
packageId :: PackageEntry -> PackageId
packageId (NormalPackage PackageId
pkgid GenericPackageDescription
_ ByteString
_ BlockNo
_) = PackageId
pkgid
packageId (BuildTreeRef BuildTreeRefType
_ PackageId
pkgid GenericPackageDescription
_ [Char]
_ BlockNo
_) = PackageId
pkgid
packageDesc :: PackageEntry -> GenericPackageDescription
packageDesc :: PackageEntry -> GenericPackageDescription
packageDesc (NormalPackage PackageId
_ GenericPackageDescription
descr ByteString
_ BlockNo
_) = GenericPackageDescription
descr
packageDesc (BuildTreeRef BuildTreeRefType
_ PackageId
_ GenericPackageDescription
descr [Char]
_ BlockNo
_) = GenericPackageDescription
descr
data PackageOrDep = Pkg PackageEntry | Dep Dependency
parsePackageIndex :: Verbosity -> ByteString -> [IO (Maybe PackageOrDep)]
parsePackageIndex :: Verbosity -> ByteString -> [IO (Maybe PackageOrDep)]
parsePackageIndex Verbosity
verbosity = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry BlockNo -> Entry -> [IO (Maybe PackageOrDep)]
extract) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Show e => Entries e -> [(BlockNo, Entry)]
tarEntriesList 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 forall a. [a] -> [a] -> [a]
++ [IO (Maybe PackageOrDep)]
tryExtractPrefs
where
tryExtractPkg :: [IO (Maybe PackageOrDep)]
tryExtractPkg = do
IO (Maybe PackageEntry)
mkPkgEntry <- forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ Verbosity -> Entry -> BlockNo -> Maybe (IO (Maybe PackageEntry))
extractPkg Verbosity
verbosity Entry
entry BlockNo
blockNo
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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' <- forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ Entry -> Maybe [Dependency]
extractPrefs Entry
entry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just 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 :: forall e. Show e => Entries e -> [(BlockNo, Entry)]
tarEntriesList = 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) = forall a. HasCallStack => [Char] -> a
error ([Char]
"tarEntriesList: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
e)
go !BlockNo
n (Tar.Next Entry
e Entries a
es') = (BlockNo
n, Entry
e) 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
_
| [Char] -> [Char]
takeExtension [Char]
fileName forall a. Eq a => a -> a -> Bool
== [Char]
".cabal"
-> case [Char] -> [[Char]]
splitDirectories ([Char] -> [Char]
normalise [Char]
fileName) of
[[Char]
pkgname,[Char]
vers,[Char]
_] -> case forall a. Parsec a => [Char] -> Maybe a
simpleParsec [Char]
vers of
Just Version
ver -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 ([Char] -> PackageName
mkPackageName [Char]
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 -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Couldn't read cabal file "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
fileName
Maybe Version
_ -> forall a. Maybe a
Nothing
[[Char]]
_ -> forall a. Maybe a
Nothing
Tar.OtherEntryType Char
typeCode ByteString
content FileSize
_
| Char -> Bool
Tar.isBuildTreeRefTypeCode Char
typeCode ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
let path :: [Char]
path = ByteString -> [Char]
byteStringToFilePath ByteString
content
Bool
dirExists <- [Char] -> IO Bool
doesDirectoryExist [Char]
path
Maybe PackageEntry
result <- if Bool -> Bool
not Bool
dirExists then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else do
[Char]
cabalFile <- Verbosity -> [Char] -> [Char] -> IO [Char]
tryFindAddSourcePackageDesc Verbosity
verbosity [Char]
path [Char]
"Error reading package index."
GenericPackageDescription
descr <- Verbosity -> [Char] -> IO GenericPackageDescription
PackageDesc.Parse.readGenericPackageDescription Verbosity
normal [Char]
cabalFile
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ BuildTreeRefType
-> PackageId
-> GenericPackageDescription
-> [Char]
-> BlockNo
-> PackageEntry
BuildTreeRef (Char -> BuildTreeRefType
refTypeFromTypeCode Char
typeCode) (forall pkg. Package pkg => pkg -> PackageId
packageId GenericPackageDescription
descr)
GenericPackageDescription
descr [Char]
path BlockNo
blockNo
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PackageEntry
result
EntryContent
_ -> forall a. Maybe a
Nothing
where
fileName :: [Char]
fileName = Entry -> [Char]
Tar.entryPath Entry
entry
extractPrefs :: Tar.Entry -> Maybe [Dependency]
Entry
entry = case Entry -> EntryContent
Tar.entryContent Entry
entry of
Tar.NormalFile ByteString
content FileSize
_
| [Char] -> Bool
isPreferredVersions [Char]
entrypath
-> forall a. a -> Maybe a
Just [Dependency]
prefs
where
entrypath :: [Char]
entrypath = Entry -> [Char]
Tar.entryPath Entry
entry
prefs :: [Dependency]
prefs = ByteString -> [Dependency]
parsePreferredVersions ByteString
content
EntryContent
_ -> forall a. Maybe a
Nothing
preferredVersions :: FilePath
preferredVersions :: [Char]
preferredVersions = [Char]
"preferred-versions"
isPreferredVersions :: FilePath -> Bool
isPreferredVersions :: [Char] -> Bool
isPreferredVersions = (forall a. Eq a => a -> a -> Bool
== [Char]
preferredVersions) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
takeFileName
parsePreferredVersions :: ByteString -> [Dependency]
parsePreferredVersions :: ByteString -> [Dependency]
parsePreferredVersions = forall a b. [Either a b] -> [b]
rights forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Either PreferredVersionsParseError Dependency]
parsePreferredVersionsWarnings
data PreferredVersionsParseError = PreferredVersionsParseError
{ PreferredVersionsParseError -> [Char]
preferredVersionsParsecError :: String
, PreferredVersionsParseError -> [Char]
preferredVersionsOriginalDependency :: String
}
deriving (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]
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 -> [Char] -> [Char]
[PreferredVersionsParseError] -> [Char] -> [Char]
PreferredVersionsParseError -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [PreferredVersionsParseError] -> [Char] -> [Char]
$cshowList :: [PreferredVersionsParseError] -> [Char] -> [Char]
show :: PreferredVersionsParseError -> [Char]
$cshow :: PreferredVersionsParseError -> [Char]
showsPrec :: Int -> PreferredVersionsParseError -> [Char] -> [Char]
$cshowsPrec :: Int -> PreferredVersionsParseError -> [Char] -> [Char]
Show, PreferredVersionsParseError -> PreferredVersionsParseError -> Bool
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
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
Ord, Typeable)
parsePreferredVersionsWarnings :: ByteString
-> [Either PreferredVersionsParseError Dependency]
parsePreferredVersionsWarnings :: ByteString -> [Either PreferredVersionsParseError Dependency]
parsePreferredVersionsWarnings =
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Either PreferredVersionsParseError Dependency
parsePreference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
"--")
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
fromUTF8LBS
where
parsePreference :: String -> Either PreferredVersionsParseError Dependency
parsePreference :: [Char] -> Either PreferredVersionsParseError Dependency
parsePreference [Char]
s = case forall a. Parsec a => [Char] -> Either [Char] a
eitherParsec [Char]
s of
Left [Char]
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ PreferredVersionsParseError
{ preferredVersionsParsecError :: [Char]
preferredVersionsParsecError = [Char]
err
, preferredVersionsOriginalDependency :: [Char]
preferredVersionsOriginalDependency = [Char]
s
}
Right Dependency
dep -> forall a b. b -> Either a b
Right Dependency
dep
lazySequence :: [IO a] -> IO [a]
lazySequence :: forall a. [IO a] -> IO [a]
lazySequence = forall a. IO a -> IO a
unsafeInterleaveIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [IO a] -> IO [a]
go
where
go :: [IO a] -> IO [a]
go [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
go (IO a
x:[IO a]
xs) = do a
x' <- IO a
x
[a]
xs' <- forall a. [IO a] -> IO [a]
lazySequence [IO a]
xs
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x' forall a. a -> [a] -> [a]
: [a]
xs')
lazyUnfold :: (k -> IO (v, Maybe k)) -> k -> IO [(k,v)]
lazyUnfold :: forall k v. (k -> IO (v, Maybe k)) -> k -> IO [(k, v)]
lazyUnfold k -> IO (v, Maybe k)
step = Maybe k -> IO [(k, v)]
goLazy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just
where
goLazy :: Maybe k -> IO [(k, v)]
goLazy Maybe k
s = 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 = 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'
forall (m :: * -> *) a. Monad m => a -> m a
return ((k
k,v
v)forall a. a -> [a] -> [a]
:[(k, v)]
vs')
data Index =
RepoIndex RepoContext Repo
| SandboxIndex FilePath
indexFile :: Index -> FilePath
indexFile :: Index -> [Char]
indexFile (RepoIndex RepoContext
_ctxt Repo
repo) = Repo -> [Char]
indexBaseName Repo
repo [Char] -> [Char] -> [Char]
<.> [Char]
"tar"
indexFile (SandboxIndex [Char]
index) = [Char]
index
cacheFile :: Index -> FilePath
cacheFile :: Index -> [Char]
cacheFile (RepoIndex RepoContext
_ctxt Repo
repo) = Repo -> [Char]
indexBaseName Repo
repo [Char] -> [Char] -> [Char]
<.> [Char]
"cache"
cacheFile (SandboxIndex [Char]
index) = [Char]
index [Char] -> [Char] -> [Char]
`replaceExtension` [Char]
"cache"
timestampFile :: Index -> FilePath
timestampFile :: Index -> [Char]
timestampFile (RepoIndex RepoContext
_ctxt Repo
repo) = Repo -> [Char]
indexBaseName Repo
repo [Char] -> [Char] -> [Char]
<.> [Char]
"timestamp"
timestampFile (SandboxIndex [Char]
index) = [Char]
index [Char] -> [Char] -> [Char]
`replaceExtension` [Char]
"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 [Char]
_) = Bool
False
updatePackageIndexCacheFile :: Verbosity -> Index -> IO ()
updatePackageIndexCacheFile :: Verbosity -> Index -> IO ()
updatePackageIndexCacheFile Verbosity
verbosity Index
index = do
Verbosity -> [Char] -> IO ()
info Verbosity
verbosity ([Char]
"Updating index cache file " forall a. [a] -> [a] -> [a]
++ Index -> [Char]
cacheFile Index
index forall a. [a] -> [a] -> [a]
++ [Char]
" ...")
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 (forall a b. (a -> b) -> [a] -> [b]
map IndexCacheEntry -> Timestamp
cacheEntryTimestamp [IndexCacheEntry]
entries)
cache :: Cache
cache = Cache { cacheHeadTs :: Timestamp
cacheHeadTs = Timestamp
maxTs
, cacheEntries :: [IndexCacheEntry]
cacheEntries = [IndexCacheEntry]
entries
}
Index -> Cache -> IO ()
writeIndexCache Index
index Cache
cache
Verbosity -> [Char] -> IO ()
info Verbosity
verbosity ([Char]
"Index cache updated to index-state "
forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow (Cache -> Timestamp
cacheHeadTs Cache
cache))
callbackNoIndex :: [NoIndexCacheEntry] -> IO ()
callbackNoIndex [NoIndexCacheEntry]
entries = do
Verbosity -> Index -> NoIndexCache -> IO ()
writeNoIndexCache Verbosity
verbosity Index
index forall a b. (a -> b) -> a -> b
$ [NoIndexCacheEntry] -> NoIndexCache
NoIndexCache [NoIndexCacheEntry]
entries
Verbosity -> [Char] -> IO ()
info Verbosity
verbosity [Char]
"Index cache updated"
withIndexEntries
:: Verbosity -> Index
-> ([IndexCacheEntry] -> IO a)
-> ([NoIndexCacheEntry] -> IO a)
-> IO a
withIndexEntries :: forall a.
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
-> forall a.
Repo -> (forall (down :: * -> *). Repository down -> IO a) -> IO a
repoContextWithSecureRepo RepoContext
repoCtxt Repo
repo forall a b. (a -> b) -> a -> b
$ \Repository down
repoSecure ->
forall (down :: * -> *) a.
Repository down -> (IndexCallbacks -> IO a) -> IO a
Sec.withIndex Repository down
repoSecure 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 <- 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 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) -> forall a. NFData a => a -> a
force
[PackageId -> BlockNo -> Timestamp -> IndexCacheEntry
CachePackageId PackageId
pkgId BlockNo
blockNo Timestamp
timestamp]
Just (Sec.IndexPkgPrefs PackageName
_pkgName) -> forall a. NFData a => a -> a
force
[ Dependency -> BlockNo -> Timestamp -> IndexCacheEntry
CachePreference Dependency
dep BlockNo
blockNo Timestamp
timestamp
| Dependency
dep <- ByteString -> [Dependency]
parsePreferredVersions (forall dec. IndexEntry dec -> ByteString
Sec.indexEntryContent IndexEntry a
sie)
]
where
blockNo :: BlockNo
blockNo = DirectoryEntry -> BlockNo
Sec.directoryEntryBlockNo DirectoryEntry
dirEntry
timestamp :: Timestamp
timestamp = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"withIndexEntries: invalid timestamp") forall a b. (a -> b) -> a -> b
$
FileSize -> Maybe Timestamp
epochTimeToTimestamp forall a b. (a -> b) -> a -> b
$ forall dec. IndexEntry dec -> FileSize
Sec.indexEntryTime IndexEntry a
sie
withIndexEntries Verbosity
verbosity (RepoIndex RepoContext
_repoCtxt (RepoLocalNoIndex (LocalRepo RepoName
name [Char]
localDir Bool
_) [Char]
_cacheDir)) [IndexCacheEntry] -> IO a
_ [NoIndexCacheEntry] -> IO a
callback = do
[[Char]]
dirContents <- [Char] -> IO [[Char]]
listDirectory [Char]
localDir
let contentSet :: Set [Char]
contentSet = forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
dirContents
[NoIndexCacheEntry]
entries <- forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle forall a. IOException -> IO a
handler forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [[Char]]
dirContents forall a b. (a -> b) -> a -> b
$ \[Char]
file -> do
case [Char] -> Maybe PackageId
isTarGz [Char]
file of
Maybe PackageId
Nothing
| [Char] -> Bool
isPreferredVersions [Char]
file -> do
ByteString
contents <- [Char] -> IO ByteString
BS.readFile ([Char]
localDir [Char] -> [Char] -> [Char]
</> [Char]
file)
let versionPreferencesParsed :: [Either PreferredVersionsParseError Dependency]
versionPreferencesParsed = ByteString -> [Either PreferredVersionsParseError Dependency]
parsePreferredVersionsWarnings ByteString
contents
let ([PreferredVersionsParseError]
warnings, [Dependency]
versionPreferences) = forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either PreferredVersionsParseError Dependency]
versionPreferencesParsed
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PreferredVersionsParseError]
warnings) forall a b. (a -> b) -> a -> b
$ do
Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
[Char]
"withIndexEntries: failed to parse some entries of \"preferred-versions\" found at: "
forall a. [a] -> [a] -> [a]
++ ([Char]
localDir [Char] -> [Char] -> [Char]
</> [Char]
file)
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [PreferredVersionsParseError]
warnings forall a b. (a -> b) -> a -> b
$ \PreferredVersionsParseError
err -> do
Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"* \"" forall a. [a] -> [a] -> [a]
++ PreferredVersionsParseError -> [Char]
preferredVersionsOriginalDependency PreferredVersionsParseError
err
Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"Parser Error: " forall a. [a] -> [a] -> [a]
++ PreferredVersionsParseError -> [Char]
preferredVersionsParsecError PreferredVersionsParseError
err
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Dependency] -> NoIndexCacheEntry
NoIndexCachePreference [Dependency]
versionPreferences
| Bool
otherwise -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Char] -> [Char]
takeFileName [Char]
file forall a. Eq a => a -> a -> Bool
== [Char]
"noindex.cache" Bool -> Bool -> Bool
|| [Char]
".cabal" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
file) forall a b. (a -> b) -> a -> b
$
Verbosity -> [Char] -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"Skipping " forall a. [a] -> [a] -> [a]
++ [Char]
file
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just PackageId
pkgid | [Char]
cabalPath forall a. Ord a => a -> Set a -> Bool
`Set.member` Set [Char]
contentSet -> do
ByteString
contents <- [Char] -> IO ByteString
BSS.readFile ([Char]
localDir [Char] -> [Char] -> [Char]
</> [Char]
cabalPath)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe ByteString
contents) forall a b. (a -> b) -> a -> b
$ \GenericPackageDescription
gpd ->
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericPackageDescription -> ByteString -> NoIndexCacheEntry
CacheGPD GenericPackageDescription
gpd ByteString
contents)
where
cabalPath :: [Char]
cabalPath = forall a. Pretty a => a -> [Char]
prettyShow PackageId
pkgid forall a. [a] -> [a] -> [a]
++ [Char]
".cabal"
Just PackageId
pkgId -> do
ByteString
tarGz <- [Char] -> IO ByteString
BS.readFile ([Char]
localDir [Char] -> [Char] -> [Char]
</> [Char]
file)
let tar :: ByteString
tar = ByteString -> ByteString
GZip.decompress ByteString
tarGz
entries :: Entries FormatError
entries = ByteString -> Entries FormatError
Tar.read ByteString
tar
case forall a e. (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
Tar.foldEntries (PackageId
-> Entry -> Maybe NoIndexCacheEntry -> Maybe NoIndexCacheEntry
readCabalEntry PackageId
pkgId) forall a. Maybe a
Nothing (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) Entries FormatError
entries of
Just NoIndexCacheEntry
ce -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just NoIndexCacheEntry
ce)
Maybe NoIndexCacheEntry
Nothing -> forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"Cannot read .cabal file inside " forall a. [a] -> [a] -> [a]
++ [Char]
file
let ([[Dependency]]
prefs, [GenericPackageDescription]
gpds) = forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map
(\case
NoIndexCachePreference [Dependency]
deps -> forall a b. a -> Either a b
Left [Dependency]
deps
CacheGPD GenericPackageDescription
gpd ByteString
_ -> forall a b. b -> Either a b
Right GenericPackageDescription
gpd
)
[NoIndexCacheEntry]
entries
Verbosity -> [Char] -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"Entries in file+noindex repository " forall a. [a] -> [a] -> [a]
++ RepoName -> [Char]
unRepoName RepoName
name
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [GenericPackageDescription]
gpds forall a b. (a -> b) -> a -> b
$ \GenericPackageDescription
gpd ->
Verbosity -> [Char] -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"- " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow (PackageDescription -> PackageId
package forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> PackageDescription
Distribution.PackageDescription.packageDescription GenericPackageDescription
gpd)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Dependency]]
prefs) forall a b. (a -> b) -> a -> b
$ do
Verbosity -> [Char] -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"Preferred versions in file+noindex repository " forall a. [a] -> [a] -> [a]
++ RepoName -> [Char]
unRepoName RepoName
name
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Dependency]]
prefs) forall a b. (a -> b) -> a -> b
$ \Dependency
pref ->
Verbosity -> [Char] -> IO ()
info Verbosity
verbosity ([Char]
"* " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow Dependency
pref)
[NoIndexCacheEntry] -> IO a
callback [NoIndexCacheEntry]
entries
where
handler :: IOException -> IO a
handler :: forall a. IOException -> IO a
handler IOException
e = forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"Error while updating index for " forall a. [a] -> [a] -> [a]
++ RepoName -> [Char]
unRepoName RepoName
name forall a. [a] -> [a] -> [a]
++ [Char]
" repository " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show IOException
e
isTarGz :: FilePath -> Maybe PackageIdentifier
isTarGz :: [Char] -> Maybe PackageId
isTarGz [Char]
fp = do
[Char]
pfx <- forall {a}. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix [Char]
".tar.gz" [Char]
fp
forall a. Parsec a => [Char] -> Maybe a
simpleParsec [Char]
pfx
stripSuffix :: [a] -> [a] -> Maybe [a]
stripSuffix [a]
sfx [a]
str = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> [a]
reverse (forall {a}. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (forall a. [a] -> [a]
reverse [a]
sfx) (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
| [Char]
filename forall a. Eq a => a -> a -> Bool
== Entry -> [Char]
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\GenericPackageDescription
gpd -> GenericPackageDescription -> ByteString -> NoIndexCacheEntry
CacheGPD GenericPackageDescription
gpd ByteString
bs) forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe ByteString
bs
where
filename :: [Char]
filename = forall a. Pretty a => a -> [Char]
prettyShow PackageId
pkgId [Char] -> [Char] -> [Char]
FilePath.Posix.</> forall a. Pretty a => a -> [Char]
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pkgId) forall a. [a] -> [a] -> [a]
++ [Char]
".cabal"
readCabalEntry PackageId
_ Entry
_ Maybe NoIndexCacheEntry
x = Maybe NoIndexCacheEntry
x
withIndexEntries Verbosity
verbosity Index
index [IndexCacheEntry] -> IO a
callback [NoIndexCacheEntry] -> IO a
_ = do
forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withFile (Index -> [Char]
indexFile Index
index) IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
ByteString
bs <- ByteString -> ByteString
maybeDecompress forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Handle -> IO ByteString
BS.hGetContents Handle
h
[Maybe PackageOrDep]
pkgsOrPrefs <- forall a. [IO a] -> IO [a]
lazySequence forall a b. (a -> b) -> a -> b
$ Verbosity -> ByteString -> [IO (Maybe PackageOrDep)]
parsePackageIndex Verbosity
verbosity ByteString
bs
[IndexCacheEntry] -> IO a
callback forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map PackageOrDep -> IndexCacheEntry
toCache (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
_ [Char]
_ 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 :: forall pkg.
Package pkg =>
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) <- forall pkg.
Package pkg =>
Verbosity
-> (PackageEntry -> pkg)
-> NoIndexCache
-> IO (PackageIndex pkg, [Dependency])
packageNoIndexFromCache Verbosity
verbosity PackageEntry -> pkg
mkPkg NoIndexCache
cache0
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 <- [Char] -> IOMode -> IO Handle
openFile (Index -> [Char]
indexFile Index
index) IOMode
ReadMode
let (Cache
cache,IndexStateInfo
isi) = RepoIndexState -> Cache -> (Cache, IndexStateInfo)
filterCache RepoIndexState
idxState Cache
cache0
(PackageIndex pkg
pkgs,[Dependency]
deps) <- forall pkg.
Package pkg =>
Verbosity
-> (PackageEntry -> pkg)
-> Handle
-> Cache
-> IO (PackageIndex pkg, [Dependency])
packageIndexFromCache Verbosity
verbosity PackageEntry -> pkg
mkPkg Handle
indexHnd Cache
cache
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 :: forall pkg.
Package pkg =>
Verbosity
-> (PackageEntry -> pkg)
-> Handle
-> Cache
-> IO (PackageIndex pkg, [Dependency])
packageIndexFromCache Verbosity
verbosity PackageEntry -> pkg
mkPkg Handle
hnd Cache
cache = do
([pkg]
pkgs, [Dependency]
prefs) <- forall pkg.
Verbosity
-> (PackageEntry -> pkg)
-> Handle
-> Cache
-> IO ([pkg], [Dependency])
packageListFromCache Verbosity
verbosity PackageEntry -> pkg
mkPkg Handle
hnd Cache
cache
PackageIndex pkg
pkgIndex <- forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall pkg. Package pkg => [pkg] -> PackageIndex pkg
PackageIndex.fromList [pkg]
pkgs
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 :: forall pkg.
Package pkg =>
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 <- forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall pkg. Package pkg => [pkg] -> PackageIndex pkg
PackageIndex.fromList [pkg]
pkgs
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageIndex pkg
pkgIndex, [Dependency]
prefs)
where
packageListFromNoIndexCache :: ([pkg], [Dependency])
packageListFromNoIndexCache :: ([pkg], [Dependency])
packageListFromNoIndexCache = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr NoIndexCacheEntry -> ([pkg], [Dependency]) -> ([pkg], [Dependency])
go 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 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) forall a. a -> [a] -> [a]
: [pkg]
pkgs, [Dependency]
prefs)
go (NoIndexCachePreference [Dependency]
deps) ([pkg]
pkgs, [Dependency]
prefs) =
([pkg]
pkgs, [Dependency]
deps forall a. [a] -> [a] -> [a]
++ [Dependency]
prefs)
packageListFromCache :: Verbosity
-> (PackageEntry -> pkg)
-> Handle
-> Cache
-> IO ([pkg], [Dependency])
packageListFromCache :: forall pkg.
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 forall a. Monoid a => a
mempty [] 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 [] = forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. Map k a -> [a]
Map.elems Map PackageId pkg
srcpkgs forall a. [a] -> [a] -> [a]
++ [pkg]
btrs, 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) <- forall a. IO a -> IO a
unsafeInterleaveIO 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
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 (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
[Char]
path <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteString -> [Char]
byteStringToFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNo -> IO ByteString
getEntryContent forall a b. (a -> b) -> a -> b
$ BlockNo
blockno
GenericPackageDescription
pkg <- do let err :: [Char]
err = [Char]
"Error reading package index from cache."
[Char]
file <- Verbosity -> [Char] -> [Char] -> IO [Char]
tryFindAddSourcePackageDesc Verbosity
verbosity [Char]
path [Char]
err
Verbosity -> [Char] -> IO GenericPackageDescription
PackageDesc.Parse.readGenericPackageDescription Verbosity
normal [Char]
file
let srcpkg :: pkg
srcpkg = PackageEntry -> pkg
mkPkg (BuildTreeRefType
-> PackageId
-> GenericPackageDescription
-> [Char]
-> BlockNo
-> PackageEntry
BuildTreeRef BuildTreeRefType
refType (forall pkg. Package pkg => pkg -> PackageId
packageId GenericPackageDescription
pkg) GenericPackageDescription
pkg [Char]
path BlockNo
blockno)
Map PackageId pkg
-> [pkg]
-> Map PackageName Dependency
-> [IndexCacheEntry]
-> IO ([pkg], [Dependency])
accum Map PackageId pkg
srcpkgs (pkg
srcpkgforall 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 (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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
content
Tar.OtherEntryType Char
typecode ByteString
content FileSize
_size
| Char -> Bool
Tar.isBuildTreeRefTypeCode Char
typecode
-> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
content
EntryContent
_ -> forall a. [Char] -> IO a
interror [Char]
"unexpected tar entry type"
readPackageDescription :: PackageIdentifier -> ByteString -> IO GenericPackageDescription
readPackageDescription :: PackageId -> ByteString -> IO GenericPackageDescription
readPackageDescription PackageId
pkgid ByteString
content =
case forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
PackageDesc.Parse.runParseResult forall a b. (a -> b) -> a -> b
$ ByteString -> ParseResult GenericPackageDescription
parseGenericPackageDescription forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.toStrict ByteString
content of
Right GenericPackageDescription
gpd -> forall (m :: * -> *) a. Monad m => a -> m a
return GenericPackageDescription
gpd
Left (Just Version
specVer, NonEmpty PError
_) | Version
specVer forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
2,Int
2] -> forall (m :: * -> *) a. Monad m => a -> m a
return (Version -> GenericPackageDescription
dummyPackageDescription Version
specVer)
Left (Maybe Version, NonEmpty PError)
_ -> forall a. [Char] -> IO a
interror [Char]
"failed to parse .cabal file"
where
dummyPackageDescription :: Version -> GenericPackageDescription
dummyPackageDescription :: Version -> GenericPackageDescription
dummyPackageDescription Version
specVer = GenericPackageDescription
{ packageDescription :: PackageDescription
packageDescription = PackageDescription
emptyPackageDescription
{ package :: PackageId
package = PackageId
pkgid
, synopsis :: ShortText
synopsis = ShortText
dummySynopsis
}
, gpdScannedVersion :: Maybe Version
gpdScannedVersion = forall a. a -> Maybe a
Just Version
specVer
, genPackageFlags :: [PackageFlag]
genPackageFlags = []
, condLibrary :: Maybe (CondTree ConfVar [Dependency] Library)
condLibrary = 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 :: forall a. [Char] -> IO a
interror [Char]
msg = forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"internal error when reading package index: " forall a. [a] -> [a] -> [a]
++ [Char]
msg
forall a. [a] -> [a] -> [a]
++ [Char]
"The package index or index cache is probably "
forall a. [a] -> [a] -> [a]
++ [Char]
"corrupt. Running cabal update might fix it."
readIndexCache :: Verbosity -> Index -> IO Cache
readIndexCache :: Verbosity -> Index -> IO Cache
readIndexCache Verbosity
verbosity Index
index = do
Either [Char] Cache
cacheOrFail <- Index -> IO (Either [Char] Cache)
readIndexCache' Index
index
case Either [Char] Cache
cacheOrFail of
Left [Char]
msg -> do
Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Char]
"Parsing the index cache failed (", [Char]
msg, [Char]
"). "
, [Char]
"Trying to regenerate the index cache..."
]
Verbosity -> Index -> IO ()
updatePackageIndexCacheFile Verbosity
verbosity Index
index
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cache -> Cache
hashConsCache) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Index -> IO (Either [Char] Cache)
readIndexCache' Index
index
Right Cache
res -> 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 [Char] NoIndexCache
cacheOrFail <- Index -> IO (Either [Char] NoIndexCache)
readNoIndexCache' Index
index
case Either [Char] NoIndexCache
cacheOrFail of
Left [Char]
msg -> do
Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Char]
"Parsing the index cache failed (", [Char]
msg, [Char]
"). "
, [Char]
"Trying to regenerate the index cache..."
]
Verbosity -> Index -> IO ()
updatePackageIndexCacheFile Verbosity
verbosity Index
index
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity) forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Index -> IO (Either [Char] NoIndexCache)
readNoIndexCache' Index
index
Right NoIndexCache
res -> forall (m :: * -> *) a. Monad m => a -> m a
return NoIndexCache
res
readIndexCache' :: Index -> IO (Either String Cache)
readIndexCache' :: Index -> IO (Either [Char] Cache)
readIndexCache' Index
index
| Index -> Bool
is01Index Index
index = forall a.
(Binary a, Structured a) =>
[Char] -> IO (Either [Char] a)
structuredDecodeFileOrFail (Index -> [Char]
cacheFile Index
index)
| Bool
otherwise = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
.ByteString -> Cache
read00IndexCache) forall a b. (a -> b) -> a -> b
$
[Char] -> IO ByteString
BSS.readFile (Index -> [Char]
cacheFile Index
index)
readNoIndexCache' :: Index -> IO (Either String NoIndexCache)
readNoIndexCache' :: Index -> IO (Either [Char] NoIndexCache)
readNoIndexCache' Index
index = forall a.
(Binary a, Structured a) =>
[Char] -> IO (Either [Char] a)
structuredDecodeFileOrFail (Index -> [Char]
cacheFile Index
index)
writeIndexCache :: Index -> Cache -> IO ()
writeIndexCache :: Index -> Cache -> IO ()
writeIndexCache Index
index Cache
cache
| Index -> Bool
is01Index Index
index = forall a. (Binary a, Structured a) => [Char] -> a -> IO ()
structuredEncodeFile (Index -> [Char]
cacheFile Index
index) Cache
cache
| Bool
otherwise = [Char] -> [Char] -> IO ()
writeFile (Index -> [Char]
cacheFile Index
index) (Cache -> [Char]
show00IndexCache Cache
cache)
writeNoIndexCache :: Verbosity -> Index -> NoIndexCache -> IO ()
writeNoIndexCache :: Verbosity -> Index -> NoIndexCache -> IO ()
writeNoIndexCache Verbosity
verbosity Index
index NoIndexCache
cache = do
let path :: [Char]
path = Index -> [Char]
cacheFile Index
index
Verbosity -> Bool -> [Char] -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True ([Char] -> [Char]
takeDirectory [Char]
path)
forall a. (Binary a, Structured a) => [Char] -> a -> IO ()
structuredEncodeFile [Char]
path NoIndexCache
cache
writeIndexTimestamp :: Index -> RepoIndexState -> IO ()
writeIndexTimestamp :: Index -> RepoIndexState -> IO ()
writeIndexTimestamp Index
index RepoIndexState
st
= [Char] -> [Char] -> IO ()
writeFile (Index -> [Char]
timestampFile Index
index) (forall a. Pretty a => a -> [Char]
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) -> 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
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
= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Parsec a => [Char] -> Maybe a
simpleParsec ([Char] -> IO [Char]
readFile (Index -> [Char]
timestampFile Index
index))
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
e ->
if IOException -> Bool
isDoesNotExistError IOException
e
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else do
Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"Warning: could not read current index timestamp: " forall a. [a] -> [a] -> [a]
++ forall e. Exception e => e -> [Char]
displayException IOException
e
forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Monoid a => a
mempty 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 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') = 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') = 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 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 :: forall k. Ord k => k -> Map k k -> (k, Map k k)
mapIntern k
k Map k k
m = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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)) (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 -> [Char] -> [Char]
[Cache] -> [Char] -> [Char]
Cache -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Cache] -> [Char] -> [Char]
$cshowList :: [Cache] -> [Char] -> [Char]
show :: Cache -> [Char]
$cshow :: Cache -> [Char]
showsPrec :: Int -> Cache -> [Char] -> [Char]
$cshowsPrec :: Int -> Cache -> [Char] -> [Char]
Show, 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 = forall a. NFData a => a -> ()
rnf forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cache -> [IndexCacheEntry]
cacheEntries
newtype NoIndexCache = NoIndexCache
{ NoIndexCache -> [NoIndexCacheEntry]
noIndexCacheEntries :: [NoIndexCacheEntry]
}
deriving (Int -> NoIndexCache -> [Char] -> [Char]
[NoIndexCache] -> [Char] -> [Char]
NoIndexCache -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [NoIndexCache] -> [Char] -> [Char]
$cshowList :: [NoIndexCache] -> [Char] -> [Char]
show :: NoIndexCache -> [Char]
$cshow :: NoIndexCache -> [Char]
showsPrec :: Int -> NoIndexCache -> [Char] -> [Char]
$cshowsPrec :: Int -> NoIndexCache -> [Char] -> [Char]
Show, 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 = forall a. NFData a => a -> ()
rnf 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
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 -> [Char] -> [Char]
[IndexCacheEntry] -> [Char] -> [Char]
IndexCacheEntry -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [IndexCacheEntry] -> [Char] -> [Char]
$cshowList :: [IndexCacheEntry] -> [Char] -> [Char]
show :: IndexCacheEntry -> [Char]
$cshow :: IndexCacheEntry -> [Char]
showsPrec :: Int -> IndexCacheEntry -> [Char] -> [Char]
$cshowsPrec :: Int -> IndexCacheEntry -> [Char] -> [Char]
Show,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
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 -> [Char] -> [Char]
[NoIndexCacheEntry] -> [Char] -> [Char]
NoIndexCacheEntry -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [NoIndexCacheEntry] -> [Char] -> [Char]
$cshowList :: [NoIndexCacheEntry] -> [Char] -> [Char]
show :: NoIndexCacheEntry -> [Char]
$cshow :: NoIndexCacheEntry -> [Char]
showsPrec :: Int -> NoIndexCacheEntry -> [Char] -> [Char]
$cshowsPrec :: Int -> NoIndexCacheEntry -> [Char] -> [Char]
Show,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
_) = forall a. NFData a => a -> ()
rnf PackageId
pkgid
rnf (CachePreference Dependency
dep BlockNo
_ Timestamp
_) = forall a. NFData a => a -> ()
rnf Dependency
dep
rnf (CacheBuildTreeRef BuildTreeRefType
_ BlockNo
_) = ()
instance NFData NoIndexCacheEntry where
rnf :: NoIndexCacheEntry -> ()
rnf (CacheGPD GenericPackageDescription
gpd ByteString
bs) = forall a. NFData a => a -> ()
rnf GenericPackageDescription
gpd seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf ByteString
bs
rnf (NoIndexCachePreference [Dependency]
dep) = 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
forall t. Binary t => t -> Put
put (Word8
0 :: Word8)
forall t. Binary t => t -> Put
put ByteString
bs
put (NoIndexCachePreference [Dependency]
dep) = do
forall t. Binary t => t -> Put
put (Word8
1 :: Word8)
forall t. Binary t => t -> Put
put [Dependency]
dep
get :: Get NoIndexCacheEntry
get = do
Word8
t :: Word8 <- forall t. Binary t => Get t
get
case Word8
t of
Word8
0 -> do
ByteString
bs <- forall t. Binary t => Get t
get
case ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe ByteString
bs of
Just GenericPackageDescription
gpd -> forall (m :: * -> *) a. Monad m => a -> m a
return (GenericPackageDescription -> ByteString -> NoIndexCacheEntry
CacheGPD GenericPackageDescription
gpd ByteString
bs)
Maybe GenericPackageDescription
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Failed to parse GPD"
Word8
1 -> do
[Dependency]
dep <- forall t. Binary t => Get t
get
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Dependency] -> NoIndexCacheEntry
NoIndexCachePreference [Dependency]
dep
Word8
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Failed to parse NoIndexCacheEntry"
instance Structured NoIndexCacheEntry where
structure :: Proxy NoIndexCacheEntry -> Structure
structure = forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure
packageKey, blocknoKey, buildTreeRefKey, preferredVersionKey :: String
packageKey :: [Char]
packageKey = [Char]
"pkg:"
blocknoKey :: [Char]
blocknoKey = [Char]
"b#"
buildTreeRefKey :: [Char]
buildTreeRefKey = [Char]
"build-tree-ref:"
preferredVersionKey :: [Char]
preferredVersionKey = [Char]
"pref-ver:"
read00IndexCache :: BSS.ByteString -> Cache
read00IndexCache :: ByteString -> Cache
read00IndexCache ByteString
bs = Cache
{ cacheHeadTs :: Timestamp
cacheHeadTs = Timestamp
nullTimestamp
, cacheEntries :: [IndexCacheEntry]
cacheEntries = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ByteString -> Maybe IndexCacheEntry
read00IndexCacheEntry 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 forall a. Eq a => a -> a -> Bool
== [Char] -> ByteString
BSS.pack [Char]
packageKey Bool -> Bool -> Bool
&& ByteString
sep forall a. Eq a => a -> a -> Bool
== [Char] -> ByteString
BSS.pack [Char]
blocknoKey ->
case (ByteString -> Maybe PackageName
parseName ByteString
pkgnamestr, ByteString -> [Int] -> Maybe Version
parseVer ByteString
pkgverstr [],
forall {a}. Num a => ByteString -> Maybe a
parseBlockNo ByteString
blocknostr) of
(Just PackageName
pkgname, Just Version
pkgver, Just BlockNo
blockno)
-> 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)
_ -> forall a. Maybe a
Nothing
[ByteString
key, ByteString
typecodestr, ByteString
blocknostr] | ByteString
key forall a. Eq a => a -> a -> Bool
== [Char] -> ByteString
BSS.pack [Char]
buildTreeRefKey ->
case (ByteString -> Maybe BuildTreeRefType
parseRefType ByteString
typecodestr, forall {a}. Num a => ByteString -> Maybe a
parseBlockNo ByteString
blocknostr) of
(Just BuildTreeRefType
refType, Just BlockNo
blockno)
-> forall a. a -> Maybe a
Just (BuildTreeRefType -> BlockNo -> IndexCacheEntry
CacheBuildTreeRef BuildTreeRefType
refType BlockNo
blockno)
(Maybe BuildTreeRefType, Maybe BlockNo)
_ -> forall a. Maybe a
Nothing
(ByteString
key: [ByteString]
remainder) | ByteString
key forall a. Eq a => a -> a -> Bool
== [Char] -> ByteString
BSS.pack [Char]
preferredVersionKey -> do
Dependency
pref <- forall a. Parsec a => ByteString -> Maybe a
simpleParsecBS ([ByteString] -> ByteString
BSS.unwords [ByteString]
remainder)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Dependency -> BlockNo -> Timestamp -> IndexCacheEntry
CachePreference Dependency
pref BlockNo
0 Timestamp
nullTimestamp
[ByteString]
_ -> forall a. Maybe a
Nothing
where
parseName :: ByteString -> Maybe PackageName
parseName ByteString
str
| (Char -> Bool) -> ByteString -> Bool
BSS.all (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-') ByteString
str
= forall a. a -> Maybe a
Just ([Char] -> PackageName
mkPackageName (ByteString -> [Char]
BSS.unpack ByteString
str))
| Bool
otherwise = 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 -> forall a. Maybe a
Nothing
Just (Int
v, ByteString
str') -> case ByteString -> Maybe (Char, ByteString)
BSS.uncons ByteString
str' of
Just (Char
'.', ByteString
str'') -> ByteString -> [Int] -> Maybe Version
parseVer ByteString
str'' (Int
vforall a. a -> [a] -> [a]
:[Int]
vs)
Just (Char, ByteString)
_ -> forall a. Maybe a
Nothing
Maybe (Char, ByteString)
Nothing -> forall a. a -> Maybe a
Just ([Int] -> Version
mkVersion (forall a. [a] -> [a]
reverse (Int
vforall 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 -> forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
blockno)
Maybe (Int, ByteString)
_ -> forall a. Maybe a
Nothing
parseRefType :: ByteString -> Maybe BuildTreeRefType
parseRefType ByteString
str =
case ByteString -> Maybe (Char, ByteString)
BSS.uncons ByteString
str of
Just (Char
typeCode, ByteString
remainder)
| ByteString -> Bool
BSS.null ByteString
remainder Bool -> Bool -> Bool
&& Char -> Bool
Tar.isBuildTreeRefTypeCode Char
typeCode
-> forall a. a -> Maybe a
Just (Char -> BuildTreeRefType
refTypeFromTypeCode Char
typeCode)
Maybe (Char, ByteString)
_ -> forall a. Maybe a
Nothing
show00IndexCache :: Cache -> String
show00IndexCache :: Cache -> [Char]
show00IndexCache Cache{[IndexCacheEntry]
Timestamp
cacheEntries :: [IndexCacheEntry]
cacheHeadTs :: Timestamp
cacheEntries :: Cache -> [IndexCacheEntry]
cacheHeadTs :: Cache -> Timestamp
..} = [[Char]] -> [Char]
unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map IndexCacheEntry -> [Char]
show00IndexCacheEntry [IndexCacheEntry]
cacheEntries
show00IndexCacheEntry :: IndexCacheEntry -> String
show00IndexCacheEntry :: IndexCacheEntry -> [Char]
show00IndexCacheEntry IndexCacheEntry
entry = [[Char]] -> [Char]
unwords forall a b. (a -> b) -> a -> b
$ case IndexCacheEntry
entry of
CachePackageId PackageId
pkgid BlockNo
b Timestamp
_ ->
[ [Char]
packageKey
, forall a. Pretty a => a -> [Char]
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pkgid)
, forall a. Pretty a => a -> [Char]
prettyShow (forall pkg. Package pkg => pkg -> Version
packageVersion PackageId
pkgid)
, [Char]
blocknoKey
, forall a. Show a => a -> [Char]
show BlockNo
b
]
CacheBuildTreeRef BuildTreeRefType
tr BlockNo
b ->
[ [Char]
buildTreeRefKey
, [BuildTreeRefType -> Char
typeCodeFromRefType BuildTreeRefType
tr]
, forall a. Show a => a -> [Char]
show BlockNo
b
]
CachePreference Dependency
dep BlockNo
_ Timestamp
_ ->
[ [Char]
preferredVersionKey
, forall a. Pretty a => a -> [Char]
prettyShow Dependency
dep
]