module Darcs.Repository.Cache
( cacheHash
, okayHash
, Cache
, mkCache
, cacheEntries
, CacheType(..)
, CacheLoc(..)
, WritableOrNot(..)
, HashedDir(..)
, hashedDir
, bucketFolder
, unionCaches
, unionRemoteCaches
, cleanCaches
, cleanCachesWithHint
, fetchFileUsingCache
, speculateFileUsingCache
, speculateFilesUsingCache
, writeFileUsingCache
, peekInCache
, repo2cache
, writable
, isThisRepo
, hashedFilePath
, allHashedDirs
, reportBadSources
, closestWritableDirectory
, dropNonRepos
) where
import Control.Concurrent.MVar ( MVar, newMVar, modifyMVar_, readMVar )
import Control.Monad ( liftM, when, unless, filterM, forM_, mplus )
import qualified Data.ByteString as B (length, ByteString )
import Data.List ( nub, intercalate, sortBy )
import Data.Maybe ( catMaybes, fromMaybe, listToMaybe )
import System.FilePath.Posix ( (</>), joinPath, dropFileName )
import System.Directory ( createDirectoryIfMissing, removeFile, doesFileExist,
doesDirectoryExist, getDirectoryContents,
getPermissions )
import qualified System.Directory as SD ( writable )
import System.IO ( hPutStrLn, stderr )
import System.IO.Unsafe (unsafePerformIO)
import System.Posix.Files ( createLink, linkCount, getSymbolicLinkStatus )
import Darcs.Prelude
import Darcs.Util.ByteString ( gzWriteFilePS )
import Darcs.Util.Global ( darcsdir, defaultRemoteDarcsCmd )
import Darcs.Util.External ( gzFetchFilePS, fetchFilePS
, speculateFileOrUrl, copyFileOrUrl
, Cachable( Cachable ) )
import Darcs.Repository.Flags ( Compression(..) )
import Darcs.Util.Lock ( writeAtomicFilePS, gzWriteAtomicFilePS,
withTemp )
import Darcs.Util.SignalHandler ( catchNonSignal )
import Darcs.Util.URL ( isValidLocalPath, isHttpUrl, isSshUrl )
import Darcs.Util.File ( withCurrentDirectory )
import Darcs.Util.Hash ( sha256sum )
import Darcs.Util.English ( englishNum, Noun(..), Pronoun(..) )
import Darcs.Util.Exception ( catchall )
import Darcs.Util.Progress ( progressList, debugMessage )
import qualified Darcs.Util.Download as Download ( ConnectionError )
data HashedDir = HashedPristineDir
| HashedPatchesDir
| HashedInventoriesDir
hashedDir :: HashedDir -> String
hashedDir :: HashedDir -> String
hashedDir HashedDir
HashedPristineDir = String
"pristine.hashed"
hashedDir HashedDir
HashedPatchesDir = String
"patches"
hashedDir HashedDir
HashedInventoriesDir = String
"inventories"
allHashedDirs :: [HashedDir]
allHashedDirs :: [HashedDir]
allHashedDirs = [ HashedDir
HashedPristineDir
, HashedDir
HashedPatchesDir
, HashedDir
HashedInventoriesDir
]
data WritableOrNot = Writable
| NotWritable
deriving ( WritableOrNot -> WritableOrNot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WritableOrNot -> WritableOrNot -> Bool
$c/= :: WritableOrNot -> WritableOrNot -> Bool
== :: WritableOrNot -> WritableOrNot -> Bool
$c== :: WritableOrNot -> WritableOrNot -> Bool
Eq, Int -> WritableOrNot -> ShowS
[WritableOrNot] -> ShowS
WritableOrNot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WritableOrNot] -> ShowS
$cshowList :: [WritableOrNot] -> ShowS
show :: WritableOrNot -> String
$cshow :: WritableOrNot -> String
showsPrec :: Int -> WritableOrNot -> ShowS
$cshowsPrec :: Int -> WritableOrNot -> ShowS
Show )
data CacheType = Repo
| Directory
deriving ( CacheType -> CacheType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CacheType -> CacheType -> Bool
$c/= :: CacheType -> CacheType -> Bool
== :: CacheType -> CacheType -> Bool
$c== :: CacheType -> CacheType -> Bool
Eq, Int -> CacheType -> ShowS
[CacheType] -> ShowS
CacheType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CacheType] -> ShowS
$cshowList :: [CacheType] -> ShowS
show :: CacheType -> String
$cshow :: CacheType -> String
showsPrec :: Int -> CacheType -> ShowS
$cshowsPrec :: Int -> CacheType -> ShowS
Show )
data CacheLoc = Cache
{ CacheLoc -> CacheType
cacheType :: !CacheType
, CacheLoc -> WritableOrNot
cacheWritable :: !WritableOrNot
, CacheLoc -> String
cacheSource :: !String
}
newtype Cache = Ca [CacheLoc]
mkCache :: [CacheLoc] -> Cache
mkCache :: [CacheLoc] -> Cache
mkCache = [CacheLoc] -> Cache
Ca forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy CacheLoc -> CacheLoc -> Ordering
compareByLocality forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub
cacheEntries :: Cache -> [CacheLoc]
cacheEntries :: Cache -> [CacheLoc]
cacheEntries (Ca [CacheLoc]
entries) = [CacheLoc]
entries
instance Eq CacheLoc where
(Cache CacheType
aTy WritableOrNot
_ String
aSrc) == :: CacheLoc -> CacheLoc -> Bool
== (Cache CacheType
bTy WritableOrNot
_ String
bSrc) = CacheType
aTy forall a. Eq a => a -> a -> Bool
== CacheType
bTy Bool -> Bool -> Bool
&& String
aSrc forall a. Eq a => a -> a -> Bool
== String
bSrc
instance Show CacheLoc where
show :: CacheLoc -> String
show (Cache CacheType
Repo WritableOrNot
Writable String
a) = String
"thisrepo:" forall a. [a] -> [a] -> [a]
++ String
a
show (Cache CacheType
Repo WritableOrNot
NotWritable String
a) = String
"repo:" forall a. [a] -> [a] -> [a]
++ String
a
show (Cache CacheType
Directory WritableOrNot
Writable String
a) = String
"cache:" forall a. [a] -> [a] -> [a]
++ String
a
show (Cache CacheType
Directory WritableOrNot
NotWritable String
a) = String
"readonly:" forall a. [a] -> [a] -> [a]
++ String
a
instance Show Cache where
show :: Cache -> String
show (Ca [CacheLoc]
cs) = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [CacheLoc]
cs
unionCaches :: Cache -> Cache -> Cache
unionCaches :: Cache -> Cache -> Cache
unionCaches (Ca [CacheLoc]
a) (Ca [CacheLoc]
b) = [CacheLoc] -> Cache
Ca (forall a. Eq a => [a] -> [a]
nub ([CacheLoc]
a forall a. [a] -> [a] -> [a]
++ [CacheLoc]
b))
unionRemoteCaches :: Cache -> Cache -> String -> IO Cache
unionRemoteCaches :: Cache -> Cache -> String -> IO Cache
unionRemoteCaches Cache
local (Ca [CacheLoc]
remote) String
repourl
| String -> Bool
isValidLocalPath String
repourl = do
[CacheLoc]
f <- IO [CacheLoc]
filtered
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Cache
local Cache -> Cache -> Cache
`unionCaches` [CacheLoc] -> Cache
Ca [CacheLoc]
f
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return Cache
local
where
filtered :: IO [CacheLoc]
filtered = forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\CacheLoc
x -> CacheLoc -> IO (Maybe CacheLoc)
mbGetRemoteCacheLoc CacheLoc
x forall a. IO a -> IO a -> IO a
`catchall` forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) [CacheLoc]
remote
mbGetRemoteCacheLoc :: CacheLoc -> IO (Maybe CacheLoc)
mbGetRemoteCacheLoc :: CacheLoc -> IO (Maybe CacheLoc)
mbGetRemoteCacheLoc (Cache CacheType
Repo WritableOrNot
Writable String
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
mbGetRemoteCacheLoc c :: CacheLoc
c@(Cache CacheType
t WritableOrNot
_ String
url)
| String -> Bool
isValidLocalPath String
url = do
Bool
ex <- String -> IO Bool
doesDirectoryExist String
url
if Bool
ex
then do
Permissions
p <- String -> IO Permissions
getPermissions String
url
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
$ if CacheLoc -> Bool
writable CacheLoc
c Bool -> Bool -> Bool
&& Permissions -> Bool
SD.writable Permissions
p
then CacheLoc
c
else CacheType -> WritableOrNot -> String -> CacheLoc
Cache CacheType
t WritableOrNot
NotWritable String
url
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just CacheLoc
c
compareByLocality :: CacheLoc -> CacheLoc -> Ordering
compareByLocality :: CacheLoc -> CacheLoc -> Ordering
compareByLocality (Cache CacheType
_ WritableOrNot
w String
x) (Cache CacheType
_ WritableOrNot
z String
y)
| String -> Bool
isValidLocalPath String
x Bool -> Bool -> Bool
&& String -> Bool
isRemote String
y = Ordering
LT
| String -> Bool
isRemote String
x Bool -> Bool -> Bool
&& String -> Bool
isValidLocalPath String
y = Ordering
GT
| String -> Bool
isHttpUrl String
x Bool -> Bool -> Bool
&& String -> Bool
isSshUrl String
y = Ordering
LT
| String -> Bool
isSshUrl String
x Bool -> Bool -> Bool
&& String -> Bool
isHttpUrl String
y = Ordering
GT
| String -> Bool
isValidLocalPath String
x Bool -> Bool -> Bool
&& WritableOrNot -> Bool
isWritable WritableOrNot
w
Bool -> Bool -> Bool
&& String -> Bool
isValidLocalPath String
y Bool -> Bool -> Bool
&& WritableOrNot -> Bool
isNotWritable WritableOrNot
z = Ordering
LT
| Bool
otherwise = Ordering
EQ
where
isRemote :: String -> Bool
isRemote String
r = String -> Bool
isHttpUrl String
r Bool -> Bool -> Bool
|| String -> Bool
isSshUrl String
r
isWritable :: WritableOrNot -> Bool
isWritable = forall a. Eq a => a -> a -> Bool
(==) WritableOrNot
Writable
isNotWritable :: WritableOrNot -> Bool
isNotWritable = forall a. Eq a => a -> a -> Bool
(==) WritableOrNot
NotWritable
repo2cache :: String -> Cache
repo2cache :: String -> Cache
repo2cache String
r = [CacheLoc] -> Cache
Ca [CacheType -> WritableOrNot -> String -> CacheLoc
Cache CacheType
Repo WritableOrNot
NotWritable String
r]
cacheHash :: B.ByteString -> String
cacheHash :: ByteString -> String
cacheHash ByteString
ps = if Int
sizeStrLen forall a. Ord a => a -> a -> Bool
> Int
10
then String
shaOfPs
else forall a. Int -> a -> [a]
replicate (Int
10 forall a. Num a => a -> a -> a
- Int
sizeStrLen) Char
'0' forall a. [a] -> [a] -> [a]
++ String
sizeStr
forall a. [a] -> [a] -> [a]
++ Char
'-' forall a. a -> [a] -> [a]
: String
shaOfPs
where
sizeStr :: String
sizeStr = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
ps
sizeStrLen :: Int
sizeStrLen = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sizeStr
shaOfPs :: String
shaOfPs = ByteString -> String
sha256sum ByteString
ps
okayHash :: String -> Bool
okayHash :: String -> Bool
okayHash String
s = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
64, Int
75]
checkHash :: String -> B.ByteString -> Bool
checkHash :: String -> ByteString -> Bool
checkHash String
h ByteString
s
| forall (t :: * -> *) a. Foldable t => t a -> Int
length String
h forall a. Eq a => a -> a -> Bool
== Int
64 = ByteString -> String
sha256sum ByteString
s forall a. Eq a => a -> a -> Bool
== String
h
| forall (t :: * -> *) a. Foldable t => t a -> Int
length String
h forall a. Eq a => a -> a -> Bool
== Int
75 =
ByteString -> Int
B.length ByteString
s forall a. Eq a => a -> a -> Bool
== forall a. Read a => String -> a
read (forall a. Int -> [a] -> [a]
take Int
10 String
h) Bool -> Bool -> Bool
&& ByteString -> String
sha256sum ByteString
s forall a. Eq a => a -> a -> Bool
== forall a. Int -> [a] -> [a]
drop Int
11 String
h
| Bool
otherwise = Bool
False
fetchFileUsingCache :: Cache -> HashedDir -> String
-> IO (String, B.ByteString)
fetchFileUsingCache :: Cache -> HashedDir -> String -> IO (String, ByteString)
fetchFileUsingCache = FromWhere
-> Cache -> HashedDir -> String -> IO (String, ByteString)
fetchFileUsingCachePrivate FromWhere
Anywhere
writable :: CacheLoc -> Bool
writable :: CacheLoc -> Bool
writable (Cache CacheType
_ WritableOrNot
NotWritable String
_) = Bool
False
writable (Cache CacheType
_ WritableOrNot
Writable String
_) = Bool
True
dropNonRepos :: Cache -> Cache
dropNonRepos :: Cache -> Cache
dropNonRepos (Ca [CacheLoc]
cache) = [CacheLoc] -> Cache
Ca forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter CacheLoc -> Bool
notRepo [CacheLoc]
cache where
notRepo :: CacheLoc -> Bool
notRepo CacheLoc
xs = case CacheLoc
xs of
Cache CacheType
Directory WritableOrNot
_ String
_ -> Bool
False
Cache CacheType
Repo WritableOrNot
Writable String
_ -> Bool
False
CacheLoc
_ -> Bool
True
closestWritableDirectory :: Cache -> Maybe String
closestWritableDirectory :: Cache -> Maybe String
closestWritableDirectory (Ca [CacheLoc]
cs) =
forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [CacheLoc]
cs forall a b. (a -> b) -> a -> b
$ \case
Cache CacheType
Directory WritableOrNot
Writable String
x -> forall a. a -> Maybe a
Just String
x
CacheLoc
_ -> forall a. Maybe a
Nothing
isThisRepo :: CacheLoc -> Bool
isThisRepo :: CacheLoc -> Bool
isThisRepo (Cache CacheType
Repo WritableOrNot
Writable String
_) = Bool
True
isThisRepo CacheLoc
_ = Bool
False
bucketFolder :: String -> String
bucketFolder :: ShowS
bucketFolder String
f = forall a. Int -> [a] -> [a]
take Int
2 (ShowS
cleanHash String
f)
where
cleanHash :: ShowS
cleanHash String
fileName = case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'-') String
fileName of
[] -> String
fileName
String
s -> forall a. Int -> [a] -> [a]
drop Int
1 String
s
hashedFilePath :: CacheLoc -> HashedDir -> String -> String
hashedFilePath :: CacheLoc -> HashedDir -> ShowS
hashedFilePath (Cache CacheType
Directory WritableOrNot
_ String
d) HashedDir
s String
f =
[String] -> String
joinPath [String
d, HashedDir -> String
hashedDir HashedDir
s, ShowS
bucketFolder String
f, String
f]
hashedFilePath (Cache CacheType
Repo WritableOrNot
_ String
r) HashedDir
s String
f =
[String] -> String
joinPath [String
r, String
darcsdir, HashedDir -> String
hashedDir HashedDir
s, String
f]
hashedFilePathReadOnly :: CacheLoc -> HashedDir -> String -> String
hashedFilePathReadOnly :: CacheLoc -> HashedDir -> ShowS
hashedFilePathReadOnly (Cache CacheType
Directory WritableOrNot
_ String
d) HashedDir
s String
f =
String
d String -> ShowS
</> HashedDir -> String
hashedDir HashedDir
s String -> ShowS
</> String
f
hashedFilePathReadOnly (Cache CacheType
Repo WritableOrNot
_ String
r) HashedDir
s String
f =
String
r String -> ShowS
</> String
darcsdir String -> ShowS
</> HashedDir -> String
hashedDir HashedDir
s String -> ShowS
</> String
f
peekInCache :: Cache -> HashedDir -> String -> IO Bool
peekInCache :: Cache -> HashedDir -> String -> IO Bool
peekInCache (Ca [CacheLoc]
cache) HashedDir
subdir String
f = [CacheLoc] -> IO Bool
cacheHasIt [CacheLoc]
cache forall a. IO a -> IO a -> IO a
`catchall` forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
where
cacheHasIt :: [CacheLoc] -> IO Bool
cacheHasIt [] = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
cacheHasIt (CacheLoc
c : [CacheLoc]
cs)
| Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ CacheLoc -> Bool
writable CacheLoc
c = [CacheLoc] -> IO Bool
cacheHasIt [CacheLoc]
cs
| Bool
otherwise = do
Bool
ex <- String -> IO Bool
doesFileExist forall a b. (a -> b) -> a -> b
$ CacheLoc -> HashedDir -> ShowS
hashedFilePath CacheLoc
c HashedDir
subdir String
f
if Bool
ex then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else [CacheLoc] -> IO Bool
cacheHasIt [CacheLoc]
cs
speculateFileUsingCache :: Cache -> HashedDir -> String -> IO ()
speculateFileUsingCache :: Cache -> HashedDir -> String -> IO ()
speculateFileUsingCache Cache
c HashedDir
sd String
h = do
String -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ String
"Speculating on " forall a. [a] -> [a] -> [a]
++ String
h
OrOnlySpeculate -> Cache -> HashedDir -> String -> IO ()
copyFileUsingCache OrOnlySpeculate
OnlySpeculate Cache
c HashedDir
sd String
h
speculateFilesUsingCache :: Cache -> HashedDir -> [String] -> IO ()
speculateFilesUsingCache :: Cache -> HashedDir -> [String] -> IO ()
speculateFilesUsingCache Cache
_ HashedDir
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
speculateFilesUsingCache Cache
cache HashedDir
sd [String]
hs = do
String -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ String
"Thinking about speculating on " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
hs
[String]
hs' <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cache -> HashedDir -> String -> IO Bool
peekInCache Cache
cache HashedDir
sd) [String]
hs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
hs') forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ String
"Speculating on " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
hs'
OrOnlySpeculate -> Cache -> HashedDir -> [String] -> IO ()
copyFilesUsingCache OrOnlySpeculate
OnlySpeculate Cache
cache HashedDir
sd [String]
hs'
data OrOnlySpeculate = ActuallyCopy
| OnlySpeculate
deriving ( OrOnlySpeculate -> OrOnlySpeculate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrOnlySpeculate -> OrOnlySpeculate -> Bool
$c/= :: OrOnlySpeculate -> OrOnlySpeculate -> Bool
== :: OrOnlySpeculate -> OrOnlySpeculate -> Bool
$c== :: OrOnlySpeculate -> OrOnlySpeculate -> Bool
Eq )
copyFileUsingCache :: OrOnlySpeculate -> Cache -> HashedDir -> String -> IO ()
copyFileUsingCache :: OrOnlySpeculate -> Cache -> HashedDir -> String -> IO ()
copyFileUsingCache OrOnlySpeculate
oos (Ca [CacheLoc]
cache) HashedDir
subdir String
f = do
String -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$
String
"I'm doing copyFileUsingCache on " forall a. [a] -> [a] -> [a]
++ HashedDir -> String
hashedDir HashedDir
subdir String -> ShowS
</> String
f
Just String
stickItHere <- [CacheLoc] -> IO (Maybe String)
cacheLoc [CacheLoc]
cache
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True
(forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'/') forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse String
stickItHere)
String -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ String
"Will effectively do copyFileUsingCache to: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
stickItHere
[CacheLoc] -> IO [CacheLoc]
filterBadSources [CacheLoc]
cache forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> [CacheLoc] -> IO ()
sfuc String
stickItHere
forall a. IO a -> IO a -> IO a
`catchall`
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
cacheLoc :: [CacheLoc] -> IO (Maybe String)
cacheLoc [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
cacheLoc (CacheLoc
c : [CacheLoc]
cs)
| Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ CacheLoc -> Bool
writable CacheLoc
c = [CacheLoc] -> IO (Maybe String)
cacheLoc [CacheLoc]
cs
| Bool
otherwise = do
let attemptPath :: String
attemptPath = CacheLoc -> HashedDir -> ShowS
hashedFilePath CacheLoc
c HashedDir
subdir String
f
Bool
ex <- String -> IO Bool
doesFileExist String
attemptPath
if Bool
ex
then forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"File already present in writable location."
else do
Maybe String
othercache <- [CacheLoc] -> IO (Maybe String)
cacheLoc [CacheLoc]
cs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe String
othercache forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall a. a -> Maybe a
Just String
attemptPath
sfuc :: String -> [CacheLoc] -> IO ()
sfuc String
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
sfuc String
out (CacheLoc
c : [CacheLoc]
cs)
| Bool -> Bool
not (CacheLoc -> Bool
writable CacheLoc
c) =
let cacheFile :: String
cacheFile = CacheLoc -> HashedDir -> ShowS
hashedFilePathReadOnly CacheLoc
c HashedDir
subdir String
f in
if OrOnlySpeculate
oos forall a. Eq a => a -> a -> Bool
== OrOnlySpeculate
OnlySpeculate
then String -> String -> IO ()
speculateFileOrUrl String
cacheFile String
out
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchNonSignal`
\SomeException
e -> String -> CacheLoc -> IO ()
checkCacheReachability (forall a. Show a => a -> String
show SomeException
e) CacheLoc
c
else do String -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ String
"Copying from " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
cacheFile forall a. [a] -> [a] -> [a]
++ String
" to " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
out
String -> String -> String -> Cachable -> IO ()
copyFileOrUrl String
defaultRemoteDarcsCmd String
cacheFile String
out Cachable
Cachable
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchNonSignal`
(\SomeException
e -> do String -> CacheLoc -> IO ()
checkCacheReachability (forall a. Show a => a -> String
show SomeException
e) CacheLoc
c
String -> [CacheLoc] -> IO ()
sfuc String
out [CacheLoc]
cs)
| Bool
otherwise = String -> [CacheLoc] -> IO ()
sfuc String
out [CacheLoc]
cs
copyFilesUsingCache :: OrOnlySpeculate -> Cache -> HashedDir -> [String]
-> IO ()
copyFilesUsingCache :: OrOnlySpeculate -> Cache -> HashedDir -> [String] -> IO ()
copyFilesUsingCache OrOnlySpeculate
oos Cache
cache HashedDir
subdir [String]
hs =
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
hs forall a b. (a -> b) -> a -> b
$ OrOnlySpeculate -> Cache -> HashedDir -> String -> IO ()
copyFileUsingCache OrOnlySpeculate
oos Cache
cache HashedDir
subdir
data FromWhere = LocalOnly
| Anywhere
deriving ( FromWhere -> FromWhere -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FromWhere -> FromWhere -> Bool
$c/= :: FromWhere -> FromWhere -> Bool
== :: FromWhere -> FromWhere -> Bool
$c== :: FromWhere -> FromWhere -> Bool
Eq )
checkCacheReachability :: String -> CacheLoc -> IO ()
checkCacheReachability :: String -> CacheLoc -> IO ()
checkCacheReachability String
e CacheLoc
cache
| String -> Bool
isValidLocalPath String
source = IO () -> IO ()
doUnreachableCheck forall a b. (a -> b) -> a -> b
$
IO Bool -> IO ()
checkFileReachability (String -> IO Bool
doesDirectoryExist String
source)
| String -> Bool
isHttpUrl String
source =
IO () -> IO ()
doUnreachableCheck forall a b. (a -> b) -> a -> b
$ do
let err :: String
err = case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'(') String
e of
(Char
_ : String
xs) -> forall a b. (a, b) -> a
fst (forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
==Char
')') String
xs)
String
_ -> String
e
case forall a. Read a => ReadS a
reads String
err :: [(Download.ConnectionError, String)] of
[(ConnectionError
_, String
_)] -> String -> IO ()
addBadSource String
source
[(ConnectionError, String)]
_ -> IO Bool -> IO ()
checkFileReachability
(CacheLoc -> IO Bool
checkHashedInventoryReachability CacheLoc
cache)
| String -> Bool
isSshUrl String
source = IO () -> IO ()
doUnreachableCheck forall a b. (a -> b) -> a -> b
$
IO Bool -> IO ()
checkFileReachability (CacheLoc -> IO Bool
checkHashedInventoryReachability CacheLoc
cache)
| Bool
otherwise = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"unknown transport protocol for: " forall a. [a] -> [a] -> [a]
++ String
source
where
source :: String
source = CacheLoc -> String
cacheSource CacheLoc
cache
doUnreachableCheck :: IO () -> IO ()
doUnreachableCheck IO ()
unreachableAction = do
String -> Bool
reachable <- IO (String -> Bool)
isReachableSource
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
reachable String
source) IO ()
unreachableAction
checkFileReachability :: IO Bool -> IO ()
checkFileReachability IO Bool
doCheck = do
Bool
reachable <- IO Bool
doCheck
if Bool
reachable
then String -> IO ()
addReachableSource String
source
else String -> IO ()
addBadSource String
source
filterBadSources :: [CacheLoc] -> IO [CacheLoc]
filterBadSources :: [CacheLoc] -> IO [CacheLoc]
filterBadSources [CacheLoc]
cache = do
String -> Bool
badSource <- IO (String -> Bool)
isBadSource
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
badSource forall b c a. (b -> c) -> (a -> b) -> a -> c
. CacheLoc -> String
cacheSource) [CacheLoc]
cache
checkHashedInventoryReachability :: CacheLoc -> IO Bool
checkHashedInventoryReachability :: CacheLoc -> IO Bool
checkHashedInventoryReachability CacheLoc
cache = forall a. (String -> IO a) -> IO a
withTemp forall a b. (a -> b) -> a -> b
$ \String
tempout -> do
let f :: String
f = CacheLoc -> String
cacheSource CacheLoc
cache String -> ShowS
</> String
darcsdir String -> ShowS
</> String
"hashed_inventory"
String -> String -> String -> Cachable -> IO ()
copyFileOrUrl String
defaultRemoteDarcsCmd String
f String
tempout Cachable
Cachable
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchNonSignal` forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
fetchFileUsingCachePrivate :: FromWhere -> Cache -> HashedDir -> String
-> IO (String, B.ByteString)
fetchFileUsingCachePrivate :: FromWhere
-> Cache -> HashedDir -> String -> IO (String, ByteString)
fetchFileUsingCachePrivate FromWhere
fromWhere (Ca [CacheLoc]
cache) HashedDir
subdir String
f = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FromWhere
fromWhere forall a. Eq a => a -> a -> Bool
== FromWhere
Anywhere) forall a b. (a -> b) -> a -> b
$
OrOnlySpeculate -> Cache -> HashedDir -> String -> IO ()
copyFileUsingCache OrOnlySpeculate
ActuallyCopy ([CacheLoc] -> Cache
Ca [CacheLoc]
cache) HashedDir
subdir String
f
[CacheLoc] -> IO [CacheLoc]
filterBadSources [CacheLoc]
cache forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [CacheLoc] -> IO (String, ByteString)
ffuc
forall a. IO a -> IO a -> IO a
`catchall` forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Couldn't fetch " forall a. [a] -> [a] -> [a]
++ String
f forall a. [a] -> [a] -> [a]
++ String
"\nin subdir "
forall a. [a] -> [a] -> [a]
++ HashedDir -> String
hashedDir HashedDir
subdir forall a. [a] -> [a] -> [a]
++ String
" from sources:\n\n"
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ([CacheLoc] -> Cache
Ca [CacheLoc]
cache))
where
ffuc :: [CacheLoc] -> IO (String, ByteString)
ffuc (CacheLoc
c : [CacheLoc]
cs)
| Bool -> Bool
not (CacheLoc -> Bool
writable CacheLoc
c) Bool -> Bool -> Bool
&&
(FromWhere
Anywhere forall a. Eq a => a -> a -> Bool
== FromWhere
fromWhere Bool -> Bool -> Bool
|| String -> Bool
isValidLocalPath (CacheLoc -> HashedDir -> ShowS
hashedFilePathReadOnly CacheLoc
c HashedDir
subdir String
f)) = do
let cacheFile :: String
cacheFile = CacheLoc -> HashedDir -> ShowS
hashedFilePathReadOnly CacheLoc
c HashedDir
subdir String
f
String -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ String
"In fetchFileUsingCachePrivate I'm directly grabbing file contents from "
forall a. [a] -> [a] -> [a]
++ String
cacheFile
ByteString
x <- String -> Cachable -> IO ByteString
gzFetchFilePS String
cacheFile Cachable
Cachable
if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ String -> ByteString -> Bool
checkHash String
f ByteString
x
then do
ByteString
x' <- String -> Cachable -> IO ByteString
fetchFilePS String
cacheFile Cachable
Cachable
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> ByteString -> Bool
checkHash String
f ByteString
x') forall a b. (a -> b) -> a -> b
$ do
Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"Hash failure in " forall a. [a] -> [a] -> [a]
++ String
cacheFile
forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Hash failure in " forall a. [a] -> [a] -> [a]
++ String
cacheFile
forall (m :: * -> *) a. Monad m => a -> m a
return (String
cacheFile, ByteString
x')
else forall (m :: * -> *) a. Monad m => a -> m a
return (String
cacheFile, ByteString
x)
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchNonSignal` \SomeException
e -> do
String -> CacheLoc -> IO ()
checkCacheReachability (forall a. Show a => a -> String
show SomeException
e) CacheLoc
c
[CacheLoc] -> IO [CacheLoc]
filterBadSources [CacheLoc]
cs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [CacheLoc] -> IO (String, ByteString)
ffuc
| CacheLoc -> Bool
writable CacheLoc
c = let cacheFile :: String
cacheFile = CacheLoc -> HashedDir -> ShowS
hashedFilePath CacheLoc
c HashedDir
subdir String
f in do
String -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ String
"About to gzFetchFilePS from " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
cacheFile
ByteString
x1 <- String -> Cachable -> IO ByteString
gzFetchFilePS String
cacheFile Cachable
Cachable
String -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ String
"gzFetchFilePS done."
ByteString
x <- if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ String -> ByteString -> Bool
checkHash String
f ByteString
x1
then do
ByteString
x2 <- String -> Cachable -> IO ByteString
fetchFilePS String
cacheFile Cachable
Cachable
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> ByteString -> Bool
checkHash String
f ByteString
x2) forall a b. (a -> b) -> a -> b
$ do
Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"Hash failure in " forall a. [a] -> [a] -> [a]
++ String
cacheFile
String -> IO ()
removeFile String
cacheFile
forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Hash failure in " forall a. [a] -> [a] -> [a]
++ String
cacheFile
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
x2
else forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
x1
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> CacheLoc -> IO ()
tryLinking String
cacheFile) [CacheLoc]
cs
forall (m :: * -> *) a. Monad m => a -> m a
return (String
cacheFile, ByteString
x)
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchNonSignal` \SomeException
e -> do
String -> IO ()
debugMessage String
"Caught exception, now attempt creating cache."
CacheLoc -> HashedDir -> IO ()
createCache CacheLoc
c HashedDir
subdir forall a. IO a -> IO a -> IO a
`catchall` forall (m :: * -> *) a. Monad m => a -> m a
return ()
String -> CacheLoc -> IO ()
checkCacheReachability (forall a. Show a => a -> String
show SomeException
e) CacheLoc
c
(String
fname, ByteString
x) <- [CacheLoc] -> IO [CacheLoc]
filterBadSources [CacheLoc]
cs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [CacheLoc] -> IO (String, ByteString)
ffuc
String -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ String
"Attempt creating link from: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
fname forall a. [a] -> [a] -> [a]
++ String
" to " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
cacheFile
(String -> String -> IO ()
createLink String
fname String
cacheFile forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String -> IO ()
debugMessage String
"successfully created link")
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (String
cacheFile, ByteString
x))
forall a. IO a -> IO a -> IO a
`catchall` do
String -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ String
"Attempt writing file: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
cacheFile
do Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (ShowS
dropFileName String
cacheFile)
String -> ByteString -> IO ()
gzWriteFilePS String
cacheFile ByteString
x
String -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ String
"successfully wrote file"
forall a. IO a -> IO a -> IO a
`catchall` forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall (m :: * -> *) a. Monad m => a -> m a
return (String
fname, ByteString
x)
| Bool
otherwise = [CacheLoc] -> IO (String, ByteString)
ffuc [CacheLoc]
cs
ffuc [] = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"No sources from which to fetch file " forall a. [a] -> [a] -> [a]
++ String
f
forall a. [a] -> [a] -> [a]
++ String
"\n"forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ([CacheLoc] -> Cache
Ca [CacheLoc]
cache)
tryLinking :: String -> CacheLoc -> IO ()
tryLinking String
ff c :: CacheLoc
c@(Cache CacheType
Directory WritableOrNot
Writable String
d) = do
Bool -> String -> IO ()
createDirectoryIfMissing Bool
False (String
d String -> ShowS
</> HashedDir -> String
hashedDir HashedDir
subdir)
String -> String -> IO ()
createLink String
ff (CacheLoc -> HashedDir -> ShowS
hashedFilePath CacheLoc
c HashedDir
subdir String
f)
forall a. IO a -> IO a -> IO a
`catchall`
forall (m :: * -> *) a. Monad m => a -> m a
return ()
tryLinking String
_ CacheLoc
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
createCache :: CacheLoc -> HashedDir -> IO ()
createCache :: CacheLoc -> HashedDir -> IO ()
createCache (Cache CacheType
Directory WritableOrNot
_ String
d) HashedDir
subdir =
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String
d String -> ShowS
</> HashedDir -> String
hashedDir HashedDir
subdir)
createCache CacheLoc
_ HashedDir
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
write :: Compression -> String -> B.ByteString -> IO ()
write :: Compression -> String -> ByteString -> IO ()
write Compression
NoCompression = forall p. FilePathLike p => p -> ByteString -> IO ()
writeAtomicFilePS
write Compression
GzipCompression = forall p. FilePathLike p => p -> ByteString -> IO ()
gzWriteAtomicFilePS
writeFileUsingCache :: Cache -> Compression -> HashedDir -> B.ByteString
-> IO String
writeFileUsingCache :: Cache -> Compression -> HashedDir -> ByteString -> IO String
writeFileUsingCache (Ca [CacheLoc]
cache) Compression
compr HashedDir
subdir ByteString
ps = do
(String, ByteString)
_ <- FromWhere
-> Cache -> HashedDir -> String -> IO (String, ByteString)
fetchFileUsingCachePrivate FromWhere
LocalOnly ([CacheLoc] -> Cache
Ca [CacheLoc]
cache) HashedDir
subdir String
hash
forall (m :: * -> *) a. Monad m => a -> m a
return String
hash
forall a. IO a -> IO a -> IO a
`catchall`
[CacheLoc] -> IO String
wfuc [CacheLoc]
cache
forall a. IO a -> IO a -> IO a
`catchall`
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Couldn't write " forall a. [a] -> [a] -> [a]
++ String
hash forall a. [a] -> [a] -> [a]
++ String
"\nin subdir "
forall a. [a] -> [a] -> [a]
++ HashedDir -> String
hashedDir HashedDir
subdir forall a. [a] -> [a] -> [a]
++ String
" to sources:\n\n"forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ([CacheLoc] -> Cache
Ca [CacheLoc]
cache))
where
hash :: String
hash = ByteString -> String
cacheHash ByteString
ps
wfuc :: [CacheLoc] -> IO String
wfuc (CacheLoc
c : [CacheLoc]
cs)
| Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ CacheLoc -> Bool
writable CacheLoc
c = [CacheLoc] -> IO String
wfuc [CacheLoc]
cs
| Bool
otherwise = do
CacheLoc -> HashedDir -> IO ()
createCache CacheLoc
c HashedDir
subdir
Compression -> String -> ByteString -> IO ()
write Compression
compr (CacheLoc -> HashedDir -> ShowS
hashedFilePath CacheLoc
c HashedDir
subdir String
hash) ByteString
ps
forall (m :: * -> *) a. Monad m => a -> m a
return String
hash
wfuc [] = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"No location to write file " forall a. [a] -> [a] -> [a]
++ (HashedDir -> String
hashedDir HashedDir
subdir String -> ShowS
</> String
hash)
cleanCaches :: Cache -> HashedDir -> IO ()
cleanCaches :: Cache -> HashedDir -> IO ()
cleanCaches Cache
c HashedDir
d = Cache -> HashedDir -> Maybe [String] -> IO ()
cleanCachesWithHint' Cache
c HashedDir
d forall a. Maybe a
Nothing
cleanCachesWithHint :: Cache -> HashedDir -> [String] -> IO ()
cleanCachesWithHint :: Cache -> HashedDir -> [String] -> IO ()
cleanCachesWithHint Cache
c HashedDir
d [String]
h = Cache -> HashedDir -> Maybe [String] -> IO ()
cleanCachesWithHint' Cache
c HashedDir
d (forall a. a -> Maybe a
Just [String]
h)
cleanCachesWithHint' :: Cache -> HashedDir -> Maybe [String] -> IO ()
cleanCachesWithHint' :: Cache -> HashedDir -> Maybe [String] -> IO ()
cleanCachesWithHint' (Ca [CacheLoc]
cs) HashedDir
subdir Maybe [String]
hint = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CacheLoc -> IO ()
cleanCache [CacheLoc]
cs
where
cleanCache :: CacheLoc -> IO ()
cleanCache (Cache CacheType
Directory WritableOrNot
Writable String
d) =
forall p a. FilePathLike p => p -> IO a -> IO a
withCurrentDirectory (String
d String -> ShowS
</> HashedDir -> String
hashedDir HashedDir
subdir) (do
[String]
fs' <- String -> IO [String]
getDirectoryContents String
"."
let fs :: [String]
fs = forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
okayHash forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [String]
fs' Maybe [String]
hint
cleanMsg :: String
cleanMsg = String
"Cleaning cache " forall a. [a] -> [a] -> [a]
++ String
d String -> ShowS
</> HashedDir -> String
hashedDir HashedDir
subdir
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
clean forall a b. (a -> b) -> a -> b
$ forall a. String -> [a] -> [a]
progressList String
cleanMsg [String]
fs)
forall a. IO a -> IO a -> IO a
`catchall`
forall (m :: * -> *) a. Monad m => a -> m a
return ()
cleanCache CacheLoc
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
clean :: String -> IO ()
clean String
f = do
LinkCount
lc <- FileStatus -> LinkCount
linkCount forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` String -> IO FileStatus
getSymbolicLinkStatus String
f
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LinkCount
lc forall a. Ord a => a -> a -> Bool
< LinkCount
2) forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeFile String
f
forall a. IO a -> IO a -> IO a
`catchall`
forall (m :: * -> *) a. Monad m => a -> m a
return ()
reportBadSources :: IO ()
reportBadSources :: IO ()
reportBadSources = do
[String]
sources <- IO [String]
getBadSourcesList
let size :: Int
size = forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
sources
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
sources) forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"\nBy the way, I could not reach the following "
, forall n. Countable n => Int -> n -> ShowS
englishNum Int
size (String -> Noun
Noun String
"location") String
":"
, String
"\n"
, forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" (forall a b. (a -> b) -> [a] -> [b]
map (String
" " forall a. [a] -> [a] -> [a]
++) [String]
sources)
, String
"\nUnless you plan to restore access to "
, forall n. Countable n => Int -> n -> ShowS
englishNum Int
size Pronoun
It String
", you should delete "
, String
"the corresponding "
, forall n. Countable n => Int -> n -> ShowS
englishNum Int
size (String -> Noun
Noun String
"entry") String
" from _darcs/prefs/sources."
]
badSourcesList :: MVar [String]
badSourcesList :: MVar [String]
badSourcesList = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar []
{-# NOINLINE badSourcesList #-}
addBadSource :: String -> IO ()
addBadSource :: String -> IO ()
addBadSource String
cache = forall a. MVar a -> (a -> a) -> IO ()
modifyMVarPure MVar [String]
badSourcesList (String
cacheforall a. a -> [a] -> [a]
:)
getBadSourcesList :: IO [String]
getBadSourcesList :: IO [String]
getBadSourcesList = forall a. MVar a -> IO a
readMVar MVar [String]
badSourcesList
isBadSource :: IO (String -> Bool)
isBadSource :: IO (String -> Bool)
isBadSource = do
[String]
badSources <- IO [String]
getBadSourcesList
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
badSources)
reachableSourcesList :: MVar [String]
reachableSourcesList :: MVar [String]
reachableSourcesList = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar []
{-# NOINLINE reachableSourcesList #-}
addReachableSource :: String -> IO ()
addReachableSource :: String -> IO ()
addReachableSource String
src = forall a. MVar a -> (a -> a) -> IO ()
modifyMVarPure MVar [String]
reachableSourcesList (String
srcforall a. a -> [a] -> [a]
:)
getReachableSources :: IO [String]
getReachableSources :: IO [String]
getReachableSources = forall a. MVar a -> IO a
readMVar MVar [String]
reachableSourcesList
isReachableSource :: IO (String -> Bool)
isReachableSource :: IO (String -> Bool)
isReachableSource = do
[String]
reachableSources <- IO [String]
getReachableSources
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
reachableSources)
modifyMVarPure :: MVar a -> (a -> a) -> IO ()
modifyMVarPure :: forall a. MVar a -> (a -> a) -> IO ()
modifyMVarPure MVar a
mvar a -> a
f = forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar a
mvar (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f)