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

import Control.Applicative ( many )
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 )
import qualified Data.ByteString.Char8 as BC ( break, pack, unpack )

import Darcs.Patch ( RepoPatch, Named, readPatch )
import qualified Darcs.Util.Parser as P ( parse )
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.File
    ( 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 :: RepoPatch p => String -> IO (SealedPatchSet p Origin)
readOldRepo :: forall (p :: * -> * -> *).
RepoPatch p =>
String -> IO (SealedPatchSet p Origin)
readOldRepo String
repo_dir = do
  String
realdir <- AbsoluteOrRemotePath -> String
forall a. FilePathOrURL a => a -> String
toPath (AbsoluteOrRemotePath -> String)
-> IO AbsoluteOrRemotePath -> IO String
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO AbsoluteOrRemotePath
ioAbsoluteOrRemote String
repo_dir
  let task :: String
task = String
"Reading inventory of repository "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
repo_dir
  String -> IO ()
beginTedious String
task
  String -> String -> String -> IO (SealedPatchSet p Origin)
forall (p :: * -> * -> *).
RepoPatch p =>
String -> String -> String -> IO (SealedPatchSet p Origin)
readRepoPrivate String
task String
realdir String
"inventory" IO (SealedPatchSet p Origin)
-> (IOError -> IO (SealedPatchSet p Origin))
-> IO (SealedPatchSet p Origin)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
                        (\IOError
e -> do Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Invalid repository:  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
realdir)
                                  IOError -> IO (SealedPatchSet p Origin)
forall a. IOError -> IO a
ioError IOError
e)

readRepoPrivate :: RepoPatch p
                => String -> FilePath -> FilePath -> IO (SealedPatchSet p Origin)
readRepoPrivate :: forall (p :: * -> * -> *).
RepoPatch p =>
String -> String -> String -> IO (SealedPatchSet p Origin)
readRepoPrivate String
task String
repo_dir String
inventory_name = do
    ByteString
inventory <- String -> Cachable -> IO ByteString
gzFetchFilePS (String
repo_dir String -> String -> String
</> String
darcsdir String -> String -> String
</> String
inventory_name) Cachable
Uncachable
    String -> String -> IO ()
finishedOneIO String
task String
inventory_name
    let parse :: PatchInfo -> IO (Sealed (PatchInfoAnd p wX))
parse PatchInfo
inf = PatchInfo -> String -> IO (Sealed (PatchInfoAnd p wX))
forall (p :: * -> * -> *) wX.
RepoPatch p =>
PatchInfo -> String -> IO (Sealed (PatchInfoAnd p wX))
parse2 PatchInfo
inf (String -> IO (Sealed (PatchInfoAnd p wX)))
-> String -> IO (Sealed (PatchInfoAnd p wX))
forall a b. (a -> b) -> a -> b
$ String
repo_dir String -> String -> String
</> String
darcsdir String -> String -> String
</> String
"patches" String -> String -> String
</> PatchInfo -> String
makeFilename PatchInfo
inf
    (Maybe PatchInfo
mt, [PatchInfo]
is) <- ByteString -> IO (Maybe PatchInfo, [PatchInfo])
readInventory ByteString
inventory
    Sealed RL (Tagged p) Origin wX
ts <- (forall wX.
 RL (Tagged p) Origin wX -> Sealed (RL (Tagged p) Origin))
-> Sealed (RL (Tagged p) Origin) -> Sealed (RL (Tagged p) Origin)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal RL (Tagged p) Origin wX -> Sealed (RL (Tagged p) Origin)
forall wX. RL (Tagged p) Origin wX -> Sealed (RL (Tagged p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Sealed (RL (Tagged p) Origin) -> Sealed (RL (Tagged p) Origin))
-> IO (Sealed (RL (Tagged p) Origin))
-> IO (Sealed (RL (Tagged p) Origin))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO (Sealed (RL (Tagged p) Origin))
-> IO (Sealed (RL (Tagged p) Origin))
forall a. IO a -> IO a
unsafeInterleaveIO ((forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB)))
-> Maybe PatchInfo -> IO (Sealed (RL (Tagged p) Origin))
forall (p :: * -> * -> *).
RepoPatch p =>
(forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB)))
-> Maybe PatchInfo -> IO (Sealed (RL (Tagged p) Origin))
read_ts PatchInfo -> IO (Sealed (PatchInfoAnd p wB))
forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB))
forall {p :: * -> * -> *} {wX}.
(ApplyState p ~ ApplyState (PrimOf p), Check p, Conflict p,
 Effect p, FromPrim p, IsHunk p, Merge p, PrimPatchBase p,
 Summary p, ToPrim p, Unwind p, PatchInspect p, RepairToFL p,
 Commute p, Eq2 p, ReadPatch p, ShowPatch p, ShowContextPatch p,
 PatchListFormat p) =>
