%  Copyright (C) 2002-2005 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}
\label{repository_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}
module Darcs.Repository.DarcsRepo ( createPristineDirectoryTree,
                    createPartialsPristineDirectoryTree,
                    slurp_all_but_darcs,
                    read_pending, with_new_pending,
                    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,
                    lazily_read_repo, sync_repo,
                    copy_patches,
                    absolute_dir,
                  ) where

import Darcs.Bug ( bugDoc )
import System.Directory ( doesDirectoryExist )
import Workaround ( getCurrentDirectory, renameFile, createDirectoryIfMissing )
import Darcs.Utils ( withCurrentDirectory, clarify_errors )
import System.IO ( hPutStrLn, stderr )
import System.IO.Unsafe ( unsafeInterleaveIO )
import Control.Monad ( liftM, when, unless )
import Data.Maybe ( isNothing, mapMaybe )
import Darcs.Hopefully ( Hopefully, actually, hopefully, unavailable )
import Darcs.SignalHandler ( withSignalsBlocked )
import FastPackedString ( PackedString, packString, gzReadFilePS,
                          readFilePS, writeFilePS,
                          breakOnPS, nullPS )
import Darcs.Lock ( withTempDir )
import Darcs.SlurpDirectory ( Slurpy, empty_slurpy,
                              slurp, slurp_remove
                            )
import Darcs.Patch ( Patch, is_null_patch, invert, patch2patchinfo,
               apply_to_slurpy, try_to_shrink,
               flatten_to_primitives, join_patches, flatten,
               is_addfile, is_adddir,
               is_hunk, is_binary, merger_equivalent, commute,
               readPatch, readPatchLazily, gzReadPatchFileLazily,
               writePatch, gzWritePatch, showPatch,
               really_eq_patches
             )
import Darcs.Patch.Info ( PatchInfo, make_filename, readPatchInfo, showPatchInfo )
import Darcs.Patch.Set ( PatchSet )
import Darcs.Patch.Depends ( is_tag )
import Darcs.External ( gzFetchFilePS, fetchFilePS, copyFilesOrUrls, Cachable(..),
                        clonePartialsTree )
import Darcs.Lock ( writeBinFile, writeDocBinFile, appendDocBinFile, appendBinFile )
import Darcs.Flags ( DarcsFlag( NoCompress ) )
import Darcs.Patch.Depends ( slightly_optimize_patchset, deep_optimize_patchset, commute_to_end,
                             get_patches_beyond_tag )
import Darcs.Repository.Pristine ( Pristine, identifyPristine, syncPristine,
                                   easyCreatePristineDirectoryTree,
                                   easyCreatePartialsPristineDirectoryTree,
                                   applyPristine,
                                 )
import Darcs.Repository.ApplyPatches ( apply_patches )
import FileName ( fp2fn )
import Darcs.Utils ( catchall )
import Darcs.URL (is_ssh_nopath )
import Printer ( text, (<+>), (<>), Doc, ($$), empty )
#include "impossible.h"
\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}
read_pending :: String -> IO (Maybe Patch)
read_pending name = do
  pend <- gzReadFilePS name `catch`
          (\_ -> return $ packString "")
  case readPatch pend of
    Nothing -> return Nothing
    Just (p,_) -> return $ if is_null_patch p then Nothing else Just p

with_new_pending :: String -> Patch -> IO Slurpy -> IO ()
with_new_pending name origp job =
 do let p = sift_for_pending origp
        newname = name ++ ".new"
    writePatch newname p
    cur <- job
    mp <- read_pending newname
    unless (isNothing mp) $
      when (isNothing $ apply_to_slurpy (fromJust mp) cur) $ do
      let buggyname = name ++ "_buggy"
      renameFile newname buggyname
      bugDoc $ text "There was an attempt to write an invalid pending!"
            $$ text "If possible, please send the contents of"
               <+> text buggyname
            $$ text "along with a bug report."
    renameFile newname name

