-- 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
    , unsafeWriteRepoFormat
    , writeProblem
    , readProblem
    , transferProblem
    , formatHas
    , addToFormat
    , removeFromFormat
    ) where

import Darcs.Prelude

import Control.Exception ( try )
import Control.Monad ( mplus, (<=<) )
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString  as B
import Data.List ( partition, intercalate, (\\) )
import Data.Maybe ( mapMaybe )
import Data.String ( IsString )
import System.FilePath.Posix( (</>) )

import Darcs.Util.File
    ( 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.Exception ( prettyException )

import Darcs.Util.ByteString ( linesPS )

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
$c== :: RepoProperty -> RepoProperty -> Bool
== :: RepoProperty -> RepoProperty -> Bool
$c/= :: RepoProperty -> RepoProperty -> Bool
/= :: 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 :: 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"
-- compatibility alias, may want to remove this at some point in the future
newStyleRebaseInProgress :: forall s. IsString s => s
newStyleRebaseInProgress = s
"new-style-rebase-in-progress"

instance Show RepoProperty where
    show :: RepoProperty -> FilePath
show RepoProperty
Darcs1 = FilePath
forall s. IsString s => s
darcs1Format
    show RepoProperty
Darcs2 = FilePath
forall s. IsString s => s
darcs2Format
    show RepoProperty
Darcs3 = FilePath
forall s. IsString s => s
darcs3Format
    show RepoProperty
HashedInventory = FilePath
forall s. IsString s => s
hashedInventoryFormat
    show RepoProperty
NoWorkingDir = FilePath
forall s. IsString s => s
noWorkingDirFormat
    show RepoProperty
RebaseInProgress = FilePath
forall s. IsString s => s
rebaseInProgressFormat
    show RepoProperty
RebaseInProgress_2_16 = FilePath
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 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 a. Eq a => a -> [a] -> 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 -> FilePath
show (RF [[RepoProperty]]
rf) = [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ ([RepoProperty] -> FilePath) -> [[RepoProperty]] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"|" ([FilePath] -> FilePath)
-> ([RepoProperty] -> [FilePath]) -> [RepoProperty] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RepoProperty -> FilePath) -> [RepoProperty] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map RepoProperty -> FilePath
forall a. Show a => a -> FilePath
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 :: FilePath -> IO RepoFormat
identifyRepoFormat = (FilePath -> IO RepoFormat)
-> (RepoFormat -> IO RepoFormat)
-> Either FilePath RepoFormat
-> IO RepoFormat
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> IO RepoFormat
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail RepoFormat -> IO RepoFormat
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath RepoFormat -> IO RepoFormat)
-> (FilePath -> IO (Either FilePath RepoFormat))
-> FilePath
-> IO RepoFormat
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< FilePath -> IO (Either FilePath 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 :: FilePath -> IO (Either FilePath RepoFormat)
tryIdentifyRepoFormat FilePath
repo = do
  Either FilePath RepoFormat
formatResult <-
    FilePath -> IO (Either SomeException ByteString)
forall {e}. Exception e => FilePath -> IO (Either e ByteString)
fetchFile FilePath
formatPath IO (Either SomeException ByteString)
-> (Either SomeException ByteString
    -> IO (Either FilePath RepoFormat))
-> IO (Either FilePath RepoFormat)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left SomeException
e ->
        Either FilePath RepoFormat -> IO (Either FilePath RepoFormat)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath RepoFormat -> IO (Either FilePath RepoFormat))
-> Either FilePath RepoFormat -> IO (Either FilePath RepoFormat)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath RepoFormat
forall a b. a -> Either a b
Left (FilePath -> Either FilePath RepoFormat)
-> FilePath -> Either FilePath RepoFormat
forall a b. (a -> b) -> a -> b
$ SomeException -> FilePath
prettyException SomeException
e
      Right ByteString
content | Char -> ByteString -> Bool
BC.elem Char
'<' ByteString
content ->
        -- 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 FilePath RepoFormat -> IO (Either FilePath RepoFormat)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath RepoFormat -> IO (Either FilePath RepoFormat))
-> Either FilePath RepoFormat -> IO (Either FilePath RepoFormat)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath RepoFormat
forall a b. a -> Either a b
Left (FilePath -> Either FilePath RepoFormat)
-> FilePath -> Either FilePath RepoFormat
forall a b. (a -> b) -> a -> b
$ FilePath
"invalid file content of " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ (FilePath
repo FilePath -> ShowS
</> FilePath
formatPath) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
":\n"
          FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> FilePath
BC.unpack ByteString
content
      Right ByteString
content ->
        Either FilePath RepoFormat -> IO (Either FilePath RepoFormat)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath RepoFormat -> IO (Either FilePath RepoFormat))
-> Either FilePath RepoFormat -> IO (Either FilePath RepoFormat)
forall a b. (a -> b) -> a -> b
$ RepoFormat -> Either FilePath RepoFormat
forall a b. b -> Either a b
Right (RepoFormat -> Either FilePath RepoFormat)
-> RepoFormat -> Either FilePath RepoFormat
forall a b. (a -> b) -> a -> b
$ ByteString -> RepoFormat
readFormat ByteString
content
  case Either FilePath RepoFormat
formatResult of
    Right RepoFormat
_ -> Either FilePath RepoFormat -> IO (Either FilePath RepoFormat)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Either FilePath RepoFormat
formatResult
    Left FilePath
