-- Copyright (C) 2005 David Roundy
--
-- This file is licensed under the GPL, version two or later.

{- | The format file.

The purpose of the format file is to check compatibility between
repositories in different formats and to allow the addition of new features
without risking corruption by old darcs versions that do not yet know about
these features.

This allows a limited form of forward compatibility between darcs versions.
Old versions of darcs that are unaware of features added in later versions
will fail with a decent error message instead of crashing or misbehaving or
even corrupting new repos.

The format file lives at _darcs/format and must only contain printable ASCII
characters and must not contain the characters @<@ and @>@.

(We currently do not strip whitespace from the lines, but may want to do so
in the future.)

The file consists of format properties. A format property can contain any
allowed ASCII character except the vertical bar (@|@) and newlines. Empty
lines are ignored and multiple properties on the same line are separated
with a @|@.

If multiple properties appear on the same line (separated by vertical bars),
then this indicates alternative format properties. These have a generic
meaning:

 * If we know *any* of these properties, then we can read the repo.

 * If we know *all* of them, we can also write the repo.

The above rules are necessary conditions, not sufficient ones. It is allowed
to further restrict read and/or write access for specific commands, but care
should be taken to not unnecessarily break forward compatibility. It is not
recommended, but sometimes necessary, to impose ad-hoc restrictions on the
format, see 'transferProblem' and 'readProblem' for examples.

The no-working-dir property is an example for how to use alternative
properties. An old darcs version that does not know this format can perform
most read-only operations correctly even if there is no working tree;
however, whatsnew will report that the whole tree was removed, so the
solution is not perfect.

When you add a new property as an alternative to an existing one, you should
make sure that the old format remains to be updated in parallel to the new
one, so that reading the repo with old darcs versions behaves correctly. If
this cannot be guaranteed, it is better to add the new format on a separate
line.

It is not advisable for commands to modify an existing format file. However,
sometimes compatibility requirements may leave us no other choice. In this
case make sure to write the format file only after having checked that the
existing repo format allows modification of the repo, and that you have
taken the repo lock.

-}

{-# 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
(RepoProperty -> RepoProperty -> Bool)
-> (RepoProperty -> RepoProperty -> Bool) -> Eq RepoProperty
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 )

-- | Define string constants in one place, for reuse in show/parse functions.
darcs1Format, darcs2Format, darcs3Format,
  hashedInventoryFormat, noWorkingDirFormat,
  rebaseInProgressFormat, rebaseInProgress_2_16,
  newStyleRebaseInProgress :: IsString s => s

darcs1Format :: s
darcs1Format = s
"darcs-1.0"
darcs2Format :: s
darcs2Format = s
"darcs-2"
darcs3Format :: s
darcs3Format = s
"darcs-3"
hashedInventoryFormat :: s
hashedInventoryFormat = s
"hashed"
noWorkingDirFormat :: s
noWorkingDirFormat = s
"no-working-dir"
rebaseInProgressFormat :: s
rebaseInProgressFormat = s
"rebase-in-progress"
rebaseInProgress_2_16 :: s
rebaseInProgress_2_16 = s
"rebase-in-progress-2-16"
-- compatibility alias, may want to remove this at some point in the future
newStyleRebaseInProgress :: s
newStyleRebaseInProgress = s
"new-style-rebase-in-progress"

instance Show RepoProperty where
    show :: RepoProperty -> String
show RepoProperty
Darcs1 = String
forall s. IsString s => s
darcs1Format
    show RepoProperty
Darcs2 = String
forall s. IsString s => s
darcs2Format
    show RepoProperty
Darcs3 = String
forall s. IsString s => s
darcs3Format
    show RepoProperty
HashedInventory = String
forall s. IsString s => s
hashedInventoryFormat
    show RepoProperty
NoWorkingDir = String
forall s. IsString s => s
noWorkingDirFormat
    show RepoProperty
RebaseInProgress = String
forall s. IsString s => s
rebaseInProgressFormat
    show RepoProperty