PatchInfo -> IO (Sealed (PatchInfoAnd p wX))
parse Maybe PatchInfo
mt)
    Sealed RL (PatchInfoAnd p) wX wX
ps <- (forall wX.
 RL (PatchInfoAnd p) wX wX -> Sealed (RL (PatchInfoAnd p) wX))
-> Sealed (RL (PatchInfoAnd p) wX)
-> Sealed (RL (PatchInfoAnd p) wX)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal RL (PatchInfoAnd p) wX wX -> Sealed (RL (PatchInfoAnd p) wX)
forall wX.
RL (PatchInfoAnd p) wX wX -> Sealed (RL (PatchInfoAnd p) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Sealed (RL (PatchInfoAnd p) wX)
 -> Sealed (RL (PatchInfoAnd p) wX))
-> IO (Sealed (RL (PatchInfoAnd p) wX))
-> IO (Sealed (RL (PatchInfoAnd p) wX))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO (Sealed (RL (PatchInfoAnd p) wX))
-> IO (Sealed (RL (PatchInfoAnd p) wX))
forall a. IO a -> IO a
unsafeInterleaveIO ((forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB)))
-> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd p) wX))
forall (p :: * -> * -> *) wX.
RepoPatch p =>
(forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB)))
-> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd p) wX))
read_patches PatchInfo -> IO (Sealed (PatchInfoAnd p wB))
forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB))
forall {p :: * -> * -> *} {wX}.
(ApplyState p ~ ApplyState (PrimOf p), Check p, Conflict p,
 Effect p, FromPrim p, IsHunk p, Merge p, PrimPatchBase p,
 Summary p, ToPrim p, Unwind p, PatchInspect p, RepairToFL p,
 Commute p, Eq2 p, ReadPatch p, ShowPatch p, ShowContextPatch p,
 PatchListFormat p) =>
PatchInfo -> IO (Sealed (PatchInfoAnd p wX))
parse [PatchInfo]
is)
    SealedPatchSet p Origin -> IO (SealedPatchSet p Origin)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SealedPatchSet p Origin -> IO (SealedPatchSet p Origin))
-> SealedPatchSet p Origin -> IO (SealedPatchSet p Origin)
forall a b. (a -> b) -> a -> b
$ PatchSet p Origin wX -> SealedPatchSet p Origin
forall (a :: * -> *) wX. a wX -> Sealed a
seal (RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts RL (PatchInfoAnd p) wX wX
ps)
    where read_ts :: RepoPatch p =>
                     (forall wB . PatchInfo -> IO (Sealed (PatchInfoAnd p wB)))
                  -> Maybe PatchInfo -> IO (Sealed (RL (Tagged p) Origin))
          read_ts :: forall (p :: * -> * -> *).
RepoPatch p =>
(forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB)))
-> Maybe PatchInfo -> IO (Sealed (RL (Tagged p) Origin))
read_ts forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB))
_ Maybe PatchInfo
Nothing = do String -> IO ()
endTedious String
task
                                 Sealed (RL (Tagged p) Origin) -> IO (Sealed (RL (Tagged p) Origin))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RL (Tagged p) Origin)
 -> IO (Sealed (RL (Tagged p) Origin)))
