bc51387e6d
Since the queue is flushed in between subcommand actions being run, there should be no issues with actions that expect to queue up some stuff and have it run after they do other stuff. So I didn't have to audit for such assumptions.
48 lines
1.1 KiB
Haskell
48 lines
1.1 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2010 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.Fix where
|
|
|
|
import Control.Monad.State (liftIO)
|
|
import System.Posix.Files
|
|
import System.Directory
|
|
|
|
import Command
|
|
import qualified AnnexQueue
|
|
import Utility
|
|
import Content
|
|
import Messages
|
|
|
|
command :: [Command]
|
|
command = [repoCommand "fix" paramPath seek
|
|
"fix up symlinks to point to annexed content"]
|
|
|
|
seek :: [CommandSeek]
|
|
seek = [withFilesInGit start]
|
|
|
|
{- Fixes the symlink to an annexed file. -}
|
|
start :: CommandStartString
|
|
start file = isAnnexed file $ \(key, _) -> do
|
|
link <- calcGitLink file key
|
|
l <- liftIO $ readSymbolicLink file
|
|
if link == l
|
|
then return Nothing
|
|
else do
|
|
showStart "fix" file
|
|
return $ Just $ perform file link
|
|
|
|
perform :: FilePath -> FilePath -> CommandPerform
|
|
perform file link = do
|
|
liftIO $ createDirectoryIfMissing True (parentDir file)
|
|
liftIO $ removeFile file
|
|
liftIO $ createSymbolicLink link file
|
|
return $ Just $ cleanup file
|
|
|
|
cleanup :: FilePath -> CommandCleanup
|
|
cleanup file = do
|
|
AnnexQueue.add "add" [Param "--"] file
|
|
return True
|