RebaseInProgress_2_16 = String
forall s. IsString s => s
rebaseInProgress_2_16
    show (UnknownFormat ByteString
f) = ByteString -> String
BC.unpack ByteString
f

readRepoProperty :: B.ByteString -> RepoProperty
readRepoProperty :: ByteString -> RepoProperty
readRepoProperty ByteString
input
    | ByteString
input ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall s. IsString s => s
darcs1Format = RepoProperty
Darcs1
    | ByteString
input ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall s. IsString s => s
darcs2Format = RepoProperty
Darcs2
    | ByteString
input ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall s. IsString s => s
darcs3Format = RepoProperty
Darcs3
    | ByteString
input ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall s. IsString s => s
hashedInventoryFormat = RepoProperty
HashedInventory
    | ByteString
input ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall s. IsString s => s
noWorkingDirFormat = RepoProperty
NoWorkingDir
    | ByteString
input ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall s. IsString s => s
rebaseInProgressFormat = RepoProperty
RebaseInProgress
    | ByteString
input ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall s. IsString s => s
newStyleRebaseInProgress = RepoProperty
RebaseInProgress_2_16
    | ByteString
input ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall s. IsString s => s
rebaseInProgress_2_16 = RepoProperty
RebaseInProgress_2_16
    | Bool
otherwise = ByteString -> RepoProperty
UnknownFormat ByteString
input

-- | Representation of the format of a repository. Each
-- sublist corresponds to a line in the format file.
newtype RepoFormat = RF [[RepoProperty]]

-- | Is a given property contained within a given format?
formatHas :: RepoProperty -> RepoFormat -> Bool
formatHas :: RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
f (RF [[RepoProperty]]
rps) = RepoProperty
f RepoProperty -> [RepoProperty] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[RepoProperty]] -> [RepoProperty]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[RepoProperty]]
rps

-- | Add a single property to an existing format.
addToFormat :: RepoProperty -> RepoFormat -> RepoFormat
addToFormat :: RepoProperty -> RepoFormat -> RepoFormat
addToFormat RepoProperty
f (RF [[RepoProperty]]
rps) = [[RepoProperty]] -> RepoFormat
RF ([[RepoProperty]]
rps [[RepoProperty]] -> [[RepoProperty]] -> [[RepoProperty]]
forall a. [a] -> [a] -> [a]
++ [[RepoProperty
f]])

-- | Remove a single property from an existing format.
removeFromFormat :: RepoProperty -> RepoFormat -> RepoFormat
removeFromFormat :: RepoProperty -> RepoFormat -> RepoFormat
removeFromFormat RepoProperty
f (RF [[RepoProperty]]
rps) = [[RepoProperty]] -> RepoFormat
RF ([[RepoProperty]]
rps [[RepoProperty]] -> [[RepoProperty]] -> [[RepoProperty]]
forall a. Eq a => [a] -> [a] -> [a]
\\ [[RepoProperty
f]])

instance Show RepoFormat where
    show :: RepoFormat -> String
show (RF [[RepoProperty]]
rf) = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ([RepoProperty] -> String) -> [[RepoProperty]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"|" ([String] -> String)
-> ([RepoProperty] -> [String]) -> [RepoProperty] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RepoProperty -> String) -> [RepoProperty] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map RepoProperty -> String
forall a. Show a => a -> String
show) [[RepoProperty]]
rf

-- | Identify the format of the repository at the
-- given location (directory, URL, or SSH path).
-- Fails if we weren't able to identify the format.
identifyRepoFormat :: String -> IO RepoFormat
identifyRepoFormat :: String -> IO RepoFormat
identifyRepoFormat = (String -> IO RepoFormat)
-> (RepoFormat -> IO RepoFormat)
-> Either String RepoFormat
-> IO RepoFormat
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO RepoFormat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail RepoFormat -> IO RepoFormat
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String RepoFormat -> IO RepoFormat)
-> (String -> IO (Either String RepoFormat))
-> String
-> IO RepoFormat
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> IO (Either String RepoFormat)
tryIdentifyRepoFormat

