--  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, void )
import qualified Data.ByteString as B
import Data.Char ( toLower )
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.Permutations ( (=/~\=) )
import Darcs.Patch.Progress ( progressFL )
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(..)
    , concatFL
    , foldFL_M
    , mapFL_FL
    , mapRL
    , reverseFL
    )
import Darcs.Patch.Witnesses.Sealed ( FlippedSeal(..), mapSeal )

import Darcs.Repository
    ( RepoJob(..)
    , Repository
    , AccessType(..)
    , applyToWorking
    , createRepositoryV2
    , finalizeRepositoryChanges
    , readPatches
    , revertRepositoryChanges
    , withRepositoryLocation
    , withUMaskFlag
    )
import qualified Darcs.Repository as R ( setAllScriptsExecutable )
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.Commands.Util ( commonHelpWithPrefsTemplates )
import Darcs.UI.Completion ( noArgs )
import Darcs.UI.Flags
    ( verbosity, useCache, umask, withWorkingDir, patchIndexNo
    , DarcsFlag, withNewRepo
    , quiet
    )
import Darcs.UI.Options ( parseFlags, (?), (^) )
import qualified Darcs.UI.Options.All as O

import Darcs.Util.File ( 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 = [Char] -> Doc
text ([[Char]] -> [Char]
unlines
 [ [Char]
"This command converts a repository that uses the old patch semantics"
 , [Char]
"`darcs-1` to a new repository with current `darcs-2` semantics."
 , [Char]
""
 , [Char]
convertDarcs2Help'
 ])
 Doc -> Doc -> Doc
$+$ Doc
commonHelpWithPrefsTemplates

-- | 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' :: [Char]
convertDarcs2Help' = [[Char]] -> [Char]
unlines
 [ [Char]
"WARNING: the repository produced by this command is not understood by"
 , [Char]
"Darcs 1.x, and patches cannot be exchanged between repositories in"
 , [Char]
"darcs-1 and darcs-2 formats. Also, you should not exchange patches"
 , [Char]
"between repositories created by different invocations of this command."
 , [Char]
"This means:"
 , [Char]
"- Before doing this conversion, you should merge into this repo any patches"
 , [Char]
"  existing elsewhere that you might want to merge in future, so that they"
 , [Char]
"  will remain mergeable. (You can always remove them again after converting)."
 , [Char]
"- After converting, you should tell everyone with a fork of this repo"
 , [Char]
"  to discard it and make a new fork of the converted repo."
 ]

convertDarcs2 :: DarcsCommand
convertDarcs2 :: DarcsCommand
convertDarcs2 = DarcsCommand
    { commandProgramName :: [Char]
commandProgramName = [Char]
"darcs"
    , commandName :: [Char]
commandName = [Char]
"darcs-2"
    , commandHelp :: Doc
commandHelp = Doc
convertDarcs2Help
    , commandDescription :: [Char]
commandDescription = [Char]
"Convert darcs-1 repository to the darcs-2 patch format"
    , commandExtraArgs :: Int
commandExtraArgs = -Int
1
    , commandExtraArgHelp :: [[Char]]
commandExtraArgHelp = [[Char]
"<SOURCE>", [Char]
"[<DESTINATION>]"]
    , commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
toDarcs2
    , commandPrereq :: [DarcsFlag] -> IO (Either [Char] ())
commandPrereq = \[DarcsFlag]
_ -> Either [Char] () -> IO (Either [Char] ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] () -> IO (Either [Char] ()))
-> Either [Char] () -> IO (Either [Char] ())
forall a b. (a -> b) -> a -> b
$ () -> Either [Char] ()
forall a b. b -> Either a b
Right ()
    , commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [[Char]] -> IO [[Char]]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [[Char]] -> IO [[Char]]
noArgs
    , commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [[Char]] -> IO [[Char]]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [[Char]] -> IO [[Char]]
nodefaults
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
opts
    }
  where
    basicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe [Char] -> SetScriptsExecutable -> WithWorkingDir -> a)
