--  Copyright (C) 2002-2014 David Roundy, Petr Rockai, Owen Stephens
--
--  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.UI.Commands.Convert.Darcs2 ( convertDarcs2 ) where

import Control.Monad ( when, unless )
import qualified Data.ByteString as B
import Data.Maybe ( catMaybes )
import Data.List ( lookup )
import System.FilePath.Posix ( (</>) )
import System.Directory ( doesDirectoryExist, doesFileExist )

import Darcs.Prelude

import Darcs.Patch ( RepoPatch, effect, displayPatch )
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.Info ( isTag, piRename, piTag )
import Darcs.Patch.Named ( Named(..), getdeps, patch2patchinfo, patchcontents )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, hopefully, info, n2pia )
import Darcs.Patch.Progress ( progressFL )
import Darcs.Patch.RepoType ( IsRepoType(..), RebaseType(..), RepoType(..) )
import Darcs.Patch.Set ( inOrderTags, patchSet2FL, patchSet2RL )
import qualified Darcs.Patch.V1 as V1 ( RepoPatchV1 )
import Darcs.Patch.V1.Commute ( publicUnravel )
import qualified Darcs.Patch.V1.Core as V1 ( RepoPatchV1(PP), isMerger )
import qualified Darcs.Patch.V1.Prim as V1 ( Prim(..) )
import qualified Darcs.Patch.V2.Prim as V2 ( Prim(..) )
import qualified Darcs.Patch.V2.RepoPatch as V2 ( RepoPatchV2(Normal) )
import Darcs.Patch.V2.RepoPatch ( mergeUnravelled )
import Darcs.Patch.Witnesses.Eq ( EqCheck(..), (=/\=) )
import Darcs.Patch.Witnesses.Ordered
    ( FL(..)
    , bunchFL
    , concatFL
    , foldFL_M
    , mapFL_FL
    , mapRL
    )
import Darcs.Patch.Witnesses.Sealed ( FlippedSeal(..), mapSeal )

import Darcs.Repository
    ( RepoJob(..)
    , Repository
    , applyToWorking
    , createRepositoryV2
    , finalizeRepositoryChanges
    , invalidateIndex
    , readRepo
    , revertRepositoryChanges
    , withRepositoryLocation
    , withUMaskFlag
    )
import qualified Darcs.Repository as R ( setScriptsExecutable )
import Darcs.Repository.Flags ( Compression(..), UpdatePending(..) )
import Darcs.Repository.Format
    ( RepoProperty(Darcs2)
    , formatHas
    , identifyRepoFormat
    )
import Darcs.Repository.Hashed ( UpdatePristine(..), tentativelyAddPatch_ )
import Darcs.Repository.Prefs ( showMotd, prefsFilePath )

import Darcs.UI.Commands ( DarcsCommand(..), nodefaults, putFinished, withStdOpts )
import Darcs.UI.Commands.Convert.Util ( updatePending )
import Darcs.UI.Completion ( noArgs )
import Darcs.UI.Flags
    ( verbosity, useCache, umask, withWorkingDir, patchIndexNo
    , DarcsFlag, withNewRepo
    , quiet
    )
import Darcs.UI.Options ( (^), odesc, ocheck, defaultFlags, parseFlags, (?) )
import qualified Darcs.UI.Options.All as O

import Darcs.Util.External ( fetchFilePS, Cachable(Uncachable) )
import Darcs.Util.Exception ( catchall )
import Darcs.Util.Lock ( withNewDirectory )
import Darcs.Util.Path( ioAbsoluteOrRemote, toPath, AbsolutePath )
import Darcs.Util.Printer ( Doc, text, ($$) )
import Darcs.Util.Printer.Color ( traceDoc )
import Darcs.Util.Prompt ( askUser )
import Darcs.Util.Tree( Tree )
import Darcs.Util.Workaround ( getCurrentDirectory )

type RepoPatchV1 = V1.RepoPatchV1 V1.Prim
type RepoPatchV2 = V2.RepoPatchV2 V2.Prim

convertDarcs2Help :: Doc
convertDarcs2Help :: Doc
convertDarcs2Help = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
 [ String
"This command converts a repository that uses the old patch semantics"
 , String
"`darcs-1` to a new repository with current `darcs-2` semantics."
 , String
""
 , String
convertDarcs2Help'
 ]

-- | This part of the help is split out because it is used twice: in
-- the help string, and in the prompt for confirmation.
convertDarcs2Help' :: String
convertDarcs2Help' :: String
convertDarcs2Help' = [String] -> String
unlines
 [ String
"WARNING: the repository produced by this command is not understood by"
 , String
"Darcs 1.x, and patches cannot be exchanged between repositories in"
 , String
"darcs-1 and darcs-2 formats."
 , String
""
 , String
"Furthermore, repositories created by different invocations of"
 , String
"this command SHOULD NOT exchange patches."
 ]

convertDarcs2 :: DarcsCommand
convertDarcs2 :: DarcsCommand
convertDarcs2 = DarcsCommand :: String
-> String
-> Doc
-> String
-> Int
-> [String]
-> ((AbsolutePath, AbsolutePath)
    -> [DarcsFlag] -> [String] -> IO ())
-> ([DarcsFlag] -> IO (Either String ()))
-> ((AbsolutePath, AbsolutePath)
    -> [DarcsFlag] -> [String] -> IO [String])