sift_for_pending :: Patch -> Patch
sift_for_pending patch =
  case flatten_to_primitives $ merger_equivalent patch of
  oldps ->
    if all (\p -> is_addfile p || is_adddir p) oldps
    then join_patches oldps
    else 
      case try_to_shrink $ sfp [] $ reverse oldps of
      ps | length ps < length oldps -> sift_for_pending $ join_patches ps
         | otherwise -> join_patches ps
      where sfp sofar [] = sofar
            sfp sofar (p:ps)
                | is_hunk p || is_binary p
                    = case commute (join_patches sofar, p) of
                      Just (_, sofar') -> sfp (flatten sofar') ps
                      Nothing -> sfp (p:sofar) ps
            sfp sofar (p:ps) = sfp (p:sofar) ps
\end{code}
\begin{code}
write_patch :: [DarcsFlag] -> Patch -> IO FilePath
write_patch opts p =
    case patch2patchinfo p of
    Nothing -> fail "Patch is not a named patch!"
    Just pinfo ->
       do let writeFun = if NoCompress `elem` opts
                         then writePatch
                         else gzWritePatch
              pname = "_darcs/patches/"++make_filename pinfo
          proceed <- hasChanged pname p
          when proceed $ writeFun pname p
          return pname
    where hasChanged :: FilePath -> Patch -> IO Bool
          hasChanged na pa =
             do old <- gzReadFilePS na
                       `catch` (\_ -> return $ packString "")
                case readPatch old of
                  Nothing -> return True -- new patch
                  Just (oldp,_) -> return $ not (oldp `really_eq_patches` pa)
\end{code}

\begin{code}
createPristineDirectoryTree :: Pristine -> FilePath -> IO ()
createPristineDirectoryTree pris fp
 = do done <- easyCreatePristineDirectoryTree pris fp
      unless done $ do
          patches <- get_whole_repo_patches
          createDirectoryIfMissing True fp
          withCurrentDirectory fp $
              apply_patches [] noPut noPut patches
    where noPut _ = return ()

createPartialsPristineDirectoryTree :: [FilePath] -> Pristine -> FilePath
                                    -> IO ()
createPartialsPristineDirectoryTree prefs pris fp
 = do done <- easyCreatePartialsPristineDirectoryTree prefs pris fp
      unless done $ withRecorded (withTempDir "recorded") $ \_ -> do
          clonePartialsTree "." fp prefs

withRecorded :: ((FilePath -> IO a) -> IO a) -> (FilePath -> IO a) -> IO a
withRecorded mk_dir f
 = do dir <- getCurrentDirectory
      mk_dir $ \d -> do
          withCurrentDirectory dir $ do
              pris <- identifyPristine
              createPristineDirectoryTree pris d
          f d

get_checkpoint_sloppily :: IO (Maybe Patch)
get_checkpoint_sloppily = do
  pis <- (map fst . concat) `fmap` read_repo "."
  pistr <- fetchFilePS ("_darcs/checkpoints/inventory") Uncachable
           `catchall` (return $ packString "")
  case filter (`elem` pis) $ reverse $ read_patch_ids pistr of
    [] -> return Nothing
    (pinfo:_) -> ((fst `fmap`). readPatch) `fmap`
                        gzFetchFilePS
                            ("_darcs/checkpoints/"++make_filename
                              pinfo) Cachable

get_whole_repo_patches :: IO [(PatchInfo, Hopefully Patch)]
get_whole_repo_patches = do
    patches <- read_repo "."
    maybe_chk <- get_checkpoint_sloppily
    return $ case maybe_chk of
             Just chk ->
                 let chtg = fromJust (patch2patchinfo chk)
                     rest = concat $ get_patches_beyond_tag chtg patches
                 in (chtg, actually chk):reverse rest
             Nothing -> reverse $ concat patches

sync_repo :: Pristine -> IO ()
sync_repo cur = syncPristine cur

slurp_all_but_darcs :: FilePath -> IO Slurpy
slurp_all_but_darcs d = do s <- slurp d
                           case slurp_remove (fp2fn "./_darcs") s of
                             Nothing -> return s
                             Just s' -> return s'
\end{code}

\begin{code}
--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 :: FilePath -> PatchSet -> 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++"/_darcs/inventories")
    simply_write_inventory "inventory" dir $ slightly_optimize_patchset ps

