    -- 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 ( get_checkpoint, get_checkpoint_by_default,
                                         identify_checkpoint,
                                         write_checkpoint_patch,
                                       ) where

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

    import Darcs.Lock ( writeDocBinFile )
    import Darcs.SlurpDirectory ( Slurpy, empty_slurpy )
    import Darcs.Patch ( RepoPatch, Patch, Named, patch2patchinfo,
                         applyToSlurpy, readPatch, gzWritePatch )
    import Darcs.Witnesses.Ordered ( RL(..), FL(..), mapRL, reverseRL )
    import Darcs.Repository.Internal ( Repository(..), read_repo )
    import Darcs.Patch.Info ( PatchInfo, make_filename, readPatchInfo,
                              showPatchInfo
                            )
    import Darcs.External ( gzFetchFilePS, fetchFilePS, Cachable(..) )
    import Darcs.Flags ( DarcsFlag( Partial, Complete ) )
    import Darcs.Utils ( catchall )
    import Darcs.RepoPath ( ioAbsoluteOrRemote, toPath )
    import Darcs.Global ( darcsdir )
    import Printer ( Doc, ($$), empty )
    import Darcs.Witnesses.Sealed ( Sealed(Sealed), Sealed2(Sealed2), seal, seal2 )
    import Control.Monad ( liftM )

    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 `fmap` (readPatch pstr :: Maybe (Sealed (Named Patch C(x)), B.ByteString)) of
                      Nothing -> return Nothing
                      Just (Sealed p) -> return $ applyToSlurpy p empty_slurpy

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

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

    identify_checkpoint :: RepoPatch p => Repository p C(r u t) -> IO (Maybe PatchInfo)
    identify_checkpoint repository@(Repo r _ _ _) = do
      pis <- (map sp2i . catMaybes . mapRL lastRL) `liftM` read_repo repository
      pistr <- fetchFilePS (r++"/"++darcsdir++"/checkpoints/inventory") Uncachable
               `catchall` return B.empty
      return $ listToMaybe $ filter (`elem` pis) $ reverse $ read_patch_ids pistr
        where lastRL :: RL a C(x y) -> Maybe (Sealed2 a)
              lastRL as = do Sealed ps <- headFL (reverseRL as)
                             return $ seal2 ps
              headFL :: FL a C(x y) -> Maybe (Sealed (a C(x)))
              headFL (x:>:_) = Just $ seal x
              headFL NilFL = Nothing
              sp2i :: Sealed2 (PatchInfoAnd p) -> PatchInfo
              sp2i (Sealed2 p) = info p

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

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

    write_checkpoint_patch :: RepoPatch p => Named p C(x y) -> IO ()
    write_checkpoint_patch p =
     do createDirectoryIfMissing False (darcsdir++"/checkpoints")
        gzWritePatch (darcsdir++"/checkpoints/"++make_filename (patch2patchinfo p)) p
        cpi <- (map fst) `fmap` read_checkpoints "."
        writeDocBinFile (darcsdir++"/checkpoints/inventory")
            $ format_inv $ reverse $ patch2patchinfo p:cpi