--  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.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 :: RepoPatch p => String -> IO (SealedPatchSet rt p Origin)
readOldRepo :: String -> IO (SealedPatchSet rt 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 (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 rt p Origin)
forall (p :: * -> * -> *) (rt :: RepoType).
RepoPatch p =>
String -> String -> String -> IO (SealedPatchSet rt p Origin)
readRepoPrivate String
task String
realdir String
"inventory" IO (SealedPatchSet rt p Origin)
-> (IOError -> IO (SealedPatchSet rt p Origin))
-> IO (SealedPatchSet rt 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 rt p Origin)
forall a. IOError -> IO a
ioError IOError
e)

readRepoPrivate :: RepoPatch p
                => String -> FilePath -> FilePath -> IO (SealedPatchSet rt p Origin)
readRepoPrivate :: String -> String -> String -> IO (SealedPatchSet rt 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 rt p wX))
parse PatchInfo
inf = PatchInfo -> String -> IO (Sealed (PatchInfoAnd rt p wX))
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
PatchInfo -> String -> IO (Sealed (PatchInfoAnd rt p wX))
parse2 PatchInfo
inf (String -> IO (Sealed (PatchInfoAnd rt p wX)))
-> String -> IO (Sealed (PatchInfoAnd rt 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 rt p) Origin wX
ts <- (forall wX.
 RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin))
-> Sealed (RL (Tagged rt p) Origin)
-> Sealed (RL (Tagged rt p) Origin)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX.
RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Sealed (RL (Tagged rt p) Origin)
 -> Sealed (RL (Tagged rt p) Origin))
-> IO (Sealed (RL (Tagged rt p) Origin))
-> IO (Sealed (RL (Tagged rt p) Origin))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO (Sealed (RL (Tagged rt p) Origin))
-> IO (Sealed (RL (Tagged rt p) Origin))
forall a. IO a -> IO a
unsafeInterleaveIO ((forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB)))
-> Maybe PatchInfo -> IO (Sealed (RL (Tagged rt p) Origin))
forall (p :: * -> * -> *) (rt :: RepoType).
RepoPatch p =>
(forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB)))
-> Maybe PatchInfo -> IO (Sealed (RL (Tagged rt p) Origin))
read_ts forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB))
forall (p :: * -> * -> *) (rt :: RepoType) wX.
(Annotate (PrimOf p), Effect p, Check p, Conflict p, FromPrim p,
 IsHunk p, Merge p, PrimPatchBase p, Summary p, ToPrim p, Unwind p,
 Commute p, Eq2 p, PatchInspect p, RepairToFL p, ReadPatch p,
 ShowPatch p, ShowContextPatch p, PatchListFormat p,
 ApplyState p ~ ApplyState (PrimOf p)) =>
PatchInfo -> IO (Sealed (PatchInfoAnd rt p wX))
parse Maybe PatchInfo
mt)
    Sealed RL (PatchInfoAnd rt p) wX wX
ps <- (forall wX.
 RL (PatchInfoAnd rt p) wX wX -> Sealed (RL (PatchInfoAnd rt p) wX))
-> Sealed (RL (PatchInfoAnd rt p) wX)
-> Sealed (RL (PatchInfoAnd rt p) wX)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX.
RL (PatchInfoAnd rt p) wX wX -> Sealed (RL (PatchInfoAnd rt p) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Sealed (RL (PatchInfoAnd rt p) wX)
 -> Sealed (RL (PatchInfoAnd rt p) wX))
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO (Sealed (RL (PatchInfoAnd rt p) wX))
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall a. IO a -> IO a
unsafeInterleaveIO ((forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB)))
-> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
(forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB)))
-> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
read_patches forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB))
forall (p :: * -> * -> *) (rt :: RepoType) wX.
(Annotate (PrimOf p), Effect p, Check p, Conflict p, FromPrim p,
 IsHunk p, Merge p, PrimPatchBase p, Summary p, ToPrim p, Unwind p,
 Commute p, Eq2 p, PatchInspect p, RepairToFL p, ReadPatch p,
 ShowPatch p, ShowContextPatch p, PatchListFormat p,
 ApplyState p ~ ApplyState (PrimOf p)) =>
