{-# LANGUAGE OverloadedStrings #-}
module Darcs.Repository.Format
( RepoFormat(..)
, RepoProperty(..)
, identifyRepoFormat
, tryIdentifyRepoFormat
, createRepoFormat
, writeRepoFormat
, writeProblem
, readProblem
, transferProblem
, formatHas
, addToFormat
, removeFromFormat
) where
import Darcs.Prelude
import Control.Monad ( mplus, (<=<) )
import qualified Data.ByteString.Char8 as BC ( split, pack, unpack, elem )
import qualified Data.ByteString as B ( ByteString, null, empty, stripPrefix )
import Data.List ( partition, intercalate, (\\) )
import Data.Maybe ( mapMaybe )
import Data.String ( IsString )
import System.FilePath.Posix( (</>) )
import Darcs.Util.External
( fetchFilePS
, Cachable( Cachable )
)
import Darcs.Util.Lock ( writeBinFile )
import qualified Darcs.Repository.Flags as F
( WithWorkingDir (..), PatchFormat (..) )
import Darcs.Repository.Paths ( formatPath, oldInventoryPath )
import Darcs.Util.SignalHandler ( catchNonSignal )
import Darcs.Util.Exception ( catchall, prettyException )
import Darcs.Util.ByteString ( linesPS )
import Darcs.Util.Progress ( beginTedious, endTedious, finishedOneIO )
data RepoProperty = Darcs1
| Darcs2
| Darcs3
| HashedInventory
| NoWorkingDir
| RebaseInProgress
| RebaseInProgress_2_16
| UnknownFormat B.ByteString
deriving ( RepoProperty -> RepoProperty -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepoProperty -> RepoProperty -> Bool
$c/= :: RepoProperty -> RepoProperty -> Bool
== :: RepoProperty -> RepoProperty -> Bool
$c== :: RepoProperty -> RepoProperty -> Bool
Eq )
darcs1Format, darcs2Format, darcs3Format,
hashedInventoryFormat, noWorkingDirFormat,
rebaseInProgressFormat, rebaseInProgress_2_16,
newStyleRebaseInProgress :: IsString s => s
darcs1Format :: forall s. IsString s => s
darcs1Format = s
"darcs-1.0"
darcs2Format :: forall s. IsString s => s
darcs2Format = s
"darcs-2"
darcs3Format :: forall s. IsString s => s
darcs3Format = s
"darcs-3"
hashedInventoryFormat :: forall s. IsString s => s
hashedInventoryFormat = s
"hashed"
noWorkingDirFormat :: forall s. IsString s => s
noWorkingDirFormat = s
"no-working-dir"
rebaseInProgressFormat :: forall s. IsString s => s
rebaseInProgressFormat = s
"rebase-in-progress"
rebaseInProgress_2_16 :: forall s. IsString s => s
rebaseInProgress_2_16 = s
"rebase-in-progress-2-16"
newStyleRebaseInProgress :: forall s. IsString s => s
newStyleRebaseInProgress = s
"new-style-rebase-in-progress"
instance Show RepoProperty where
show :: RepoProperty -> FilePath
show RepoProperty
Darcs1 = forall s. IsString s => s
darcs1Format
show RepoProperty
Darcs2 = forall s. IsString s => s
darcs2Format
show RepoProperty
Darcs3 = forall s. IsString s => s
darcs3Format
show RepoProperty
HashedInventory = forall s. IsString s => s
hashedInventoryFormat
show RepoProperty
NoWorkingDir = forall s. IsString s => s
noWorkingDirFormat
show RepoProperty
RebaseInProgress = forall s. IsString s => s
rebaseInProgressFormat
show RepoProperty
RebaseInProgress_2_16 = forall s. IsString s => s
rebaseInProgress_2_16
show (UnknownFormat ByteString
f) = ByteString -> FilePath
BC.unpack ByteString
f
readRepoProperty :: B.ByteString -> RepoProperty
readRepoProperty :: ByteString -> RepoProperty
readRepoProperty ByteString
input
| ByteString
input forall a. Eq a => a -> a -> Bool
== forall s. IsString s => s
darcs1Format = RepoProperty
Darcs1
| ByteString
input forall a. Eq a => a -> a -> Bool
== forall s. IsString s => s
darcs2Format = RepoProperty
Darcs2
| ByteString
input forall a. Eq a => a -> a -> Bool
== forall s. IsString s => s
darcs3Format = RepoProperty
Darcs3
| ByteString
input forall a. Eq a => a -> a -> Bool
== forall s. IsString s => s
hashedInventoryFormat = RepoProperty
HashedInventory
| ByteString
input forall a. Eq a => a -> a -> Bool
== forall s. IsString s => s
noWorkingDirFormat = RepoProperty
NoWorkingDir
| ByteString
input forall a. Eq a => a -> a -> Bool
== forall s. IsString s => s
rebaseInProgressFormat = RepoProperty
RebaseInProgress
| ByteString
input forall a. Eq a => a -> a -> Bool
== forall s. IsString s => s
newStyleRebaseInProgress = RepoProperty
RebaseInProgress_2_16
| ByteString
input forall a. Eq a => a -> a -> Bool
== forall s. IsString s => s
rebaseInProgress_2_16 = RepoProperty
RebaseInProgress_2_16
| Bool
otherwise = ByteString -> RepoProperty
UnknownFormat ByteString
input
newtype RepoFormat = RF [[RepoProperty]]
formatHas :: RepoProperty -> RepoFormat -> Bool
formatHas :: RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
f (RF [[RepoProperty]]
rps) = RepoProperty
f forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[RepoProperty]]
rps
addToFormat :: RepoProperty -> RepoFormat -> RepoFormat
addToFormat :: RepoProperty -> RepoFormat -> RepoFormat
addToFormat RepoProperty
f (RF [[RepoProperty]]
rps) = [[RepoProperty]] -> RepoFormat
RF ([[RepoProperty]]
rps forall a. [a] -> [a] -> [a]
++ [[RepoProperty
f]])
removeFromFormat :: RepoProperty -> RepoFormat -> RepoFormat
removeFromFormat :: RepoProperty -> RepoFormat -> RepoFormat
removeFromFormat RepoProperty
f (RF [[RepoProperty]]
rps) = [[RepoProperty]] -> RepoFormat
RF ([[RepoProperty]]
rps forall a. Eq a => [a] -> [a] -> [a]
\\ [[RepoProperty
f]])
instance Show RepoFormat where
show :: RepoFormat -> FilePath
show (RF [[RepoProperty]]
rf) = [FilePath] -> FilePath
unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"|" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> FilePath
show) [[RepoProperty]]
rf
identifyRepoFormat :: String -> IO RepoFormat
identifyRepoFormat :: FilePath -> IO RepoFormat
identifyRepoFormat = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< FilePath -> IO (Either FilePath RepoFormat)
tryIdentifyRepoFormat
tryIdentifyRepoFormat :: String -> IO (Either String RepoFormat)
tryIdentifyRepoFormat :: FilePath -> IO (Either FilePath RepoFormat)
tryIdentifyRepoFormat FilePath
repo = do
let k :: FilePath
k = FilePath
"Identifying repository " forall a. [a] -> [a] -> [a]
++ FilePath
repo
FilePath -> IO ()
beginTedious FilePath
k
FilePath -> FilePath -> IO ()
finishedOneIO FilePath
k FilePath
"format"
ByteString
formatInfo <- (FilePath -> Cachable -> IO ByteString
fetchFilePS (FilePath
repo FilePath -> ShowS
</> FilePath
formatPath) Cachable
Cachable)
forall a. IO a -> IO a -> IO a
`catchall` (forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty)
Either FilePath RepoFormat
format <-
if ByteString -> Bool
B.null ByteString
formatInfo Bool -> Bool -> Bool
|| Char -> ByteString -> Bool
BC.elem Char
'<' ByteString
formatInfo then do
FilePath -> FilePath -> IO ()
finishedOneIO FilePath
k FilePath
"inventory"
Maybe FilePath
missingInvErr <- FilePath -> IO (Maybe FilePath)
checkFile (FilePath
repo FilePath -> ShowS
</> FilePath
oldInventoryPath)
case Maybe FilePath
missingInvErr of
Maybe FilePath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [[RepoProperty]] -> RepoFormat
RF [[RepoProperty
Darcs1]]
Just FilePath
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ShowS
makeErrorMsg FilePath
e
else forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ByteString -> RepoFormat
readFormat ByteString
formatInfo
FilePath -> IO ()
endTedious FilePath
k
forall (m :: * -> *) a. Monad m => a -> m a
return Either FilePath RepoFormat
format
where
readFormat :: ByteString -> RepoFormat
readFormat =
[[RepoProperty]] -> RepoFormat
RF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> RepoProperty
readRepoProperty forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fixupUnknownFormat)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [[ByteString]]
splitFormat
fixupUnknownFormat :: ByteString -> ByteString
fixupUnknownFormat ByteString
s =
case ByteString -> ByteString -> Maybe ByteString
B.stripPrefix ByteString
"Unknown format: " ByteString
s of
Maybe ByteString
Nothing -> ByteString
s
Just ByteString
s' -> ByteString -> ByteString
fixupUnknownFormat ByteString
s'
splitFormat :: ByteString -> [[ByteString]]
splitFormat = forall a b. (a -> b) -> [a] -> [b]
map (Char -> ByteString -> [ByteString]
BC.split Char
'|') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
B.null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
linesPS
checkFile :: FilePath -> IO (Maybe FilePath)
checkFile FilePath
path = (FilePath -> Cachable -> IO ByteString
fetchFilePS FilePath
path Cachable
Cachable forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchNonSignal`
(forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> FilePath
prettyException)
makeErrorMsg :: ShowS
makeErrorMsg FilePath
e = FilePath
"Not a repository: " forall a. [a] -> [a] -> [a]
++ FilePath
repo forall a. [a] -> [a] -> [a]
++ FilePath
" (" forall a. [a] -> [a] -> [a]
++ FilePath
e forall a. [a] -> [a] -> [a]
++ FilePath
")"
writeRepoFormat :: RepoFormat -> FilePath -> IO ()
writeRepoFormat :: RepoFormat -> FilePath -> IO ()
writeRepoFormat RepoFormat
rf FilePath
loc = forall p. FilePathLike p => p -> ByteString -> IO ()
writeBinFile FilePath
loc forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
BC.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show RepoFormat
rf
createRepoFormat :: F.PatchFormat -> F.WithWorkingDir -> RepoFormat
createRepoFormat :: PatchFormat -> WithWorkingDir -> RepoFormat
createRepoFormat PatchFormat
fmt WithWorkingDir
wwd = [[RepoProperty]] -> RepoFormat
RF forall a b. (a -> b) -> a -> b
$ (RepoProperty
HashedInventory forall a. a -> [a] -> [a]
: WithWorkingDir -> [RepoProperty]
flags2wd WithWorkingDir
wwd) forall a. a -> [a] -> [a]
: PatchFormat -> [[RepoProperty]]
flags2format PatchFormat
fmt
where
flags2format :: PatchFormat -> [[RepoProperty]]
flags2format PatchFormat
F.PatchFormat1 = []
flags2format PatchFormat
F.PatchFormat2 = [[RepoProperty
Darcs2]]
flags2format PatchFormat
F.PatchFormat3 = [[RepoProperty
Darcs3]]
flags2wd :: WithWorkingDir -> [RepoProperty]
flags2wd WithWorkingDir
F.NoWorkingDir = [RepoProperty
NoWorkingDir]
flags2wd WithWorkingDir
F.WithWorkingDir = []
writeProblem :: RepoFormat -> Maybe String
writeProblem :: RepoFormat -> Maybe FilePath
writeProblem RepoFormat
target = RepoFormat -> Maybe FilePath
readProblem RepoFormat
target forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` RepoFormat -> ([RepoProperty] -> Maybe FilePath) -> Maybe FilePath
findProblems RepoFormat
target [RepoProperty] -> Maybe FilePath
wp
where
wp :: [RepoProperty] -> Maybe FilePath
wp [] = forall a. HasCallStack => FilePath -> a
error FilePath
"impossible case"
wp [RepoProperty]
x = case forall a. (a -> Bool) -> [a] -> ([a], [a])
partition RepoProperty -> Bool
isKnown [RepoProperty]
x of
([RepoProperty]
_, []) -> forall a. Maybe a
Nothing
([RepoProperty]
_, [RepoProperty]
unknowns) -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unwords forall a b. (a -> b) -> a -> b
$
FilePath
"Can't write repository: unknown formats:" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> FilePath
show [RepoProperty]
unknowns
transferProblem :: RepoFormat -> RepoFormat -> Maybe String
transferProblem :: RepoFormat -> RepoFormat -> Maybe FilePath
transferProblem RepoFormat
source RepoFormat
target
| RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
Darcs3 RepoFormat
source forall a. Eq a => a -> a -> Bool
/= RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
Darcs3 RepoFormat
target =
forall a. a -> Maybe a
Just FilePath
"Cannot mix darcs-3 repositories with older formats"
| RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
Darcs2 RepoFormat
source forall a. Eq a => a -> a -> Bool
/= RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
Darcs2 RepoFormat
target =
forall a. a -> Maybe a
Just FilePath
"Cannot mix darcs-2 repositories with older formats"
| RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
RebaseInProgress RepoFormat
source =
forall a. a -> Maybe a
Just FilePath
"Cannot transfer patches from a repository \
\where an old-style rebase is in progress"
| Bool
otherwise = RepoFormat -> Maybe FilePath
readProblem RepoFormat
source forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` RepoFormat -> Maybe FilePath
writeProblem RepoFormat
target
readProblem :: RepoFormat -> Maybe String
readProblem :: RepoFormat -> Maybe FilePath
readProblem RepoFormat
source
| RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
Darcs1 RepoFormat
source Bool -> Bool -> Bool
&& RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
Darcs2 RepoFormat
source =
forall a. a -> Maybe a
Just FilePath
"Invalid repository format: format 2 is incompatible with format 1"
| RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
RebaseInProgress RepoFormat
source Bool -> Bool -> Bool
&& RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
RebaseInProgress_2_16 RepoFormat
source =
forall a. a -> Maybe a
Just FilePath
"Invalid repository format: \
\cannot have both old-style and new-style rebase in progress"
readProblem RepoFormat
source = RepoFormat -> ([RepoProperty] -> Maybe FilePath) -> Maybe FilePath
findProblems RepoFormat
source [RepoProperty] -> Maybe FilePath
rp
where
rp :: [RepoProperty] -> Maybe FilePath
rp [RepoProperty]
x | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any RepoProperty -> Bool
isKnown [RepoProperty]
x = forall a. Maybe a
Nothing
rp [] = forall a. HasCallStack => FilePath -> a
error FilePath
"impossible case"
rp [RepoProperty]
x = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unwords forall a b. (a -> b) -> a -> b
$ FilePath
"Can't read repository: unknown formats:" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> FilePath
show [RepoProperty]
x
findProblems :: RepoFormat -> ([RepoProperty] -> Maybe String) -> Maybe String
findProblems :: RepoFormat -> ([RepoProperty] -> Maybe FilePath) -> Maybe FilePath
findProblems (RF [[RepoProperty]]
ks) [RepoProperty] -> Maybe FilePath
formatHasProblem = case forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [RepoProperty] -> Maybe FilePath
formatHasProblem [[RepoProperty]]
ks of
[] -> forall a. Maybe a
Nothing
[FilePath]
xs -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines [FilePath]
xs
isKnown :: RepoProperty -> Bool
isKnown :: RepoProperty -> Bool
isKnown RepoProperty
p = RepoProperty
p forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RepoProperty]
knownProperties
where
knownProperties :: [RepoProperty]
knownProperties :: [RepoProperty]
knownProperties = [ RepoProperty
Darcs1
, RepoProperty
Darcs2
, RepoProperty
Darcs3
, RepoProperty
HashedInventory
, RepoProperty
NoWorkingDir
, RepoProperty
RebaseInProgress
, RepoProperty
RebaseInProgress_2_16
]