-- | Identify the format of the repository at the
-- given location (directory, URL, or SSH path).
-- Return @'Left' reason@ if it fails, where @reason@ explains why
-- we weren't able to identify the format. Note that we do no verification of
-- the format, which is handled by 'readProblem' or 'writeProblem' on the
-- resulting 'RepoFormat'.
tryIdentifyRepoFormat :: String -> IO (Either String RepoFormat)
tryIdentifyRepoFormat :: String -> IO (Either String RepoFormat)
tryIdentifyRepoFormat String
repo = do
    let k :: String
k = String
"Identifying repository " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
repo
    String -> IO ()
beginTedious String
k
    String -> String -> IO ()
finishedOneIO String
k String
"format"
    ByteString
formatInfo <- (String -> Cachable -> IO ByteString
fetchFilePS (String
repo String -> ShowS
</> String
formatPath) Cachable
Cachable)
                  IO ByteString -> IO ByteString -> IO ByteString
forall a. IO a -> IO a -> IO a
`catchall` (ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty)
    -- We use a workaround for servers that don't return a 404 on nonexistent
    -- files (we trivially check for something that looks like a HTML/XML tag).
    Either String RepoFormat
format <-
      if ByteString -> Bool
B.null ByteString
formatInfo Bool -> Bool -> Bool
|| Char -> ByteString -> Bool
BC.elem Char
'<' ByteString
formatInfo then do
        String -> String -> IO ()
finishedOneIO String
k String
"inventory"
        Maybe String
missingInvErr <- String -> IO (Maybe String)
checkFile (String
repo String -> ShowS
</> String
oldInventoryPath)
        case Maybe String
missingInvErr of
          Maybe String
Nothing -> Either String RepoFormat -> IO (Either String RepoFormat)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String RepoFormat -> IO (Either String RepoFormat))
-> (RepoFormat -> Either String RepoFormat)
-> RepoFormat
-> IO (Either String RepoFormat)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoFormat -> Either String RepoFormat
forall a b. b -> Either a b
Right (RepoFormat -> IO (Either String RepoFormat))
-> RepoFormat -> IO (Either String RepoFormat)
forall a b. (a -> b) -> a -> b
$ [[RepoProperty]] -> RepoFormat
RF [[RepoProperty
Darcs1]]
          Just String
e -> Either String RepoFormat -> IO (Either String RepoFormat)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String RepoFormat -> IO (Either String RepoFormat))
-> (String -> Either String RepoFormat)
-> String
-> IO (Either String RepoFormat)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String RepoFormat
forall a b. a -> Either a b
Left (String -> IO (Either String RepoFormat))
-> String -> IO (Either String RepoFormat)
forall a b. (a -> b) -> a -> b
$ ShowS
makeErrorMsg String
e
      else Either String RepoFormat -> IO (Either String RepoFormat)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String RepoFormat -> IO (Either String RepoFormat))
-> (RepoFormat -> Either String RepoFormat)
-> RepoFormat
-> IO (Either String RepoFormat)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoFormat -> Either String RepoFormat
forall a b. b -> Either a b
Right (RepoFormat -> IO (Either String RepoFormat))
-> RepoFormat -> IO (Either String RepoFormat)
forall a b. (a -> b) -> a -> b
$ ByteString -> RepoFormat
readFormat ByteString
formatInfo
    String -> IO ()
endTedious String
k
    Either String RepoFormat -> IO (Either String RepoFormat)
forall (m :: * -> *) a. Monad m => a -> m a
return Either String RepoFormat
format
  where
    readFormat :: ByteString -> RepoFormat
readFormat =
      [[RepoProperty]] -> RepoFormat
