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

module Darcs.Repository.Old ( readOldRepo,
                              oldRepoFailMsg ) where

import Prelude ()
import Darcs.Prelude

import Darcs.Util.Progress ( debugMessage, beginTedious, endTedious, finishedOneIO )
import Darcs.Util.Path ( ioAbsoluteOrRemote, toPath )
import System.IO ( hPutStrLn, stderr )
import System.IO.Unsafe ( unsafeInterleaveIO )
import System.FilePath.Posix ( (</>) )
import Darcs.Patch.PatchInfoAnd ( Hopefully, PatchInfoAnd,
                         patchInfoAndPatch,
                         actually, unavailable )

import qualified Data.ByteString as B ( ByteString, null )
import qualified Data.ByteString.Char8 as BC ( break, pack, unpack )

import Darcs.Patch ( RepoPatch, IsRepoType, WrappedNamed,
                     readPatch )
import Darcs.Patch.ReadMonads as RM ( parseStrictly )
import Darcs.Patch.Witnesses.Ordered ( RL(..) )
import Darcs.Patch.Witnesses.Sealed ( Sealed(Sealed), seal, unseal, mapSeal )
import Darcs.Patch.Info ( PatchInfo(..), makePatchname, readPatchInfo, displayPatchInfo )
import Darcs.Patch.Set ( PatchSet(..), Tagged(..), SealedPatchSet, Origin )
import Darcs.Util.External
    ( gzFetchFilePS
    , Cachable(..)
    )
import Darcs.Util.Printer ( renderString )
import Darcs.Util.Global ( darcsdir )
import Darcs.Util.Hash ( sha1PS )
import Darcs.Util.IsoDate ( readUTCDateOldFashioned, showIsoDateTime )

import Control.Exception ( catch, IOException )

readOldRepo :: (IsRepoType rt, RepoPatch p) => String -> IO (SealedPatchSet rt p Origin)
readOldRepo repo_dir = do
  realdir <- toPath `fmap` ioAbsoluteOrRemote repo_dir
  let task = "Reading inventory of repository "++repo_dir
  beginTedious task
  readRepoPrivate task realdir "inventory" `catch`
                        (\e -> do hPutStrLn stderr ("Invalid repository:  " ++ realdir)
                                  ioError e)

readRepoPrivate :: (IsRepoType rt, RepoPatch p)
                => String -> FilePath -> FilePath -> IO (SealedPatchSet rt p Origin)
readRepoPrivate task repo_dir inventory_name = do
    inventory <- gzFetchFilePS (repo_dir </> darcsdir </> inventory_name) Uncachable
    finishedOneIO task inventory_name
    let parse inf = parse2 inf $ repo_dir </> darcsdir </> "patches" </> makeFilename inf
        (mt, is) = case BC.break ('\n' ==) inventory of
                   (swt,pistr) | swt == BC.pack "Starting with tag:" ->
                                     case readPatchInfos pistr of
                                     (t:ids) -> (Just t,reverse ids)
                                     [] -> bug "bad inventory in readRepoPrivate"
                   _ -> (Nothing, reverse $ readPatchInfos inventory)
    Sealed ts <- unseal seal `fmap` unsafeInterleaveIO (read_ts parse mt)
    Sealed ps <- unseal seal `fmap` unsafeInterleaveIO (read_patches parse is)
    return $ seal (PatchSet ts ps)
    where read_ts :: RepoPatch p =>
                     (forall wB . PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB)))
                  -> Maybe PatchInfo -> IO (Sealed (RL (Tagged rt p) Origin))
          read_ts _ Nothing = do endTedious task
                                 return $ seal NilRL
          read_ts parse (Just tag0) =
              do debugMessage $ "Looking for inventory for:\n"++ renderString (displayPatchInfo tag0)
                 i <- unsafeInterleaveIO $
                      do x <- gzFetchFilePS (repo_dir </> darcsdir </> "inventories" </> makeFilename tag0) Uncachable
                         finishedOneIO task (renderString (displayPatchInfo tag0))
                         return x
                 let (mt, is) = case BC.break ('\n' ==) i of
                                (swt,pistr) | swt == BC.pack "Starting with tag:" ->
                                                case readPatchInfos pistr of
                                                (t:ids) -> (Just t,reverse ids)
                                                [] -> bug "bad inventory in readRepoPrivate"
                                _ -> (Nothing, reverse $ readPatchInfos i)
                 Sealed ts <- fmap (unseal seal) $ unsafeInterleaveIO $ read_ts parse mt
                 Sealed ps <- unseal seal `fmap` unsafeInterleaveIO (read_patches parse is)
                 Sealed tag00 <-  parse tag0 `catch`
                                  \(e :: IOException) ->
                                        return $ seal $
                                        patchInfoAndPatch tag0 $ unavailable $ show e
                 return $ seal $ ts :<: Tagged tag00 Nothing ps
          parse2 :: (IsRepoType rt, RepoPatch p)
                 => PatchInfo -> FilePath
                 -> IO (Sealed (PatchInfoAnd rt p wX))
          parse2 i fn = do ps <- unsafeInterleaveIO $ gzFetchFilePS fn Cachable
                           return $ patchInfoAndPatch i
                             `mapSeal` hopefullyNoParseError (toPath fn) (readPatch ps)
          hopefullyNoParseError :: String -> Maybe (Sealed (WrappedNamed rt a1dr wX))
                                -> Sealed (Hopefully (WrappedNamed rt a1dr) wX)
          hopefullyNoParseError _ (Just (Sealed x)) = seal $ actually x
          hopefullyNoParseError s Nothing = seal $ unavailable $ "Couldn't parse file "++s
          read_patches :: RepoPatch p =>
                          (forall wB . PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB)))
                       -> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
          read_patches _ [] = return $ seal NilRL
          read_patches parse (i:is) =
              lift2Sealed (flip (:<:))
                          (read_patches parse is)
                          (parse i `catch` \(e :: IOException) ->
                           return $ seal $ patchInfoAndPatch i $ unavailable $ show e)
          lift2Sealed :: (forall wY wZ . q wY wZ -> pp wY -> r wZ)
                      -> IO (Sealed pp) -> (forall wB . IO (Sealed (q wB))) -> IO (Sealed r)
          lift2Sealed f iox ioy = do Sealed x <- unseal seal `fmap` unsafeInterleaveIO iox
                                     Sealed y <- unseal seal `fmap` unsafeInterleaveIO ioy
                                     return $ seal $ f y x

oldRepoFailMsg :: String
oldRepoFailMsg = "ERROR: repository upgrade required, try `darcs optimize upgrade`\n"
              ++ "See http://wiki.darcs.net/OF for more details."

-- | This makes darcs-1 (non-hashed repos) filenames.
--
-- The name consists of three segments:
--
--  * timestamp (ISO8601-compatible yyyymmmddHHMMSS;
--    note that the old-fashioned (non-hashed) format expects this date to
--    be exactly as in the patch, /ignoring/ any timezone info,
--    which is why we use 'readUTCDateOldFashioned' here)
--
--  * SHA1 hash of the author
--
--  * SHA1 hash of the patch name, author, date, log, and \"inverted\"
--    flag.
makeFilename :: PatchInfo -> String
makeFilename pi = showIsoDateTime d++"-"++sha1_a++"-"++ (show $ makePatchname pi) ++ ".gz"
    where d = readUTCDateOldFashioned $ BC.unpack $ _piDate pi
          sha1_a = take 5 $ show $ sha1PS $ _piAuthor pi

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