PatchInfo -> IO (Sealed (PatchInfoAnd rt p wX))
parse [PatchInfo]
is)
    SealedPatchSet rt p Origin -> IO (SealedPatchSet rt p Origin)
forall (m :: * -> *) a. Monad m => a -> m a
return (SealedPatchSet rt p Origin -> IO (SealedPatchSet rt p Origin))
-> SealedPatchSet rt p Origin -> IO (SealedPatchSet rt p Origin)
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wX -> SealedPatchSet rt p Origin
forall (a :: * -> *) wX. a wX -> Sealed a
seal (RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
ts RL (PatchInfoAnd rt p) wX wX
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 :: (forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB)))
-> Maybe PatchInfo -> IO (Sealed (RL (Tagged rt p) Origin))
read_ts forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB))
_ Maybe PatchInfo
Nothing = do String -> IO ()
endTedious String
task
                                 Sealed (RL (Tagged rt p) Origin)
-> IO (Sealed (RL (Tagged rt p) Origin))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RL (Tagged rt p) Origin)
 -> IO (Sealed (RL (Tagged rt p) Origin)))
-> Sealed (RL (Tagged rt p) Origin)
-> IO (Sealed (RL (Tagged rt p) Origin))
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin Origin -> Sealed (RL (Tagged rt p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal RL (Tagged rt p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
          read_ts forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt 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 (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 rt p) Origin wX
ts <- (Sealed (RL (Tagged rt p) Origin)
 -> Sealed (RL (Tagged rt p) Origin))
-> IO (Sealed (RL (Tagged rt p) Origin))
-> IO (Sealed (RL (Tagged rt p) Origin))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall wX.
 RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin))
-> Sealed (RL (Tagged rt p) Origin)
-> Sealed (RL (Tagged rt p) Origin)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX.
RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal) (IO (Sealed (RL (Tagged rt p) Origin))
 -> IO (Sealed (RL (Tagged rt p) Origin)))
-> IO (Sealed (RL (Tagged rt p) Origin))
-> IO (Sealed (RL (Tagged rt p) Origin))
forall a b. (a -> b) -> a -> b
$ IO (Sealed (RL (Tagged rt p) Origin))
-> IO (Sealed (RL (Tagged rt p) Origin))
forall a. IO a -> IO a
unsafeInterleaveIO (IO (Sealed (RL (Tagged rt p) Origin))
 -> IO (Sealed (RL (Tagged rt p) Origin)))
-> IO (Sealed (RL (Tagged rt p) Origin))
-> IO (Sealed (RL (Tagged rt p) Origin))
forall a b. (a -> b) -> a -> b
$ (forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB)))
-> Maybe PatchInfo -> IO (Sealed (RL (Tagged rt p) Origin))
forall (p :: * -> * -> *) (rt :: RepoType).
RepoPatch p =>
(forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB)))
-> Maybe PatchInfo -> IO (Sealed (RL (Tagged rt p) Origin))
read_ts forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB))
parse Maybe PatchInfo
mt
                 Sealed RL (PatchInfoAnd rt p) wX wX
ps <- (forall wX.
 RL (PatchInfoAnd rt p) wX wX -> Sealed (RL (PatchInfoAnd rt p) wX))
-> Sealed (RL (PatchInfoAnd rt p) wX)
-> Sealed (RL (PatchInfoAnd rt p) wX)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX.
RL (PatchInfoAnd rt p) wX wX -> Sealed (RL (PatchInfoAnd rt p) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Sealed (RL (PatchInfoAnd rt p) wX)
 -> Sealed (RL (PatchInfoAnd rt p) wX))
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO (Sealed (RL (PatchInfoAnd rt p) wX))
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall a. IO a -> IO a
unsafeInterleaveIO ((forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB)))
-> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
(forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB)))
-> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
read_patches forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB))
parse [PatchInfo]
is)
                 Sealed PatchInfoAnd rt p wX wX
