src/Darcs/Repository/DarcsRepo.lhs

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