-> Sealed (RL (Tagged p) Origin)
-> IO (Sealed (RL (Tagged p) Origin))
forall a b. (a -> b) -> a -> b
$ RL (Tagged p) Origin Origin -> Sealed (RL (Tagged p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal RL (Tagged p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
          read_ts forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB))
parse (Just PatchInfo
tag0) =
              do String -> IO ()
debugMessage (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Looking for inventory for:\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
renderString (PatchInfo -> Doc
displayPatchInfo PatchInfo
tag0)
                 ByteString
i <- IO ByteString -> IO ByteString
forall a. IO a -> IO a
unsafeInterleaveIO (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$
                      do ByteString
x <- String -> Cachable -> IO ByteString
gzFetchFilePS (String
repo_dir String -> String -> String
</> String
darcsdir String -> String -> String
</> String
"inventories" String -> String -> String
</> PatchInfo -> String
makeFilename PatchInfo
tag0) Cachable
Uncachable
                         String -> String -> IO ()
finishedOneIO String
task (Doc -> String
renderString (PatchInfo -> Doc
displayPatchInfo PatchInfo
tag0))
                         ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
x
                 (Maybe PatchInfo
mt, [PatchInfo]
is) <- ByteString -> IO (Maybe PatchInfo, [PatchInfo])
readInventory ByteString
i
                 Sealed RL (Tagged p) Origin wX
ts <- (Sealed (RL (Tagged p) Origin) -> Sealed (RL (Tagged p) Origin))
-> IO (Sealed (RL (Tagged p) Origin))
-> IO (Sealed (RL (Tagged p) Origin))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall wX.
 RL (Tagged p) Origin wX -> Sealed (RL (Tagged p) Origin))
-> Sealed (RL (Tagged p) Origin) -> Sealed (RL (Tagged p) Origin)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal RL (Tagged p) Origin wX -> Sealed (RL (Tagged p) Origin)
forall wX. RL (Tagged p) Origin wX -> Sealed (RL (Tagged p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal) (IO (Sealed (RL (Tagged p) Origin))
 -> IO (Sealed (RL (Tagged p) Origin)))
-> IO (Sealed (RL (Tagged p) Origin))
-> IO (Sealed (RL (Tagged p) Origin))
forall a b. (a -> b) -> a -> b
$ IO (Sealed (RL (Tagged p) Origin))
-> IO (Sealed (RL (Tagged p) Origin))
forall a. IO a -> IO a
unsafeInterleaveIO (IO (Sealed (RL (Tagged p) Origin))
 -> IO (Sealed (RL (Tagged p) Origin)))
-> IO (Sealed (RL (Tagged p) Origin))
-> IO (Sealed (RL (Tagged p) Origin))
forall a b. (a -> b) -> a -> b
$ (forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB)))
-> Maybe PatchInfo -> IO (Sealed (RL (Tagged p) Origin))
forall (p :: * -> * -> *).
RepoPatch p =>
(forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB)))
-> Maybe PatchInfo -> IO (Sealed (RL (Tagged p) Origin))
read_ts PatchInfo -> IO (Sealed (PatchInfoAnd p wB))
forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB))
parse Maybe PatchInfo
mt
                 Sealed RL (PatchInfoAnd p) wX wX
ps <- (forall wX.
 RL (PatchInfoAnd p) wX wX -> Sealed (RL (PatchInfoAnd p) wX))
-> Sealed (RL (PatchInfoAnd p) wX)
-> Sealed (RL (PatchInfoAnd p) wX)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal RL (PatchInfoAnd p) wX wX -> Sealed (RL (PatchInfoAnd p) wX)
forall wX.
RL (PatchInfoAnd p) wX wX -> Sealed (RL (PatchInfoAnd p) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Sealed (RL (PatchInfoAnd p) wX)
 -> Sealed (RL (PatchInfoAnd p) wX))
-> IO (Sealed (RL (PatchInfoAnd p) wX))
-> IO (Sealed (RL (PatchInfoAnd p) wX))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO (Sealed (RL (PatchInfoAnd p) wX))
-> IO (Sealed (RL (PatchInfoAnd p) wX))
forall a. IO a -> IO a
unsafeInterleaveIO ((forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB)))
-> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd p) wX))
forall (p :: * -> * -> *) wX.
RepoPatch p =>
(forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB)))
-> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd p) wX))
read_patches PatchInfo -> IO (Sealed (PatchInfoAnd p wB))
forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB))
parse [PatchInfo]
is)
                 Sealed PatchInfoAnd p wX wX
