ded2591124
This was more complex than would be expected. unannex has to use git commit -a since it's removing files from git; git commit filelist won't do. Allow commands to be added to the Git queue that have no associated files, and run such commands once.
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 stop
|
|
else do
|
|
showStart "fix" file
|
|
next $ perform file link
|
|
|
|
perform :: FilePath -> FilePath -> CommandPerform
|
|
perform file link = do
|
|
liftIO $ createDirectoryIfMissing True (parentDir file)
|
|
liftIO $ removeFile file
|
|
liftIO $ createSymbolicLink link file
|
|
next $ cleanup file
|
|
|
|
cleanup :: FilePath -> CommandCleanup
|
|
cleanup file = do
|
|
AnnexQueue.add "add" [Param "--"] [file]
|
|
return True
|