Use commandProgramName
[darcs-mirror-ipatch.git] / src / IPatch / Split.hs
1 {-
2  - Copyright (C) 2010 Joachim Breitner
3  - 
4  - This program is free software; you can redistribute it and/or modify
5  - it under the terms of the GNU General Public License as published by
6  - the Free Software Foundation; either version 2, or (at your option)
7  - any later version.
8  - 
9  - This program is distributed in the hope that it will be useful,
10  - but WITHOUT ANY WARRANTY; without even the implied warranty of
11  - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12  - GNU General Public License for more details.
13  - 
14  - You should have received a copy of the GNU General Public License
15  - along with this program; see the file COPYING.  If not, write to
16  - the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
17  - Boston, MA 02110-1301, USA.
18  -}
19 {-# LANGUAGE Rank2Types #-}
20 module IPatch.Split where
21
22 import qualified Data.ByteString as B ( writeFile )
23 import Control.Applicative ( (<$>) )
24 import System.Directory ( createDirectory )
25 import Control.Monad ( when )
26 import Control.Monad.Fix ( fix )
27 import System.Exit ( exitWith, ExitCode(ExitSuccess) )
28 import System.FilePath ( (</>) )
29
30 import Darcs.Commands ( DarcsCommand(..) )
31 import Darcs.Arguments ( DarcsFlag, fixFilePathOrStd, listFiles )
32 import Darcs.Repository ( amNotInRepository )
33 import Darcs.External ( execPipeIgnoreError )
34 import Darcs.Lock ( withTempDir )
35 import Darcs.Patch ( Prim, apply )
36 import Printer ( empty, renderPS )
37 import Workaround ( getCurrentDirectory )
38 import Darcs.Global ( debugMessage )
39 import Darcs.Utils ( askUser, promptYorn )
40 import Darcs.Utils ( withCurrentDirectory )
41 import Darcs.SelectChanges
42     ( WhichChanges(First),
43       runSelection,
44       selectChanges,
45       selectionContextPrim )
46 import Darcs.Patch.Split ( primSplitter )
47 import Darcs.Witnesses.Ordered ( FL, (:>)(..), nullFL )
48
49 import IPatch.Common
50     ( withTempRepository,
51       initializeBaseState,
52       diffToPrims,
53       stdindefault )
54 import IPatch.DiffFile ( readDiffFile, filesTouchedByDiff )
55
56 splitHelp :: String
57 splitHelp =
58     "The `ipatch split file.patch' lets the user select different parts (hunks) of the\n" ++
59     "given patch file. After making a choice for each hunk, the user has to provide a\n" ++
60     "file name where the selected changes are stored. This procedure is repeated until\n" ++
61     "each change in the original file has been selected for one output file.\n" ++
62     "\n"++
63     "No files are modified by this command. The output patch files are all written at the\n" ++
64     "of the process.\n"
65
66
67 splitDescription :: String
68 splitDescription = "Split a diff file interactively."
69
70 split :: DarcsCommand
71 split = DarcsCommand {commandProgramName = "ipatch",
72                       commandName = "split",
73                       commandHelp = splitHelp,
74                       commandDescription = splitDescription,
75                       commandExtraArgs = 1,
76                       commandExtraArgHelp = ["<PATCHFILE>"],
77                       commandCommand = splitCmd,
78                       commandPrereq = amNotInRepository,
79                       commandGetArgPossibilities = listFiles,
80                       commandArgdefaults = const stdindefault,
81                       commandAdvancedOptions = [],
82                       commandBasicOptions = []}
83
84 splitCmd :: [DarcsFlag] -> [String] -> IO ()
85 splitCmd _ [""] = fail "Empty filename argument given to split!"
86 splitCmd opts [unfixed_patchesfile] = do
87     maindir <- getCurrentDirectory
88     patchesfile <- fixFilePathOrStd opts unfixed_patchesfile
89     diffPS <- readDiffFile patchesfile
90     files <- filesTouchedByDiff diffPS
91     if null files
92       then putStrLn "Patch seems to be empty"
93       else withTempRepository "work" $ \rdir -> do
94         init_ps <- initializeBaseState rdir maindir files
95         patch_ps <- diffToPrims diffPS
96
97         let run :: (FL Prim -> Int -> IO [(FL Prim,String)]) ->
98                    (FL Prim -> Int -> IO [(FL Prim,String)])
99             run repeat remaining_ps n = if nullFL remaining_ps then return [] else do
100                 putStrLn $ "Please select the changes for the " ++ ordinal n ++ " patch"
101                 --putStrLn $ "To choose " ++ show remaining_ps
102                 let context = selectionContextPrim "split" [] (Just primSplitter) []
103                 let selector = selectChanges First remaining_ps
104                 (chosen_ps :> remaining_ps') <- runSelection selector context
105                 {- we need to force chosen_ps before accessing remaining_ps',
106                  - see pull_only_firsts in ./Darcs/Patch/Choices.hs. There is a reason
107                  - why unsafeReadIO is called unsafe...-}
108                 --length (show chosen_ps) `seq` return ()
109                 --length (show remaining_ps') `seq` return ()
110                 if (nullFL chosen_ps) 
111                   then do
112                     yorn <- promptYorn "You selected nothing. Do you want to abort?"
113                     when (yorn == 'y') $ do
114                         exitWith ExitSuccess
115                     repeat remaining_ps n
116                   else do
117                     filename <- askUser $ "Please enter filename for the " ++ ordinal n ++ " patch: "
118                     --putStrLn $ "Chosen " ++ show chosen_ps
119                     --putStrLn $ "Left " ++ show remaining_ps'
120                     ((chosen_ps,filename) :) <$> repeat remaining_ps' (succ n)
121
122         chunks <- fix run patch_ps 1
123
124         when (null chunks) $ do
125             putStrLn "No patched splitted, exiting."
126             exitWith ExitSuccess
127
128         withTempDir "ipatch-diff-area" $ \bpath -> do
129             debugMessage "Setting up old and new staging areas"
130             createDirectory "old" -- Find nicer names based on original directory name
131             createDirectory "new"
132
133             withCurrentDirectory "new" $ apply [] init_ps 
134             let applyAndDiff last next name = do
135                 withCurrentDirectory "old" $ apply [] last
136                 withCurrentDirectory "new" $ apply [] next
137                 output <- renderPS <$> execPipeIgnoreError "diff" ["-Nur","old","new"] empty
138                 putStrLn $ "Writing File " ++ name ++ " .."
139                 B.writeFile (maindir </> name) output
140             sequence_ $ zipWith3 applyAndDiff (init_ps : map fst chunks) (map fst chunks) (map snd chunks)
141
142
143 ordinal 1 = "first"
144 ordinal 2 = "second"
145 ordinal 3 = "third"
146 ordinal n = show n ++ "th"