-> ([DarcsFlag] -> AbsolutePath -> [String] -> IO [String])
-> [DarcsOptDescr DarcsFlag]
-> [DarcsOptDescr DarcsFlag]
-> [DarcsFlag]
-> ([DarcsFlag] -> [String])
-> DarcsCommand
DarcsCommand
    { commandProgramName :: String
commandProgramName = String
"darcs"
    , commandName :: String
commandName = String
"darcs-2"
    , commandHelp :: Doc
commandHelp = Doc
convertDarcs2Help
    , commandDescription :: String
commandDescription = String
"Convert darcs-1 repository to the darcs-2 patch format"
    , commandExtraArgs :: Int
commandExtraArgs = -Int
1
    , commandExtraArgHelp :: [String]
commandExtraArgHelp = [String
"<SOURCE>", String
"[<DESTINATION>]"]
    , commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
toDarcs2
    , commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = \[DarcsFlag]
_ -> Either String () -> IO (Either String ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String () -> IO (Either String ()))
-> Either String () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ () -> Either String ()
forall a b. b -> Either a b
Right ()
    , commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
noArgs
    , commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
    , commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  (NetworkOptions -> WithPatchIndex -> UMask -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  (NetworkOptions -> WithPatchIndex -> UMask -> Any)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (NetworkOptions -> WithPatchIndex -> UMask -> a)
convertDarcs2AdvancedOpts
    , commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  (Maybe String -> SetScriptsExecutable -> WithWorkingDir -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  (Maybe String -> SetScriptsExecutable -> WithWorkingDir -> Any)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe String -> SetScriptsExecutable -> WithWorkingDir -> a)
convertDarcs2BasicOpts
    , commandDefaults :: [DarcsFlag]
commandDefaults = OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  (Maybe String
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> PatchFormat
   -> [DarcsFlag])
-> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags (DarcsOption
  (PatchFormat -> [DarcsFlag])
  (Maybe String
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> PatchFormat
   -> [DarcsFlag])
forall a.
DarcsOption
  a
  (Maybe String
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
convertDarcs2Opts DarcsOption
  (PatchFormat -> [DarcsFlag])
  (Maybe String
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> PatchFormat
   -> [DarcsFlag])
-> OptSpec
     DarcsOptDescr DarcsFlag [DarcsFlag] (PatchFormat -> [DarcsFlag])
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     [DarcsFlag]
     (Maybe String
      -> SetScriptsExecutable
      -> WithWorkingDir
      -> Maybe StdCmdAction
      -> Verbosity
      -> NetworkOptions
      -> WithPatchIndex
      -> UMask
      -> UseCache
      -> HooksConfig
      -> Bool
      -> Bool
      -> Bool
      -> PatchFormat
      -> [DarcsFlag])
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr DarcsFlag [DarcsFlag] (PatchFormat -> [DarcsFlag])
forall a. PrimOptSpec DarcsOptDescr DarcsFlag a PatchFormat
convertDarcs2SilentOpts)
    , commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  (Maybe String
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> Any)
-> [DarcsFlag] -> [String]
forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  (Maybe String
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> Any)
forall a.
DarcsOption
  a
  (Maybe String
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
convertDarcs2Opts
    }
  where
    convertDarcs2BasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe String -> SetScriptsExecutable -> WithWorkingDir -> a)
convertDarcs2BasicOpts = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (SetScriptsExecutable -> WithWorkingDir -> a)
  (Maybe String)
PrimDarcsOption (Maybe String)
O.newRepo PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (SetScriptsExecutable -> WithWorkingDir -> a)
  (Maybe String)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithWorkingDir -> a)
     (SetScriptsExecutable -> WithWorkingDir -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithWorkingDir -> a)
     (Maybe String -> SetScriptsExecutable -> WithWorkingDir -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (WithWorkingDir -> a)
  (SetScriptsExecutable -> WithWorkingDir -> a)
PrimDarcsOption SetScriptsExecutable
O.setScriptsExecutable OptSpec
  DarcsOptDescr
  DarcsFlag
  (WithWorkingDir -> a)
  (Maybe String -> SetScriptsExecutable -> WithWorkingDir -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (WithWorkingDir -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (Maybe String -> SetScriptsExecutable -> WithWorkingDir -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (WithWorkingDir -> a)
PrimDarcsOption WithWorkingDir
O.withWorkingDir
    convertDarcs2AdvancedOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (NetworkOptions -> WithPatchIndex -> UMask -> a)
convertDarcs2AdvancedOpts = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (WithPatchIndex -> UMask -> a)
  NetworkOptions
PrimDarcsOption NetworkOptions
O.network PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (WithPatchIndex -> UMask -> a)
  NetworkOptions
-> OptSpec
     DarcsOptDescr DarcsFlag (UMask -> a) (WithPatchIndex -> UMask -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (UMask -> a)
     (NetworkOptions -> WithPatchIndex -> UMask -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr DarcsFlag (UMask -> a) (WithPatchIndex -> UMask -> a)
PrimDarcsOption WithPatchIndex
O.patchIndexNo OptSpec
  DarcsOptDescr
  DarcsFlag
  (UMask -> a)
  (NetworkOptions -> WithPatchIndex -> UMask -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (UMask -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (NetworkOptions -> WithPatchIndex -> UMask -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (UMask -> a)
PrimDarcsOption UMask
O.umask
    convertDarcs2Opts :: DarcsOption
  a
  (Maybe String
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
convertDarcs2Opts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
  (Maybe String
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe String -> SetScriptsExecutable -> WithWorkingDir -> a)
convertDarcs2BasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
  (Maybe String
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
-> DarcsOption
     (UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a)
     (NetworkOptions
      -> WithPatchIndex
      -> UMask
      -> UseCache
      -> HooksConfig
      -> Bool
      -> Bool
      -> Bool
      -> a)
-> DarcsOption
     a
     (Maybe String
      -> SetScriptsExecutable
      -> WithWorkingDir
      -> Maybe StdCmdAction
      -> Verbosity
      -> NetworkOptions
      -> WithPatchIndex
      -> UMask
      -> UseCache
      -> HooksConfig
      -> Bool
      -> Bool
      -> Bool
      -> a)
forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` DarcsOption
  (UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a)
  (NetworkOptions
   -> WithPatchIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (NetworkOptions -> WithPatchIndex -> UMask -> a)
convertDarcs2AdvancedOpts
    convertDarcs2SilentOpts :: PrimOptSpec DarcsOptDescr DarcsFlag a PatchFormat
convertDarcs2SilentOpts = PrimOptSpec DarcsOptDescr DarcsFlag a PatchFormat
forall a. PrimOptSpec DarcsOptDescr DarcsFlag a PatchFormat
O.patchFormat

toDarcs2 :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
toDarcs2 :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
toDarcs2 (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts' [String]
args = do
  (String
inrepodir, [DarcsFlag]
opts) <-
    case [String]
args of
      [String
arg1, String
arg2] -> (String, [DarcsFlag]) -> IO (String, [DarcsFlag])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
arg1, String -> [DarcsFlag] -> [DarcsFlag]
withNewRepo String
arg2 [DarcsFlag]
opts')
      [String
arg1] -> (String, [DarcsFlag]) -> IO (String, [DarcsFlag])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
arg1, [DarcsFlag]
opts')
      [String]
_ -> String -> IO (String, [DarcsFlag])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"You must provide either one or two arguments."
  AbsoluteOrRemotePath
typed_repodir <- String -> IO AbsoluteOrRemotePath
ioAbsoluteOrRemote String
inrepodir
  let repodir :: String
repodir = AbsoluteOrRemotePath -> String
forall a. FilePathOrURL a => a -> String
toPath AbsoluteOrRemotePath
typed_repodir

  RepoFormat
format <- String -> IO RepoFormat
identifyRepoFormat String
repodir
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
Darcs2 RepoFormat
format) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Repository is already in darcs 2 format."

  String -> IO ()
putStrLn String
convertDarcs2Help'
  let vow :: String
vow = String
"I understand the consequences of my action"
  String -> IO ()
putStrLn String
"Please confirm that you have read and understood the above"
  String
vow' <- String -> IO String
askUser (String
"by typing `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
vow String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"': ")
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
vow' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
vow) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"User didn't understand the consequences."

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([DarcsFlag] -> Bool
quiet [DarcsFlag]
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
showMotd String
repodir

  String
mysimplename <- [DarcsFlag] -> String -> IO String
makeRepoName [DarcsFlag]
opts String
repodir
  UMask -> IO () -> IO ()
forall a. UMask -> IO a -> IO a
withUMaskFlag (PrimDarcsOption UMask
umask PrimDarcsOption UMask -> [DarcsFlag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
withNewDirectory String
mysimplename (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Repository
  ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
_repo <- WithWorkingDir
-> WithPatchIndex
-> UseCache
-> IO
     (Repository
        ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin)
createRepositoryV2
      (PrimDarcsOption WithWorkingDir
withWorkingDir PrimDarcsOption WithWorkingDir -> [DarcsFlag] -> WithWorkingDir
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption WithPatchIndex
patchIndexNo PrimDarcsOption WithPatchIndex -> [DarcsFlag] -> WithPatchIndex
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption UseCache
O.useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
    Repository
  ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
_repo <- Repository
  ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
-> UpdatePending
-> IO
     (Repository
        ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT
-> UpdatePending -> IO (Repository rt p wR wU wR)
revertRepositoryChanges Repository
  ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
_repo UpdatePending
NoUpdatePending

    UseCache -> String -> RepoJob () -> IO ()
forall a. UseCache -> String -> RepoJob a -> IO a
withRepositoryLocation (PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) String
repodir (RepoJob () -> IO ()) -> RepoJob () -> IO ()
forall a b. (a -> b) -> a -> b
$ (forall wR wU.
 Repository ('RepoType 'NoRebase) (RepoPatchV1 Prim) wR wU wR
 -> IO ())
-> RepoJob ()
forall a.
(forall wR wU.
 Repository ('RepoType 'NoRebase) (RepoPatchV1 Prim) wR wU wR
 -> IO a)
-> RepoJob a
V1Job ((forall wR wU.
  Repository ('RepoType 'NoRebase) (RepoPatchV1 Prim) wR wU wR
  -> IO ())
 -> RepoJob ())
-> (forall wR wU.
    Repository ('RepoType 'NoRebase) (RepoPatchV1 Prim) wR wU wR
    -> IO ())
-> RepoJob ()
forall a b. (a -> b) -> a -> b
$ \Repository ('RepoType 'NoRebase) (RepoPatchV1 Prim) wR wU wR
other -> do
      PatchSet ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin wR
theirstuff <- Repository ('RepoType 'NoRebase) (RepoPatchV1 Prim) wR wU wR
-> IO (PatchSet ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository ('RepoType 'NoRebase) (RepoPatchV1 Prim) wR wU wR
other
      let patches :: FL
  (PatchInfoAndG ('RepoType 'NoRebase) (Named (RepoPatchV2 Prim)))
  Origin
  wR
patches = (forall wW wY.
 PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV1 Prim) wW wY
 -> PatchInfoAndG
      ('RepoType 'NoRebase) (Named (RepoPatchV2 Prim)) wW wY)
-> FL
     (PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV1 Prim)) Origin wR
-> FL
     (PatchInfoAndG ('RepoType 'NoRebase) (Named (RepoPatchV2 Prim)))
     Origin
     wR
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL (Named (RepoPatchV1 Prim) wW wY
-> PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV2 Prim) wW wY
forall wX wY.
Named (RepoPatchV1 Prim) wX wY
-> PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV2 Prim) wX wY
convertNamed (Named (RepoPatchV1 Prim) wW wY
 -> PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV2 Prim) wW wY)
-> (PatchInfoAndG
      ('RepoType 'NoRebase) (Named (RepoPatchV1 Prim)) wW wY
    -> Named (RepoPatchV1 Prim) wW wY)
-> PatchInfoAndG
     ('RepoType 'NoRebase) (Named (RepoPatchV1 Prim)) wW wY
-> PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV2 Prim) wW wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAndG
  ('RepoType 'NoRebase) (Named (RepoPatchV1 Prim)) wW wY
-> Named (RepoPatchV1 Prim) wW wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully) (FL
   (PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV1 Prim)) Origin wR
 -> FL
      (PatchInfoAndG ('RepoType 'NoRebase) (Named (RepoPatchV2 Prim)))
      Origin
      wR)
-> FL
     (PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV1 Prim)) Origin wR
-> FL
     (PatchInfoAndG ('RepoType 'NoRebase) (Named (RepoPatchV2 Prim)))
     Origin
     wR
forall a b. (a -> b) -> a -> b
$ PatchSet ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin wR
-> FL
     (PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV1 Prim)) Origin wR
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> FL (PatchInfoAnd rt p) wStart wX
patchSet2FL PatchSet ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin wR
theirstuff
          outOfOrderTags :: [(PatchInfo, [PatchInfo])]
outOfOrderTags = [Maybe (PatchInfo, [PatchInfo])] -> [(PatchInfo, [PatchInfo])]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (PatchInfo, [PatchInfo])] -> [(PatchInfo, [PatchInfo])])
-> [Maybe (PatchInfo, [PatchInfo])] -> [(PatchInfo, [PatchInfo])]
forall a b. (a -> b) -> a -> b
$ (forall wW wZ.
 PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV1 Prim) wW wZ
 -> Maybe (PatchInfo, [PatchInfo]))
-> RL
     (PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV1 Prim)) Origin wR
-> [Maybe (PatchInfo, [PatchInfo])]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL forall wW wZ.
PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV1 Prim) wW wZ
-> Maybe (PatchInfo, [PatchInfo])
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
HasDeps p =>
PatchInfoAndG rt p wX wY -> Maybe (PatchInfo, [PatchInfo])
oot (RL
   (PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV1 Prim)) Origin wR
 -> [Maybe (PatchInfo, [PatchInfo])])
-> RL
     (PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV1 Prim)) Origin wR
-> [Maybe (PatchInfo, [PatchInfo])]
forall a b. (a -> b) -> a -> b
$ PatchSet ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin wR
-> RL
     (PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV1 Prim)) Origin wR
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX
patchSet2RL PatchSet ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin wR
theirstuff
              where oot :: PatchInfoAndG rt p wX wY -> Maybe (PatchInfo, [PatchInfo])