basicOpts = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (SetScriptsExecutable -> WithWorkingDir -> a)
  (Maybe [Char])
PrimDarcsOption (Maybe [Char])
O.newRepo PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (SetScriptsExecutable -> WithWorkingDir -> a)
  (Maybe [Char])
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithWorkingDir -> a)
     (SetScriptsExecutable -> WithWorkingDir -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithWorkingDir -> a)
     (Maybe [Char] -> 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 [Char] -> SetScriptsExecutable -> WithWorkingDir -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (WithWorkingDir -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (Maybe [Char] -> 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
    advancedOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (RemoteDarcs -> WithPatchIndex -> UMask -> PatchFormat -> a)
advancedOpts = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (WithPatchIndex -> UMask -> PatchFormat -> a)
  RemoteDarcs
PrimDarcsOption RemoteDarcs
O.remoteDarcs PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (WithPatchIndex -> UMask -> PatchFormat -> a)
  RemoteDarcs
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (UMask -> PatchFormat -> a)
     (WithPatchIndex -> UMask -> PatchFormat -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (UMask -> PatchFormat -> a)
     (RemoteDarcs -> WithPatchIndex -> UMask -> PatchFormat -> 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 -> PatchFormat -> a)
  (WithPatchIndex -> UMask -> PatchFormat -> a)
PrimDarcsOption WithPatchIndex
O.patchIndexNo OptSpec
  DarcsOptDescr
  DarcsFlag
  (UMask -> PatchFormat -> a)
  (RemoteDarcs -> WithPatchIndex -> UMask -> PatchFormat -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (PatchFormat -> a)
     (UMask -> PatchFormat -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (PatchFormat -> a)
     (RemoteDarcs -> WithPatchIndex -> UMask -> PatchFormat -> 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
  (PatchFormat -> a)
  (UMask -> PatchFormat -> a)
PrimDarcsOption UMask
O.umask OptSpec
  DarcsOptDescr
  DarcsFlag
  (PatchFormat -> a)
  (RemoteDarcs -> WithPatchIndex -> UMask -> PatchFormat -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (PatchFormat -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (RemoteDarcs -> WithPatchIndex -> UMask -> PatchFormat -> 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 (PatchFormat -> a)
PrimDarcsOption PatchFormat
O.patchFormat
    opts :: CommandOptions
opts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> RemoteDarcs
   -> WithPatchIndex
   -> UMask
   -> PatchFormat
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Maybe [Char]
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> Maybe StdCmdAction
   -> Verbosity
   -> RemoteDarcs
   -> WithPatchIndex
   -> UMask
   -> PatchFormat
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe [Char] -> SetScriptsExecutable -> WithWorkingDir -> a)
basicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> RemoteDarcs
   -> WithPatchIndex
   -> UMask
   -> PatchFormat
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Maybe [Char]
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> Maybe StdCmdAction
   -> Verbosity
   -> RemoteDarcs
   -> WithPatchIndex
   -> UMask
   -> PatchFormat
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (RemoteDarcs
      -> WithPatchIndex
      -> UMask
      -> PatchFormat
      -> UseCache
      -> UseIndex
      -> HooksConfig
      -> Bool
      -> Bool
      -> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     b
-> CommandOptions
`withStdOpts` DarcsOption
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
  (RemoteDarcs
   -> WithPatchIndex
   -> UMask
   -> PatchFormat
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (RemoteDarcs -> WithPatchIndex -> UMask -> PatchFormat -> a)
advancedOpts

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

  RepoFormat
format <- [Char] -> IO RepoFormat
identifyRepoFormat [Char]
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
$ [Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Repository is already in darcs 2 format."

  [Char] -> IO ()
putStrLn [Char]
convertDarcs2Help'
  [Char]
answer <- [Char] -> IO [Char]
askUser ([Char]
"Do you still want to proceed ? If so, please type \"yes\": ")
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
answer [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"yes") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Ok, doing nothing."

  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
$ [Char] -> IO ()
showMotd [Char]
repodir

  [Char]
mysimplename <- [DarcsFlag] -> [Char] -> IO [Char]
makeRepoName [DarcsFlag]
opts [Char]
repodir
  UMask -> IO () -> IO ()
forall a. UMask -> IO a -> IO a
withUMaskFlag (PrimOptSpec DarcsOptDescr DarcsFlag a UMask
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
$ [Char] -> IO () -> IO ()
withNewDirectory [Char]
mysimplename (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Repository 'RO (RepoPatchV2 Prim) Origin Origin
_repo <-
      WithWorkingDir
-> WithPatchIndex
-> UseCache
-> WithPrefsTemplates
-> IO (Repository 'RO (RepoPatchV2 Prim) Origin Origin)
createRepositoryV2 (PrimOptSpec DarcsOptDescr DarcsFlag a WithWorkingDir
PrimDarcsOption WithWorkingDir
withWorkingDir PrimDarcsOption WithWorkingDir -> [DarcsFlag] -> WithWorkingDir
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimOptSpec DarcsOptDescr DarcsFlag a WithPatchIndex
PrimDarcsOption WithPatchIndex
patchIndexNo PrimDarcsOption WithPatchIndex -> [DarcsFlag] -> WithPatchIndex
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
        (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
O.useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimOptSpec DarcsOptDescr DarcsFlag a WithPrefsTemplates
PrimDarcsOption WithPrefsTemplates
O.withPrefsTemplates PrimDarcsOption WithPrefsTemplates
-> [DarcsFlag] -> WithPrefsTemplates
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
    Repository 'RW (RepoPatchV2 Prim) Origin Origin
_repo <- Repository 'RO (RepoPatchV2 Prim) Origin Origin
-> IO (Repository 'RW (RepoPatchV2 Prim) Origin Origin)
forall (p :: * -> * -> *) wU wR.
RepoPatch p =>
Repository 'RO p wU wR -> IO (Repository 'RW p wU wR)
revertRepositoryChanges Repository 'RO (RepoPatchV2 Prim) Origin Origin
_repo

    UseCache -> [Char] -> RepoJob 'RO () -> IO ()
forall a. UseCache -> [Char] -> RepoJob 'RO a -> IO a
withRepositoryLocation (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) [Char]
repodir (RepoJob 'RO () -> IO ()) -> RepoJob 'RO () -> IO ()
forall a b. (a -> b) -> a -> b
$ V1PatchJob 'RO () -> RepoJob 'RO ()
forall (rt :: AccessType) a. V1PatchJob rt a -> RepoJob rt a
V1Job (V1PatchJob 'RO () -> RepoJob 'RO ())
-> V1PatchJob 'RO () -> RepoJob 'RO ()
forall a b. (a -> b) -> a -> b
$ \Repository 'RO p wU wR
other -> do
      PatchSet p Origin wR
theirstuff <- Repository 'RO p wU wR -> IO (PatchSet p Origin wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (PatchSet p Origin wR)
readPatches Repository 'RO p wU wR
other
      let patches :: FL (PatchInfoAndG (Named (RepoPatchV2 Prim))) Origin wR
patches = (forall wW wY.
 PatchInfoAnd p wW wY
 -> PatchInfoAndG (Named (RepoPatchV2 Prim)) wW wY)
-> FL (PatchInfoAnd p) Origin wR
-> FL (PatchInfoAndG (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 (RepoPatchV2 Prim) wW wY
forall wX wY.
Named (RepoPatchV1 Prim) wX wY
-> PatchInfoAnd (RepoPatchV2 Prim) wX wY
convertNamed (Named (RepoPatchV1 Prim) wW wY
 -> PatchInfoAnd (RepoPatchV2 Prim) wW wY)
-> (PatchInfoAnd p wW wY -> Named (RepoPatchV1 Prim) wW wY)
-> PatchInfoAnd p wW wY
-> PatchInfoAnd (RepoPatchV2 Prim) wW wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAnd p wW wY -> Named (RepoPatchV1 Prim) wW wY
PatchInfoAndG (Named (RepoPatchV1 Prim)) wW wY
-> Named (RepoPatchV1 Prim) wW wY
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> p wA wB
hopefully) (FL (PatchInfoAnd p) Origin wR
 -> FL (PatchInfoAndG (Named (RepoPatchV2 Prim))) Origin wR)
-> FL (PatchInfoAnd p) Origin wR
-> FL (PatchInfoAndG (Named (RepoPatchV2 Prim))) Origin wR
forall a b. (a -> b) -> a -> b
$ PatchSet p Origin wR -> FL (PatchInfoAnd p) Origin wR
forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> FL (PatchInfoAnd p) wStart wX
patchSet2FL PatchSet p 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 p wW wZ -> Maybe (PatchInfo, [PatchInfo]))
-> RL (PatchInfoAnd p) Origin wR
-> [Maybe (PatchInfo, [PatchInfo])]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL PatchInfoAndG (Named p) wW wZ -> Maybe (PatchInfo, [PatchInfo])
forall wW wZ.
PatchInfoAnd p wW wZ -> Maybe (PatchInfo, [PatchInfo])
forall {p :: * -> * -> *} {wX} {wY}.
HasDeps p =>
PatchInfoAndG p wX wY -> Maybe (PatchInfo, [PatchInfo])
oot (RL (PatchInfoAnd p) Origin wR -> [Maybe (PatchInfo, [PatchInfo])])
-> RL (PatchInfoAnd p) Origin wR
-> [Maybe (PatchInfo, [PatchInfo])]
forall a b. (a -> b) -> a -> b
$ PatchSet p Origin wR -> RL (PatchInfoAnd p) Origin wR
forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> RL (PatchInfoAnd p) wStart wX
patchSet2RL PatchSet p Origin wR
theirstuff
              where oot :: PatchInfoAndG p wX wY -> Maybe (PatchInfo, [PatchInfo])
oot PatchInfoAndG p wX wY
t = if PatchInfo -> Bool
isTag (PatchInfoAndG p wX wY -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAndG p wX wY
t) Bool -> Bool -> Bool
&& PatchInfoAndG p wX wY -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAndG p wX wY
t PatchInfo -> [PatchInfo] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` PatchSet p Origin wR -> [PatchInfo]
forall (p :: * -> * -> *) wS wX. PatchSet p wS wX -> [PatchInfo]
inOrderTags PatchSet p Origin wR
theirstuff
                            then (PatchInfo, [PatchInfo]) -> Maybe (PatchInfo, [PatchInfo])
forall a. a -> Maybe a
Just (PatchInfoAndG p wX wY -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAndG p wX wY
t, p wX wY -> [PatchInfo]
forall wX wY. 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 p wX wY -> p wX wY
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> p wA wB
hopefully PatchInfoAndG 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 :: forall wX wY. 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 Prim wW wY -> Prim wW wY
forall wW wY. Prim wW wY -> Prim wW wY
primV1toV2 (RepoPatchV1 wX wY -> FL (PrimOf (RepoPatchV1 Prim)) wX wY
forall wX wY.
RepoPatchV1 Prim 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 Prim wW wY -> Prim wW wY
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 FL Prim wX wY -> RL Prim wX wY
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL (RepoPatchV2 Prim wX wY -> FL (PrimOf (RepoPatchV2 Prim)) wX wY
forall wX wY.
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) RL Prim wX wY -> RL Prim wX wY -> EqCheck wX wX
forall (p :: * -> * -> *) wA wB wC.
(Commute p, Eq2 p) =>
RL p wA wC -> RL p wB wC -> EqCheck wA wB
=/~\= FL Prim wX wY -> RL Prim wX wY
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL Prim wX wY
ex of
                 EqCheck wX wX
IsEq -> RepoPatchV2 Prim wX wY
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 ([Char] -> Doc
text [Char]
"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 Prim wW wY -> RepoPatchV2 Prim wW wY
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 ([Char] -> Doc
text
                                  [Char]
"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 Prim wW wY -> RepoPatchV2 Prim wW wY
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
_ = [Char] -> FL (RepoPatchV2 Prim) wX wY
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
          convertFL :: FL RepoPatchV1 wX wY -> FL RepoPatchV2 wX wY
          convertFL :: forall wX wY.
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 wX wY. RepoPatchV1 wX wY -> FL (RepoPatchV2 Prim) wX 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 RepoPatchV1 wW wY -> FL (RepoPatchV2 Prim) wW wY
forall wX wY. RepoPatchV1 wX wY -> FL (RepoPatchV2 Prim) wX wY
convertOne
          convertNamed :: Named RepoPatchV1 wX wY
                       -> PatchInfoAnd RepoPatchV2 wX wY
          convertNamed :: forall wX wY.
Named (RepoPatchV1 Prim) wX wY
-> PatchInfoAnd (RepoPatchV2 Prim) wX wY
convertNamed Named (RepoPatchV1 Prim) wX wY
n = Named (RepoPatchV2 Prim) wX wY
-> PatchInfoAndG (Named (RepoPatchV2 Prim)) wX wY
forall (p :: * -> * -> *) wX wY.
(Ident p, PatchId p ~ PatchInfo) =>
p wX wY -> PatchInfoAndG p wX wY
n2pia (Named (RepoPatchV2 Prim) wX wY
 -> PatchInfoAndG (Named (RepoPatchV2 Prim)) wX wY)
-> Named (RepoPatchV2 Prim) wX wY
-> PatchInfoAndG (Named (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 wX wY. 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 a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` PatchSet p Origin wR -> [PatchInfo]
forall (p :: * -> * -> *) wS wX. PatchSet p wS wX -> [PatchInfo]
inOrderTags PatchSet p Origin wR
theirstuff = PatchInfo
n
                        | Bool
otherwise = PatchInfo -> ([Char] -> PatchInfo) -> Maybe [Char] -> PatchInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PatchInfo
n (\[Char]
t -> PatchInfo -> [Char] -> PatchInfo
piRename PatchInfo
n ([Char]
"old tag: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
t)) (Maybe [Char] -> PatchInfo) -> Maybe [Char] -> PatchInfo
forall a b. (a -> b) -> a -> b
$ PatchInfo -> Maybe [Char]
piTag PatchInfo
n

      Repository 'RW (RepoPatchV2 Prim) wR wR
_ <- [DarcsFlag]
-> Repository 'RW (RepoPatchV2 Prim) Origin Origin
-> FL (PatchInfoAndG (Named (RepoPatchV2 Prim))) Origin wR
-> IO (Repository 'RW (RepoPatchV2 Prim) wR wR)
forall (p :: * -> * -> *) wX wY.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> Repository 'RW p wX wX
-> FL (PatchInfoAnd p) wX wY
-> IO (Repository 'RW p wY wY)
applyAll [DarcsFlag]
opts Repository 'RW (RepoPatchV2 Prim) Origin Origin
_repo (FL (PatchInfoAndG (Named (RepoPatchV2 Prim))) Origin wR
 -> IO (Repository 'RW (RepoPatchV2 Prim) wR wR))
-> FL (PatchInfoAndG (Named (RepoPatchV2 Prim))) Origin wR
-> IO (Repository 'RW (RepoPatchV2 Prim) wR wR)
forall a b. (a -> b) -> a -> b
$ [Char]
-> FL (PatchInfoAndG (Named (RepoPatchV2 Prim))) Origin wR
-> FL (PatchInfoAndG (Named (RepoPatchV2 Prim))) Origin wR
forall (a :: * -> * -> *) wX wY. [Char] -> FL a wX wY -> FL a wX wY
progressFL [Char]
"Converting patch" FL (PatchInfoAndG (Named (RepoPatchV2 Prim))) Origin wR
patches
      IO (Repository 'RO (RepoPatchV2 Prim) Origin Origin) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Repository 'RO (RepoPatchV2 Prim) Origin Origin) -> IO ())
-> IO (Repository 'RO (RepoPatchV2 Prim) Origin Origin) -> IO ()
forall a b. (a -> b) -> a -> b
$ Repository 'RW (RepoPatchV2 Prim) Origin Origin
-> DryRun -> IO (Repository 'RO (RepoPatchV2 Prim) Origin Origin)
forall (p :: * -> * -> *) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository 'RW p wU wR -> DryRun -> IO (Repository 'RO p wU wR)
finalizeRepositoryChanges Repository 'RW (RepoPatchV2 Prim) Origin Origin
_repo (PrimOptSpec DarcsOptDescr DarcsFlag a DryRun
PrimDarcsOption DryRun
O.dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
      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 PrimOptSpec DarcsOptDescr DarcsFlag a SetScriptsExecutable
PrimDarcsOption SetScriptsExecutable
O.setScriptsExecutable [DarcsFlag]
opts SetScriptsExecutable -> SetScriptsExecutable -> Bool
forall a. Eq a => a -> a -> Bool
== SetScriptsExecutable
O.YesSetScriptsExecutable)
        IO ()
R.setAllScriptsExecutable

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

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

    applyAll :: (RepoPatch p, ApplyState p ~ Tree)
             => [DarcsFlag]
             -> Repository 'RW p wX wX
             -> FL (PatchInfoAnd p) wX wY
             -> IO (Repository 'RW p wY wY)
    applyAll :: forall (p :: * -> * -> *) wX wY.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> Repository 'RW p wX wX
-> FL (PatchInfoAnd p) wX wY
-> IO (Repository 'RW p wY wY)
applyAll [DarcsFlag]
opts Repository 'RW p wX wX
r FL (PatchInfoAnd p) wX wY
xss = W2 (Repository 'RW p) wY -> Repository 'RW p wY wY
forall (r :: * -> * -> *) wX. W2 r wX -> r wX wX
unW2 (W2 (Repository 'RW p) wY -> Repository 'RW p wY wY)
-> IO (W2 (Repository 'RW p) wY) -> IO (Repository 'RW p wY wY)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall wA wB.
 W2 (Repository 'RW p) wA
 -> PatchInfoAnd p wA wB -> IO (W2 (Repository 'RW p) wB))
-> W2 (Repository 'RW p) wX
-> FL (PatchInfoAnd p) wX wY
-> IO (W2 (Repository 'RW 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]
-> W2 (Repository 'RW p) wA
-> PatchInfoAndG (Named p) wA wB
-> IO (W2 (Repository 'RW p) wB)
forall (p :: * -> * -> *) wX wY.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> W2 (Repository 'RW p) wX
-> PatchInfoAnd p wX wY
-> IO (W2 (Repository 'RW p) wY)
applyOne [DarcsFlag]
opts) (Repository 'RW p wX wX -> W2 (Repository 'RW p) wX
forall (r :: * -> * -> *) wX. r wX wX -> W2 r wX
W2 Repository 'RW p wX wX
r) FL (PatchInfoAnd p) wX wY
xss

    updatePristine :: [DarcsFlag] -> UpdatePristine
    updatePristine :: [DarcsFlag] -> UpdatePristine
updatePristine [DarcsFlag]
opts =
      case PrimOptSpec DarcsOptDescr DarcsFlag a WithWorkingDir
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 {forall (r :: * -> * -> *) wX. W2 r wX -> r wX wX
unW2 :: r wX wX}

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

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