Initial check-in
[darcs-mirror-ipatch.git] / Split.hs
1 {-# LANGUAGE Rank2Types #-}
2 module Split where
3
4 import qualified Data.ByteString as B ( writeFile )
5 import Control.Applicative ( (<$>) )
6 import System.Directory ( createDirectory )
7 import Control.Monad ( when )
8 import Control.Monad.Fix ( fix )
9 import System.Exit ( exitWith, ExitCode(ExitSuccess) )
10 import System.FilePath ( (</>) )
11
12 import Darcs.Commands
13     ( DarcsCommand(DarcsCommand, commandAdvancedOptions,
14                    commandArgdefaults, commandBasicOptions, commandCommand,
15                    commandDescription, commandExtraArgHelp, commandExtraArgs,
16                    commandGetArgPossibilities, commandHelp, commandName,
17                    commandPrereq) )
18 import Darcs.Arguments ( DarcsFlag, fixFilePathOrStd, listFiles )
19 import Darcs.Repository ( amNotInRepository )
20 import Darcs.External ( execPipeIgnoreError )
21 import Darcs.Lock ( withTempDir )
22 import Darcs.Patch ( Prim, apply )
23 import Printer ( empty, renderPS )
24 import Workaround ( getCurrentDirectory )
25 import Darcs.Global ( debugMessage )
26 import Darcs.Utils ( askUser, promptYorn )
27 import Darcs.Utils ( withCurrentDirectory )
28 import Darcs.SelectChanges
29     ( WhichChanges(First),
30       runSelection,
31       selectChanges,
32       selectionContextPrim )
33 import Darcs.Patch.Split ( primSplitter )
34 import Darcs.Witnesses.Ordered ( FL, (:>)(..), nullFL )
35
36 import Common
37     ( withTempRepository,
38       initializeBaseState,
39       diffToPrims,
40       stdindefault )
41 import DiffFile ( readDiffFile, filesTouchedByDiff )
42
43 splitHelp :: String
44 splitHelp = "split help"
45
46 splitDescription :: String
47 splitDescription = "Split a diff file interactively."
48
49 split :: DarcsCommand
50 split = DarcsCommand {commandName = "split",
51                       commandHelp = splitHelp,
52                       commandDescription = splitDescription,
53                       commandExtraArgs = 1,
54                       commandExtraArgHelp = ["<PATCHFILE>"],
55                       commandCommand = splitCmd,
56                       commandPrereq = amNotInRepository,
57                       commandGetArgPossibilities = listFiles,
58                       commandArgdefaults = const stdindefault,
59                       commandAdvancedOptions = [],
60                       commandBasicOptions = []}
61
62 splitCmd :: [DarcsFlag] -> [String] -> IO ()
63 splitCmd _ [""] = fail "Empty filename argument given to split!"
64 splitCmd opts [unfixed_patchesfile] = do
65     maindir <- getCurrentDirectory
66     patchesfile <- fixFilePathOrStd opts unfixed_patchesfile
67     diffPS <- readDiffFile patchesfile
68     files <- filesTouchedByDiff diffPS
69     if null files
70       then putStrLn "Patch seems to be empty"
71       else withTempRepository "work" $ \rdir -> do
72         init_ps <- initializeBaseState rdir maindir files
73         patch_ps <- diffToPrims diffPS
74
75         let run :: (FL Prim -> Int -> IO [(FL Prim,String)]) ->
76                    (FL Prim -> Int -> IO [(FL Prim,String)])
77             run repeat remaining_ps n = if nullFL remaining_ps then return [] else do
78                 putStrLn $ "Please select the changes for the " ++ ordinal n ++ " patch"
79                 --putStrLn $ "To choose " ++ show remaining_ps
80                 let context = selectionContextPrim "split" [] (Just primSplitter) []
81                 let selector = selectChanges First remaining_ps
82                 (chosen_ps :> remaining_ps') <- runSelection selector context
83                 {- we need to force chosen_ps before accessing remaining_ps',
84                  - see pull_only_firsts in ./Darcs/Patch/Choices.hs. There is a reason
85                  - why unsafeReadIO is called unsafe...-}
86                 --length (show chosen_ps) `seq` return ()
87                 --length (show remaining_ps') `seq` return ()
88                 if (nullFL chosen_ps) 
89                   then do
90                     yorn <- promptYorn "You selected nothing. Do you want to abort?"
91                     when (yorn == 'y') $ do
92                         exitWith ExitSuccess
93                     repeat remaining_ps n
94                   else do
95                     filename <- askUser $ "Please enter filename for the " ++ ordinal n ++ " patch: "
96                     --putStrLn $ "Chosen " ++ show chosen_ps
97                     --putStrLn $ "Left " ++ show remaining_ps'
98                     ((chosen_ps,filename) :) <$> repeat remaining_ps' (succ n)
99
100         chunks <- fix run patch_ps 1
101
102         when (null chunks) $ do
103             putStrLn "No patched splitted, exiting."
104             exitWith ExitSuccess
105
106         withTempDir "ipatch-diff-area" $ \bpath -> do
107             debugMessage "Setting up old and new staging areas"
108             createDirectory "old" -- Find nicer names based on original directory name
109             createDirectory "new"
110
111             withCurrentDirectory "new" $ apply init_ps 
112             let applyAndDiff last next name = do
113                 withCurrentDirectory "old" $ apply last
114                 withCurrentDirectory "new" $ apply next
115                 output <- renderPS <$> execPipeIgnoreError "diff" ["-u","-r","old","new"] empty
116                 putStrLn $ "Writing File " ++ name ++ " .."
117                 B.writeFile (maindir </> name) output
118             sequence_ $ zipWith3 applyAndDiff (init_ps : map fst chunks) (map fst chunks) (map snd chunks)
119
120
121 ordinal 1 = "first"
122 ordinal 2 = "second"
123 ordinal 3 = "third"
124 ordinal n = show n ++ "th"