oot PatchInfoAndG rt p wX wY
t = if PatchInfo -> Bool
isTag (PatchInfoAndG rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAndG rt p wX wY
t) Bool -> Bool -> Bool
&& PatchInfoAndG rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAndG rt p wX wY
t PatchInfo -> [PatchInfo] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` PatchSet ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin wR
-> [PatchInfo]
forall (rt :: RepoType) (p :: * -> * -> *) wS wX.
PatchSet rt p wS wX -> [PatchInfo]
inOrderTags PatchSet ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin wR
theirstuff
                            then (PatchInfo, [PatchInfo]) -> Maybe (PatchInfo, [PatchInfo])
forall a. a -> Maybe a
Just (PatchInfoAndG rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAndG rt p wX wY
t, p wX wY -> [PatchInfo]
forall (p :: * -> * -> *) wX wY.
HasDeps p =>
p wX wY -> [PatchInfo]
getdeps (p wX wY -> [PatchInfo]) -> p wX wY -> [PatchInfo]
forall a b. (a -> b) -> a -> b
$ PatchInfoAndG rt p wX wY -> p wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully PatchInfoAndG rt p wX wY
t)
                            else Maybe (PatchInfo, [PatchInfo])
forall a. Maybe a
Nothing
          fixDep :: PatchInfo -> [PatchInfo]
fixDep PatchInfo
p = case PatchInfo -> [(PatchInfo, [PatchInfo])] -> Maybe [PatchInfo]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup PatchInfo
p [(PatchInfo, [PatchInfo])]
outOfOrderTags of
                     Just [PatchInfo]
d -> PatchInfo
p PatchInfo -> [PatchInfo] -> [PatchInfo]
forall a. a -> [a] -> [a]
: (PatchInfo -> [PatchInfo]) -> [PatchInfo] -> [PatchInfo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PatchInfo -> [PatchInfo]
fixDep [PatchInfo]
d
                     Maybe [PatchInfo]
Nothing -> [PatchInfo
p]
          primV1toV2 :: Prim x y -> Prim x y
primV1toV2 = Prim x y -> Prim x y
forall x y. Prim x y -> Prim x y
V2.Prim (Prim x y -> Prim x y)
-> (Prim x y -> Prim x y) -> Prim x y -> Prim x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prim x y -> Prim x y
forall x y. Prim x y -> Prim x y
V1.unPrim
          convertOne :: RepoPatchV1 wX wY -> FL RepoPatchV2 wX wY
          convertOne :: RepoPatchV1 wX wY -> FL (RepoPatchV2 Prim) wX wY
convertOne RepoPatchV1 wX wY
x | RepoPatchV1 wX wY -> Bool
forall (prim :: * -> * -> *) wA wB. RepoPatchV1 prim wA wB -> Bool
V1.isMerger RepoPatchV1 wX wY
x =
            let ex :: FL Prim wX wY
ex = (forall wW wY. Prim wW wY -> Prim wW wY)
-> FL Prim wX wY -> FL Prim wX wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall wW wY. Prim wW wY -> Prim wW wY
primV1toV2 (RepoPatchV1 wX wY -> FL (PrimOf (RepoPatchV1 Prim)) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect RepoPatchV1 wX wY
x) in
            case [Sealed (FL Prim wY)] -> Maybe (FlippedSeal (RepoPatchV2 Prim) wY)
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
[Sealed (FL prim wX)] -> Maybe (FlippedSeal (RepoPatchV2 prim) wX)
mergeUnravelled ([Sealed (FL Prim wY)]
 -> Maybe (FlippedSeal (RepoPatchV2 Prim) wY))
-> [Sealed (FL Prim wY)]
-> Maybe (FlippedSeal (RepoPatchV2 Prim) wY)
forall a b. (a -> b) -> a -> b
$ (Sealed (FL Prim wY) -> Sealed (FL Prim wY))
-> [Sealed (FL Prim wY)] -> [Sealed (FL Prim wY)]
forall a b. (a -> b) -> [a] -> [b]
map ((forall wX. FL Prim wY wX -> FL Prim wY wX)
-> Sealed (FL Prim wY) -> Sealed (FL Prim wY)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal ((forall wW wY. Prim wW wY -> Prim wW wY)
-> FL Prim wY wX -> FL Prim wY wX
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall wW wY. Prim wW wY -> Prim wW wY
primV1toV2)) ([Sealed (FL Prim wY)] -> [Sealed (FL Prim wY)])
-> [Sealed (FL Prim wY)] -> [Sealed (FL Prim wY)]
forall a b. (a -> b) -> a -> b
$ RepoPatchV1 wX wY -> [Sealed (FL Prim wY)]
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
RepoPatchV1 prim wX wY -> [Sealed (FL prim wY)]
publicUnravel RepoPatchV1 wX wY
x of
             Just (FlippedSeal RepoPatchV2 Prim wX wY
y) ->
                 case RepoPatchV2 Prim wX wY -> FL (PrimOf (RepoPatchV2 Prim)) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect RepoPatchV2 Prim wX wY
y FL Prim wX wY -> FL Prim wX wY -> EqCheck wX wX
forall (p :: * -> * -> *) wA wC wB.
Eq2 p =>
p wA wC -> p wB wC -> EqCheck wA wB
=/\= FL Prim wX wY
ex of
                 EqCheck wX wX
IsEq -> RepoPatchV2 Prim wX wY
y RepoPatchV2 Prim wX wY
-> FL (RepoPatchV2 Prim) wY wY -> FL (RepoPatchV2 Prim) wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RepoPatchV2 Prim) wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
                 EqCheck wX wX
NotEq ->
                     Doc -> FL (RepoPatchV2 Prim) wX wY -> FL (RepoPatchV2 Prim) wX wY
forall a. Doc -> a -> a
traceDoc (String -> Doc
text String
"lossy conversion:" Doc -> Doc -> Doc
$$
                               RepoPatchV1 wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch RepoPatchV1 wX wY
x) (FL (RepoPatchV2 Prim) wX wY -> FL (RepoPatchV2 Prim) wX wY)
-> FL (RepoPatchV2 Prim) wX wY -> FL (RepoPatchV2 Prim) wX wY
forall a b. (a -> b) -> a -> b
$
                     (forall wW wY. Prim wW wY -> RepoPatchV2 wW wY)
-> FL Prim wX wY -> FL (RepoPatchV2 Prim) wX wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall wW wY. Prim wW wY -> RepoPatchV2 wW wY
forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RepoPatchV2 prim wX wY
V2.Normal FL Prim wX wY
ex
             Maybe (FlippedSeal (RepoPatchV2 Prim) wY)
Nothing -> Doc -> FL (RepoPatchV2 Prim) wX wY -> FL (RepoPatchV2 Prim) wX wY
forall a. Doc -> a -> a
traceDoc (String -> Doc
text
                                  String
"lossy conversion of complicated conflict:" Doc -> Doc -> Doc
$$
                                  RepoPatchV1 wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch RepoPatchV1 wX wY
x) (FL (RepoPatchV2 Prim) wX wY -> FL (RepoPatchV2 Prim) wX wY)
-> FL (RepoPatchV2 Prim) wX wY -> FL (RepoPatchV2 Prim) wX wY
forall a b. (a -> b) -> a -> b
$
                        (forall wW wY. Prim wW wY -> RepoPatchV2 wW wY)
-> FL Prim wX wY -> FL (RepoPatchV2 Prim) wX wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall wW wY. Prim wW wY -> RepoPatchV2 wW wY
forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RepoPatchV2 prim wX wY
V2.Normal FL Prim wX wY
ex
          convertOne (V1.PP Prim wX wY
x) = Prim wX wY -> RepoPatchV2 Prim wX wY
forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RepoPatchV2 prim wX wY
V2.Normal (Prim wX wY -> Prim wX wY
forall wW wY. Prim wW wY -> Prim wW wY
primV1toV2 Prim wX wY
x) RepoPatchV2 Prim wX wY
-> FL (RepoPatchV2 Prim) wY wY -> FL (RepoPatchV2 Prim) wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RepoPatchV2 Prim) wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
          convertOne RepoPatchV1 wX wY
_ = String -> FL (RepoPatchV2 Prim) wX wY
forall a. HasCallStack => String -> a
error String
"impossible case"
          convertFL :: FL RepoPatchV1 wX wY -> FL RepoPatchV2 wX wY
          convertFL :: FL (RepoPatchV1 Prim) wX wY -> FL (RepoPatchV2 Prim) wX wY
convertFL = FL (FL (RepoPatchV2 Prim)) wX wY -> FL (RepoPatchV2 Prim) wX wY
forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL (FL (FL (RepoPatchV2 Prim)) wX wY -> FL (RepoPatchV2 Prim) wX wY)
-> (FL (RepoPatchV1 Prim) wX wY
    -> FL (FL (RepoPatchV2 Prim)) wX wY)
-> FL (RepoPatchV1 Prim) wX wY
-> FL (RepoPatchV2 Prim) wX wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wY. RepoPatchV1 wW wY -> FL (RepoPatchV2 Prim) wW wY)
-> FL (RepoPatchV1 Prim) wX wY -> FL (FL (RepoPatchV2 Prim)) wX wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall wW wY. RepoPatchV1 wW wY -> FL (RepoPatchV2 Prim) wW wY
convertOne
          convertNamed :: Named RepoPatchV1 wX wY
                       -> PatchInfoAnd ('RepoType 'NoRebase) RepoPatchV2 wX wY
          convertNamed :: Named (RepoPatchV1 Prim) wX wY
-> PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV2 Prim) wX wY
convertNamed Named (RepoPatchV1 Prim) wX wY
n = Named (RepoPatchV2 Prim) wX wY
-> PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV2 Prim) wX wY
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
(Ident p, PatchId p ~ PatchInfo) =>
p wX wY -> PatchInfoAndG rt p wX wY
n2pia (Named (RepoPatchV2 Prim) wX wY
 -> PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV2 Prim) wX wY)
-> Named (RepoPatchV2 Prim) wX wY
-> PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV2 Prim) wX wY
forall a b. (a -> b) -> a -> b
$
                           PatchInfo
-> [PatchInfo]
-> FL (RepoPatchV2 Prim) wX wY
-> Named (RepoPatchV2 Prim) wX wY
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP
                            (PatchInfo -> PatchInfo
convertInfo (PatchInfo -> PatchInfo) -> PatchInfo -> PatchInfo
forall a b. (a -> b) -> a -> b
$ Named (RepoPatchV1 Prim) wX wY -> PatchInfo
forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
patch2patchinfo Named (RepoPatchV1 Prim) wX wY
n)
                            ((PatchInfo -> PatchInfo) -> [PatchInfo] -> [PatchInfo]
forall a b. (a -> b) -> [a] -> [b]
map PatchInfo -> PatchInfo
convertInfo ([PatchInfo] -> [PatchInfo]) -> [PatchInfo] -> [PatchInfo]
forall a b. (a -> b) -> a -> b
$ (PatchInfo -> [PatchInfo]) -> [PatchInfo] -> [PatchInfo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PatchInfo -> [PatchInfo]
fixDep ([PatchInfo] -> [PatchInfo]) -> [PatchInfo] -> [PatchInfo]
forall a b. (a -> b) -> a -> b
$ Named (RepoPatchV1 Prim) wX wY -> [PatchInfo]
forall (p :: * -> * -> *) wX wY.
HasDeps p =>
p wX wY -> [PatchInfo]
getdeps Named (RepoPatchV1 Prim) wX wY
n)
                            (FL (RepoPatchV1 Prim) wX wY -> FL (RepoPatchV2 Prim) wX wY
forall wX wY.
FL (RepoPatchV1 Prim) wX wY -> FL (RepoPatchV2 Prim) wX wY
convertFL (FL (RepoPatchV1 Prim) wX wY -> FL (RepoPatchV2 Prim) wX wY)
-> FL (RepoPatchV1 Prim) wX wY -> FL (RepoPatchV2 Prim) wX wY
forall a b. (a -> b) -> a -> b
$ Named (RepoPatchV1 Prim) wX wY -> FL (RepoPatchV1 Prim) wX wY
forall (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
patchcontents Named (RepoPatchV1 Prim) wX wY
n)
          convertInfo :: PatchInfo -> PatchInfo
convertInfo PatchInfo
n | PatchInfo
n PatchInfo -> [PatchInfo] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` PatchSet ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin wR
-> [PatchInfo]
forall (rt :: RepoType) (p :: * -> * -> *) wS wX.
PatchSet rt p wS wX -> [PatchInfo]
inOrderTags PatchSet ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin wR
theirstuff = PatchInfo
n
                        | Bool