simply_write_inventory :: String -> FilePath -> PatchSet -> IO ()
simply_write_inventory name dir [] =
    writeBinFile (dir++"/_darcs/"++name) ""
simply_write_inventory name dir [ps] = do
    writeDocBinFile (dir++"/_darcs/"++name) $ format_inventory $ map fst $ reverse ps
simply_write_inventory _ _ ([]:_) =
    fail $ "Bug in simply_write_inventory, please report!"
simply_write_inventory name dir (ps:pss) = do
    tagname <- return $ make_filename $ fst $ last ps
    simply_write_inventory ("inventories/"++tagname) dir pss
    writeDocBinFile (dir++"/_darcs/"++name) $ text "Starting with tag:"
                                           $$ format_inventory (map fst $ reverse ps)

write_inventory_and_patches :: [DarcsFlag] -> PatchSet -> IO ()
write_inventory_and_patches opts ps = do write_inventory "." ps
                                         mapM_ (write_patch opts . hopefully) $ concat ps

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

add_to_tentative_inventory :: [DarcsFlag] -> Patch -> IO FilePath
add_to_tentative_inventory opts p =
    do appendDocBinFile ("_darcs/tentative_inventory") $ text "\n" <> showPatchInfo pinf
       write_patch opts p
    where pinf = fromJust $ patch2patchinfo p

add_to_tentative_pristine :: FilePath -> IO ()
add_to_tentative_pristine fp =
    do p <- liftM (fromJust . liftM fst . readPatch) $ gzReadFilePS fp
       appendDocBinFile ("_darcs/tentative_pristine") $ showPatch p -- FIXME: this is inefficient!
       appendBinFile ("_darcs/tentative_pristine") "\n"

remove_from_tentative_inventory :: [DarcsFlag] -> [Patch] -> IO ()
remove_from_tentative_inventory opts to_remove =
    do finalize_tentative_changes
       allpatches <- read_repo "."
       let (_, skipped) = commute_to_end to_remove allpatches
       sequence_ $ map (write_patch opts) skipped
       repo_patches <- read_repo "."
       write_inventory "." $ foldl (flip rempatch) repo_patches (reverse to_remove)
       remove_from_checkpoint_inventory to_remove
       pris <- identifyPristine
       repairable $ applyPristine pris (invert $ join_patches to_remove)
       revert_tentative_changes
    where rempatch :: Patch -> PatchSet -> PatchSet
          rempatch p (pps:ppss) =
              case patch2patchinfo p of
                Just pinfo -> if pinfo `elem` simple_infos
                              then (filter ((/= pinfo).fst) pps) : ppss
                              else deep_optimize_patchset $
                                   map (filter ((/= pinfo).fst)) (pps:ppss)
                    where simple_infos = init $ map fst pps
                Nothing -> impossible
          rempatch _ [] = impossible       

finalize_tentative_changes :: IO ()
finalize_tentative_changes = renameFile "_darcs/tentative_inventory" "_darcs/inventory"

finalize_pristine_changes :: IO ()
finalize_pristine_changes =
    do ps <- read_patches "_darcs/tentative_pristine"
       pris <- identifyPristine
       repairable $ applyPristine pris $ join_patches ps
    where read_patches f = do ps <- readFilePS f
                              return $ rp ps
          rp ps = case readPatch ps of
                    Just (p, rest) -> p : rp rest
                    Nothing -> []

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 readFilePS "_darcs/inventory" >>= writeFilePS "_darcs/tentative_inventory"
       writeBinFile "_darcs/tentative_pristine" ""
\end{code}

\begin{code}
copy_patches :: [DarcsFlag] -> FilePath -> FilePath -> [PatchInfo] -> IO ()
copy_patches opts dir out patches = do
  realdir <- absolute_dir dir
  copyFilesOrUrls opts (realdir++"/_darcs/patches") (map make_filename patches)
                       (out++"/_darcs/patches") Cachable

read_repo :: String -> IO PatchSet
read_repo d = do
  realdir <- absolute_dir d
  read_repo_private False realdir "inventory" `catch`
              (\e -> do hPutStrLn stderr ("Invalid repository:  " ++ realdir)
                        ioError e)

