1 % Copyright (C) 2002-2005,2007-2008 David Roundy 2 % 3 % This program is free software; you can redistribute it and/or modify 4 % it under the terms of the GNU General Public License as published by 5 % the Free Software Foundation; either version 2, or (at your option) 6 % any later version. 7 % 8 % This program is distributed in the hope that it will be useful, 9 % but WITHOUT ANY WARRANTY; without even the implied warranty of 10 % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 % GNU General Public License for more details. 12 % 13 % You should have received a copy of the GNU General Public License 14 % along with this program; see the file COPYING. If not, write to 15 % the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 16 % Boston, MA 02110-1301, USA. 17 18 \chapter{DarcsRepo format} 19 20 A repository consists of a working directory, which has within it a 21 directory called \verb!_darcs!. There must also be a subdirectory within 22 \verb!_darcs! named \verb!patches!. The \verb!patches! directory contains 23 the actual patches which are in the repository. There must also be a 24 \emph{pristine tree}, which may either be a directory containing a cache of 25 the version of the tree which has been recorded, or a stub, and may be 26 named either ``current'' or ``pristine''. 27 28 \emph{WARNING!} Viewing files in the pristine cache is perfectly 29 acceptable, but if you view them with an editor (e.g.\ vi or Emacs), that 30 editor may create temporary files in the pristine tree 31 (\verb|_darcs/pristine/| or \verb|_darcs/current/|), which will temporarily 32 cause your repository to be inconsistent. So \emph{don't record any 33 patches while viewing files in \_darcs/current with an editor!} A better 34 plan would be to restrict yourself to viewing these files with a pager such 35 as more or less. 36 37 Also within \verb!_darcs! is the \verb!inventory! file, which lists all the 38 patches that are in the repository. Moreover, it also gives the order of the 39 representation of the patches as they are stored. Given a source of patches, 40 i.e.\ any other set of repositories which have between them all the patches 41 contained in a given repository, that repository can be reproduced based on only the 42 information in the \verb!inventory! file. Under those circumstances, the 43 order of the patches specified in the \verb!inventory! file would be 44 unimportant, as this order is only needed to provide context for the 45 interpretation of the stored patches in this repository. 46 47 \begin{code} 48 {-# OPTIONS_GHC -cpp -fglasgow-exts #-} 49 {-# LANGUAGE CPP, ScopedTypeVariables #-} 50 51 #include "gadts.h" 52 53 module Darcs.Repository.DarcsRepo ( write_inventory, write_inventory_and_patches, 54 add_to_inventory, add_to_tentative_pristine, 55 add_to_tentative_inventory, remove_from_tentative_inventory, 56 finalize_tentative_changes, finalize_pristine_changes, 57 revert_tentative_changes, 58 read_repo, read_tentative_repo, write_and_read_patch, 59 copy_patches 60 ) where 61 62 import System.Directory ( doesDirectoryExist, createDirectoryIfMissing ) 63 import Workaround ( renameFile ) 64 import Darcs.Utils ( clarify_errors ) 65 import Progress ( debugMessage, beginTedious, endTedious, finishedOneIO ) 66 import Darcs.RepoPath ( ioAbsoluteOrRemote, toPath ) 67 import System.IO ( hPutStrLn, stderr ) 68 import System.IO.Unsafe ( unsafeInterleaveIO ) 69 import Control.Monad ( liftM, when, unless ) 70 import Darcs.Hopefully ( Hopefully, PatchInfoAnd, 71 patchInfoAndPatch, info, 72 actually, hopefully, unavailable, n2pia ) 73 import Darcs.SignalHandler ( withSignalsBlocked ) 74 75 import ByteStringUtils ( gzReadFilePS ) 76 import qualified Data.ByteString as B (ByteString, null, readFile, empty) 77 import qualified Data.ByteString.Char8 as BC (break, pack) 78 79 import Darcs.SlurpDirectory ( Slurpy, empty_slurpy ) 80 import Darcs.Patch ( RepoPatch, Effect, Prim, Named, Patch, invert, 81 effect, 82 patch2patchinfo, 83 apply_to_slurpy, 84 readPatch, 85 writePatch, gzWritePatch, showPatch ) 86 import Darcs.Ordered ( FL(..), RL(..), (:<)(..), 87 reverseFL, mapFL, unsafeCoerceP, 88 reverseRL, concatRL, mapRL, mapRL_RL ) 89 import Darcs.Patch.Info ( PatchInfo, make_filename, readPatchInfo, 90 showPatchInfo, is_tag 91 ) 92 import Darcs.Patch.Set ( PatchSet, SealedPatchSet ) 93 import Darcs.External ( gzFetchFilePS, fetchFilePS, copyFilesOrUrls, Cachable(..), 94 cloneFile ) 95 import Darcs.Lock ( writeBinFile, writeDocBinFile, appendDocBinFile, appendBinFile ) 96 import Darcs.Flags ( DarcsFlag( NoCompress ) ) 97 import Darcs.Patch.Depends ( slightly_optimize_patchset, commute_to_end, deep_optimize_patchset ) 98 import Darcs.Repository.Pristine ( identifyPristine, applyPristine ) 99 import Darcs.Global ( darcsdir ) 100 import Darcs.Utils ( catchall ) 101 import Darcs.ProgressPatches ( progressFL ) 102 import Printer ( text, (<>), Doc, ($$), empty ) 103 import Darcs.Sealed ( Sealed(Sealed), seal, unseal ) 104 \end{code} 105 106 There is a very special patch which may be stored in \verb!patches! which 107 is called `pending'. This patch describes any changes which have not yet 108 been recorded, and cannot be determined by a simple diff. For example, file 109 additions or renames are placed in pending until they are recorded. 110 Similarly, token replaces are stored in pending until they are recorded. 111 112 \begin{code} 113 write_patch :: RepoPatch p => [DarcsFlag] -> Named p C(x y) -> IO FilePath 114 write_patch opts p = 115 do let writeFun = if NoCompress `elem` opts 116 then writePatch 117 else gzWritePatch 118 pname = darcsdir++"/patches/"++make_filename (patch2patchinfo p) 119 writeFun pname p 120 return pname 121 122 write_and_read_patch :: RepoPatch p => [DarcsFlag] -> PatchInfoAnd p C(x y) 123 -> IO (PatchInfoAnd p C(x y)) 124 write_and_read_patch opts p = do fn <- write_patch opts $ hopefully p 125 unsafeInterleaveIO $ parse fn 126 where parse fn = do debugMessage ("Reading patch file: "++ fn) 127 ps <- gzReadFilePS fn 128 Sealed pp <- case readPatch ps of 129 Just (x,_) -> return x 130 Nothing -> fail ("Couldn't parse patch file "++fn) 131 return $ n2pia $ unsafeCoerceP pp 132 133 --format_inventory is not exported for use outside of the DarcsRepo module 134 --itself. 135 format_inventory :: [PatchInfo] -> Doc 136 format_inventory [] = empty 137 format_inventory (pinfo:ps) = showPatchInfo pinfo $$ format_inventory ps 138 139 write_inventory :: RepoPatch p => FilePath -> PatchSet p C(x) -> IO () 140 -- Note that write_inventory optimizes the inventory it writes out by 141 -- checking on tag dependencies. 142 -- FIXME: There is also a problem that write_inventory always writes 143 -- out the entire inventory, including the parts that you haven't 144 -- changed... 145 write_inventory dir ps = withSignalsBlocked $ do 146 createDirectoryIfMissing False (dir++"/"++darcsdir++"/inventories") 147 simply_write_inventory "inventory" dir $ slightly_optimize_patchset ps 148 149 simply_write_inventory :: RepoPatch p => String -> FilePath -> PatchSet p C(x) -> IO () 150 simply_write_inventory name dir NilRL = 151 writeBinFile (dir++"/"++darcsdir++"/"++name) "" 152 simply_write_inventory name dir (ps:<:NilRL) = do 153 writeDocBinFile (dir++"/"++darcsdir++"/"++name) $ format_inventory $ mapFL info $ reverseRL ps 154 simply_write_inventory _ _ (NilRL:<:_) = 155 fail $ "Bug in simply_write_inventory, please report!" 156 simply_write_inventory name dir (ps:<:pss) = do 157 tagname <- return $ make_filename $ last $ mapRL info ps 158 simply_write_inventory ("inventories/"++tagname) dir pss 159 writeDocBinFile (dir++"/"++darcsdir++"/"++name) $ text "Starting with tag:" 160 $$ format_inventory (mapFL info $ reverseRL ps) 161 162 write_inventory_and_patches :: RepoPatch p => [DarcsFlag] -> PatchSet p C(x) -> IO () 163 write_inventory_and_patches opts ps = do write_inventory "." ps 164 sequence_ $ mapRL (write_patch opts . hopefully) $ concatRL ps 165 166 add_to_inventory :: FilePath -> [PatchInfo] -> IO () 167 add_to_inventory dir pinfos = 168 appendDocBinFile (dir++"/"++darcsdir++"/inventory") $ text "\n" <> pidocs pinfos 169 where 170 pidocs [] = text "" 171 pidocs (p:ps) = showPatchInfo p $$ pidocs ps 172 173 add_to_tentative_inventory :: forall p C(x y). RepoPatch p => [DarcsFlag] -> Named p C(x y) -> IO FilePath 174 add_to_tentative_inventory opts p = 175 do appendDocBinFile (darcsdir++"/tentative_inventory") $ text "\n" 176 <> showPatchInfo (patch2patchinfo p) 177 when (is_tag $ patch2patchinfo p) $ 178 do debugMessage "Optimizing the tentative inventory, since we're adding a tag." 179 realdir <- toPath `fmap` ioAbsoluteOrRemote "." 180 let k = "Reading tentative inventory" 181 beginTedious k 182 Sealed ps <- read_repo_private k opts realdir "tentative_inventory" 183 :: IO (SealedPatchSet p) 184 simply_write_inventory "tentative_inventory" "." $ slightly_optimize_patchset ps 185 write_patch opts p 186 187 add_to_tentative_pristine :: Effect p => p C(x y) -> IO () 188 add_to_tentative_pristine p = 189 do -- Sealed p <- (fst . fromJust . readPatchCarefully) `fmap` gzReadFilePS fp 190 appendDocBinFile (darcsdir++"/tentative_pristine") $ showPatch (effect p) -- FIXME: this is inefficient! 191 appendBinFile (darcsdir++"/tentative_pristine") "\n" 192 193 remove_from_tentative_inventory :: RepoPatch p => Bool -> [DarcsFlag] -> FL (Named p) C(x y) -> IO () 194 remove_from_tentative_inventory update_pristine opts to_remove = 195 do finalize_tentative_changes 196 Sealed allpatches <- read_repo opts "." 197 skipped :< unmodified <- return $ commute_to_end (unsafeCoerceP to_remove) allpatches 198 sequence_ $ mapFL (write_patch opts) skipped 199 write_inventory "." $ deep_optimize_patchset 200 $ mapRL_RL n2pia (reverseFL skipped) :<: unmodified 201 remove_from_checkpoint_inventory to_remove 202 when update_pristine $ 203 do pris <- identifyPristine 204 repairable $ applyPristine pris 205 $ progressFL "Applying inverse to pristine" $ invert to_remove 206 revert_tentative_changes 207 208 finalize_tentative_changes :: IO () 209 finalize_tentative_changes = renameFile (darcsdir++"/tentative_inventory") (darcsdir++"/inventory") 210 211 finalize_pristine_changes :: IO () 212 finalize_pristine_changes = 213 do Sealed ps <- read_patches $ darcsdir++"/tentative_pristine" 214 pris <- identifyPristine 215 repairable $ applyPristine pris ps 216 where 217 read_patches :: String -> IO (Sealed (FL Prim C(x))) 218 read_patches f = do ps <- B.readFile f 219 return $ case readPatch ps of 220 Just (x, _) -> x 221 Nothing -> seal $ NilFL 222 223 repairable :: IO a -> IO a 224 repairable x = x `clarify_errors` unlines 225 ["Your repository is now in an inconsistent state.", 226 "This must be fixed by running darcs repair."] 227 228 revert_tentative_changes :: IO () 229 revert_tentative_changes = 230 do cloneFile (darcsdir++"/inventory") (darcsdir++"/tentative_inventory") 231 writeBinFile (darcsdir++"/tentative_pristine") "" 232 233 copy_patches :: [DarcsFlag] -> FilePath -> FilePath -> [PatchInfo] -> IO () 234 copy_patches opts dir out patches = do 235 realdir <- toPath `fmap` ioAbsoluteOrRemote dir 236 copyFilesOrUrls opts (realdir++"/"++darcsdir++"/patches") (map make_filename patches) 237 (out++"/"++darcsdir++"/patches") Cachable 238 239 read_repo :: RepoPatch p => [DarcsFlag] -> String -> IO (SealedPatchSet p) 240 read_repo opts d = do 241 realdir <- toPath `fmap` ioAbsoluteOrRemote d 242 let k = "Reading inventory of repository "++d 243 beginTedious k 244 read_repo_private k opts realdir "inventory" `catch` 245 (\e -> do hPutStrLn stderr ("Invalid repository: " ++ realdir) 246 ioError e) 247 248 read_tentative_repo :: RepoPatch p => [DarcsFlag] -> String -> IO (SealedPatchSet p) 249 read_tentative_repo opts d = do 250 realdir <- toPath `fmap` ioAbsoluteOrRemote d 251 let k = "Reading tentative inventory of repository "++d 252 beginTedious k 253 read_repo_private k opts realdir "tentative_inventory" `catch` 254 (\e -> do hPutStrLn stderr ("Invalid repository: " ++ realdir) 255 ioError e) 256 257 read_repo_private :: RepoPatch p => String -> [DarcsFlag] -> FilePath -> FilePath -> IO (SealedPatchSet p) 258 read_repo_private k opts d iname = do 259 i <- gzFetchFilePS (d++"/"++darcsdir++"/"++iname) Uncachable 260 finishedOneIO k iname 261 (rest,str) <- case BC.break ((==) '\n') i of 262 (swt,pistr) | swt == BC.pack "Starting with tag:" -> 263 do r <- rr $ head $ read_patch_ids pistr 264 return (r,pistr) 265 _ -> do endTedious k 266 return (seal NilRL,i) 267 pis <- return $ reverse $ read_patch_ids str 268 isdir <- doesDirectoryExist d 269 let parse f = let fn = d ++ "/"++darcsdir++"/patches/" ++ make_filename f 270 in if isdir then parse_local fn 271 else parse_remote fn 272 lift2Sealed (:<:) (return rest) (read_patches parse pis) 273 where rr pinfo = unsafeInterleaveIO $ read_repo_private k opts d $ 274 "inventories/"++make_filename pinfo 275 -- parse_remote should really download to a temporary file removed 276 -- at exit 277 parse_remote, parse_local :: RepoPatch p => String -> IO (Sealed (Hopefully (Named p) C(x))) 278 parse_remote fn = do ps <- gzFetchFilePS fn Cachable 279 return $ hopefullyNoParseError fn (readPatch ps) 280 parse_local fn = do ps <- gzReadFilePS fn 281 return $ hopefullyNoParseError fn (readPatch ps) 282 hopefullyNoParseError :: String -> Maybe (Sealed (a C(x)), b) -> Sealed (Hopefully a C(x)) 283 hopefullyNoParseError _ (Just (Sealed x, _)) = seal $ actually x 284 hopefullyNoParseError s Nothing = seal $ unavailable $ "Couldn't parse file "++s 285 read_patches :: RepoPatch p => (FORALL(b) PatchInfo -> IO (Sealed (Hopefully (Named p) C(b)))) 286 -> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd p) C(x))) 287 read_patches _ [] = return $ seal NilRL 288 read_patches parse (i:is) = 289 lift2Sealed (\p rest -> i `patchInfoAndPatch` p :<: rest) 290 (read_patches parse is) 291 (parse i `catch` \e -> return $ seal $ unavailable $ show e) 292 lift2Sealed :: (FORALL(y z) q C(y z) -> p C(x y) -> r C(x z)) 293 -> IO (Sealed (p C(x))) -> (FORALL(b) IO (Sealed (q C(b)))) -> IO (Sealed (r C(x))) 294 lift2Sealed f iox ioy = do Sealed x <- unseal seal `fmap` unsafeInterleaveIO iox 295 Sealed y <- unseal seal `fmap` unsafeInterleaveIO ioy 296 return $ seal $ f y x 297 298 read_patch_ids :: B.ByteString -> [PatchInfo] 299 read_patch_ids inv | B.null inv = [] 300 read_patch_ids inv = case readPatchInfo inv of 301 Just (pinfo,r) -> pinfo : read_patch_ids r 302 Nothing -> [] 303 304 read_checkpoints :: String -> IO [(PatchInfo, Maybe Slurpy)] 305 read_checkpoints d = do 306 realdir <- toPath `fmap` ioAbsoluteOrRemote d 307 pistr <- fetchFilePS (realdir++"/"++darcsdir++"/checkpoints/inventory") Uncachable 308 `catchall` return B.empty 309 pis <- return $ reverse $ read_patch_ids pistr 310 slurpies <- sequence $ map (fetch_checkpoint realdir) pis 311 return $ zip pis slurpies 312 where fetch_checkpoint r pinfo = 313 unsafeInterleaveIO $ do 314 pstr <- gzFetchFilePS 315 (r++"/"++darcsdir++"/checkpoints/"++make_filename pinfo) Cachable 316 case fst `liftM` readPatch_ pstr of 317 Nothing -> return Nothing 318 Just (Sealed p) -> return $ apply_to_slurpy p empty_slurpy 319 readPatch_ :: B.ByteString -> Maybe (Sealed (Named Patch C(x)), B.ByteString) 320 readPatch_ = readPatch 321 322 remove_from_checkpoint_inventory :: RepoPatch p => FL (Named p) C(x y) -> IO () 323 remove_from_checkpoint_inventory ps = do 324 -- only tags can be checkpoints 325 let pinfos = filter is_tag $ mapFL patch2patchinfo ps 326 unless (null pinfos) $ do 327 createDirectoryIfMissing False (darcsdir++"/checkpoints") 328 cpi <- (map fst) `liftM` read_checkpoints "." 329 writeDocBinFile (darcsdir++"/checkpoints/inventory") $ 330 format_inventory $ reverse $ filter (`notElem` pinfos) cpi 331 \end{code} 332 333 The \verb!_darcs! directory also contains a directory called 334 ``\verb!prefs!'', which is described in Chapter~\ref{configuring}. 335 336 \begin{comment} 337 \section{Getting interesting info on change history} 338 339 One can query the repository for the entire markup history of a file. This 340 provides a data structure which contains a history of \emph{all} the 341 revisions ever made on a given file. 342 343 \end{comment} 344