otherwise = PatchInfo -> (String -> PatchInfo) -> Maybe String -> PatchInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PatchInfo
n (\String
t -> PatchInfo -> String -> PatchInfo
piRename PatchInfo
n (String
"old tag: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
t)) (Maybe String -> PatchInfo) -> Maybe String -> PatchInfo
forall a b. (a -> b) -> a -> b
$ PatchInfo -> Maybe String
piTag PatchInfo
n

      -- Note: we use bunchFL so we can commit every 100 patches
      Repository ('RepoType 'NoRebase) (RepoPatchV2 Prim) wR wR wR
_ <- [DarcsFlag]
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
-> FL
     (FL
        (PatchInfoAndG ('RepoType 'NoRebase) (Named (RepoPatchV2 Prim))))
     Origin
     wR
-> IO
     (Repository ('RepoType 'NoRebase) (RepoPatchV2 Prim) wR wR wR)
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> Repository rt p wX wX wX
-> FL (FL (PatchInfoAnd rt p)) wX wY
-> IO (Repository rt p wY wY wY)
applyAll [DarcsFlag]
opts Repository
  ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
_repo (FL
   (FL
      (PatchInfoAndG ('RepoType 'NoRebase) (Named (RepoPatchV2 Prim))))
   Origin
   wR
 -> IO
      (Repository ('RepoType 'NoRebase) (RepoPatchV2 Prim) wR wR wR))