formatError ->
      FilePath -> IO (Either SomeException ByteString)
forall {e}. Exception e => FilePath -> IO (Either e ByteString)
fetchFile FilePath
oldInventoryPath IO (Either SomeException ByteString)
-> (Either SomeException ByteString
    -> IO (Either FilePath RepoFormat))
-> IO (Either FilePath RepoFormat)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right ByteString
_ ->
          Either FilePath RepoFormat -> IO (Either FilePath RepoFormat)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath RepoFormat -> IO (Either FilePath RepoFormat))
-> Either FilePath RepoFormat -> IO (Either FilePath RepoFormat)
forall a b. (a -> b) -> a -> b
$ RepoFormat -> Either FilePath RepoFormat
forall a b. b -> Either a b
Right (RepoFormat -> Either FilePath RepoFormat)
-> RepoFormat -> Either FilePath RepoFormat
forall a b. (a -> b) -> a -> b
$ [[RepoProperty]] -> RepoFormat
RF [[RepoProperty
Darcs1]]
        Left SomeException
inventoryError ->
          -- report only the formatError
          Either FilePath RepoFormat -> IO (Either FilePath RepoFormat)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath RepoFormat -> IO (Either FilePath RepoFormat))
-> Either FilePath RepoFormat -> IO (Either FilePath RepoFormat)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath RepoFormat
forall a b. a -> Either a b
Left (FilePath -> Either FilePath RepoFormat)
-> FilePath -> Either FilePath RepoFormat
forall a b. (a -> b) -> a -> b
$ ShowS
makeErrorMsg ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
            FilePath
formatError FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"\nAnd also:\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeException -> FilePath
prettyException SomeException
inventoryError
  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

    fetchFile :: FilePath -> IO (Either e ByteString)
fetchFile FilePath
path = IO ByteString -> IO (Either e ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
try (FilePath -> Cachable -> IO ByteString
fetchFilePS (FilePath
repo FilePath -> ShowS
</> FilePath
path) Cachable
Cachable)

    makeErrorMsg :: ShowS
makeErrorMsg FilePath
e =  FilePath
"Not a repository: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
repo FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
":\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
e

-- | Write the repo format to the given file.
-- This is unsafe because we don't check that we are allowed to write
-- to the repo.
unsafeWriteRepoFormat :: RepoFormat -> FilePath -> IO ()
unsafeWriteRepoFormat :: RepoFormat -> FilePath -> IO ()
unsafeWriteRepoFormat RepoFormat
rf FilePath
loc = FilePath -> ByteString -> IO ()
forall p. FilePathLike p => p -> ByteString -> IO ()
writeBinFile FilePath
loc (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
BC.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ RepoFormat -> FilePath
forall a. Show a => a -> FilePath
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 FilePath
writeProblem RepoFormat
target = RepoFormat -> Maybe FilePath
readProblem RepoFormat
target Maybe FilePath -> Maybe FilePath -> Maybe FilePath
forall a. Maybe a -> Maybe a -> Maybe a
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 [] = FilePath -> Maybe FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"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 FilePath
forall a. Maybe a
Nothing
               ([RepoProperty]
_, [RepoProperty]
unknowns) -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> ([FilePath] -> FilePath) -> [FilePath] -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unwords ([FilePath] -> Maybe FilePath) -> [FilePath] -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$
                    FilePath
"Can't write repository: unknown formats:" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (RepoProperty -> FilePath) -> [RepoProperty] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map RepoProperty -> FilePath
forall a. Show a => a -> FilePath
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 FilePath
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 =
        FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"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 =
        FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"Cannot mix darcs-2 repositories with older formats"
    | RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
RebaseInProgress RepoFormat
source =
        FilePath -> Maybe FilePath
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 Maybe FilePath -> Maybe FilePath -> Maybe FilePath
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` RepoFormat -> Maybe FilePath
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 FilePath
readProblem RepoFormat
source
    | RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
Darcs1 RepoFormat
source Bool -> Bool -> Bool
&& RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
Darcs2 RepoFormat
source =
        FilePath -> Maybe FilePath
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 =
        FilePath -> Maybe FilePath
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 | (RepoProperty -> Bool) -> [RepoProperty] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any RepoProperty -> Bool
isKnown [RepoProperty]
x = Maybe FilePath
forall a. Maybe a
Nothing
    rp [] = FilePath -> Maybe FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"impossible case"
    rp [RepoProperty]
x = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> ([FilePath] -> FilePath) -> [FilePath] -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unwords ([FilePath] -> Maybe FilePath) -> [FilePath] -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't read repository: unknown formats:" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (RepoProperty -> FilePath) -> [RepoProperty] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map RepoProperty -> FilePath
forall a. Show a => a -> FilePath
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 FilePath) -> Maybe FilePath
findProblems (RF [[RepoProperty]]
ks) [RepoProperty] -> Maybe FilePath
formatHasProblem = case ([RepoProperty] -> Maybe FilePath)
-> [[RepoProperty]] -> [FilePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [RepoProperty] -> Maybe FilePath
formatHasProblem [[RepoProperty]]
ks of
                                            [] -> Maybe FilePath
forall a. Maybe a
Nothing
                                            [FilePath]
xs -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines [FilePath]
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 a. Eq a => a -> [a] -> 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
                      ]