tag00 <-  PatchInfo -> IO (Sealed (PatchInfoAnd p wX))
forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB))
parse PatchInfo
tag0 IO (Sealed (PatchInfoAnd p wX))
-> (IOError -> IO (Sealed (PatchInfoAnd p wX)))
-> IO (Sealed (PatchInfoAnd p wX))
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
                                  \(IOError
e :: IOException) ->
                                        Sealed (PatchInfoAnd p wX) -> IO (Sealed (PatchInfoAnd p wX))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (PatchInfoAnd p wX) -> IO (Sealed (PatchInfoAnd p wX)))
-> Sealed (PatchInfoAnd p wX) -> IO (Sealed (PatchInfoAnd p wX))
forall a b. (a -> b) -> a -> b
$ PatchInfoAnd p wX Any -> Sealed (PatchInfoAnd p wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (PatchInfoAnd p wX Any -> Sealed (PatchInfoAnd p wX))
-> PatchInfoAnd p wX Any -> Sealed (PatchInfoAnd p wX)
forall a b. (a -> b) -> a -> b
$
                                        PatchInfo -> Hopefully (Named p) wX Any -> PatchInfoAnd p wX Any
forall (p :: * -> * -> *) wA wB.
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG p wA wB
patchInfoAndPatch PatchInfo
tag0 (Hopefully (Named p) wX Any -> PatchInfoAnd p wX Any)
-> Hopefully (Named p) wX Any -> PatchInfoAnd p wX Any
forall a b. (a -> b) -> a -> b
$ String -> Hopefully (Named p) wX Any
forall (a :: * -> * -> *) wX wY. String -> Hopefully a wX wY
unavailable (String -> Hopefully (Named p) wX Any)
-> String -> Hopefully (Named p) wX Any
forall a b. (a -> b) -> a -> b
$ IOError -> String
forall a. Show a => a -> String
show IOError
e
                 Sealed (RL (Tagged p) Origin) -> IO (Sealed (RL (Tagged p) Origin))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RL (Tagged p) Origin)
 -> IO (Sealed (RL (Tagged p) Origin)))