tag00 <-  PatchInfo -> IO (Sealed (PatchInfoAnd rt p wX))
forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB))
parse PatchInfo
tag0 IO (Sealed (PatchInfoAnd rt p wX))
-> (IOError -> IO (Sealed (PatchInfoAnd rt p wX)))
-> IO (Sealed (PatchInfoAnd rt p wX))
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
                                  \(IOError
e :: IOException) ->
                                        Sealed (PatchInfoAnd rt p wX) -> IO (Sealed (PatchInfoAnd rt p wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (PatchInfoAnd rt p wX)
 -> IO (Sealed (PatchInfoAnd rt p wX)))
-> Sealed (PatchInfoAnd rt p wX)
-> IO (Sealed (PatchInfoAnd rt p wX))
forall a b. (a -> b) -> a -> b
$ PatchInfoAndG rt (Named p) wX Any -> Sealed (PatchInfoAnd rt p wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (PatchInfoAndG rt (Named p) wX Any
 -> Sealed (PatchInfoAnd rt p wX))
-> PatchInfoAndG rt (Named p) wX Any
-> Sealed (PatchInfoAnd rt p wX)
forall a b. (a -> b) -> a -> b
$
                                        PatchInfo
-> Hopefully (Named p) wX Any -> PatchInfoAndG rt (Named p) wX Any
forall (p :: * -> * -> *) wA wB (rt :: RepoType).
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG rt p wA wB
patchInfoAndPatch PatchInfo
tag0 (Hopefully (Named p) wX Any -> PatchInfoAndG rt (Named p) wX Any)
-> Hopefully (Named p) wX Any -> PatchInfoAndG rt (Named 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 rt p) Origin)
-> IO (Sealed (RL (Tagged rt p) Origin))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RL (Tagged rt p) Origin)
 -> IO (Sealed (RL (Tagged rt p) Origin)))
-> Sealed (RL (Tagged rt p) Origin)
-> IO (Sealed (RL (Tagged rt p) Origin))
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin))
-> RL (Tagged rt p) Origin wX -> Sealed (RL (Tagged rt p) Origin)
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin wX
ts RL (Tagged rt p) Origin wX
-> Tagged rt p wX wX -> RL (Tagged rt p) Origin wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wX wX
-> Maybe String
-> RL (PatchInfoAnd rt p) wX wX
-> Tagged rt p wX wX
forall (rt :: RepoType) (p :: * -> * -> *) wY wZ wX.
PatchInfoAnd rt p wY wZ
-> Maybe String
-> RL (PatchInfoAnd rt p) wX wY
-> Tagged rt p wX wZ
Tagged PatchInfoAnd rt p wX wX
tag00 Maybe String
forall a. Maybe a
Nothing RL (PatchInfoAnd rt p) wX wX
ps
          parse2 :: RepoPatch p
                 => PatchInfo -> FilePath
                 -> IO (Sealed (PatchInfoAnd rt p wX))
          parse2 :: PatchInfo -> String -> IO (Sealed (PatchInfoAnd rt 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 rt p wX) -> IO (Sealed (PatchInfoAnd rt p wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (PatchInfoAnd rt p wX)
 -> IO (Sealed (PatchInfoAnd rt p wX)))
-> Sealed (PatchInfoAnd rt p wX)
-> IO (Sealed (PatchInfoAnd rt p wX))
forall a b. (a -> b) -> a -> b
$ PatchInfo
-> Hopefully (Named p) wX wX -> PatchInfoAndG rt (Named p) wX wX
forall (p :: * -> * -> *) wA wB (rt :: RepoType).
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG rt p wA wB
patchInfoAndPatch PatchInfo
i
                             (forall wX.
 Hopefully (Named p) wX wX -> PatchInfoAndG rt (Named p) wX wX)
-> Sealed (Hopefully (Named p) wX) -> Sealed (PatchInfoAnd rt 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 :: 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 rt p wB)))
                       -> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
          read_patches :: (forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB)))
-> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
read_patches forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB))
_ [] = Sealed (RL (PatchInfoAnd rt p) wX)
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RL (PatchInfoAnd rt p) wX)
 -> IO (Sealed (RL (PatchInfoAnd rt p) wX)))
-> Sealed (RL (PatchInfoAnd rt p) wX)
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall a b. (a -> b) -> a -> b
$ RL (PatchInfoAnd rt p) wX wX -> Sealed (RL (PatchInfoAnd rt p) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal RL (PatchInfoAnd rt p) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
          read_patches forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB))
parse (PatchInfo
i:[PatchInfo]
is) =
              (forall wY wZ.
 PatchInfoAnd rt p wY wZ
 -> RL (PatchInfoAnd rt p) wX wY -> RL (PatchInfoAnd rt p) wX wZ)
-> IO (Sealed (RL (PatchInfoAnd rt p) wX))
-> (forall wB. IO (Sealed (PatchInfoAnd rt p wB)))
-> IO (Sealed (RL (PatchInfoAnd rt 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 rt p) wX wY
 -> PatchInfoAnd rt p wY wZ -> RL (PatchInfoAnd rt p) wX wZ)
-> PatchInfoAnd rt p wY wZ
-> RL (PatchInfoAnd rt p) wX wY
-> RL (PatchInfoAnd rt p) wX wZ
forall a b c. (a -> b -> c) -> b -> a -> c
flip RL (PatchInfoAnd rt p) wX wY
-> PatchInfoAnd rt p wY wZ -> RL (PatchInfoAnd rt 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 rt p wB)))
-> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
(forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB)))
-> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
read_patches forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB))
parse [PatchInfo]
is)
                          (PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB))
forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB))
parse PatchInfo
i IO (Sealed (PatchInfoAnd rt p wB))
-> (IOError -> IO (Sealed (PatchInfoAnd rt p wB)))
-> IO (Sealed (PatchInfoAnd rt p wB))
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOError
e :: IOException) ->
                           Sealed (PatchInfoAnd rt p wB) -> IO (Sealed (PatchInfoAnd rt p wB))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (PatchInfoAnd rt p wB)
 -> IO (Sealed (PatchInfoAnd rt p wB)))
-> Sealed (PatchInfoAnd rt p wB)
-> IO (Sealed (PatchInfoAnd rt p wB))
forall a b. (a -> b) -> a -> b
$ PatchInfoAndG rt (Named p) wB Any -> Sealed (PatchInfoAnd rt p wB)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (PatchInfoAndG rt (Named p) wB Any
 -> Sealed (PatchInfoAnd rt p wB))
-> PatchInfoAndG rt (Named p) wB Any
-> Sealed (PatchInfoAnd rt p wB)
forall a b. (a -> b) -> a -> b
$ PatchInfo
-> Hopefully (Named p) wB Any -> PatchInfoAndG rt (Named p) wB Any
forall (p :: * -> * -> *) wA wB (rt :: RepoType).
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG rt p wA wB
patchInfoAndPatch PatchInfo
i (Hopefully (Named p) wB Any -> PatchInfoAndG rt (Named p) wB Any)
-> Hopefully (Named p) wB Any -> PatchInfoAndG rt (Named 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 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 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 (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 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 (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 (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 (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ByteString PatchInfo
readPatchInfo) ByteString
inv of
        Right ([PatchInfo]
r, ByteString
_) -> [PatchInfo] -> IO [PatchInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [PatchInfo]
r
        Left String
e -> String -> IO [PatchInfo]
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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return (Maybe PatchInfo
forall a. Maybe a
Nothing, [PatchInfo] -> [PatchInfo]
forall a. [a] -> [a]
reverse [PatchInfo]
infos)