RF ([[RepoProperty]] -> RepoFormat)
-> (ByteString -> [[RepoProperty]]) -> ByteString -> RepoFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ByteString] -> [RepoProperty])
-> [[ByteString]] -> [[RepoProperty]]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> RepoProperty) -> [ByteString] -> [RepoProperty]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> RepoProperty
readRepoProperty (ByteString -> RepoProperty)
-> (ByteString -> ByteString) -> ByteString -> RepoProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fixupUnknownFormat)) ([[ByteString]] -> [[RepoProperty]])
-> (ByteString -> [[ByteString]]) -> ByteString -> [[RepoProperty]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [[ByteString]]
splitFormat

    -- silently fixup unknown format entries broken by previous darcs versions
    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' -- repeat until not found anymore

    -- split into lines, then split each non-empty line on '|'
    splitFormat :: ByteString -> [[ByteString]]
splitFormat = (ByteString -> [ByteString]) -> [ByteString] -> [[ByteString]]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> ByteString -> [ByteString]
BC.split Char
'|') ([ByteString] -> [[ByteString]])
-> (ByteString -> [ByteString]) -> ByteString -> [[ByteString]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
B.null) ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
linesPS

    checkFile :: String -> IO (Maybe String)
checkFile String
path = (String -> Cachable -> IO ByteString
fetchFilePS String
path Cachable
Cachable IO ByteString -> IO (Maybe String) -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing)
                     IO (Maybe String)
-> (SomeException -> IO (Maybe String)) -> IO (Maybe String)
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchNonSignal`
                     (Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> (SomeException -> Maybe String)
-> SomeException
-> IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (SomeException -> String) -> SomeException -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
prettyException)

    makeErrorMsg :: ShowS
makeErrorMsg String
e =  String
"Not a repository: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
repo String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

-- | Write the repo format to the given file.
writeRepoFormat :: RepoFormat -> FilePath -> IO ()
writeRepoFormat :: RepoFormat -> String -> IO ()
writeRepoFormat RepoFormat
rf String
loc = String -> ByteString -> IO ()
forall p. FilePathLike p => p -> ByteString -> IO ()
writeBinFile String
loc (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BC.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ RepoFormat -> String
forall a. Show a => a -> String
show RepoFormat
rf
-- note: this assumes show returns ascii

-- | Create a repo format. The first argument specifies the patch
-- format; the second says whether the repo has a working tree.
createRepoFormat :: F.PatchFormat -> F.WithWorkingDir -> RepoFormat
createRepoFormat :: PatchFormat -> WithWorkingDir -> RepoFormat
createRepoFormat PatchFormat
fmt WithWorkingDir
wwd = [[RepoProperty]] -> RepoFormat
RF ([[RepoProperty]] -> RepoFormat) -> [[RepoProperty]] -> RepoFormat
forall a b. (a -> b) -> a -> b
$ (RepoProperty
HashedInventory RepoProperty -> [RepoProperty] -> [RepoProperty]
forall a. a -> [a] -> [a]
: WithWorkingDir -> [RepoProperty]
flags2wd WithWorkingDir
wwd) [RepoProperty] -> [[RepoProperty]] -> [[RepoProperty]]
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' source@ returns 'Just' an error message if we cannot write
-- to a repo in format @source@, or 'Nothing' if there's no such problem.
writeProblem :: RepoFormat -> Maybe String
writeProblem :: RepoFormat -> Maybe String
writeProblem RepoFormat
target = RepoFormat -> Maybe String
readProblem RepoFormat
target Maybe String -> Maybe String -> Maybe String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` RepoFormat -> ([RepoProperty] -> Maybe String) -> Maybe String
findProblems RepoFormat
target [RepoProperty] -> Maybe String
wp
  where
    wp :: [RepoProperty] -> Maybe String
wp [] = String -> Maybe String
forall a. HasCallStack => String -> a
error String
"impossible case"
    wp [RepoProperty]