-> Sealed (RL (Tagged p) Origin)
-> IO (Sealed (RL (Tagged p) Origin))
forall a b. (a -> b) -> a -> b
$ RL (Tagged p) Origin wX -> Sealed (RL (Tagged p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (RL (Tagged p) Origin wX -> Sealed (RL (Tagged p) Origin))
-> RL (Tagged p) Origin wX -> Sealed (RL (Tagged p) Origin)
forall a b. (a -> b) -> a -> b
$ RL (Tagged p) Origin wX
ts RL (Tagged p) Origin wX
-> Tagged p wX wX -> RL (Tagged p) Origin wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: RL (PatchInfoAnd p) wX wX
-> PatchInfoAnd p wX wX -> Maybe InventoryHash -> Tagged p wX wX
forall (p :: * -> * -> *) wX wY wZ.
RL (PatchInfoAnd p) wX wY
-> PatchInfoAnd p wY wZ -> Maybe InventoryHash -> Tagged p wX wZ
Tagged RL (PatchInfoAnd p) wX wX
ps PatchInfoAnd p wX wX
tag00 Maybe InventoryHash
forall a. Maybe a
Nothing
          parse2 :: RepoPatch p
                 => PatchInfo -> FilePath
                 -> IO (Sealed (PatchInfoAnd p wX))
          parse2 :: forall (p :: * -> * -> *) wX.
RepoPatch p =>
PatchInfo -> String -> IO (Sealed (PatchInfoAnd p wX))
parse2 PatchInfo
i String
fn = do ByteString
ps <- IO ByteString -> IO ByteString
forall a. IO a -> IO a
unsafeInterleaveIO (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> Cachable -> IO ByteString
gzFetchFilePS String
fn Cachable
Cachable
                           Sealed (PatchInfoAnd p wX) -> IO (Sealed (PatchInfoAnd p wX))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (PatchInfoAnd p wX) -> IO (Sealed (PatchInfoAnd p wX)))
-> Sealed (PatchInfoAnd p wX) -> IO (Sealed (PatchInfoAnd p wX))
forall a b. (a -> b) -> a -> b
$ PatchInfo
-> Hopefully (Named p) wX wX -> PatchInfoAndG (Named p) wX wX
forall (p :: * -> * -> *) wA wB.
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG p wA wB
patchInfoAndPatch PatchInfo
i
                             (forall {wX}.
 Hopefully (Named p) wX wX -> PatchInfoAndG (Named p) wX wX)
-> Sealed (Hopefully (Named p) wX) -> Sealed (PatchInfoAnd p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
`mapSeal` String
-> Either String (Sealed (Named p wX))
-> Sealed (Hopefully (Named p) wX)
forall (a1dr :: * -> * -> *) wX.
String
-> Either String (Sealed (Named a1dr wX))
-> Sealed (Hopefully (Named a1dr) wX)
hopefullyNoParseError (String -> String
forall a. FilePathOrURL a => a -> String
toPath String
fn) (ByteString -> Either String (Sealed (Named p wX))
forall (p :: * -> * -> *) wX.
ReadPatch p =>
ByteString -> Either String (Sealed (p wX))
readPatch ByteString
ps)
          hopefullyNoParseError :: String -> Either String (Sealed (Named a1dr wX))
                                -> Sealed (Hopefully (Named a1dr) wX)
          hopefullyNoParseError :: forall (a1dr :: * -> * -> *) wX.
String
-> Either String (Sealed (Named a1dr wX))
-> Sealed (Hopefully (Named a1dr) wX)
hopefullyNoParseError String
_ (Right (Sealed Named a1dr wX wX
x)) = Hopefully (Named a1dr) wX wX -> Sealed (Hopefully (Named a1dr) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Hopefully (Named a1dr) wX wX
 -> Sealed (Hopefully (Named a1dr) wX))
-> Hopefully (Named a1dr) wX wX
-> Sealed (Hopefully (Named a1dr) wX)
forall a b. (a -> b) -> a -> b
$ Named a1dr wX wX -> Hopefully (Named a1dr) wX wX
forall (a :: * -> * -> *) wX wY. a wX wY -> Hopefully a wX wY
actually Named a1dr wX wX
x
          hopefullyNoParseError String
s (Left String
e) =
              Hopefully (Named a1dr) wX Any -> Sealed (Hopefully (Named a1dr) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Hopefully (Named a1dr) wX Any
 -> Sealed (Hopefully (Named a1dr) wX))
-> Hopefully (Named a1dr) wX Any
-> Sealed (Hopefully (Named a1dr) wX)
forall a b. (a -> b) -> a -> b
$ String -> Hopefully (Named a1dr) wX Any
forall (a :: * -> * -> *) wX wY. String -> Hopefully a wX wY
unavailable (String -> Hopefully (Named a1dr) wX Any)
-> String -> Hopefully (Named a1dr) wX Any
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"Couldn't parse file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s, String
e]
          read_patches :: RepoPatch p =>
                          (forall wB . PatchInfo -> IO (Sealed (PatchInfoAnd p wB)))
                       -> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd p) wX))
          read_patches :: forall (p :: * -> * -> *) wX.
RepoPatch p =>
(forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB)))
-> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd p) wX))
read_patches forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB))
_ [] = Sealed (RL (PatchInfoAnd p) wX)
-> IO (Sealed (RL (PatchInfoAnd p) wX))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RL (PatchInfoAnd p) wX)
 -> IO (Sealed (RL (PatchInfoAnd p) wX)))
-> Sealed (RL (PatchInfoAnd p) wX)
-> IO (Sealed (RL (PatchInfoAnd p) wX))
forall a b. (a -> b) -> a -> b
$ RL (PatchInfoAnd p) wX wX -> Sealed (RL (PatchInfoAnd p) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal RL (PatchInfoAnd p) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
          read_patches forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB))
parse (PatchInfo
i:[PatchInfo]
is) =
              (forall wY wZ.
 PatchInfoAnd p wY wZ
 -> RL (PatchInfoAnd p) wX wY -> RL (PatchInfoAnd p) wX wZ)
-> IO (Sealed (RL (PatchInfoAnd p) wX))
-> (forall wB. IO (Sealed (PatchInfoAnd p wB)))
-> IO (Sealed (RL (PatchInfoAnd p) wX))
forall (q :: * -> * -> *) (pp :: * -> *) (r :: * -> *).
(forall wY wZ. q wY wZ -> pp wY -> r wZ)
-> IO (Sealed pp)
-> (forall wB. IO (Sealed (q wB)))
-> IO (Sealed r)
lift2Sealed ((RL (PatchInfoAnd p) wX wY
 -> PatchInfoAnd p wY wZ -> RL (PatchInfoAnd p) wX wZ)
-> PatchInfoAnd p wY wZ
-> RL (PatchInfoAnd p) wX wY
-> RL (PatchInfoAnd p) wX wZ
forall a b c. (a -> b -> c) -> b -> a -> c
flip RL (PatchInfoAnd p) wX wY
-> PatchInfoAnd p wY wZ -> RL (PatchInfoAnd p) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
(:<:))
                          ((forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB)))
-> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd p) wX))
forall (p :: * -> * -> *) wX.
RepoPatch p =>
(forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB)))
-> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd p) wX))
read_patches PatchInfo -> IO (Sealed (PatchInfoAnd p wB))
forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB))
parse [PatchInfo]
is)
                          (PatchInfo -> IO (Sealed (PatchInfoAndG (Named p) wB))
forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd p wB))
parse PatchInfo
i IO (Sealed (PatchInfoAndG (Named p) wB))
-> (IOError -> IO (Sealed (PatchInfoAndG (Named p) wB)))
-> IO (Sealed (PatchInfoAndG (Named p) wB))
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOError
e :: IOException) ->
                           Sealed (PatchInfoAndG (Named p) wB)
-> IO (Sealed (PatchInfoAndG (Named p) wB))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (PatchInfoAndG (Named p) wB)
 -> IO (Sealed (PatchInfoAndG (Named p) wB)))
-> Sealed (PatchInfoAndG (Named p) wB)
-> IO (Sealed (PatchInfoAndG (Named p) wB))
forall a b. (a -> b) -> a -> b
$ PatchInfoAnd p wB Any -> Sealed (PatchInfoAndG (Named p) wB)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (PatchInfoAnd p wB Any -> Sealed (PatchInfoAndG (Named p) wB))
-> PatchInfoAnd p wB Any -> Sealed (PatchInfoAndG (Named p) wB)
forall a b. (a -> b) -> a -> b
$ PatchInfo -> Hopefully (Named p) wB Any -> PatchInfoAnd p wB Any
forall (p :: * -> * -> *) wA wB.
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG p wA wB
patchInfoAndPatch PatchInfo
i (Hopefully (Named p) wB Any -> PatchInfoAnd p wB Any)
-> Hopefully (Named p) wB Any -> PatchInfoAnd p wB Any
forall a b. (a -> b) -> a -> b
$ String -> Hopefully (Named p) wB Any
forall (a :: * -> * -> *) wX wY. String -> Hopefully a wX wY
unavailable (String -> Hopefully (Named p) wB Any)
-> String -> Hopefully (Named p) wB Any
forall a b. (a -> b) -> a -> b
$ IOError -> String
forall a. Show a => a -> String
show IOError
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 :: forall (q :: * -> * -> *) (pp :: * -> *) (r :: * -> *).
(forall wY wZ. q wY wZ -> pp wY -> r wZ)
-> IO (Sealed pp)
-> (forall wB. IO (Sealed (q wB)))
-> IO (Sealed r)
lift2Sealed forall wY wZ. q wY wZ -> pp wY -> r wZ
f IO (Sealed pp)
iox forall wB. IO (Sealed (q wB))
ioy = do Sealed pp wX
x <- (forall wX. pp wX -> Sealed pp) -> Sealed pp -> Sealed pp
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal pp wX -> Sealed pp
forall wX. pp wX -> Sealed pp
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Sealed pp -> Sealed pp) -> IO (Sealed pp) -> IO (Sealed pp)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO (Sealed pp) -> IO (Sealed pp)
forall a. IO a -> IO a
unsafeInterleaveIO IO (Sealed pp)
iox
                                     Sealed q wX wX
y <- (forall wX. q wX wX -> Sealed (q wX))
-> Sealed (q wX) -> Sealed (q wX)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal q wX wX -> Sealed (q wX)
forall wX. q wX wX -> Sealed (q wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Sealed (q wX) -> Sealed (q wX))
-> IO (Sealed (q wX)) -> IO (Sealed (q wX))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO (Sealed (q wX)) -> IO (Sealed (q wX))
forall a. IO a -> IO a
unsafeInterleaveIO IO (Sealed (q wX))
forall wB. IO (Sealed (q wB))
ioy
                                     Sealed r -> IO (Sealed r)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed r -> IO (Sealed r)) -> Sealed r -> IO (Sealed r)
