158ba9d332
This used to work, but now hsc2hs is failing with a usage message. Since I have not changed my windows build environment at all, it must be some change due to a change in the cabal file. Perhaps too make flags are causing it to hit a windows command line length limit? Anyway, these hsc files did nothing on Windows, so can be omitted and not built to work around yet another epic windows weirdness.
61 lines
1.4 KiB
Haskell
61 lines
1.4 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2010 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Command.Fix where
|
|
|
|
import System.PosixCompat.Files
|
|
|
|
import Common.Annex
|
|
import Command
|
|
import qualified Annex.Queue
|
|
#ifndef __ANDROID__
|
|
#ifdef WITH_CLIBS
|
|
import Utility.Touch
|
|
#endif
|
|
#endif
|
|
|
|
def :: [Command]
|
|
def = [notDirect $ noCommit $ command "fix" paramPaths seek
|
|
SectionMaintenance "fix up symlinks to point to annexed content"]
|
|
|
|
seek :: [CommandSeek]
|
|
seek = [withFilesInGit $ whenAnnexed start]
|
|
|
|
{- Fixes the symlink to an annexed file. -}
|
|
start :: FilePath -> (Key, Backend) -> CommandStart
|
|
start file (key, _) = do
|
|
link <- inRepo $ gitAnnexLink file key
|
|
stopUnless ((/=) (Just link) <$> liftIO (catchMaybeIO $ readSymbolicLink file)) $ do
|
|
showStart "fix" file
|
|
next $ perform file link
|
|
|
|
perform :: FilePath -> FilePath -> CommandPerform
|
|
perform file link = do
|
|
liftIO $ do
|
|
#ifndef __ANDROID__
|
|
#ifdef WITH_CLIBS
|
|
-- preserve mtime of symlink
|
|
mtime <- catchMaybeIO $ TimeSpec . modificationTime
|
|
<$> getSymbolicLinkStatus file
|
|
#endif
|
|
#endif
|
|
createDirectoryIfMissing True (parentDir file)
|
|
removeFile file
|
|
createSymbolicLink link file
|
|
#ifndef __ANDROID__
|
|
#ifdef WITH_CLIBS
|
|
maybe noop (\t -> touch file t False) mtime
|
|
#endif
|
|
#endif
|
|
next $ cleanup file
|
|
|
|
cleanup :: FilePath -> CommandCleanup
|
|
cleanup file = do
|
|
Annex.Queue.addCommand "add" [Param "--force", Param "--"] [file]
|
|
return True
|