lazily_read_repo :: String -> IO PatchSet
lazily_read_repo d = do
  realdir <- absolute_dir d
  read_repo_private True realdir "inventory" `catch`
              (\e -> do hPutStrLn stderr ("Invalid repository:  " ++ realdir)
                        ioError e)

read_repo_private :: Bool -> FilePath -> FilePath -> IO PatchSet
read_repo_private am_lazy d iname = do
    i <- fetchFilePS (d++"/_darcs/"++iname) Uncachable
    (rest,str) <- case breakOnPS '\n' i of
                  (swt,pistr) | swt == packString "Starting with tag:" ->
                    do r <- rr $ head $ read_patch_ids pistr
                       return (r,pistr)
                  _ -> return ([],i)
    pis <- return $ reverse $ read_patch_ids str
    isdir <- doesDirectoryExist d
    let parse f = let fn = d ++ "/_darcs/patches/" ++ make_filename f
                  in if isdir then parse_local fn
                              else parse_remote fn
    these <- read_patches parse pis
    return $ these : rest
    where rr pinfo = unsafeInterleaveIO $ read_repo_private am_lazy d $
                     "inventories/"++make_filename pinfo
          -- parse_remote should really download to a temporary file removed
          -- at exit
          parse_remote fn = do ps <- gzFetchFilePS fn Cachable
                               return $ liftM fst $
                                   if am_lazy
                                   then actually $ readPatchLazily ps
                                   else hopefullyNoParseError fn $ readPatch ps
          parse_local fn = if am_lazy
                           then actually `fmap` gzReadPatchFileLazily fn
                           else (hopefullyNoParseError fn . (fmap fst . readPatch))
                                    `fmap` gzReadFilePS fn
          hopefullyNoParseError :: String -> Maybe a -> Hopefully a
          hopefullyNoParseError _ (Just x) = actually x
          hopefullyNoParseError s Nothing = unavailable $ "Couldn't parse file "++s
          read_patches :: (PatchInfo -> IO (Hopefully Patch))
                       -> [PatchInfo] -> IO [(PatchInfo, Hopefully Patch)]
          read_patches _ [] = return []
          read_patches parse (i:is) = do
              mp <- unsafeInterleaveIO $ parse i `catch`
                    \e -> return $ unavailable $ show e
              rest <- read_patches parse is
              return $ (i,mp) : rest

read_patch_ids :: PackedString -> [PatchInfo]
read_patch_ids inv | nullPS inv = []
read_patch_ids inv = case readPatchInfo inv of
                     Just (pinfo,r) -> pinfo : read_patch_ids r
                     Nothing -> []

absolute_dir :: FilePath -> IO FilePath
absolute_dir dir = do
  isdir <- doesDirectoryExist dir
  if not isdir
     then if is_ssh_nopath dir
            then return $ dir++"."
            else return $ if (take 1 $ reverse dir) == "/"
              then init dir
              else dir
             -- hope it's an URL
     else do
          realdir <- withCurrentDirectory dir getCurrentDirectory
                     -- This one is absolute!
          return realdir
\end{code}

\begin{code}
read_checkpoints :: String -> IO [(PatchInfo, Maybe Slurpy)]
read_checkpoints d = do
  realdir <- absolute_dir d
  pistr <- fetchFilePS (realdir++"/_darcs/checkpoints/inventory") Uncachable
           `catchall` (return $ packString "")
  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++"/_darcs/checkpoints/"++make_filename pinfo) Cachable
                case fst `liftM` readPatch pstr of
                  Nothing -> return Nothing
                  Just p -> return $ apply_to_slurpy p empty_slurpy

remove_from_checkpoint_inventory :: [Patch] -> IO ()
remove_from_checkpoint_inventory ps = do
    -- only tags can be checkpoints
    let pinfos = filter is_tag $ mapMaybe patch2patchinfo ps
    unless (null pinfos) $ do
        createDirectoryIfMissing False "_darcs/checkpoints"
        cpi <- (map fst) `liftM` read_checkpoints "."
        writeDocBinFile "_darcs/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}