x = case (RepoProperty -> Bool)
-> [RepoProperty] -> ([RepoProperty], [RepoProperty])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition RepoProperty -> Bool
isKnown [RepoProperty]
x of
               ([RepoProperty]
_, []) -> Maybe String
forall a. Maybe a
Nothing
               ([RepoProperty]
_, [RepoProperty]
unknowns) -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> ([String] -> String) -> [String] -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> Maybe String) -> [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$
                    String
"Can't write repository: unknown formats:" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (RepoProperty -> String) -> [RepoProperty] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map RepoProperty -> String
forall a. Show a => a -> String
show [RepoProperty]
unknowns

-- | @'transferProblem' source target@ returns 'Just' an error message if we
-- cannot transfer patches from a repo in format @source@ to a repo in format
-- @target@, or 'Nothing' if there are no such problem.
transferProblem :: RepoFormat -> RepoFormat -> Maybe String
transferProblem :: RepoFormat -> RepoFormat -> Maybe String
transferProblem RepoFormat
source RepoFormat
target
    | RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
Darcs3 RepoFormat
source Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
Darcs3 RepoFormat
target =
        String -> Maybe String
forall a. a -> Maybe a
Just String
"Cannot mix darcs-3 repositories with older formats"
    | RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
Darcs2 RepoFormat
source Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
Darcs2 RepoFormat
target =
        String -> Maybe String
forall a. a -> Maybe a
Just String
"Cannot mix darcs-2 repositories with older formats"
    | RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
RebaseInProgress RepoFormat
source =
        String -> Maybe String
forall a. a -> Maybe a
Just String
"Cannot transfer patches from a repository \
          \where an old-style rebase is in progress"
    | Bool
otherwise = RepoFormat -> Maybe String
readProblem RepoFormat
source Maybe String -> Maybe String -> Maybe String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` RepoFormat -> Maybe String
writeProblem RepoFormat
target

-- | @'readProblem' source@ returns 'Just' an error message if we cannot read
-- from a repo in format @source@, or 'Nothing' if there's no such problem.
readProblem :: RepoFormat -> Maybe String
readProblem :: RepoFormat -> Maybe String
readProblem RepoFormat
source
    | RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
Darcs1 RepoFormat
source Bool -> Bool -> Bool
&& RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
Darcs2 RepoFormat
source =
        String -> Maybe String
forall a. a -> Maybe a
Just String
"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 =
        String -> Maybe String
forall a. a -> Maybe a
Just String
"Invalid repository format: \
          \cannot have both old-style and new-style rebase in progress"
readProblem RepoFormat
source = RepoFormat -> ([RepoProperty] -> Maybe String) -> Maybe String
findProblems RepoFormat
source [RepoProperty] -> Maybe String
rp
  where
    rp :: [RepoProperty] -> Maybe String
rp [RepoProperty]
x | (RepoProperty -> Bool) -> [RepoProperty] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any RepoProperty -> Bool
isKnown [RepoProperty]
x = Maybe String
forall a. Maybe a
Nothing
    rp [] = String -> Maybe String
forall a. HasCallStack => String -> a
error String
"impossible case"
    rp [RepoProperty]
x = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> ([String] -> String) -> [String] -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> Maybe String) -> [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"Can't read repository: unknown formats:" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (RepoProperty -> String) -> [RepoProperty] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map RepoProperty -> String
forall a. Show a => a -> String
show [RepoProperty]
x

-- |'findProblems' applies a function that maps format-entries to an optional
-- error message, to each repoformat entry. Returning any errors.
findProblems :: RepoFormat -> ([RepoProperty] -> Maybe String) -> Maybe String
findProblems :: RepoFormat -> ([RepoProperty] -> Maybe String) -> Maybe String
findProblems (RF [[RepoProperty]]
ks) [RepoProperty] -> Maybe String
formatHasProblem = case ([RepoProperty] -> Maybe String) -> [[RepoProperty]] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [RepoProperty] -> Maybe String
formatHasProblem [[RepoProperty]]
ks of
                                            [] -> Maybe String
forall a. Maybe a
Nothing
                                            [String]
xs -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String]
xs

-- | Does this version of darcs know how to handle this property?
isKnown :: RepoProperty -> Bool
isKnown :: RepoProperty -> Bool
isKnown RepoProperty
p = RepoProperty
p RepoProperty -> [RepoProperty] -> Bool
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
                      ]