-> FL
     (FL
        (PatchInfoAndG ('RepoType 'NoRebase) (Named (RepoPatchV2 Prim))))
     Origin
     wR
-> IO
     (Repository ('RepoType 'NoRebase) (RepoPatchV2 Prim) wR wR wR)
forall a b. (a -> b) -> a -> b
$ Int
-> FL
     (PatchInfoAndG ('RepoType 'NoRebase) (Named (RepoPatchV2 Prim)))
     Origin
     wR
-> FL
     (FL
        (PatchInfoAndG ('RepoType 'NoRebase) (Named (RepoPatchV2 Prim))))
     Origin
     wR
forall (a :: * -> * -> *) wX wY.
Int -> FL a wX wY -> FL (FL a) wX wY
bunchFL Int
100 (FL
   (PatchInfoAndG ('RepoType 'NoRebase) (Named (RepoPatchV2 Prim)))
   Origin
   wR
 -> FL
      (FL
         (PatchInfoAndG ('RepoType 'NoRebase) (Named (RepoPatchV2 Prim))))
      Origin
      wR)
-> FL
     (PatchInfoAndG ('RepoType 'NoRebase) (Named (RepoPatchV2 Prim)))
     Origin
     wR
-> FL
     (FL
        (PatchInfoAndG ('RepoType 'NoRebase) (Named (RepoPatchV2 Prim))))
     Origin
     wR
