%  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 ( clarify_errors )
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,
                     apply_to_slurpy,
                     readPatch,
                     writePatch, gzWritePatch, showPatch )
import Darcs.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.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 `clarify_errors` 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 $ apply_to_slurpy 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}