some easy createDirectoryUnder conversions

diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs
index 7f623c4139e32b3a89e2fbf311f9311562192696..841d1f27566262ac4f17e8a19bade4400becca28 100644 (file)
--- a/Annex/AdjustedBranch.hs
+++ b/Annex/AdjustedBranch.hs
@@ -57,6 +57,7 @@ import Annex.Tmp
 import Annex.GitOverlay
 import Utility.Tmp.Dir
 import Utility.CopyFile
+import Utility.Directory
 import qualified Database.Keys
 import Config
 
@@ -375,10 +376,10 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm
         - index file is currently locked.)
         -}
        changestomerge (Just updatedorig) = withOtherTmp $ \othertmpdir -> do
-               tmpwt <- fromRepo gitAnnexMergeDir
                git_dir <- fromRawFilePath <$> fromRepo Git.localGitDir
+               tmpwt <- fromRepo gitAnnexMergeDir
                withTmpDirIn othertmpdir "git" $ \tmpgit -> withWorkTreeRelated tmpgit $
-                       withemptydir tmpwt $ withWorkTree tmpwt $ do
+                       withemptydir git_dir tmpwt $ withWorkTree tmpwt $ do
                                liftIO $ writeFile (tmpgit </> "HEAD") (fromRef updatedorig)
                                -- Copy in refs and packed-refs, to work
                                -- around bug in git 2.13.0, which
@@ -390,7 +391,7 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm
                                        whenM (doesFileExist src) $ do
                                                dest <- relPathDirToFile git_dir src
                                                let dest' = tmpgit </> dest