forall a b. (a -> b) -> a -> b
$ String
-> FL
     (PatchInfoAndG ('RepoType 'NoRebase) (Named (RepoPatchV2 Prim)))
     Origin
     wR
-> FL
     (PatchInfoAndG ('RepoType 'NoRebase) (Named (RepoPatchV2 Prim)))
     Origin
     wR
forall (a :: * -> * -> *) wX wY. String -> FL a wX wY -> FL a wX wY
progressFL String
"Converting patch" FL
  (PatchInfoAndG ('RepoType 'NoRebase) (Named (RepoPatchV2 Prim)))
  Origin
  wR
patches
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PrimDarcsOption SetScriptsExecutable
-> [DarcsFlag] -> SetScriptsExecutable
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimDarcsOption SetScriptsExecutable
O.setScriptsExecutable [DarcsFlag]
opts SetScriptsExecutable -> SetScriptsExecutable -> Bool
forall a. Eq a => a -> a -> Bool
== SetScriptsExecutable
O.YesSetScriptsExecutable)
        IO ()
R.setScriptsExecutable

      -- Copy over the prefs file
      (String -> Cachable -> IO ByteString
fetchFilePS (String
repodir String -> String -> String
</> String
prefsFilePath) Cachable
Uncachable IO ByteString -> (ByteString -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ByteString -> IO ()
B.writeFile String
prefsFilePath)
       IO () -> IO () -> IO ()
forall a. IO a -> IO a -> IO a
`catchall` () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

      [DarcsFlag] -> String -> IO ()
putFinished [DarcsFlag]
opts String
"converting"
  where
    applyOne :: (RepoPatch p, ApplyState p ~ Tree)
             => [DarcsFlag]
             -> W2 (Repository rt p wR) wX
             -> PatchInfoAnd rt p wX wY
             -> IO (W2 (Repository rt p wR) wY)
    applyOne :: [DarcsFlag]
-> W2 (Repository rt p wR) wX
-> PatchInfoAnd rt p wX wY
-> IO (W2 (Repository rt p wR) wY)
applyOne [DarcsFlag]
opts (W2 Repository rt p wR wX wX
_repo) PatchInfoAnd rt p wX wY
x = do
      Repository rt p wR wX wY
_repo <- UpdatePristine
-> Repository rt p wR wX wX
-> Compression
-> Verbosity
-> UpdatePending
-> PatchInfoAnd rt p wX wY
-> IO (Repository rt p wR wX wY)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(RepoPatch p, ApplyState p ~ Tree) =>
UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdatePending
-> PatchInfoAnd rt p wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatch_ ([DarcsFlag] -> UpdatePristine
updatePristine [DarcsFlag]
opts) Repository rt p wR wX wX
_repo
        Compression
GzipCompression (PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) ([DarcsFlag] -> UpdatePending
updatePending [DarcsFlag]
opts) PatchInfoAnd rt p wX wY
x
      Repository rt p wR wY wY
_repo <- Repository rt p wR wX wY
-> Verbosity
-> FL (PrimOf p) wX wY
-> IO (Repository rt p wR wY wY)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Repository rt p wR wU wT
-> Verbosity
-> FL (PrimOf p) wU wY
-> IO (Repository rt p wR wY wT)
applyToWorking Repository rt p wR wX wY
_repo (PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PatchInfoAnd rt p wX wY
-> FL (PrimOf (PatchInfoAndG rt (Named p))) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect PatchInfoAnd rt p wX wY
x)
      Repository rt p wR wY wY -> IO ()
forall t. t -> IO ()
invalidateIndex Repository rt p wR wY wY
_repo
      W2 (Repository rt p wR) wY -> IO (W2 (Repository rt p wR) wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (Repository rt p wR wY wY -> W2 (Repository rt p wR) wY
forall (r :: * -> * -> *) wX. r wX wX -> W2 r wX
W2 Repository rt p wR wY wY
_repo)

    applySome :: [DarcsFlag]
-> W3 (Repository rt p) wR
-> FL (PatchInfoAndG rt (Named p)) wR wX
-> IO (W3 (Repository rt p) wX)
applySome [DarcsFlag]
opts (W3 Repository rt p wR wR wR
_repo) FL (PatchInfoAndG rt (Named p)) wR wX
xs = do
      Repository rt p wR wX wX
_repo <- W2 (Repository rt p wR) wX -> Repository rt p wR wX wX
forall (r :: * -> * -> *) wX. W2 r wX -> r wX wX
unW2 (W2 (Repository rt p wR) wX -> Repository rt p wR wX wX)
-> IO (W2 (Repository rt p wR) wX) -> IO (Repository rt p wR wX wX)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall wA wB.
 W2 (Repository rt p wR) wA
 -> PatchInfoAndG rt (Named p) wA wB
 -> IO (W2 (Repository rt p wR) wB))
-> W2 (Repository rt p wR) wR
-> FL (PatchInfoAndG rt (Named p)) wR wX
-> IO (W2 (Repository rt p wR) wX)
forall (m :: * -> *) (r :: * -> *) (p :: * -> * -> *) wX wY.
Monad m =>
(forall wA wB. r wA -> p wA wB -> m (r wB))
-> r wX -> FL p wX wY -> m (r wY)
foldFL_M ([DarcsFlag]
-> W2 (Repository rt p wR) wA
-> PatchInfoAnd rt p wA wB
-> IO (W2 (Repository rt p wR) wB)
forall (p :: * -> * -> *) (rt :: RepoType) wR wX wY.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> W2 (Repository rt p wR) wX
-> PatchInfoAnd rt p wX wY
-> IO (W2 (Repository rt p wR) wY)
applyOne [DarcsFlag]
opts) (Repository rt p wR wR wR -> W2 (Repository rt p wR) wR
forall (r :: * -> * -> *) wX. r wX wX -> W2 r wX
W2 Repository rt p wR wR wR
_repo) FL (PatchInfoAndG rt (Named p)) wR wX
xs
      -- commit after applying a bunch of patches
      Repository rt p wX wX wX
_repo <- Repository rt p wR wX wX
-> UpdatePending -> Compression -> IO (Repository rt p wX wX wX)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> UpdatePending -> Compression -> IO (Repository rt p wT wU wT)
finalizeRepositoryChanges Repository rt p wR wX wX
_repo ([DarcsFlag] -> UpdatePending
updatePending [DarcsFlag]
opts) Compression
GzipCompression
      Repository rt p wX wX wX
_repo <- Repository rt p wX wX wX
-> UpdatePending -> IO (Repository rt p wX wX wX)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT
-> UpdatePending -> IO (Repository rt p wR wU wR)
revertRepositoryChanges Repository rt p wX wX wX
_repo ([DarcsFlag] -> UpdatePending
updatePending [DarcsFlag]
opts)
      W3 (Repository rt p) wX -> IO (W3 (Repository rt p) wX)
forall (m :: * -> *) a. Monad m => a -> m a
return (Repository rt p wX wX wX -> W3 (Repository rt p) wX
forall (r :: * -> * -> * -> *) wX. r wX wX wX -> W3 r wX
W3 Repository rt p wX wX wX
_repo)

    applyAll :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
             => [DarcsFlag]
             -> Repository rt p wX wX wX
             -> FL (FL (PatchInfoAnd rt p)) wX wY
             -> IO (Repository rt p wY wY wY)
    applyAll :: [DarcsFlag]
-> Repository rt p wX wX wX
-> FL (FL (PatchInfoAnd rt p)) wX wY
-> IO (Repository rt p wY wY wY)
applyAll [DarcsFlag]
opts Repository rt p wX wX wX
r FL (FL (PatchInfoAnd rt p)) wX wY
xss = W3 (Repository rt p) wY -> Repository rt p wY wY wY
forall (r :: * -> * -> * -> *) wX. W3 r wX -> r wX wX wX
unW3 (W3 (Repository rt p) wY -> Repository rt p wY wY wY)
-> IO (W3 (Repository rt p) wY) -> IO (Repository rt p wY wY wY)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall wA wB.
 W3 (Repository rt p) wA
 -> FL (PatchInfoAnd rt p) wA wB -> IO (W3 (Repository rt p) wB))
