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 :: forall (p :: * -> * -> *) (rt :: RepoType).
RepoPatch p =>
String -> IO (SealedPatchSet rt p Origin)
readOldRepo String
repo_dir = do
String
realdir <- forall a. FilePathOrURL a => a -> String
toPath 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 "forall a. [a] -> [a] -> [a]
++String
repo_dir
String -> IO ()
beginTedious String
task
forall (p :: * -> * -> *) (rt :: RepoType).
RepoPatch p =>
String -> String -> String -> IO (SealedPatchSet rt p Origin)
readRepoPrivate String
task String
realdir String
"inventory" 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: " forall a. [a] -> [a] -> [a]
++ String
realdir)
forall a. IOError -> IO a
ioError IOError
e)
readRepoPrivate :: RepoPatch p
=> String -> FilePath -> FilePath -> IO (SealedPatchSet rt p Origin)
readRepoPrivate :: forall (p :: * -> * -> *) (rt :: RepoType).
RepoPatch p =>
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 = forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
PatchInfo -> String -> IO (Sealed (PatchInfoAnd rt p wX))
parse2 PatchInfo
inf 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 (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall (a :: * -> *) wX. a wX -> Sealed a
seal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. IO a -> IO a
unsafeInterleaveIO (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 {p :: * -> * -> *} {rt :: RepoType} {wX}.
(ApplyState p ~ ApplyState (PrimOf p), 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) =>
PatchInfo -> IO (Sealed (PatchInfoAnd rt p wX))
parse Maybe PatchInfo
mt)
Sealed RL (PatchInfoAnd rt p) wX wX
ps <- forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall (a :: * -> *) wX. a wX -> Sealed a
seal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. IO a -> IO a
unsafeInterleaveIO (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 {p :: * -> * -> *} {rt :: RepoType} {wX}.
(ApplyState p ~ ApplyState (PrimOf p), 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) =>
PatchInfo -> IO (Sealed (PatchInfoAnd rt p wX))
parse [PatchInfo]
is)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wX. a wX -> Sealed a
seal (forall (rt :: RepoType) (p :: * -> * -> *) wY wY.
RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY 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 (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))
_ Maybe PatchInfo
Nothing = do String -> IO ()
endTedious String
task
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wX. a wX -> Sealed a
seal 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 forall a b. (a -> b) -> a -> b
$ String
"Looking for inventory for:\n"forall a. [a] -> [a] -> [a]
++ Doc -> String
renderString (PatchInfo -> Doc
displayPatchInfo PatchInfo
tag0)
ByteString
i <- forall a. IO a -> IO a
unsafeInterleaveIO 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))
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 <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall (a :: * -> *) wX. a wX -> Sealed a
seal) forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ 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 (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall (a :: * -> *) wX. a wX -> Sealed a
seal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. IO a -> IO a
unsafeInterleaveIO (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 <- forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB))
parse PatchInfo
tag0 forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
\(IOError
e :: IOException) ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wX. a wX -> Sealed a
seal forall a b. (a -> b) -> a -> b
$
forall (p :: * -> * -> *) wA wB (rt :: RepoType).
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG rt p wA wB
patchInfoAndPatch PatchInfo
tag0 forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) wX wY. String -> Hopefully a wX wY
unavailable forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show IOError
e
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wX. a wX -> Sealed a
seal forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin wX
ts forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: 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 forall a. Maybe a
Nothing RL (PatchInfoAnd rt p) wX wX
ps
parse2 :: RepoPatch p
=> PatchInfo -> FilePath
-> IO (Sealed (PatchInfoAnd rt p wX))
parse2 :: forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
PatchInfo -> String -> IO (Sealed (PatchInfoAnd rt p wX))
parse2 PatchInfo
i String
fn = do ByteString
ps <- forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ String -> Cachable -> IO ByteString
gzFetchFilePS String
fn Cachable
Cachable
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wA wB (rt :: RepoType).
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG rt p wA wB
patchInfoAndPatch PatchInfo
i
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
`mapSeal` forall (a1dr :: * -> * -> *) wX.
String
-> Either String (Sealed (Named a1dr wX))
-> Sealed (Hopefully (Named a1dr) wX)
hopefullyNoParseError (forall a. FilePathOrURL a => a -> String
toPath String
fn) (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)) = forall (a :: * -> *) wX. a wX -> Sealed a
seal forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) wX wY. a wX wY -> Hopefully a wX wY
actually Named a1dr wX wX
x
hopefullyNoParseError String
s (Left String
e) =
forall (a :: * -> *) wX. a wX -> Sealed a
seal forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) wX wY. String -> Hopefully a wX wY
unavailable forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"Couldn't parse file " 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 (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 (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wX. a wX -> Sealed a
seal 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 (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 a b c. (a -> b -> c) -> b -> a -> c
flip forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
(:<:))
(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)
(forall wB. PatchInfo -> IO (Sealed (PatchInfoAnd rt p wB))
parse PatchInfo
i forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOError
e :: IOException) ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wX. a wX -> Sealed a
seal forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wA wB (rt :: RepoType).
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG rt p wA wB
patchInfoAndPatch PatchInfo
i forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) wX wY. String -> Hopefully a wX wY
unavailable forall a b. (a -> b) -> a -> b
$ 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 (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall (a :: * -> *) wX. a wX -> Sealed a
seal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. IO a -> IO a
unsafeInterleaveIO IO (Sealed pp)
iox
Sealed q wX wX
y <- forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall (a :: * -> *) wX. a wX -> Sealed a
seal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. IO a -> IO a
unsafeInterleaveIO forall wB. IO (Sealed (q wB))
ioy
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wX. a wX -> Sealed a
seal forall a b. (a -> b) -> a -> b
$ 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"
forall a. [a] -> [a] -> [a]
++ String
"See http://wiki.darcs.net/OF for more details."
makeFilename :: PatchInfo -> String
makeFilename :: PatchInfo -> String
makeFilename PatchInfo
pi = CalendarTime -> String
showIsoDateTime CalendarTime
dforall a. [a] -> [a] -> [a]
++String
"-"forall a. [a] -> [a] -> [a]
++String
sha1_aforall a. [a] -> [a] -> [a]
++String
"-"forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ PatchInfo -> SHA1
makePatchname PatchInfo
pi) forall a. [a] -> [a] -> [a]
++ String
".gz"
where d :: CalendarTime
d = String -> CalendarTime
readUTCDateOldFashioned forall a b. (a -> b) -> a -> b
$ ByteString -> String
BC.unpack forall a b. (a -> b) -> a -> b
$ PatchInfo -> ByteString
_piDate PatchInfo
pi
sha1_a :: String
sha1_a = forall a. Int -> [a] -> [a]
take Int
5 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ ByteString -> SHA1
sha1PS 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 forall a. Parser a -> ByteString -> Either String (a, ByteString)
P.parse (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser PatchInfo
readPatchInfo) ByteString
inv of
Right ([PatchInfo]
r, ByteString
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return [PatchInfo]
r
Left String
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail 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' forall a. Eq a => a -> a -> Bool
==) ByteString
inv of
(ByteString
swt,ByteString
pistr) | ByteString
swt 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) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just PatchInfo
t, forall a. [a] -> [a]
reverse [PatchInfo]
ids)
[] -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail 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
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, forall a. [a] -> [a]
reverse [PatchInfo]
infos)