summaryrefslogtreecommitdiff
path: root/Annex
diff options
context:
space:
mode:
Diffstat (limited to 'Annex')
-rw-r--r--Annex/Content.hs6
-rw-r--r--Annex/Content/Direct.hs2
-rw-r--r--Annex/Direct.hs21
-rw-r--r--Annex/Direct/Fixup.hs5
-rw-r--r--Annex/Perms.hs10
-rw-r--r--Annex/ReplaceFile.hs2
-rw-r--r--Annex/Ssh.hs2
7 files changed, 23 insertions, 25 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index 2d52dcefb..37090d3bb 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -261,7 +261,7 @@ finishGetViaTmp check key action = do
prepTmp :: Key -> Annex FilePath
prepTmp key = do
tmp <- fromRepo $ gitAnnexTmpObjectLocation key
- createAnnexDirectory (takeDirectory tmp)
+ createAnnexDirectory (parentDir tmp)
return tmp
{- Creates a temp file for a key, runs an action on it, and cleans up
@@ -425,7 +425,7 @@ cleanObjectLoc key cleaner = do
where
removeparents _ 0 = noop
removeparents file n = do
- let dir = takeDirectory file
+ let dir = parentDir file
maybe noop (const $ removeparents dir (n-1))
<=< catchMaybeIO $ removeDirectory dir
@@ -474,7 +474,7 @@ moveBad key = do
src <- calcRepo $ gitAnnexLocation key
bad <- fromRepo gitAnnexBadDir
let dest = bad </> takeFileName src
- createAnnexDirectory (takeDirectory dest)
+ createAnnexDirectory (parentDir dest)
cleanObjectLoc key $
liftIO $ moveFile src dest
logStatus key InfoMissing
diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs
index 43defdca3..c09a08f0d 100644
--- a/Annex/Content/Direct.hs
+++ b/Annex/Content/Direct.hs
@@ -247,7 +247,7 @@ sentinalStatus = maybe check return =<< Annex.getState Annex.sentinalstatus
createInodeSentinalFile :: Annex ()
createInodeSentinalFile = unlessM (alreadyexists <||> hasobjects) $ do
s <- annexSentinalFile
- createAnnexDirectory (takeDirectory (sentinalFile s))
+ createAnnexDirectory (parentDir (sentinalFile s))
liftIO $ writeSentinalFile s
where
alreadyexists = liftIO. sentinalFileExists =<< annexSentinalFile
diff --git a/Annex/Direct.hs b/Annex/Direct.hs
index 710227e7e..15eb04060 100644
--- a/Annex/Direct.hs
+++ b/Annex/Direct.hs
@@ -270,7 +270,7 @@ updateWorkTree d oldref = do
- Empty work tree directories are removed, per git behavior. -}
moveout_raw _ _ f = liftIO $ do
nukeFile f
- void $ tryIO $ removeDirectory $ takeDirectory f
+ void $ tryIO $ removeDirectory $ parentDir f
{- If the file is already present, with the right content for the
- key, it's left alone.
@@ -291,7 +291,7 @@ updateWorkTree d oldref = do
movein_raw item makeabs f = do
preserveUnannexed item makeabs f oldref
liftIO $ do
- createDirectoryIfMissing True $ takeDirectory f
+ createDirectoryIfMissing True $ parentDir f
void $ tryIO $ rename (d </> getTopFilePath (DiffTree.file item)) f
{- If the file that's being moved in is already present in the work
@@ -309,14 +309,13 @@ preserveUnannexed item makeabs absf oldref = do
checkdirs (DiffTree.file item)
where
checkdirs from = do
- case parentDir (getTopFilePath from) of
- Nothing -> noop
- Just p -> do
- let d = asTopFilePath p
- let absd = makeabs d
- whenM (liftIO (colliding_nondir absd) <&&> unannexed absd) $
- liftIO $ findnewname absd 0
- checkdirs d
+ let p = parentDir (getTopFilePath from)
+ let d = asTopFilePath p
+ unless (null p) $ do
+ let absd = makeabs d
+ whenM (liftIO (colliding_nondir absd) <&&> unannexed absd) $
+ liftIO $ findnewname absd 0
+ checkdirs d
collidingitem f = isJust
<$> catchMaybeIO (getSymbolicLinkStatus f)
@@ -383,7 +382,7 @@ removeDirect k f = do
)
liftIO $ do
nukeFile f
- void $ tryIO $ removeDirectory $ takeDirectory f
+ void $ tryIO $ removeDirectory $ parentDir f
{- Called when a direct mode file has been changed. Its old content may be
- lost. -}
diff --git a/Annex/Direct/Fixup.hs b/Annex/Direct/Fixup.hs
index 73cefb134..13485242a 100644
--- a/Annex/Direct/Fixup.hs
+++ b/Annex/Direct/Fixup.hs
@@ -10,17 +10,16 @@ module Annex.Direct.Fixup where
import Git.Types
import Git.Config
import qualified Git.Construct as Construct
+import Utility.Path
import Utility.SafeCommand
-import System.FilePath
-
{- Direct mode repos have core.bare=true, but are not really bare.
- Fix up the Repo to be a non-bare repo, and arrange for git commands
- run by git-annex to be passed parameters that override this setting. -}
fixupDirect :: Repo -> IO Repo
fixupDirect r@(Repo { location = l@(Local { gitdir = d, worktree = Nothing }) }) = do
let r' = r
- { location = l { worktree = Just (takeDirectory d) }
+ { location = l { worktree = Just (parentDir d) }
, gitGlobalOpts = gitGlobalOpts r ++
[ Param "-c"
, Param $ coreBare ++ "=" ++ boolConfig False
diff --git a/Annex/Perms.hs b/Annex/Perms.hs
index d314e382c..3430554c7 100644
--- a/Annex/Perms.hs
+++ b/Annex/Perms.hs
@@ -71,12 +71,12 @@ annexFileMode = withShared $ return . go
createAnnexDirectory :: FilePath -> Annex ()
createAnnexDirectory dir = traverse dir [] =<< top
where
- top = takeDirectory <$> fromRepo gitAnnexDir
+ top = parentDir <$> fromRepo gitAnnexDir
traverse d below stop
| d `equalFilePath` stop = done
| otherwise = ifM (liftIO $ doesDirectoryExist d)
( done
- , traverse (takeDirectory d) (d:below) stop
+ , traverse (parentDir d) (d:below) stop
)
where
done = forM_ below $ \p -> do
@@ -92,14 +92,14 @@ freezeContentDir :: FilePath -> Annex ()
freezeContentDir file = unlessM crippledFileSystem $
liftIO . go =<< fromRepo getSharedRepository
where
- dir = takeDirectory file
+ dir = parentDir file
go GroupShared = groupWriteRead dir
go AllShared = groupWriteRead dir
go _ = preventWrite dir
thawContentDir :: FilePath -> Annex ()
thawContentDir file = unlessM crippledFileSystem $
- liftIO $ allowWrite $ takeDirectory file
+ liftIO $ allowWrite $ parentDir file
{- Makes the directory tree to store an annexed file's content,
- with appropriate permissions on each level. -}
@@ -111,7 +111,7 @@ createContentDir dest = do
unlessM crippledFileSystem $
liftIO $ allowWrite dir
where
- dir = takeDirectory dest
+ dir = parentDir dest
{- Creates the content directory for a file if it doesn't already exist,
- or thaws it if it does, then runs an action to modify the file, and
diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs
index 4bb99b370..0355ddd51 100644
--- a/Annex/ReplaceFile.hs
+++ b/Annex/ReplaceFile.hs
@@ -46,5 +46,5 @@ replaceFileFrom src dest = go `catchIO` fallback
where
go = moveFile src dest
fallback _ = do
- createDirectoryIfMissing True $ takeDirectory dest
+ createDirectoryIfMissing True $ parentDir dest
go
diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs
index 2eb8c97dd..15b169862 100644
--- a/Annex/Ssh.hs
+++ b/Annex/Ssh.hs
@@ -125,7 +125,7 @@ prepSocket socketfile = do
-- Cleanup at end of this run.
Annex.addCleanup SshCachingCleanup sshCleanup
- liftIO $ createDirectoryIfMissing True $ takeDirectory socketfile
+ liftIO $ createDirectoryIfMissing True $ parentDir socketfile
lockFileShared $ socket2lock socketfile
enumSocketFiles :: Annex [FilePath]