-> W3 (Repository rt p) wX
-> FL (FL (PatchInfoAnd rt p)) wX wY
-> IO (W3 (Repository rt p) wY)
forall (m :: * -> *) (r :: * -> *) (p :: * -> * -> *) wX wY.
Monad m =>
(forall wA wB. r wA -> p wA wB -> m (r wB))
-> r wX -> FL p wX wY -> m (r wY)
foldFL_M ([DarcsFlag]
-> W3 (Repository rt p) wA
-> FL (PatchInfoAnd rt p) wA wB
-> IO (W3 (Repository rt p) wB)
forall (rt :: RepoType) (p :: * -> * -> *) wR wX.
(IsRepoType rt, 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 ~ Tree, ApplyState p ~ ApplyState (PrimOf p)) =>
[DarcsFlag]
-> W3 (Repository rt p) wR
-> FL (PatchInfoAndG rt (Named p)) wR wX
-> IO (W3 (Repository rt p) wX)
applySome [DarcsFlag]
opts) (Repository rt p wX wX wX -> W3 (Repository rt p) wX
forall (r :: * -> * -> * -> *) wX. r wX wX wX -> W3 r wX
W3 Repository rt p wX wX wX
r) FL (FL (PatchInfoAnd rt p)) wX wY
xss

    updatePristine :: [DarcsFlag] -> UpdatePristine
    updatePristine :: [DarcsFlag] -> UpdatePristine
