Revert to 2.5 beta Darcs API (not darcs.net)
[darcs-mirror-ipatch.git] / Common.hs
1 {-# LANGUAGE Rank2Types #-}
2 module Common where
3
4 import Control.Applicative ( (<$>) )
5
6 import Darcs.Arguments ( DarcsFlag(LookForAdds) )
7 import Darcs.Repository
8     ( createRepository,
9       applyToWorking,
10       finalizeRepositoryChanges,
11       tentativelyAddPatch,
12       withGutsOf,
13       withRepoLock,
14       invalidateIndex,
15       unrecordedChanges )
16 import Darcs.Flags ( Compression(..) )
17 import Darcs.RepoPath ( AbsolutePath, FilePathLike(..) )
18 import Darcs.External ( clonePaths )
19 import Darcs.Lock ( withTempDir )
20 import Darcs.Patch ( invert, fromPrims, namepatch )
21 import Darcs.Global ( debugMessage )
22 import Darcs.Hopefully ( n2pia )
23 import Darcs.Utils ( clarifyErrors )
24
25 import DiffFile ( applyDiff )
26
27 withTempRepository :: String -> (AbsolutePath -> IO a) -> IO a
28 withTempRepository name job =
29     withTempDir ("ipatch-repo-" ++ name) $ \rdir -> do
30         debugMessage $ "Creating temporary repository in directory " ++ show rdir
31         createRepository []
32         job rdir
33
34 initializeBaseState rdir sdir files = do
35     debugMessage $ "Copying " ++ show (length files) ++ " files to temporary repository."  
36     clonePaths sdir (toFilePath rdir) files
37     -- Create a patch from the newly added files
38     debugMessage $ "Creating initial check  in patch"
39     withRepoLock [LookForAdds] $ \repo -> do
40         init_ps <- unrecordedChanges [LookForAdds] repo [] -- Correct flags?
41         init_patch <- n2pia <$> namepatch "NODATE" "Initial state" "NOAUTHOR" [] (fromPrims init_ps)
42         tentativelyAddPatch repo [] init_patch
43         invalidateIndex repo
44         withGutsOf repo (finalizeRepositoryChanges repo)
45             `clarifyErrors` "Failed to apply inital patch"
46         return init_ps
47
48
49 diffToPrims diff = do
50     debugMessage $ "Applying the user provided diff"
51     -- Now apply the patch
52     applyDiff diff
53
54     debugMessage $ "Creating a patch from the user changes"
55     withRepoLock [LookForAdds] $ \repo -> do
56         -- Create another patch from the changed files
57         patch_ps <- unrecordedChanges [LookForAdds] repo []
58         -- patch_patch <- n2pia <$> namepatch date "Patch effect" author [] (fromPrims patch_ps)
59         -- tentativelyAddPatch repo [] patch_patch
60         -- Now we obliterate the patch, undoing its effects
61         applyToWorking repo [] (invert patch_ps) `catch` \e ->
62             fail ("Couldn't undo diff effect in working dir.\n" ++ show e)
63         return patch_ps
64       
65 stdindefault :: a -> [String] -> IO [String]
66 stdindefault _ [] = return ["-"]
67 stdindefault _ x = return x