-                                               createDirectoryIfMissing True (takeDirectory dest')
+                                               createDirectoryUnder git_dir (takeDirectory dest')
                                                void $ createLinkOrCopy src dest'
                                -- This reset makes git merge not care
                                -- that the work tree is empty; otherwise
@@ -411,12 +412,12 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm
                                        else return $ return False
        changestomerge Nothing = return $ return False
        
-       withemptydir d a = bracketIO setup cleanup (const a)
+       withemptydir git_dir d a = bracketIO setup cleanup (const a)
          where
                setup = do
                        whenM (doesDirectoryExist d) $
                                removeDirectoryRecursive d
-                       createDirectoryIfMissing True d
+                       createDirectoryUnder git_dir d
                cleanup _ = removeDirectoryRecursive d
 
        {- A merge commit has been made between the basisbranch and 

diff --git a/Annex/ChangedRefs.hs b/Annex/ChangedRefs.hs
index 6b6be4d202a91ddcc737ebb1211fa3b5c2103414..786a193e555a60d886d3aa0f7e9d3857b0b130d0 100644 (file)
--- a/Annex/ChangedRefs.hs
+++ b/Annex/ChangedRefs.hs
@@ -76,8 +76,9 @@ watchChangedRefs = do
        chan <- liftIO $ newTBMChanIO 100
        
        g <- gitRepo
-       let refdir = fromRawFilePath (Git.localGitDir g) </> "refs"
-       liftIO $ createDirectoryIfMissing True refdir
+       let gittop = fromRawFilePath (Git.localGitDir g)
+       let refdir = gittop </> "refs"
+       liftIO $ createDirectoryUnder gittop refdir
 
        let notifyhook = Just $ notifyHook chan
        let hooks = mkWatchHooks

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 961551366989b71504c1ca23b2a6a6fe47c078d7..84383c192bc6a2664924c2b983783ee3f9048514 100644 (file)
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -879,8 +879,7 @@ withTmpWorkDir key action = do
                liftIO $ writeFile obj ""
                setAnnexFilePerm obj
        let tmpdir = gitAnnexTmpWorkDir obj
-       liftIO $ createDirectoryIfMissing True tmpdir
-       setAnnexDirPerm tmpdir
+       createAnnexDirectory tmpdir
        res <- action tmpdir
        case res of
                Just _ -> liftIO $ removeDirectoryRecursive tmpdir

diff --git a/Assistant.hs b/Assistant.hs
index 037dd19c910431140cf9dfc1cb1c81010497daa7..26569836d12dba6f91946ce35233563dca8d73fc 100644 (file)
--- a/Assistant.hs
+++ b/Assistant.hs
@@ -75,6 +75,7 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser =
        pidfile <- fromRepo gitAnnexPidFile
        logfile <- fromRepo gitAnnexLogFile
        liftIO $ debugM desc $ "logging to " ++ logfile
+       createAnnexDirectory (parentDir pidfile)
 #ifndef mingw32_HOST_OS
        createAnnexDirectory (parentDir logfile)
        logfd <- liftIO $ handleToFd =<< openLog logfile

diff --git a/Config/Smudge.hs b/Config/Smudge.hs
index 9b104a76507795e16ea129e8357015440838bb04..9f4cf85060088656a57f94293cc2a97c72c96a4a 100644 (file)
--- a/Config/Smudge.hs
+++ b/Config/Smudge.hs
@@ -33,8 +33,9 @@ configureSmudgeFilter = unlessM (fromRepo Git.repoIsLocalBare) $ do
        gf <- Annex.fromRepo Git.attributes
        lfs <- readattr lf
        gfs <- readattr gf
+       gittop <- fromRawFilePath . Git.localGitDir <$> gitRepo
        liftIO $ unless ("filter=annex" `isInfixOf` (lfs ++ gfs)) $ do
-               createDirectoryIfMissing True (takeDirectory lf)
+               createDirectoryUnder gittop (takeDirectory lf)
                writeFile lf (lfs ++ "\n" ++ unlines stdattr)
   where
        readattr = liftIO . catchDefaultIO "" . readFileStrict

diff --git a/Database/Init.hs b/Database/Init.hs
index f2503298875a45b7cb4418f889a37556cbe1d2f4..3744de658268934276f3a6a8d91d7a63746c1b69 100644 (file)
--- a/Database/Init.hs
+++ b/Database/Init.hs
@@ -1,6 +1,6 @@
 {- Persistent sqlite database initialization
  -
- - Copyright 2015-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2015-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -10,6 +10,7 @@ module Database.Init where
 import Annex.Common
 import Annex.Perms
 import Utility.FileMode
+import Utility.Directory
 
 import Database.Persist.Sqlite
 import Control.Monad.IO.Class (liftIO)
@@ -29,9 +30,10 @@ initDb db migration = do
        let dbdir = takeDirectory db
        let tmpdbdir = dbdir ++ ".tmp"
        let tmpdb = tmpdbdir </> "db"
-       let tdb = T.pack tmpdb  
+       let tdb = T.pack tmpdb
+       top <- parentDir . fromRawFilePath <$> fromRepo gitAnnexDir
        liftIO $ do
-               createDirectoryIfMissing True tmpdbdir
+               createDirectoryUnder top tmpdbdir
                runSqliteInfo (enableWAL tdb) migration
        setAnnexDirPerm tmpdbdir
        -- Work around sqlite bug that prevents it from honoring

diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index bf83cc847659edd0527e99f506c9d88c2fc1657a..60247d19cc5b1a18713a334230413964de903fc7 100644 (file)
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -170,13 +170,13 @@ checkDiskSpaceDirectory d k = do
 
 store :: FilePath -> ChunkConfig -> Key -> L.ByteString -> MeterUpdate -> Annex Bool
 store d chunkconfig k b p = liftIO $ do
-       void $ tryIO $ createDirectoryIfMissing True tmpdir
+       void $ tryIO $ createDirectoryUnder d tmpdir
        case chunkconfig of
-               LegacyChunks chunksize -> Legacy.store chunksize finalizeStoreGeneric k b p tmpdir destdir
+               LegacyChunks chunksize -> Legacy.store d chunksize (finalizeStoreGeneric d) k b p tmpdir destdir
                _ -> do
                        let tmpf = tmpdir </> kf
                        meteredWriteFile p tmpf b
-                       finalizeStoreGeneric tmpdir destdir
+                       finalizeStoreGeneric d tmpdir destdir
                        return True
   where
        tmpdir = addTrailingPathSeparator $ d </> "tmp" </> kf
@@ -187,11 +187,11 @@ store d chunkconfig k b p = liftIO $ do
  - in the dest directory, moves it into place. Anything already existing
  - in the dest directory will be deleted. File permissions will be locked
  - down. -}
-finalizeStoreGeneric :: FilePath -> FilePath -> IO ()
-finalizeStoreGeneric tmp dest = do
+finalizeStoreGeneric :: FilePath -> FilePath -> FilePath -> IO ()
+finalizeStoreGeneric d tmp dest = do
        void $ tryIO $ allowWrite dest -- may already exist
        void $ tryIO $ removeDirectoryRecursive dest -- or not exist
-       createDirectoryIfMissing True (parentDir dest)
+       createDirectoryUnder d (parentDir dest)
        renameDirectory tmp dest
        -- may fail on some filesystems
        void $ tryIO $ do
@@ -267,7 +267,7 @@ checkPresentGeneric' d check = ifM check
 
 storeExportM :: FilePath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool
 storeExportM d src _k loc p = liftIO $ catchBoolIO $ do
-       createDirectoryIfMissing True (takeDirectory dest)
+       createDirectoryUnder d (takeDirectory dest)
        -- Write via temp file so that checkPresentGeneric will not
        -- see it until it's fully stored.
        viaTmp (\tmp () -> withMeteredFile src p (L.writeFile tmp)) dest ()
@@ -298,7 +298,7 @@ renameExportM :: FilePath -> Key -> ExportLocation -> ExportLocation -> Annex (M
 renameExportM d _k oldloc newloc = liftIO $ Just <$> go
   where
        go = catchBoolIO $ do
-               createDirectoryIfMissing True (takeDirectory dest)
+               createDirectoryUnder d (takeDirectory dest)
                renameFile src dest
                removeExportLocation d oldloc
                return True
@@ -413,7 +413,7 @@ storeExportWithContentIdentifierM dir src _k loc overwritablecids p =
        catchIO go (return . Left . show)
   where
        go = do
-               liftIO $ createDirectoryIfMissing True destdir
+               liftIO $ createDirectoryUnder dir destdir
                withTmpFileIn destdir template $ \tmpf tmph -> do
                        liftIO $ withMeteredFile src p (L.hPut tmph)
                        liftIO $ hFlush tmph

diff --git a/Remote/Directory/LegacyChunked.hs b/Remote/Directory/LegacyChunked.hs
index d9d5a860ce993f86d234104f314548178cddeaa7..0943f63234c733deeb7d488446bc73055fef1410 100644 (file)
--- a/Remote/Directory/LegacyChunked.hs
+++ b/Remote/Directory/LegacyChunked.hs
@@ -70,9 +70,9 @@ storeLegacyChunked' meterupdate chunksize (d:dests) bs c = do
                                feed bytes' (sz - s) ls h
                        else return (l:ls)
 
-storeHelper :: (FilePath -> FilePath -> IO ()) -> Key -> ([FilePath] -> IO [FilePath]) -> FilePath -> FilePath -> IO Bool
-storeHelper finalizer key storer tmpdir destdir = do
-       void $ liftIO $ tryIO $ createDirectoryIfMissing True tmpdir
+storeHelper :: FilePath -> (FilePath -> FilePath -> IO ()) -> Key -> ([FilePath] -> IO [FilePath]) -> FilePath -> FilePath -> IO Bool
+storeHelper repotop finalizer key storer tmpdir destdir = do
+       void $ liftIO $ tryIO $ createDirectoryUnder repotop tmpdir
        Legacy.storeChunks key tmpdir destdir storer recorder finalizer
   where
        recorder f s = do
@@ -80,8 +80,8 @@ storeHelper finalizer key storer tmpdir destdir = do
                writeFile f s
                void $ tryIO $ preventWrite f
 
-store :: ChunkSize -> (FilePath -> FilePath -> IO ()) -> Key -> L.ByteString -> MeterUpdate -> FilePath -> FilePath -> IO Bool
-store chunksize finalizer k b p = storeHelper finalizer k $ \dests ->
+store :: FilePath -> ChunkSize -> (FilePath -> FilePath -> IO ()) -> Key -> L.ByteString -> MeterUpdate -> FilePath -> FilePath -> IO Bool
+store repotop chunksize finalizer k b p = storeHelper repotop finalizer k $ \dests ->
        storeLegacyChunked p chunksize dests b
 
 {- Need to get a single ByteString containing every chunk.

diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 1b60638b9478cf51e77626e50643efbed8ceb285..a50d949d267a18bdbf8ac1ec84206779b6c9a197 100644 (file)
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -372,7 +372,7 @@ store' repo r rsyncopts
                        let tmpf = tmpdir </> fromRawFilePath (keyFile k)
                        meteredWriteFile p tmpf b
                        let destdir = parentDir $ gCryptLocation repo k
-                       Remote.Directory.finalizeStoreGeneric tmpdir destdir
+                       Remote.Directory.finalizeStoreGeneric (Git.repoLocation repo) tmpdir destdir
                        return True
        | Git.repoIsSsh repo = if accessShell r
                then fileStorer $ \k f p -> do

diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs
index 7b6ae77368b3980f39a72eecc2f60fdb8c68f767..5d23e0c06b5e2d723f2874692f00b2d0bdd60103 100644 (file)
--- a/Remote/Helper/Hooks.hs
+++ b/Remote/Helper/Hooks.hs
@@ -48,7 +48,7 @@ runHooks r starthook stophook a = do
        dir <- fromRepo gitAnnexRemotesDir
        let lck = dir </> remoteid ++ ".lck"
        whenM (notElem lck . M.keys <$> getLockCache) $ do
-               liftIO $ createDirectoryIfMissing True dir
+               createAnnexDirectory dir
                firstrun lck
        a
   where

diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs
index d4f060e6bb5b01300a44937e00a3102f06332a50..2e1a9baa8f7cbfa1e1bb7e7c605f3e36665727a5 100644 (file)
--- a/Utility/Daemon.hs
+++ b/Utility/Daemon.hs
@@ -90,7 +90,6 @@ foreground pidfile a = do
  - Fails if the pid file is already locked by another process. -}
 lockPidFile :: FilePath -> IO ()
 lockPidFile pidfile = do
-       createDirectoryIfMissing True (parentDir pidfile)
 #ifndef mingw32_HOST_OS
        fd <- openFd pidfile ReadWrite (Just stdFileMode) defaultFileFlags
        locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0)

diff --git a/doc/todo/stop_using_createDirectoryIfMissing_True/comment_2_1633fecf3fd5096c1bfcf77dfe471189._comment b/doc/todo/stop_using_createDirectoryIfMissing_True/comment_2_1633fecf3fd5096c1bfcf77dfe471189._comment
new file mode 100644 (file)
index 0000000..c6dc45f
--- /dev/null
+++ b/doc/todo/stop_using_createDirectoryIfMissing_True/comment_2_1633fecf3fd5096c1bfcf77dfe471189._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2020-03-05T19:18:31Z"
+ content="""
+Most of the easy ones have been converted now.
+
+There's one in Annex.ReplaceFile that's hard, and is probably the only
+important one left unconverted.
+"""]]