updatePristine [DarcsFlag]
opts =
      case PrimDarcsOption WithWorkingDir
withWorkingDir PrimDarcsOption WithWorkingDir -> [DarcsFlag] -> WithWorkingDir
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts of
        WithWorkingDir
O.WithWorkingDir -> UpdatePristine
UpdatePristine
        -- this should not be necessary but currently is, because
        -- some commands (e.g. send) cannot cope with a missing pristine
        -- even if the repo is marked as having no working tree
        WithWorkingDir
O.NoWorkingDir -> {- DontUpdatePristineNorRevert -}UpdatePristine
UpdatePristine

-- | Need this to make 'foldFL_M' work with a function that changes
-- the last two (identical) witnesses at the same time.
newtype W2 r wX = W2 {W2 r wX -> r wX wX
unW2 :: r wX wX}

-- | Similarly for when the function changes all three witnesses.
newtype W3 r wX = W3 {W3 r wX -> r wX wX wX
unW3 :: r wX wX wX}

makeRepoName :: [DarcsFlag] -> FilePath -> IO String
makeRepoName :: [DarcsFlag] -> String -> IO String
makeRepoName [DarcsFlag]
opts String
d =
  case PrimDarcsOption (Maybe String)
O.newRepo PrimDarcsOption (Maybe String) -> [DarcsFlag] -> Maybe String
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts of
    Just String
n -> do
      Bool
exists <- String -> IO Bool
doesDirectoryExist String
n
      Bool
file_exists <- String -> IO Bool
doesFileExist String
n
      if Bool
exists Bool -> Bool -> Bool
|| Bool
file_exists
        then String -> IO String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"Directory or file named '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' already exists."
        else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
n
    Maybe String
Nothing ->
      case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
           String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
           (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
           (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse String
d of
        String
"" -> String -> IO String
modifyRepoName String
"anonymous_repo"
        String
base -> String -> IO String
modifyRepoName String
base

modifyRepoName :: String -> IO String
modifyRepoName :: String -> IO String
modifyRepoName String
name =
    if String -> Char
forall a. [a] -> a
head String
name Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'
    then String -> Int -> IO String
mrn String
name (-Int
1)
    else do String
cwd <- IO String
getCurrentDirectory
            String -> Int -> IO String
mrn (String
cwd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name) (-Int
1)
 where
  mrn :: String -> Int -> IO String
  mrn :: String -> Int -> IO String
mrn String
n Int
i = do
    Bool
exists <- String -> IO Bool
doesDirectoryExist String
thename
    Bool
file_exists <- String -> IO Bool
doesFileExist String
thename
    if Bool -> Bool
not Bool
exists Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
file_exists
       then do Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= -Int
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Directory '"String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
                               String
"' already exists, creating repository as '"String -> String -> String
forall a. [a] -> [a] -> [a]
++
                               String
thename String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"'"
               String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
thename
       else String -> Int -> IO String
mrn String
n (Int -> IO String) -> Int -> IO String
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
    where thename :: String
thename = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 then String
n else String
nString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"_"String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
i