-- 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.

{-# OPTIONS_GHC -cpp #-}
{-# LANGUAGE CPP #-}

#include "gadts.h"

module Darcs.Repository.Checkpoint ( getCheckpoint, getCheckpointByDefault,
                                     identifyCheckpoint,
                                     writeCheckpointPatch,
                                   ) where

import System.Directory ( createDirectoryIfMissing )
import Data.Maybe ( listToMaybe )
import Darcs.Hopefully ( PatchInfoAnd, info )
import qualified Data.ByteString as B ( null, empty, ByteString )

import Darcs.Lock ( writeDocBinFile )
import Darcs.Patch ( RepoPatch, Named, patch2patchinfo,
                     readPatch, gzWritePatch )
import Darcs.Witnesses.Ordered ( mapRL )
import Darcs.Repository.Internal ( Repository(..), readRepo )
import Darcs.Repository.DarcsRepo ( readCheckpoints )
import Darcs.Patch.Info ( PatchInfo, makeFilename, readPatchInfo,
                          showPatchInfo )
import Darcs.Patch.Set( PatchSet(..), Tagged(..) )
import Darcs.External ( gzFetchFilePS, fetchFilePS, Cachable(..) )
import Darcs.Flags ( DarcsFlag( Partial, Complete ) )
import Darcs.Utils ( catchall )
import Darcs.Global ( darcsdir )
import Printer ( Doc, ($$), empty )
import Darcs.Witnesses.Sealed ( Sealed, Sealed2(Sealed2), seal2 )
import Control.Monad ( liftM )

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

getCheckpoint :: RepoPatch p => Repository p C(r u t) -> IO (Maybe (Sealed (Named p C(x))))
getCheckpoint repository@(Repo _ opts _ _) = if Partial `elem` opts
                                              then getCheckInternal repository
                                              else return Nothing

getCheckpointByDefault :: RepoPatch p => Repository p C(r u t) -> IO (Maybe (Sealed (Named p C(x))))
getCheckpointByDefault repository@(Repo _ opts _ _) = if Complete `elem` opts
                                                         then return Nothing
                                                         else getCheckInternal repository

identifyCheckpoint :: RepoPatch p => Repository p C(r u t) -> IO (Maybe PatchInfo)
identifyCheckpoint repository@(Repo r _ _ _) = do
  pis <- (map sp2i . extractTags) `liftM` readRepo repository
  pistr <- fetchFilePS (r++"/"++darcsdir++"/checkpoints/inventory") Uncachable
           `catchall` return B.empty
  return $ listToMaybe $ filter (`elem` pis) $ reverse $ readPatchIds pistr
    where extractTags :: PatchSet p C(start end) -> [Sealed2 (PatchInfoAnd p)]
          extractTags (PatchSet _ ts) = mapRL (\(Tagged t _ _) -> seal2 t) ts
          sp2i :: Sealed2 (PatchInfoAnd p) -> PatchInfo
          sp2i (Sealed2 p) = info p

getCheckInternal :: RepoPatch p => Repository p C(r u t) -> IO (Maybe (Sealed (Named p C(x))))
getCheckInternal repository@(Repo r _ _ _) = do
  mc <- identifyCheckpoint repository
  case mc of
    Nothing -> return Nothing
    Just pinfo ->  do ps <- gzFetchFilePS
                            (r++"/"++darcsdir++"/checkpoints/"++makeFilename pinfo) Cachable
                      return $ case readPatch ps of
                               Just (p, _) -> Just p
                               Nothing -> Nothing

formatInv :: [PatchInfo] -> Doc
formatInv [] = empty
formatInv (pinfo:ps) = showPatchInfo pinfo
                     $$ formatInv ps

writeCheckpointPatch :: RepoPatch p => Named p C(x y) -> IO ()
writeCheckpointPatch p =
 do createDirectoryIfMissing False (darcsdir++"/checkpoints")
    gzWritePatch (darcsdir++"/checkpoints/"++makeFilename (patch2patchinfo p)) p
    cpi <- readCheckpoints "."
    writeDocBinFile (darcsdir++"/checkpoints/inventory")
        $ formatInv $ reverse $ patch2patchinfo p:cpi