% Copyright (C) 2002-2005,2007-2008 David Roundy % % This program is free software; you can redistribute it and/or modify % it under the terms of the GNU General Public License as published by % the Free Software Foundation; either version 2, or (at your option) % any later version. % % This program is distributed in the hope that it will be useful, % but WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with this program; see the file COPYING. If not, write to % the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, % Boston, MA 02110-1301, USA. \chapter{DarcsRepo format} A repository consists of a working directory, which has within it a directory called \verb!_darcs!. There must also be a subdirectory within \verb!_darcs! named \verb!patches!. The \verb!patches! directory contains the actual patches which are in the repository. There must also be a \emph{pristine tree}, which may either be a directory containing a cache of the version of the tree which has been recorded, or a stub, and may be named either ``current'' or ``pristine''. \emph{WARNING!} Viewing files in the pristine cache is perfectly acceptable, but if you view them with an editor (e.g.\ vi or Emacs), that editor may create temporary files in the pristine tree (\verb|_darcs/pristine/| or \verb|_darcs/current/|), which will temporarily cause your repository to be inconsistent. So \emph{don't record any patches while viewing files in \_darcs/current with an editor!} A better plan would be to restrict yourself to viewing these files with a pager such as more or less. Also within \verb!_darcs! is the \verb!inventory! file, which lists all the patches that are in the repository. Moreover, it also gives the order of the representation of the patches as they are stored. Given a source of patches, i.e.\ any other set of repositories which have between them all the patches contained in a given repository, that repository can be reproduced based on only the information in the \verb!inventory! file. Under those circumstances, the order of the patches specified in the \verb!inventory! file would be unimportant, as this order is only needed to provide context for the interpretation of the stored patches in this repository. \begin{code}

    {-# OPTIONS_GHC -cpp -fglasgow-exts #-}
    {-# LANGUAGE CPP, ScopedTypeVariables #-}

    #include "gadts.h"

    module Darcs.Repository.DarcsRepo ( write_inventory, write_inventory_and_patches,
                                        add_to_inventory, add_to_tentative_pristine,
                                        add_to_tentative_inventory, remove_from_tentative_inventory,
                                        finalize_tentative_changes, finalize_pristine_changes,
                                        revert_tentative_changes,
                                        read_repo, read_tentative_repo, write_and_read_patch,
                                        copy_patches
                                      ) where

    import System.Directory ( doesDirectoryExist, createDirectoryIfMissing )
    import Workaround ( renameFile )
    import Darcs.Utils ( clarifyErrors )
    import Progress ( debugMessage, beginTedious, endTedious, finishedOneIO )
    import Darcs.RepoPath ( ioAbsoluteOrRemote, toPath )
    import System.IO ( hPutStrLn, stderr )
    import System.IO.Unsafe ( unsafeInterleaveIO )
    import Control.Monad ( liftM, when, unless )
    import Darcs.Hopefully ( Hopefully, PatchInfoAnd,
                             patchInfoAndPatch, info,
                             actually, hopefully, unavailable, n2pia )
    import Darcs.SignalHandler ( withSignalsBlocked )

    import ByteStringUtils ( gzReadFilePS )
    import qualified Data.ByteString as B (ByteString, null, readFile, empty)
    import qualified Data.ByteString.Char8 as BC (break, pack)

    import Darcs.SlurpDirectory ( Slurpy, empty_slurpy )
    import Darcs.Patch ( RepoPatch, Effect, Prim, Named, Patch, invert,
                         effect,
                         patch2patchinfo,
                         applyToSlurpy,
                         readPatch,
                         writePatch, gzWritePatch, showPatch )
    import Darcs.Witnesses.Ordered ( FL(..), RL(..), (:<)(..),
                                 reverseFL, mapFL, unsafeCoerceP,
                                 reverseRL, concatRL, mapRL, mapRL_RL )
    import Darcs.Patch.Info ( PatchInfo, make_filename, readPatchInfo,
                              showPatchInfo, is_tag
                     )
    import Darcs.Patch.Set ( PatchSet, SealedPatchSet )
    import Darcs.External ( gzFetchFilePS, fetchFilePS, copyFilesOrUrls, Cachable(..),
                            cloneFile )
    import Darcs.Lock ( writeBinFile, writeDocBinFile, appendDocBinFile, appendBinFile )
    import Darcs.Flags ( DarcsFlag( NoCompress ) )
    import Darcs.Patch.Depends ( slightly_optimize_patchset, commute_to_end, deep_optimize_patchset )
    import Darcs.Repository.Pristine ( identifyPristine, applyPristine )
    import Darcs.Global ( darcsdir )
    import Darcs.Utils ( catchall )
    import Darcs.ProgressPatches ( progressFL )
    import Printer ( text, (<>), Doc, ($$), empty )
    import Darcs.Witnesses.Sealed ( Sealed(Sealed), seal, unseal )

\end{code} There is a very special patch which may be stored in \verb!patches! which is called `pending'. This patch describes any changes which have not yet been recorded, and cannot be determined by a simple diff. For example, file additions or renames are placed in pending until they are recorded. Similarly, token replaces are stored in pending until they are recorded. \begin{code}

    write_patch :: RepoPatch p => [DarcsFlag] -> Named p C(x y) -> IO FilePath
    write_patch opts p =
           do let writeFun = if NoCompress `elem` opts
                             then writePatch
                             else gzWritePatch
                  pname = darcsdir++"/patches/"++make_filename (patch2patchinfo p)
              writeFun pname p
              return pname

    write_and_read_patch :: RepoPatch p => [DarcsFlag] -> PatchInfoAnd p C(x y)
                         -> IO (PatchInfoAnd p C(x y))
    write_and_read_patch opts p = do fn <- write_patch opts $ hopefully p
                                     unsafeInterleaveIO $ parse fn
        where parse fn = do debugMessage ("Reading patch file: "++ fn)
                            ps <- gzReadFilePS fn
                            Sealed pp <- case readPatch ps of
                                        Just (x,_) -> return x
                                        Nothing -> fail ("Couldn't parse patch file "++fn)
                            return $ n2pia $ unsafeCoerceP pp

    --format_inventory is not exported for use outside of the DarcsRepo module
    --itself.
    format_inventory :: [PatchInfo] -> Doc
    format_inventory [] = empty
    format_inventory (pinfo:ps) = showPatchInfo pinfo $$ format_inventory ps

    write_inventory :: RepoPatch p => FilePath -> PatchSet p C(x) -> IO ()
    -- Note that write_inventory optimizes the inventory it writes out by
    -- checking on tag dependencies.
    -- FIXME: There is also a problem that write_inventory always writes
    -- out the entire inventory, including the parts that you haven't
    -- changed...
    write_inventory dir ps = withSignalsBlocked $ do
        createDirectoryIfMissing False (dir++"/"++darcsdir++"/inventories")
        simply_write_inventory "inventory" dir $ slightly_optimize_patchset ps

    simply_write_inventory :: RepoPatch p => String -> FilePath -> PatchSet p C(x) -> IO ()
    simply_write_inventory name dir NilRL =
        writeBinFile (dir++"/"++darcsdir++"/"++name) ""
    simply_write_inventory name dir (ps:<:NilRL) = do
        writeDocBinFile (dir++"/"++darcsdir++"/"++name) $ format_inventory $ mapFL info $ reverseRL ps
    simply_write_inventory _ _ (NilRL:<:_) =
        fail $ "Bug in simply_write_inventory, please report!"
    simply_write_inventory name dir (ps:<:pss) = do
        tagname <- return $ make_filename $ last $ mapRL info ps
        simply_write_inventory ("inventories/"++tagname) dir pss
        writeDocBinFile (dir++"/"++darcsdir++"/"++name) $ text "Starting with tag:"
                                               $$ format_inventory (mapFL info $ reverseRL ps)

    write_inventory_and_patches :: RepoPatch p => [DarcsFlag] -> PatchSet p C(x) -> IO ()
    write_inventory_and_patches opts ps = do write_inventory "." ps
                                             sequence_ $ mapRL (write_patch opts . hopefully) $ concatRL ps

    add_to_inventory :: FilePath -> [PatchInfo] -> IO ()
    add_to_inventory dir pinfos =
        appendDocBinFile (dir++"/"++darcsdir++"/inventory") $ text "\n" <> pidocs pinfos
        where
            pidocs [] = text ""
            pidocs (p:ps) = showPatchInfo p $$ pidocs ps

    add_to_tentative_inventory :: forall p C(x y). RepoPatch p => [DarcsFlag] -> Named p C(x y) -> IO FilePath
    add_to_tentative_inventory opts p =
        do appendDocBinFile (darcsdir++"/tentative_inventory") $ text "\n"
                                <> showPatchInfo (patch2patchinfo p)
           when (is_tag $ patch2patchinfo p) $
                do debugMessage "Optimizing the tentative inventory, since we're adding a tag."
                   realdir <- toPath `fmap` ioAbsoluteOrRemote "."
                   let k = "Reading tentative inventory"
                   beginTedious k
                   Sealed ps <- read_repo_private k opts realdir "tentative_inventory"
                                :: IO  (SealedPatchSet p)
                   simply_write_inventory "tentative_inventory" "." $ slightly_optimize_patchset ps
           write_patch opts p

    add_to_tentative_pristine :: Effect p => p C(x y) -> IO ()
    add_to_tentative_pristine p =
        do -- Sealed p <- (fst . fromJust . readPatchCarefully) `fmap` gzReadFilePS fp
           appendDocBinFile (darcsdir++"/tentative_pristine") $ showPatch (effect p) -- FIXME: this is inefficient!
           appendBinFile (darcsdir++"/tentative_pristine") "\n"

    remove_from_tentative_inventory :: RepoPatch p => Bool -> [DarcsFlag] -> FL (Named p) C(x y) -> IO ()
    remove_from_tentative_inventory update_pristine opts to_remove =
        do finalize_tentative_changes
           Sealed allpatches <- read_repo opts "."
           skipped :< unmodified <- return $ commute_to_end (unsafeCoerceP to_remove) allpatches
           sequence_ $ mapFL (write_patch opts) skipped
           write_inventory "." $ deep_optimize_patchset
                               $ mapRL_RL n2pia (reverseFL skipped) :<: unmodified
           remove_from_checkpoint_inventory to_remove
           when update_pristine $
                do pris <- identifyPristine
                   repairable $ applyPristine pris
                                  $ progressFL "Applying inverse to pristine" $ invert to_remove
           revert_tentative_changes

    finalize_tentative_changes :: IO ()
    finalize_tentative_changes = renameFile (darcsdir++"/tentative_inventory") (darcsdir++"/inventory")

    finalize_pristine_changes :: IO ()
    finalize_pristine_changes =
        do Sealed ps <- read_patches $ darcsdir++"/tentative_pristine"
           pris <- identifyPristine
           repairable $ applyPristine pris ps
        where
          read_patches :: String -> IO (Sealed (FL Prim C(x)))
          read_patches f = do ps <- B.readFile f
                              return $ case readPatch ps of
                                       Just (x, _) -> x
                                       Nothing -> seal $ NilFL

    repairable :: IO a -> IO a
    repairable x = x `clarifyErrors` unlines
                   ["Your repository is now in an inconsistent state.",
                    "This must be fixed by running darcs repair."]

    revert_tentative_changes :: IO ()
    revert_tentative_changes =
        do cloneFile (darcsdir++"/inventory") (darcsdir++"/tentative_inventory")
           writeBinFile (darcsdir++"/tentative_pristine") ""

    copy_patches :: [DarcsFlag] -> FilePath -> FilePath -> [PatchInfo] -> IO ()
    copy_patches opts dir out patches = do
      realdir <- toPath `fmap` ioAbsoluteOrRemote dir
      copyFilesOrUrls opts (realdir++"/"++darcsdir++"/patches") (map make_filename patches)
                           (out++"/"++darcsdir++"/patches") Cachable

    read_repo :: RepoPatch p => [DarcsFlag] -> String -> IO (SealedPatchSet p)
    read_repo opts d = do
      realdir <- toPath `fmap` ioAbsoluteOrRemote d
      let k = "Reading inventory of repository "++d
      beginTedious k
      read_repo_private k opts realdir "inventory" `catch`
                            (\e -> do hPutStrLn stderr ("Invalid repository:  " ++ realdir)
                                      ioError e)

    read_tentative_repo :: RepoPatch p => [DarcsFlag] -> String -> IO (SealedPatchSet p)
    read_tentative_repo opts d = do
      realdir <- toPath `fmap` ioAbsoluteOrRemote d
      let k = "Reading tentative inventory of repository "++d
      beginTedious k
      read_repo_private k opts realdir "tentative_inventory" `catch`
                            (\e -> do hPutStrLn stderr ("Invalid repository:  " ++ realdir)
                                      ioError e)

    read_repo_private :: RepoPatch p => String -> [DarcsFlag] -> FilePath -> FilePath -> IO (SealedPatchSet p)
    read_repo_private k opts d iname = do
        i <- gzFetchFilePS (d++"/"++darcsdir++"/"++iname) Uncachable
        finishedOneIO k iname
        (rest,str) <- case BC.break ((==) '\n') i of
                      (swt,pistr) | swt == BC.pack "Starting with tag:" ->
                        do r <- rr $ head $ read_patch_ids pistr
                           return (r,pistr)
                      _ -> do endTedious k
                              return (seal NilRL,i)
        pis <- return $ reverse $ read_patch_ids str
        isdir <- doesDirectoryExist d
        let parse f = let fn = d ++ "/"++darcsdir++"/patches/" ++ make_filename f
                      in if isdir then parse_local fn
                                  else parse_remote fn
        lift2Sealed (:<:) (return rest) (read_patches parse pis)
        where rr pinfo = unsafeInterleaveIO $ read_repo_private k opts d $
                         "inventories/"++make_filename pinfo
              -- parse_remote should really download to a temporary file removed
              -- at exit
              parse_remote, parse_local :: RepoPatch p => String -> IO (Sealed (Hopefully (Named p) C(x)))
              parse_remote fn = do ps <- gzFetchFilePS fn Cachable
                                   return $ hopefullyNoParseError fn (readPatch ps)
              parse_local fn = do ps <- gzReadFilePS fn
                                  return $ hopefullyNoParseError fn (readPatch ps)
              hopefullyNoParseError :: String -> Maybe (Sealed (a C(x)), b) -> Sealed (Hopefully a C(x))
              hopefullyNoParseError _ (Just (Sealed x, _)) = seal $ actually x
              hopefullyNoParseError s Nothing = seal $ unavailable $ "Couldn't parse file "++s
              read_patches :: RepoPatch p => (FORALL(b) PatchInfo -> IO (Sealed (Hopefully (Named p) C(b))))
                           -> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd p) C(x)))
              read_patches _ [] = return $ seal NilRL
              read_patches parse (i:is) =
                  lift2Sealed (\p rest -> i `patchInfoAndPatch` p :<: rest)
                              (read_patches parse is)
                              (parse i `catch` \e -> return $ seal $ unavailable $ show e)
              lift2Sealed :: (FORALL(y z) q C(y z) -> p C(x y) -> r C(x z))
                          -> IO (Sealed (p C(x))) -> (FORALL(b) IO (Sealed (q C(b)))) -> IO (Sealed (r C(x)))
              lift2Sealed f iox ioy = do Sealed x <- unseal seal `fmap` unsafeInterleaveIO iox
                                         Sealed y <- unseal seal `fmap` unsafeInterleaveIO ioy
                                         return $ seal $ f y x

    read_patch_ids :: B.ByteString -> [PatchInfo]
    read_patch_ids inv | B.null inv = []
    read_patch_ids inv = case readPatchInfo inv of
                         Just (pinfo,r) -> pinfo : read_patch_ids r
                         Nothing -> []

    read_checkpoints :: String -> IO [(PatchInfo, Maybe Slurpy)]
    read_checkpoints d = do
      realdir <- toPath `fmap` ioAbsoluteOrRemote d
      pistr <- fetchFilePS (realdir++"/"++darcsdir++"/checkpoints/inventory") Uncachable
               `catchall` return B.empty
      pis <- return $ reverse $ read_patch_ids pistr
      slurpies <- sequence $ map (fetch_checkpoint realdir) pis
      return $ zip pis slurpies
          where fetch_checkpoint r pinfo =
                    unsafeInterleaveIO $ do
                    pstr <- gzFetchFilePS
                        (r++"/"++darcsdir++"/checkpoints/"++make_filename pinfo) Cachable
                    case fst `liftM` readPatch_ pstr of
                      Nothing -> return Nothing
                      Just (Sealed p) -> return $ applyToSlurpy p empty_slurpy
                readPatch_ :: B.ByteString -> Maybe (Sealed (Named Patch C(x)), B.ByteString)
                readPatch_ = readPatch

    remove_from_checkpoint_inventory :: RepoPatch p => FL (Named p) C(x y) -> IO ()
    remove_from_checkpoint_inventory ps = do
        -- only tags can be checkpoints
        let pinfos = filter is_tag $ mapFL patch2patchinfo ps
        unless (null pinfos) $ do
            createDirectoryIfMissing False (darcsdir++"/checkpoints")
            cpi <- (map fst) `liftM` read_checkpoints "."
            writeDocBinFile (darcsdir++"/checkpoints/inventory") $
                format_inventory $ reverse $ filter (`notElem` pinfos) cpi

\end{code} The \verb!_darcs! directory also contains a directory called ``\verb!prefs!'', which is described in Chapter~\ref{configuring}. \begin{comment} \section{Getting interesting info on change history} One can query the repository for the entire markup history of a file. This provides a data structure which contains a history of \emph{all} the revisions ever made on a given file. \end{comment}