forall a b. (a -> b) -> a -> b
$ r wX -> Sealed r
forall (a :: * -> *) wX. a wX -> Sealed a
seal (r wX -> Sealed r) -> r wX -> Sealed r
forall a b. (a -> b) -> a -> b
$ q wX wX -> pp wX -> r wX
forall wY wZ. q wY wZ -> pp wY -> r wZ
f q wX wX
y pp wX
x

oldRepoFailMsg :: String
oldRepoFailMsg :: String
oldRepoFailMsg = String
"ERROR: repository upgrade required, try `darcs optimize upgrade`\n"
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"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 :: PatchInfo -> String
makeFilename PatchInfo
pi = CalendarTime -> String
showIsoDateTime CalendarTime
dString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"-"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
sha1_aString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"-"String -> String -> String
forall a. [a] -> [a] -> [a]
++ (SHA1 -> String
forall a. Show a => a -> String
show (SHA1 -> String) -> SHA1 -> String
forall a b. (a -> b) -> a -> b
$ PatchInfo -> SHA1
makePatchname PatchInfo
pi) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".gz"
    where d :: CalendarTime
d = String -> CalendarTime
readUTCDateOldFashioned (String -> CalendarTime) -> String -> CalendarTime
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BC.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ PatchInfo -> ByteString
_piDate PatchInfo
pi
          sha1_a :: String
sha1_a = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
5 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ SHA1 -> String
forall a. Show a => a -> String
show (SHA1 -> String) -> SHA1 -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> SHA1
sha1PS (ByteString -> SHA1) -> ByteString -> SHA1
forall a b. (a -> b) -> a -> b
$ PatchInfo -> ByteString
_piAuthor PatchInfo
pi

readPatchInfos :: B.ByteString -> IO [PatchInfo]
readPatchInfos :: ByteString -> IO [PatchInfo]
readPatchInfos ByteString
inv =
    case Parser [PatchInfo]
-> ByteString -> Either String ([PatchInfo], ByteString)
forall a. Parser a -> ByteString -> Either String (a, ByteString)
P.parse (Parser ByteString PatchInfo -> Parser [PatchInfo]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ByteString PatchInfo
readPatchInfo) ByteString
inv of
        Right ([PatchInfo]
r, ByteString
_) -> [PatchInfo] -> IO [PatchInfo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [PatchInfo]
r
        Left String
e -> String -> IO [PatchInfo]
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO [PatchInfo]) -> String -> IO [PatchInfo]
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"cannot parse inventory:", String
e]

readInventory :: B.ByteString -> IO (Maybe PatchInfo, [PatchInfo])
readInventory :: ByteString -> IO (Maybe PatchInfo, [PatchInfo])
readInventory ByteString
inv =
    case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BC.break (Char
'\n' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) ByteString
inv of
        (ByteString
swt,ByteString
pistr) | ByteString
swt ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BC.pack String
"Starting with tag:" -> do
            [PatchInfo]
infos <- ByteString -> IO [PatchInfo]
readPatchInfos ByteString
pistr
            case [PatchInfo]
infos of
                (PatchInfo
t:[PatchInfo]
ids) -> (Maybe PatchInfo, [PatchInfo]) -> IO (Maybe PatchInfo, [PatchInfo])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfo -> Maybe PatchInfo
forall a. a -> Maybe a
Just PatchInfo
t, [PatchInfo] -> [PatchInfo]
forall a. [a] -> [a]
reverse [PatchInfo]
ids)
                [] -> String -> IO (Maybe PatchInfo, [PatchInfo])
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO (Maybe PatchInfo, [PatchInfo]))
-> String -> IO (Maybe PatchInfo, [PatchInfo])
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"empty parent inventory:", ByteString -> String
BC.unpack ByteString
pistr]
        (ByteString, ByteString)
_ -> do
            [PatchInfo]
infos <- ByteString -> IO [PatchInfo]
readPatchInfos ByteString
inv
            (Maybe PatchInfo, [PatchInfo]) -> IO (Maybe PatchInfo, [PatchInfo])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PatchInfo
forall a. Maybe a
Nothing, [PatchInfo] -> [PatchInfo]
forall a. [a] -> [a]
reverse [PatchInfo]
infos)