f885ad43924d62c0dc89947303735e140078bbc9
[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
31     ( DarcsCommand(DarcsCommand, commandAdvancedOptions,
32                    commandArgdefaults, commandBasicOptions, commandCommand,
33                    commandDescription, commandExtraArgHelp, commandExtraArgs,
34                    commandGetArgPossibilities, commandHelp, commandName,
35                    commandPrereq) )
36 import Darcs.Arguments ( DarcsFlag, fixFilePathOrStd, listFiles )
37 import Darcs.Repository ( amNotInRepository )
38 import Darcs.External ( execPipeIgnoreError )
39 import Darcs.Lock ( withTempDir )
40 import Darcs.Patch ( Prim, apply )
41 import Printer ( empty, renderPS )
42 import Workaround ( getCurrentDirectory )
43 import Darcs.Global ( debugMessage )
44 import Darcs.Utils ( askUser, promptYorn )
45 import Darcs.Utils ( withCurrentDirectory )
46 import Darcs.SelectChanges
47     ( WhichChanges(First),
48       runSelection,
49       selectChanges,
50       selectionContextPrim )
51 import Darcs.Patch.Split ( primSplitter )
52 import Darcs.Witnesses.Ordered ( FL, (:>)(..), nullFL )
53
54 import IPatch.Common
55     ( withTempRepository,
56       initializeBaseState,
57       diffToPrims,
58       stdindefault )
59 import IPatch.DiffFile ( readDiffFile, filesTouchedByDiff )
60
61 splitHelp :: String
62 splitHelp =
63     "The `ipatch split file.patch' lets the user select different parts (hunks) of the\n" ++
64     "given patch file. After making a choice for each hunk, the user has to provide a\n" ++
65     "file name where the selected changes are stored. This procedure is repeated until\n" ++
66     "each change in the original file has been selected for one output file.\n" ++
67     "\n"++
68     "No files are modified by this command. The output patch files are all written at the\n" ++
69     "of the process.\n"
70
71
72 splitDescription :: String
73 splitDescription = "Split a diff file interactively."
74
75 split :: DarcsCommand
76 split = DarcsCommand {commandName = "split",
77                       commandHelp = splitHelp,
78                       commandDescription = splitDescription,
79                       commandExtraArgs = 1,
80                       commandExtraArgHelp = ["<PATCHFILE>"],
81                       commandCommand = splitCmd,
82                       commandPrereq = amNotInRepository,
83                       commandGetArgPossibilities = listFiles,
84                       commandArgdefaults = const stdindefault,
85                       commandAdvancedOptions = [],
86                       commandBasicOptions = []}
87
88 splitCmd :: [DarcsFlag] -> [String] -> IO ()
89 splitCmd _ [""] = fail "Empty filename argument given to split!"
90 splitCmd opts [unfixed_patchesfile] = do
91     maindir <- getCurrentDirectory
92     patchesfile <- fixFilePathOrStd opts unfixed_patchesfile
93     diffPS <- readDiffFile patchesfile
94     files <- filesTouchedByDiff diffPS
95     if null files
96       then putStrLn "Patch seems to be empty"
97       else withTempRepository "work" $ \rdir -> do
98         init_ps <- initializeBaseState rdir maindir files
99         patch_ps <- diffToPrims diffPS
100
101         let run :: (FL Prim -> Int -> IO [(FL Prim,String)]) ->
102                    (FL Prim -> Int -> IO [(FL Prim,String)])
103             run repeat remaining_ps n = if nullFL remaining_ps then return [] else do
104                 putStrLn $ "Please select the changes for the " ++ ordinal n ++ " patch"
105                 --putStrLn $ "To choose " ++ show remaining_ps
106                 let context = selectionContextPrim "split" [] (Just primSplitter) []
107                 let selector = selectChanges First remaining_ps
108                 (chosen_ps :> remaining_ps') <- runSelection selector context
109                 {- we need to force chosen_ps before accessing remaining_ps',
110                  - see pull_only_firsts in ./Darcs/Patch/Choices.hs. There is a reason
111                  - why unsafeReadIO is called unsafe...-}
112                 --length (show chosen_ps) `seq` return ()
113                 --length (show remaining_ps') `seq` return ()
114                 if (nullFL chosen_ps) 
115                   then do
116                     yorn <- promptYorn "You selected nothing. Do you want to abort?"
117                     when (yorn == 'y') $ do
118                         exitWith ExitSuccess
119                     repeat remaining_ps n
120                   else do
121                     filename <- askUser $ "Please enter filename for the " ++ ordinal n ++ " patch: "
122                     --putStrLn $ "Chosen " ++ show chosen_ps
123                     --putStrLn $ "Left " ++ show remaining_ps'
124                     ((chosen_ps,filename) :) <$> repeat remaining_ps' (succ n)
125
126         chunks <- fix run patch_ps 1
127
128         when (null chunks) $ do
129             putStrLn "No patched splitted, exiting."
130             exitWith ExitSuccess
131
132         withTempDir "ipatch-diff-area" $ \bpath -> do
133             debugMessage "Setting up old and new staging areas"
134             createDirectory "old" -- Find nicer names based on original directory name
135             createDirectory "new"
136
137             withCurrentDirectory "new" $ apply [] init_ps 
138             let applyAndDiff last next name = do
139                 withCurrentDirectory "old" $ apply [] last
140                 withCurrentDirectory "new" $ apply [] next
141                 output <- renderPS <$> execPipeIgnoreError "diff" ["-Nur","old","new"] empty
142                 putStrLn $ "Writing File " ++ name ++ " .."
143                 B.writeFile (maindir </> name) output
144             sequence_ $ zipWith3 applyAndDiff (init_ps : map fst chunks) (map fst chunks) (map snd chunks)
145
146
147 ordinal 1 = "first"
148 ordinal 2 = "second"
149 ordinal 3 = "third"
150 ordinal n = show n ++ "th"