module Darcs.Repository
( Repository
, HashedDir(..)
, Cache(..)
, CacheLoc(..)
, WritableOrNot(..)
, RepoJob(..)
, maybeIdentifyRepository
, identifyRepositoryFor
, withRecorded
, withRepoLock
, withRepoLockCanFail
, withRepository
, withRepositoryDirectory
, writePatchSet
, findRepository
, amInRepository
, amNotInRepository
, amInHashedRepository
, replacePristine
, readRepo
, prefsUrl
, repoPatchType
, readRepoUsingSpecificInventory
, addToPending
, addPendingDiffToPending
, tentativelyAddPatch
, tentativelyRemovePatches
, tentativelyAddToPending
, readTentativeRepo
, RebaseJobFlags(..)
, withManualRebaseUpdate
, tentativelyMergePatches
, considerMergeToWorking
, revertRepositoryChanges
, finalizeRepositoryChanges
, createRepository
, cloneRepository
, patchSetToRepository
, unrevertUrl
, applyToWorking
, createPristineDirectoryTree
, createPartialsPristineDirectoryTree
, reorderInventory
, cleanRepository
, PatchSet
, SealedPatchSet
, PatchInfoAnd
, setScriptsExecutable
, setScriptsExecutablePatches
, checkUnrelatedRepos
, testTentative
, modifyCache
, reportBadSources
, readRecorded
, readUnrecorded
, unrecordedChanges
, unrecordedChangesWithPatches
, filterOutConflicts
, readPending
, readRecordedAndPending
, readIndex
, invalidateIndex
, listFiles
, listRegisteredFiles
, listUnregisteredFiles
) where
import Prelude ()
import Darcs.Prelude
import Control.Monad ( unless, when )
import Data.List ( (\\) )
import System.Exit ( exitSuccess )
import Darcs.Repository.State
( readRecorded
, readUnrecorded
, unrecordedChanges
, unrecordedChangesWithPatches
, readPendingAndWorking
, readPending
, readIndex
, invalidateIndex
, readRecordedAndPending
, restrictDarcsdir
, restrictBoring
, applyTreeFilter
, filterOutConflicts
)
import Darcs.Repository.Internal
( Repository(..)
, maybeIdentifyRepository
, identifyRepositoryFor
, findRepository
, amInRepository
, amNotInRepository
, amInHashedRepository
, readRepo
, readTentativeRepo
, readRepoUsingSpecificInventory
, prefsUrl
, withRecorded
, tentativelyAddPatch
, tentativelyRemovePatches
, tentativelyAddToPending
, revertRepositoryChanges
, finalizeRepositoryChanges
, unrevertUrl
, applyToWorking
, createPristineDirectoryTree
, createPartialsPristineDirectoryTree
, reorderInventory
, cleanRepository
, setScriptsExecutable
, setScriptsExecutablePatches
, makeNewPending
, repoPatchType
)
import Darcs.Repository.Job
( RepoJob(..)
, withRepoLock
, withRepoLockCanFail
, withRepository
, withRepositoryDirectory
)
import Darcs.Repository.Rebase ( RebaseJobFlags(..), withManualRebaseUpdate )
import Darcs.Repository.Test ( testTentative )
import Darcs.Repository.Merge( tentativelyMergePatches
, considerMergeToWorking
)
import Darcs.Repository.Cache ( HashedDir(..)
, Cache(..)
, CacheLoc(..)
, WritableOrNot(..)
, reportBadSources
)
import Darcs.Repository.InternalTypes ( modifyCache )
import Darcs.Repository.Flags
( DiffAlgorithm (..)
, ScanKnown(..)
, UpdateWorking(..)
, UseCache(..)
, UseIndex(..)
)
import Darcs.Repository.Clone
( createRepository
, cloneRepository
, replacePristine
, writePatchSet
, patchSetToRepository
)
import Darcs.Patch ( RepoPatch
, PrimOf
)
import Darcs.Patch.Set ( PatchSet(..)
, SealedPatchSet
)
import Darcs.Patch.Commute( commuteFL )
import Darcs.Patch.Permutations ( genCommuteWhatWeCanRL )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), FreeLeft, unFreeLeft )
import Darcs.Patch.Witnesses.Ordered
( (:>)(..)
, reverseRL
, reverseFL
, FL(..)
, (+>+)
)
import Darcs.Patch.Depends ( areUnrelatedRepos )
import Darcs.Util.Prompt ( promptYorn )
import Darcs.Util.Path( anchorPath )
import Darcs.Util.Tree( Tree, emptyTree, expand, list )
import Darcs.Util.Tree.Plain( readPlainTree )
checkUnrelatedRepos :: RepoPatch p
=> Bool
-> PatchSet rt p wStart wX
-> PatchSet rt p wStart wY
-> IO ()
checkUnrelatedRepos allowUnrelatedRepos us them =
when ( not allowUnrelatedRepos && areUnrelatedRepos us them ) $
do confirmed <- promptYorn "Repositories seem to be unrelated. Proceed?"
unless confirmed $ do putStrLn "Cancelled."
exitSuccess
addPendingDiffToPending :: (RepoPatch p, ApplyState p ~ Tree, ApplyState (PrimOf p) ~ Tree)
=> Repository rt p wR wU wT -> UpdateWorking
-> FreeLeft (FL (PrimOf p)) -> IO ()
addPendingDiffToPending _ NoUpdateWorking _ = return ()
addPendingDiffToPending repo@(Repo{}) uw@YesUpdateWorking newP = do
(toPend :> _) <-
readPendingAndWorking (UseIndex, ScanKnown, MyersDiff) repo Nothing
invalidateIndex repo
case unFreeLeft newP of
(Sealed p) -> makeNewPending repo uw $ toPend +>+ p
addToPending :: (RepoPatch p, ApplyState p ~ Tree, ApplyState (PrimOf p) ~ Tree)
=> Repository rt p wR wU wT -> UpdateWorking -> FL (PrimOf p) wU wY -> IO ()
addToPending _ NoUpdateWorking _ = return ()
addToPending repo@(Repo{}) uw@YesUpdateWorking p = do
(toPend :> toUnrec) <- readPendingAndWorking (UseIndex, ScanKnown, MyersDiff) repo Nothing
invalidateIndex repo
case genCommuteWhatWeCanRL commuteFL (reverseFL toUnrec :> p) of
(toP' :> p' :> _excessUnrec) ->
makeNewPending repo uw $ toPend +>+ reverseRL toP' +>+ p'
listFiles :: Bool -> IO [String]
listFiles takeBoring =
do
nonboring <- considered emptyTree
working <- expand =<< applyTreeFilter nonboring <$> readPlainTree "."
return $ map (anchorPath "" . fst) $ list working
where
considered = if takeBoring
then const (return restrictDarcsdir)
else restrictBoring
listUnregisteredFiles :: Bool -> IO [String]
listUnregisteredFiles includeBoring =
do unregd <- listFiles includeBoring
regd <- listRegisteredFiles
return $ unregd \\ regd
listRegisteredFiles :: IO [String]
listRegisteredFiles =
do recorded <- expand =<< withRepository YesUseCache (RepoJob readRecordedAndPending)
return $ map (anchorPath "" . fst) $ list recorded