{-# LANGUAGE NamedFieldPuns #-}
module Darcs.Repository.PatchIndex
( doesPatchIndexExist
, isPatchIndexDisabled
, isPatchIndexInSync
, canUsePatchIndex
, createPIWithInterrupt
, createOrUpdatePatchIndexDisk
, deletePatchIndex
, attemptCreatePatchIndex
, PatchFilter
, maybeFilterPatches
, getRelevantSubsequence
, dumpPatchIndex
, piTest
) where
import Darcs.Prelude
import Control.Exception ( catch )
import Control.Monad ( forM_, unless, when )
import Control.Monad.State.Strict ( evalState, execState, State, gets, modify )
import Data.Binary ( Binary, encodeFile, decodeFileOrFail )
import qualified Data.ByteString as B
import Data.Int ( Int8 )
import Data.List ( group, mapAccumL, sort, nub, (\\) )
import Data.Maybe ( fromJust, fromMaybe, isJust )
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Word ( Word32 )
import System.Directory
( createDirectory
, doesDirectoryExist
, doesFileExist
, removeDirectoryRecursive
, removeFile
, renameDirectory
)
import System.FilePath( (</>) )
import System.IO ( openFile, IOMode(WriteMode), hClose )
import Darcs.Patch ( RepoPatch, listTouchedFiles )
import Darcs.Patch.Apply ( ApplyState(..) )
import Darcs.Patch.Index.Types
import Darcs.Patch.Index.Monad ( applyToFileMods, makePatchID )
import Darcs.Patch.Inspect ( PatchInspect )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info )
import Darcs.Patch.Progress (progressFL )
import Darcs.Patch.Set ( PatchSet, patchSet2FL, Origin, patchSet2FL )
import Darcs.Patch.Witnesses.Ordered ( mapFL, RL(..), FL(..), reverseRL )
import Darcs.Patch.Witnesses.Sealed
( Sealed2(..)
, Sealed(..)
, seal
, seal2
, unseal
, unseal2
)
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP, unsafeCoercePEnd )
import Darcs.Repository.Format ( formatHas, RepoProperty( HashedInventory ) )
import Darcs.Repository.InternalTypes ( Repository, repoLocation, repoFormat )
import Darcs.Util.Global ( darcsdir )
import Darcs.Util.Hash ( sha256sum, showAsHex )
import Darcs.Util.Lock ( withPermDir )
import Darcs.Util.Path ( AnchoredPath, displayPath, toFilePath, isPrefix )
import Darcs.Util.Progress ( debugMessage )
import Darcs.Util.SignalHandler ( catchInterrupt )
import Darcs.Util.Tree ( Tree(..) )
type Map = M.Map
type Set = S.Set
data FileIdSpan = FidSpan
!FileId
!PatchId
!(Maybe PatchId)
deriving (Int -> FileIdSpan -> ShowS
[FileIdSpan] -> ShowS
FileIdSpan -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FileIdSpan] -> ShowS
$cshowList :: [FileIdSpan] -> ShowS
show :: FileIdSpan -> FilePath
$cshow :: FileIdSpan -> FilePath
showsPrec :: Int -> FileIdSpan -> ShowS
$cshowsPrec :: Int -> FileIdSpan -> ShowS
Show, FileIdSpan -> FileIdSpan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileIdSpan -> FileIdSpan -> Bool
$c/= :: FileIdSpan -> FileIdSpan -> Bool
== :: FileIdSpan -> FileIdSpan -> Bool
$c== :: FileIdSpan -> FileIdSpan -> Bool
Eq, Eq FileIdSpan
FileIdSpan -> FileIdSpan -> Bool
FileIdSpan -> FileIdSpan -> Ordering
FileIdSpan -> FileIdSpan -> FileIdSpan
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FileIdSpan -> FileIdSpan -> FileIdSpan
$cmin :: FileIdSpan -> FileIdSpan -> FileIdSpan
max :: FileIdSpan -> FileIdSpan -> FileIdSpan
$cmax :: FileIdSpan -> FileIdSpan -> FileIdSpan
>= :: FileIdSpan -> FileIdSpan -> Bool
$c>= :: FileIdSpan -> FileIdSpan -> Bool
> :: FileIdSpan -> FileIdSpan -> Bool
$c> :: FileIdSpan -> FileIdSpan -> Bool
<= :: FileIdSpan -> FileIdSpan -> Bool
$c<= :: FileIdSpan -> FileIdSpan -> Bool
< :: FileIdSpan -> FileIdSpan -> Bool
$c< :: FileIdSpan -> FileIdSpan -> Bool
compare :: FileIdSpan -> FileIdSpan -> Ordering
$ccompare :: FileIdSpan -> FileIdSpan -> Ordering
Ord)
data FilePathSpan = FpSpan
!AnchoredPath
!PatchId
!(Maybe PatchId)
deriving (Int -> FilePathSpan -> ShowS
[FilePathSpan] -> ShowS
FilePathSpan -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FilePathSpan] -> ShowS
$cshowList :: [FilePathSpan] -> ShowS
show :: FilePathSpan -> FilePath
$cshow :: FilePathSpan -> FilePath
showsPrec :: Int -> FilePathSpan -> ShowS
$cshowsPrec :: Int -> FilePathSpan -> ShowS
Show, FilePathSpan -> FilePathSpan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilePathSpan -> FilePathSpan -> Bool
$c/= :: FilePathSpan -> FilePathSpan -> Bool
== :: FilePathSpan -> FilePathSpan -> Bool
$c== :: FilePathSpan -> FilePathSpan -> Bool
Eq, Eq FilePathSpan
FilePathSpan -> FilePathSpan -> Bool
FilePathSpan -> FilePathSpan -> Ordering
FilePathSpan -> FilePathSpan -> FilePathSpan
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FilePathSpan -> FilePathSpan -> FilePathSpan
$cmin :: FilePathSpan -> FilePathSpan -> FilePathSpan
max :: FilePathSpan -> FilePathSpan -> FilePathSpan
$cmax :: FilePathSpan -> FilePathSpan -> FilePathSpan
>= :: FilePathSpan -> FilePathSpan -> Bool
$c>= :: FilePathSpan -> FilePathSpan -> Bool
> :: FilePathSpan -> FilePathSpan -> Bool
$c> :: FilePathSpan -> FilePathSpan -> Bool
<= :: FilePathSpan -> FilePathSpan -> Bool
$c<= :: FilePathSpan -> FilePathSpan -> Bool
< :: FilePathSpan -> FilePathSpan -> Bool
$c< :: FilePathSpan -> FilePathSpan -> Bool
compare :: FilePathSpan -> FilePathSpan -> Ordering
$ccompare :: FilePathSpan -> FilePathSpan -> Ordering
Ord)
data FileInfo = FileInfo
{ FileInfo -> Bool
isFile :: Bool
, FileInfo -> Set Word32
touching :: Set Word32
} deriving (Int -> FileInfo -> ShowS
[FileInfo] -> ShowS
FileInfo -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FileInfo] -> ShowS
$cshowList :: [FileInfo] -> ShowS
show :: FileInfo -> FilePath
$cshow :: FileInfo -> FilePath
showsPrec :: Int -> FileInfo -> ShowS
$cshowsPrec :: Int -> FileInfo -> ShowS
Show, FileInfo -> FileInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileInfo -> FileInfo -> Bool
$c/= :: FileInfo -> FileInfo -> Bool
== :: FileInfo -> FileInfo -> Bool
$c== :: FileInfo -> FileInfo -> Bool
Eq, Eq FileInfo
FileInfo -> FileInfo -> Bool
FileInfo -> FileInfo -> Ordering
FileInfo -> FileInfo -> FileInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FileInfo -> FileInfo -> FileInfo
$cmin :: FileInfo -> FileInfo -> FileInfo
max :: FileInfo -> FileInfo -> FileInfo
$cmax :: FileInfo -> FileInfo -> FileInfo
>= :: FileInfo -> FileInfo -> Bool
$c>= :: FileInfo -> FileInfo -> Bool
> :: FileInfo -> FileInfo -> Bool
$c> :: FileInfo -> FileInfo -> Bool
<= :: FileInfo -> FileInfo -> Bool
$c<= :: FileInfo -> FileInfo -> Bool
< :: FileInfo -> FileInfo -> Bool
$c< :: FileInfo -> FileInfo -> Bool
compare :: FileInfo -> FileInfo -> Ordering
$ccompare :: FileInfo -> FileInfo -> Ordering
Ord)
type FileIdSpans = Map AnchoredPath [FileIdSpan]
type FilePathSpans = Map FileId [FilePathSpan]
type InfoMap = Map FileId FileInfo
data PatchIndex = PatchIndex
{ PatchIndex -> [PatchId]
pids :: [PatchId]
, PatchIndex -> FileIdSpans
fidspans :: FileIdSpans
, PatchIndex -> FilePathSpans
fpspans :: FilePathSpans
, PatchIndex -> InfoMap
infom :: InfoMap
}
version :: Int8
version :: Int8
version = Int8
3
type PIM a = State PatchIndex a
applyPatchMods :: [(PatchId, [PatchMod AnchoredPath])] -> PatchIndex -> PatchIndex
applyPatchMods :: [(PatchId, [PatchMod AnchoredPath])] -> PatchIndex -> PatchIndex
applyPatchMods [(PatchId, [PatchMod AnchoredPath])]
pmods PatchIndex
pindex =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> s
execState PatchIndex
pindex forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (PatchId, [PatchMod AnchoredPath]) -> PIM ()
goList [(PatchId, [PatchMod AnchoredPath])]
pmods
where goList :: (PatchId, [PatchMod AnchoredPath]) -> PIM ()
goList :: (PatchId, [PatchMod AnchoredPath]) -> PIM ()
goList (PatchId
pid, [PatchMod AnchoredPath]
mods) = do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind{pids :: [PatchId]
pids = PatchId
pidforall a. a -> [a] -> [a]
:PatchIndex -> [PatchId]
pids PatchIndex
pind})
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. ((a, b) -> c) -> a -> b -> c
curry (PatchId, PatchMod AnchoredPath) -> PIM ()
go PatchId
pid) ([PatchMod AnchoredPath] -> [PatchMod AnchoredPath]
nubSeq [PatchMod AnchoredPath]
mods)
nubSeq :: [PatchMod AnchoredPath] -> [PatchMod AnchoredPath]
nubSeq = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [[a]]
group
go :: (PatchId, PatchMod AnchoredPath) -> PIM ()
go :: (PatchId, PatchMod AnchoredPath) -> PIM ()
go (PatchId
pid, PCreateFile AnchoredPath
fn) = do
FileId
fid <- AnchoredPath -> PatchId -> PIM FileId
createFidStartSpan AnchoredPath
fn PatchId
pid
FileId -> AnchoredPath -> PatchId -> PIM ()
startFpSpan FileId
fid AnchoredPath
fn PatchId
pid
FileId -> Bool -> PIM ()
createInfo FileId
fid Bool
True
FileId -> PatchId -> PIM ()
insertTouch FileId
fid PatchId
pid
go (PatchId
pid, PCreateDir AnchoredPath
fn) = do
FileId
fid <- AnchoredPath -> PatchId -> PIM FileId
createFidStartSpan AnchoredPath
fn PatchId
pid
FileId -> AnchoredPath -> PatchId -> PIM ()
startFpSpan FileId
fid AnchoredPath
fn PatchId
pid
FileId -> Bool -> PIM ()
createInfo FileId
fid Bool
False
FileId -> PatchId -> PIM ()
insertTouch FileId
fid PatchId
pid
go (PatchId
pid, PTouch AnchoredPath
fn) = do
FileId
fid <- AnchoredPath -> PIM FileId
lookupFid AnchoredPath
fn
FileId -> PatchId -> PIM ()
insertTouch FileId
fid PatchId
pid
go (PatchId
pid, PRename AnchoredPath
oldfn AnchoredPath
newfn) = do
FileId
fid <- AnchoredPath -> PIM FileId
lookupFid AnchoredPath
oldfn
FileId -> PatchId -> PIM ()
stopFpSpan FileId
fid PatchId
pid
FileId -> AnchoredPath -> PatchId -> PIM ()
startFpSpan FileId
fid AnchoredPath
newfn PatchId
pid
FileId -> PatchId -> PIM ()
insertTouch FileId
fid PatchId
pid
AnchoredPath -> PatchId -> PIM ()
stopFidSpan AnchoredPath
oldfn PatchId
pid
AnchoredPath -> PatchId -> FileId -> PIM ()
startFidSpan AnchoredPath
newfn PatchId
pid FileId
fid
go (PatchId
pid, PRemove AnchoredPath
fn) = do
FileId
fid <- AnchoredPath -> PIM FileId
lookupFid AnchoredPath
fn
FileId -> PatchId -> PIM ()
insertTouch FileId
fid PatchId
pid
AnchoredPath -> PatchId -> PIM ()
stopFidSpan AnchoredPath
fn PatchId
pid
FileId -> PatchId -> PIM ()
stopFpSpan FileId
fid PatchId
pid
go (PatchId
pid, PDuplicateTouch AnchoredPath
fn) = do
FileIdSpans
fidm <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PatchIndex -> FileIdSpans
fidspans
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AnchoredPath
fn FileIdSpans
fidm of
Just (FidSpan FileId
fid PatchId
_ Maybe PatchId
_:[FileIdSpan]
_) -> FileId -> PatchId -> PIM ()
insertTouch FileId
fid PatchId
pid
Maybe [FileIdSpan]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just [] -> forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"applyPatchMods: impossible, no entry for "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> FilePath
show AnchoredPath
fn
forall a. [a] -> [a] -> [a]
++FilePath
" in FileIdSpans in duplicate, empty list"
createFidStartSpan :: AnchoredPath -> PatchId -> PIM FileId
createFidStartSpan :: AnchoredPath -> PatchId -> PIM FileId
createFidStartSpan AnchoredPath
fn PatchId
pstart = do
FileIdSpans
fidspans <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PatchIndex -> FileIdSpans
fidspans
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AnchoredPath
fn FileIdSpans
fidspans of
Maybe [FileIdSpan]
Nothing -> do
let fid :: FileId
fid = AnchoredPath -> Int -> FileId
FileId AnchoredPath
fn Int
1
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind {fidspans :: FileIdSpans
fidspans=forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert AnchoredPath
fn [FileId -> PatchId -> Maybe PatchId -> FileIdSpan
FidSpan FileId
fid PatchId
pstart forall a. Maybe a
Nothing] FileIdSpans
fidspans})
forall (m :: * -> *) a. Monad m => a -> m a
return FileId
fid
Just [FileIdSpan]
fspans -> do
let fid :: FileId
fid = AnchoredPath -> Int -> FileId
FileId AnchoredPath
fn (forall (t :: * -> *) a. Foldable t => t a -> Int
length [FileIdSpan]
fspansforall a. Num a => a -> a -> a
+Int
1)
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind {fidspans :: FileIdSpans
fidspans=forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert AnchoredPath
fn (FileId -> PatchId -> Maybe PatchId -> FileIdSpan
FidSpan FileId
fid PatchId
pstart forall a. Maybe a
Nothingforall a. a -> [a] -> [a]
:[FileIdSpan]
fspans) FileIdSpans
fidspans})
forall (m :: * -> *) a. Monad m => a -> m a
return FileId
fid
startFpSpan :: FileId -> AnchoredPath -> PatchId -> PIM ()
startFpSpan :: FileId -> AnchoredPath -> PatchId -> PIM ()
startFpSpan FileId
fid AnchoredPath
fn PatchId
pstart = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind {fpspans :: FilePathSpans
fpspans=forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe [FilePathSpan] -> Maybe [FilePathSpan]
alt FileId
fid (PatchIndex -> FilePathSpans
fpspans PatchIndex
pind)})
where alt :: Maybe [FilePathSpan] -> Maybe [FilePathSpan]
alt Maybe [FilePathSpan]
Nothing = forall a. a -> Maybe a
Just [AnchoredPath -> PatchId -> Maybe PatchId -> FilePathSpan
FpSpan AnchoredPath
fn PatchId
pstart forall a. Maybe a
Nothing]
alt (Just [FilePathSpan]
spans) = forall a. a -> Maybe a
Just (AnchoredPath -> PatchId -> Maybe PatchId -> FilePathSpan
FpSpan AnchoredPath
fn PatchId
pstart forall a. Maybe a
Nothingforall a. a -> [a] -> [a]
:[FilePathSpan]
spans)
stopFpSpan :: FileId -> PatchId -> PIM ()
stopFpSpan :: FileId -> PatchId -> PIM ()
stopFpSpan FileId
fid PatchId
pend = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind {fpspans :: FilePathSpans
fpspans=forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe [FilePathSpan] -> Maybe [FilePathSpan]
alt FileId
fid (PatchIndex -> FilePathSpans
fpspans PatchIndex
pind)})
where alt :: Maybe [FilePathSpan] -> Maybe [FilePathSpan]
alt Maybe [FilePathSpan]
Nothing = forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"impossible: no span for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FileId
fid
alt (Just []) = forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"impossible: no span for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FileId
fidforall a. [a] -> [a] -> [a]
++FilePath
", empty list"
alt (Just (FpSpan AnchoredPath
fp PatchId
pstart Maybe PatchId
Nothing:[FilePathSpan]
spans)) =
forall a. a -> Maybe a
Just (AnchoredPath -> PatchId -> Maybe PatchId -> FilePathSpan
FpSpan AnchoredPath
fp PatchId
pstart (forall a. a -> Maybe a
Just PatchId
pend)forall a. a -> [a] -> [a]
:[FilePathSpan]
spans)
alt Maybe [FilePathSpan]
_ = forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"impossible: span already ended for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FileId
fid
startFidSpan :: AnchoredPath -> PatchId -> FileId -> PIM ()
startFidSpan :: AnchoredPath -> PatchId -> FileId -> PIM ()
startFidSpan AnchoredPath
fn PatchId
pstart FileId
fid = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind {fidspans :: FileIdSpans
fidspans=forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe [FileIdSpan] -> Maybe [FileIdSpan]
alt AnchoredPath
fn (PatchIndex -> FileIdSpans
fidspans PatchIndex
pind)})
where alt :: Maybe [FileIdSpan] -> Maybe [FileIdSpan]
alt Maybe [FileIdSpan]
Nothing = forall a. a -> Maybe a
Just [FileId -> PatchId -> Maybe PatchId -> FileIdSpan
FidSpan FileId
fid PatchId
pstart forall a. Maybe a
Nothing]
alt (Just [FileIdSpan]
spans) = forall a. a -> Maybe a
Just (FileId -> PatchId -> Maybe PatchId -> FileIdSpan
FidSpan FileId
fid PatchId
pstart forall a. Maybe a
Nothingforall a. a -> [a] -> [a]
:[FileIdSpan]
spans)
stopFidSpan :: AnchoredPath -> PatchId -> PIM ()
stopFidSpan :: AnchoredPath -> PatchId -> PIM ()
stopFidSpan AnchoredPath
fn PatchId
pend = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind {fidspans :: FileIdSpans
fidspans=forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe [FileIdSpan] -> Maybe [FileIdSpan]
alt AnchoredPath
fn (PatchIndex -> FileIdSpans
fidspans PatchIndex
pind)})
where alt :: Maybe [FileIdSpan] -> Maybe [FileIdSpan]
alt Maybe [FileIdSpan]
Nothing = forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"impossible: no span for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show AnchoredPath
fn
alt (Just []) = forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"impossible: no span for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show AnchoredPath
fnforall a. [a] -> [a] -> [a]
++FilePath
", empty list"
alt (Just (FidSpan FileId
fid PatchId
pstart Maybe PatchId
Nothing:[FileIdSpan]
spans)) =
forall a. a -> Maybe a
Just (FileId -> PatchId -> Maybe PatchId -> FileIdSpan
FidSpan FileId
fid PatchId
pstart (forall a. a -> Maybe a
Just PatchId
pend)forall a. a -> [a] -> [a]
:[FileIdSpan]
spans)
alt Maybe [FileIdSpan]
_ = forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"impossible: span already ended for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show AnchoredPath
fn
createInfo :: FileId -> Bool -> PIM ()
createInfo :: FileId -> Bool -> PIM ()
createInfo FileId
fid Bool
isF = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind {infom :: InfoMap
infom=forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter forall {a}. Maybe a -> Maybe FileInfo
alt FileId
fid (PatchIndex -> InfoMap
infom PatchIndex
pind)})
where alt :: Maybe a -> Maybe FileInfo
alt Maybe a
Nothing = forall a. a -> Maybe a
Just (Bool -> Set Word32 -> FileInfo
FileInfo Bool
isF forall a. Set a
S.empty)
alt (Just a
_) = forall a. a -> Maybe a
Just (Bool -> Set Word32 -> FileInfo
FileInfo Bool
isF forall a. Set a
S.empty)
insertTouch :: FileId -> PatchId -> PIM ()
insertTouch :: FileId -> PatchId -> PIM ()
insertTouch FileId
fid PatchId
pid = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind {infom :: InfoMap
infom=forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe FileInfo -> Maybe FileInfo
alt FileId
fid (PatchIndex -> InfoMap
infom PatchIndex
pind)})
where alt :: Maybe FileInfo -> Maybe FileInfo
alt Maybe FileInfo
Nothing = forall a. HasCallStack => FilePath -> a
error FilePath
"impossible: Fileid does not exist"
alt (Just (FileInfo Bool
isF Set Word32
pids)) = forall a. a -> Maybe a
Just (Bool -> Set Word32 -> FileInfo
FileInfo Bool
isF (forall a. Ord a => a -> Set a -> Set a
S.insert (PatchId -> Word32
short PatchId
pid) Set Word32
pids))
lookupFid :: AnchoredPath -> PIM FileId
lookupFid :: AnchoredPath -> PIM FileId
lookupFid AnchoredPath
fn = do
Maybe FileId
maybeFid <- AnchoredPath -> PIM (Maybe FileId)
lookupFid' AnchoredPath
fn
case Maybe FileId
maybeFid of
Maybe FileId
Nothing -> forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"couldn't find " forall a. [a] -> [a] -> [a]
++ AnchoredPath -> FilePath
displayPath AnchoredPath
fn forall a. [a] -> [a] -> [a]
++ FilePath
" in patch index"
Just FileId
fid -> forall (m :: * -> *) a. Monad m => a -> m a
return FileId
fid
lookupFid' :: AnchoredPath -> PIM (Maybe FileId)
lookupFid' :: AnchoredPath -> PIM (Maybe FileId)
lookupFid' AnchoredPath
fn = do
FileIdSpans
fidm <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PatchIndex -> FileIdSpans
fidspans
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AnchoredPath
fn FileIdSpans
fidm of
Just (FidSpan FileId
fid PatchId
_ Maybe PatchId
_:[FileIdSpan]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just FileId
fid
Maybe [FileIdSpan]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
lookupFidf' :: AnchoredPath -> PIM [FileId]
lookupFidf' :: AnchoredPath -> PIM [FileId]
lookupFidf' AnchoredPath
fn = do
FileIdSpans
fidm <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PatchIndex -> FileIdSpans
fidspans
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AnchoredPath
fn FileIdSpans
fidm of
Just [FileIdSpan]
spans -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(FidSpan FileId
fid PatchId
_ Maybe PatchId
_) -> FileId
fid) [FileIdSpan]
spans
Maybe [FileIdSpan]
Nothing ->
forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"lookupFidf': no entry for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show AnchoredPath
fn forall a. [a] -> [a] -> [a]
++ FilePath
" in FileIdSpans"
lookupFids :: AnchoredPath -> PIM [FileId]
lookupFids :: AnchoredPath -> PIM [FileId]
lookupFids AnchoredPath
fn = do
FileIdSpans
fid_spans <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PatchIndex -> FileIdSpans
fidspans
[[FileId]]
file_idss <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AnchoredPath -> PIM [FileId]
lookupFidf' forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter (AnchoredPath -> AnchoredPath -> Bool
isPrefix AnchoredPath
fn) (FileIdSpans -> [AnchoredPath]
fpSpans2filePaths' FileIdSpans
fid_spans)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FileId]]
file_idss
lookupFids' :: AnchoredPath -> PIM [FileId]
lookupFids' :: AnchoredPath -> PIM [FileId]
lookupFids' AnchoredPath
fn = do
InfoMap
info_map <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PatchIndex -> InfoMap
infom
FilePathSpans
fps_spans <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PatchIndex -> FilePathSpans
fpspans
Maybe FileId
a <- AnchoredPath -> PIM (Maybe FileId)
lookupFid' AnchoredPath
fn
if forall a. Maybe a -> Bool
isJust Maybe FileId
a then do
let fid :: FileId
fid = forall a. HasCallStack => Maybe a -> a
fromJust Maybe FileId
a
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FileId
fid InfoMap
info_map of
Just (FileInfo Bool
True Set Word32
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return [FileId
fid]
Just (FileInfo Bool
False Set Word32
_) ->
let file_names :: [AnchoredPath]
file_names = forall a b. (a -> b) -> [a] -> [b]
map (\(FpSpan AnchoredPath
x PatchId
_ Maybe PatchId
_) -> AnchoredPath
x) (FilePathSpans
fps_spans forall k a. Ord k => Map k a -> k -> a
M.! FileId
fid)
in forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AnchoredPath -> PIM [FileId]
lookupFids [AnchoredPath]
file_names
Maybe FileInfo
Nothing -> forall a. HasCallStack => FilePath -> a
error FilePath
"lookupFids' : could not find file"
else forall (m :: * -> *) a. Monad m => a -> m a
return []
createPatchIndexDisk
:: (RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wT
-> PatchSet rt p Origin wR
-> IO ()
createPatchIndexDisk :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
createPatchIndexDisk Repository rt p wR wU wT
repository PatchSet rt p Origin wR
ps = do
let patches :: [Sealed2 (PatchInfoAnd rt p)]
patches = forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall (a :: * -> * -> *) wY wY. a wY wY -> Sealed2 a
Sealed2 forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) wX wY.
FilePath -> FL a wX wY -> FL a wX wY
progressFL FilePath
"Create patch index" forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> FL (PatchInfoAnd rt p) wStart wX
patchSet2FL PatchSet rt p Origin wR
ps
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT
-> [(PatchId, [PatchMod AnchoredPath])] -> IO ()
createPatchIndexFrom Repository rt p wR wU wT
repository forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (rt :: RepoType).
(Apply p, PatchInspect p, ApplyState p ~ Tree) =>
[Sealed2 (PatchInfoAnd rt p)]
-> Set AnchoredPath -> [(PatchId, [PatchMod AnchoredPath])]
patches2patchMods [Sealed2 (PatchInfoAnd rt p)]
patches forall a. Set a
S.empty
patches2patchMods :: (Apply p, PatchInspect p, ApplyState p ~ Tree)
=> [Sealed2 (PatchInfoAnd rt p)] -> Set AnchoredPath -> [(PatchId, [PatchMod AnchoredPath])]
patches2patchMods :: forall (p :: * -> * -> *) (rt :: RepoType).
(Apply p, PatchInspect p, ApplyState p ~ Tree) =>
[Sealed2 (PatchInfoAnd rt p)]
-> Set AnchoredPath -> [(PatchId, [PatchMod AnchoredPath])]
patches2patchMods [Sealed2 (PatchInfoAnd rt p)]
patches Set AnchoredPath
fns = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL forall {p :: * -> * -> *} {rt :: RepoType}.
(PatchInspect p, ApplyState p ~ Tree, Apply p) =>
Set AnchoredPath
-> Sealed2 (PatchInfoAndG rt p)
-> (Set AnchoredPath, (PatchId, [PatchMod AnchoredPath]))
go Set AnchoredPath
fns [Sealed2 (PatchInfoAnd rt p)]
patches
where
go :: Set AnchoredPath
-> Sealed2 (PatchInfoAndG rt p)
-> (Set AnchoredPath, (PatchId, [PatchMod AnchoredPath]))
go Set AnchoredPath
filenames (Sealed2 PatchInfoAndG rt p wX wY
p) = (Set AnchoredPath
filenames', (PatchId
pid, [PatchMod AnchoredPath]
pmods_effect forall a. [a] -> [a] -> [a]
++ [PatchMod AnchoredPath]
pmods_dup))
where pid :: PatchId
pid = PatchInfo -> PatchId
makePatchID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info forall a b. (a -> b) -> a -> b
$ PatchInfoAndG rt p wX wY
p
(Set AnchoredPath
filenames', [PatchMod AnchoredPath]
pmods_effect) = forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY
-> Set AnchoredPath -> (Set AnchoredPath, [PatchMod AnchoredPath])
applyToFileMods PatchInfoAndG rt p wX wY
p Set AnchoredPath
filenames
touched :: PatchMod a -> [a]
touched PatchMod a
pm = case PatchMod a
pm of {PTouch a
f -> [a
f]; PRename a
a a
b -> [a
a,a
b];
PCreateDir a
f -> [a
f]; PCreateFile a
f -> [a
f];
PRemove a
f -> [a
f]; PatchMod a
_ -> []}
touched_all :: [AnchoredPath]
touched_all = forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles PatchInfoAndG rt p wX wY
p
touched_effect :: [AnchoredPath]
touched_effect = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. PatchMod a -> [a]
touched [PatchMod AnchoredPath]
pmods_effect
pmods_dup :: [PatchMod AnchoredPath]
pmods_dup = forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> PatchMod a
PDuplicateTouch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
S.elems
forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Set a -> Set a -> Set a
S.difference (forall a. Ord a => [a] -> Set a
S.fromList [AnchoredPath]
touched_all)
(forall a. Ord a => [a] -> Set a
S.fromList [AnchoredPath]
touched_effect)
fpSpans2fileNames :: FilePathSpans -> Set AnchoredPath
fpSpans2fileNames :: FilePathSpans -> Set AnchoredPath
fpSpans2fileNames FilePathSpans
fpSpans =
forall a. Ord a => [a] -> Set a
S.fromList [AnchoredPath
fn | (FpSpan AnchoredPath
fn PatchId
_ Maybe PatchId
Nothing:[FilePathSpan]
_)<- forall k a. Map k a -> [a]
M.elems FilePathSpans
fpSpans]
removePidSuffix :: Map PatchId Int -> [PatchId] -> PatchIndex -> PatchIndex
removePidSuffix :: Map PatchId Int -> [PatchId] -> PatchIndex -> PatchIndex
removePidSuffix Map PatchId Int
_ [] PatchIndex
pindex = PatchIndex
pindex
removePidSuffix Map PatchId Int
pid2idx oldpids :: [PatchId]
oldpids@(PatchId
oldpid:[PatchId]
_) (PatchIndex [PatchId]
pids FileIdSpans
fidspans FilePathSpans
fpspans InfoMap
infom) =
[PatchId] -> FileIdSpans -> FilePathSpans -> InfoMap -> PatchIndex
PatchIndex ([PatchId]
pids forall a. Eq a => [a] -> [a] -> [a]
\\ [PatchId]
oldpids)
(forall a b k. (a -> Maybe b) -> Map k a -> Map k b
M.mapMaybe forall {t :: * -> *}.
Foldable t =>
t FileIdSpan -> Maybe [FileIdSpan]
removefid FileIdSpans
fidspans)
(forall a b k. (a -> Maybe b) -> Map k a -> Map k b
M.mapMaybe forall {t :: * -> *}.
Foldable t =>
t FilePathSpan -> Maybe [FilePathSpan]
removefp FilePathSpans
fpspans)
InfoMap
infom
where
findIdx :: PatchId -> Int
findIdx PatchId
pid = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
error FilePath
"impossible case") (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PatchId
pid Map PatchId Int
pid2idx)
oldidx :: Int
oldidx = PatchId -> Int
findIdx PatchId
oldpid
PatchId
from after :: PatchId -> Int -> Bool
`after` Int
idx = PatchId -> Int
findIdx PatchId
from forall a. Ord a => a -> a -> Bool
> Int
idx
Maybe PatchId
mto afterM :: Maybe PatchId -> Int -> Bool
`afterM` Int
idx | Just PatchId
to <- Maybe PatchId
mto, PatchId -> Int
findIdx PatchId
to forall a. Ord a => a -> a -> Bool
> Int
idx = Bool
True
| Bool
otherwise = Bool
False
removefid :: t FileIdSpan -> Maybe [FileIdSpan]
removefid t FileIdSpan
fidsps = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FileIdSpan]
fidsps' then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just [FileIdSpan]
fidsps'
where
fidsps' :: [FileIdSpan]
fidsps' = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FileIdSpan -> [FileIdSpan]
go t FileIdSpan
fidsps
go :: FileIdSpan -> [FileIdSpan]
go (FidSpan FileId
fid PatchId
from Maybe PatchId
mto)
| PatchId
from PatchId -> Int -> Bool
`after` Int
oldidx Bool -> Bool -> Bool
&& Maybe PatchId
mto Maybe PatchId -> Int -> Bool
`afterM` Int
oldidx = [FileId -> PatchId -> Maybe PatchId -> FileIdSpan
FidSpan FileId
fid PatchId
from Maybe PatchId
mto]
| PatchId
from PatchId -> Int -> Bool
`after` Int
oldidx = [FileId -> PatchId -> Maybe PatchId -> FileIdSpan
FidSpan FileId
fid PatchId
from forall a. Maybe a
Nothing]
| Bool
otherwise = []
removefp :: t FilePathSpan -> Maybe [FilePathSpan]
removefp t FilePathSpan
fpsps = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePathSpan]
fpsps' then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just [FilePathSpan]
fpsps'
where
fpsps' :: [FilePathSpan]
fpsps' = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePathSpan -> [FilePathSpan]
go t FilePathSpan
fpsps
go :: FilePathSpan -> [FilePathSpan]
go (FpSpan AnchoredPath
fn PatchId
from Maybe PatchId
mto)
| PatchId
from PatchId -> Int -> Bool
`after` Int
oldidx Bool -> Bool -> Bool
&& Maybe PatchId
mto Maybe PatchId -> Int -> Bool
`afterM` Int
oldidx = [AnchoredPath -> PatchId -> Maybe PatchId -> FilePathSpan
FpSpan AnchoredPath
fn PatchId
from Maybe PatchId
mto]
| PatchId
from PatchId -> Int -> Bool
`after` Int
oldidx = [AnchoredPath -> PatchId -> Maybe PatchId -> FilePathSpan
FpSpan AnchoredPath
fn PatchId
from forall a. Maybe a
Nothing]
| Bool
otherwise = []
updatePatchIndexDisk
:: (RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wT
-> PatchSet rt p Origin wR
-> IO ()
updatePatchIndexDisk :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
updatePatchIndexDisk Repository rt p wR wU wT
repo PatchSet rt p Origin wR
patches = do
let repodir :: FilePath
repodir = forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> FilePath
repoLocation Repository rt p wR wU wT
repo
(Int8
_,FilePath
_,Map PatchId Int
pid2idx,PatchIndex
pindex) <- FilePath -> IO (Int8, FilePath, Map PatchId Int, PatchIndex)
loadPatchIndex FilePath
repodir
let flpatches :: FL (PatchInfoAnd rt p) Origin wR
flpatches = forall (a :: * -> * -> *) wX wY.
FilePath -> FL a wX wY -> FL a wX wY
progressFL FilePath
"Update patch index" forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> FL (PatchInfoAnd rt p) wStart wX
patchSet2FL PatchSet rt p Origin wR
patches
let pidsrepo :: [PatchId]
pidsrepo = forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (PatchInfo -> PatchId
makePatchID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info) FL (PatchInfoAnd rt p) Origin wR
flpatches
([PatchId]
oldpids,[PatchId]
_,Int
len_common) = [PatchId] -> [PatchId] -> ([PatchId], [PatchId], Int)
uncommon (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ PatchIndex -> [PatchId]
pids PatchIndex
pindex) [PatchId]
pidsrepo
pindex' :: PatchIndex
pindex' = Map PatchId Int -> [PatchId] -> PatchIndex -> PatchIndex
removePidSuffix Map PatchId Int
pid2idx [PatchId]
oldpids PatchIndex
pindex
filenames :: Set AnchoredPath
filenames = FilePathSpans -> Set AnchoredPath
fpSpans2fileNames (PatchIndex -> FilePathSpans
fpspans PatchIndex
pindex')
cdir :: FilePath
cdir = FilePath
repodir FilePath -> ShowS
</> FilePath
indexDir
let newpatches :: [Sealed2 (PatchInfoAnd rt p)]
newpatches = forall a. Int -> [a] -> [a]
drop Int
len_common forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall (a :: * -> * -> *) wY wY. a wY wY -> Sealed2 a
seal2 FL (PatchInfoAnd rt p) Origin wR
flpatches
newpmods :: [(PatchId, [PatchMod AnchoredPath])]
newpmods = forall (p :: * -> * -> *) (rt :: RepoType).
(Apply p, PatchInspect p, ApplyState p ~ Tree) =>
[Sealed2 (PatchInfoAnd rt p)]
-> Set AnchoredPath -> [(PatchId, [PatchMod AnchoredPath])]
patches2patchMods [Sealed2 (PatchInfoAnd rt p)]
newpatches Set AnchoredPath
filenames
FilePath
inv_hash <- FilePath -> IO FilePath
getInventoryHash FilePath
repodir
FilePath -> FilePath -> PatchIndex -> IO ()
storePatchIndex FilePath
cdir FilePath
inv_hash ([(PatchId, [PatchMod AnchoredPath])] -> PatchIndex -> PatchIndex
applyPatchMods [(PatchId, [PatchMod AnchoredPath])]
newpmods PatchIndex
pindex')
where
uncommon :: [PatchId] -> [PatchId] -> ([PatchId], [PatchId], Int)
uncommon = forall {a} {c}. (Eq a, Num c) => c -> [a] -> [a] -> ([a], [a], c)
uncommon' Int
0
uncommon' :: c -> [a] -> [a] -> ([a], [a], c)
uncommon' c
x (a
a:[a]
as) (a
b:[a]
bs)
| a
a forall a. Eq a => a -> a -> Bool
== a
b = c -> [a] -> [a] -> ([a], [a], c)
uncommon' (c
xforall a. Num a => a -> a -> a
+c
1) [a]
as [a]
bs
| Bool
otherwise = (a
aforall a. a -> [a] -> [a]
:[a]
as,a
bforall a. a -> [a] -> [a]
:[a]
bs,c
x)
uncommon' c
x [a]
as [a]
bs = ([a]
as,[a]
bs,c
x)
createPatchIndexFrom :: Repository rt p wR wU wT
-> [(PatchId, [PatchMod AnchoredPath])] -> IO ()
createPatchIndexFrom :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT
-> [(PatchId, [PatchMod AnchoredPath])] -> IO ()
createPatchIndexFrom Repository rt p wR wU wT
repo [(PatchId, [PatchMod AnchoredPath])]
pmods = do
FilePath
inv_hash <- FilePath -> IO FilePath
getInventoryHash FilePath
repodir
FilePath -> FilePath -> PatchIndex -> IO ()
storePatchIndex FilePath
cdir FilePath
inv_hash ([(PatchId, [PatchMod AnchoredPath])] -> PatchIndex -> PatchIndex
applyPatchMods [(PatchId, [PatchMod AnchoredPath])]
pmods PatchIndex
emptyPatchIndex)
where repodir :: FilePath
repodir = forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> FilePath
repoLocation Repository rt p wR wU wT
repo
cdir :: FilePath
cdir = FilePath
repodir FilePath -> ShowS
</> FilePath
indexDir
emptyPatchIndex :: PatchIndex
emptyPatchIndex = [PatchId] -> FileIdSpans -> FilePathSpans -> InfoMap -> PatchIndex
PatchIndex [] forall k a. Map k a
M.empty forall k a. Map k a
M.empty forall k a. Map k a
M.empty
getInventoryHash :: FilePath -> IO String
getInventoryHash :: FilePath -> IO FilePath
getInventoryHash FilePath
repodir = do
ByteString
inv <- FilePath -> IO ByteString
B.readFile (FilePath
repodir FilePath -> ShowS
</> FilePath
darcsdir FilePath -> ShowS
</> FilePath
"hashed_inventory")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
sha256sum ByteString
inv
loadPatchIndex :: FilePath -> IO (Int8, String, Map PatchId Int, PatchIndex)
loadPatchIndex :: FilePath -> IO (Int8, FilePath, Map PatchId Int, PatchIndex)
loadPatchIndex FilePath
repodir = do
let pindex_dir :: FilePath
pindex_dir = FilePath
repodir FilePath -> ShowS
</> FilePath
indexDir
(Int8
v,FilePath
inv_hash) <- FilePath -> IO (Int8, FilePath)
loadRepoState (FilePath
pindex_dir FilePath -> ShowS
</> FilePath
repoStateFile)
[PatchId]
pids <- FilePath -> IO [PatchId]
loadPatchIds (FilePath
pindex_dir FilePath -> ShowS
</> FilePath
pidsFile)
let pid2idx :: Map PatchId Int
pid2idx = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [PatchId]
pids [(Int
1::Int)..]
InfoMap
infom <- FilePath -> IO InfoMap
loadInfoMap (FilePath
pindex_dir FilePath -> ShowS
</> FilePath
touchMapFile)
FileIdSpans
fidspans <- FilePath -> IO FileIdSpans
loadFidMap (FilePath
pindex_dir FilePath -> ShowS
</> FilePath
fidMapFile)
FilePathSpans
fpspans <- FilePath -> IO FilePathSpans
loadFpMap (FilePath
pindex_dir FilePath -> ShowS
</> FilePath
fpMapFile)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8
v, FilePath
inv_hash, Map PatchId Int
pid2idx, [PatchId] -> FileIdSpans -> FilePathSpans -> InfoMap -> PatchIndex
PatchIndex [PatchId]
pids FileIdSpans
fidspans FilePathSpans
fpspans InfoMap
infom)
loadSafePatchIndex :: (RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wT
-> PatchSet rt p Origin wR
-> IO PatchIndex
loadSafePatchIndex :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> PatchSet rt p Origin wR -> IO PatchIndex
loadSafePatchIndex Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps = do
let repodir :: FilePath
repodir = forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> FilePath
repoLocation Repository rt p wR wU wT
repo
Bool
can_use <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO Bool
isPatchIndexInSync Repository rt p wR wU wT
repo
(Int8
_,FilePath
_,Map PatchId Int
_,PatchIndex
pi) <-
if Bool
can_use
then FilePath -> IO (Int8, FilePath, Map PatchId Int, PatchIndex)
loadPatchIndex FilePath
repodir
else do forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
createOrUpdatePatchIndexDisk Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps
FilePath -> IO (Int8, FilePath, Map PatchId Int, PatchIndex)
loadPatchIndex FilePath
repodir
forall (m :: * -> *) a. Monad m => a -> m a
return PatchIndex
pi
doesPatchIndexExist :: FilePath -> IO Bool
doesPatchIndexExist :: FilePath -> IO Bool
doesPatchIndexExist FilePath
repodir = do
Bool
filesArePresent <- forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath -> IO Bool
doesFileExist forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
pindex_dir FilePath -> ShowS
</>))
[FilePath
repoStateFile, FilePath
pidsFile, FilePath
touchMapFile, FilePath
fidMapFile, FilePath
fpMapFile]
if Bool
filesArePresent
then do Int8
v <- IO Int8
piVersion
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8
v forall a. Eq a => a -> a -> Bool
== Int8
version)
else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
where pindex_dir :: FilePath
pindex_dir = FilePath
repodir FilePath -> ShowS
</> FilePath
indexDir
piVersion :: IO Int8
piVersion = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Int8, FilePath)
loadRepoState (FilePath
pindex_dir FilePath -> ShowS
</> FilePath
repoStateFile)
isPatchIndexDisabled :: FilePath -> IO Bool
isPatchIndexDisabled :: FilePath -> IO Bool
isPatchIndexDisabled FilePath
repodir = FilePath -> IO Bool
doesFileExist (FilePath
repodir FilePath -> ShowS
</> FilePath
darcsdir FilePath -> ShowS
</> FilePath
noPatchIndex)
createOrUpdatePatchIndexDisk :: (RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
createOrUpdatePatchIndexDisk :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
createOrUpdatePatchIndexDisk Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps = do
let repodir :: FilePath
repodir = forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> FilePath
repoLocation Repository rt p wR wU wT
repo
FilePath -> IO ()
removeFile (FilePath
repodir FilePath -> ShowS
</> FilePath
darcsdir FilePath -> ShowS
</> FilePath
noPatchIndex) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOError
_ :: IOError) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
dpie <- FilePath -> IO Bool
doesPatchIndexExist FilePath
repodir
if Bool
dpie
then forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
updatePatchIndexDisk Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps
else forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
createPatchIndexDisk Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps
canUsePatchIndex :: Repository rt p wR wU wT -> IO Bool
canUsePatchIndex :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO Bool
canUsePatchIndex Repository rt p wR wU wT
repo = do
let repodir :: FilePath
repodir = forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> FilePath
repoLocation Repository rt p wR wU wT
repo
Bool
piExists <- FilePath -> IO Bool
doesPatchIndexExist FilePath
repodir
Bool
piDisabled <- FilePath -> IO Bool
isPatchIndexDisabled FilePath
repodir
case (Bool
piExists, Bool
piDisabled) of
(Bool
True, Bool
False) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
(Bool
False, Bool
True) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
(Bool
True, Bool
True) -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"patch index exists, and patch index is disabled. run optimize enable-patch-index or disable-patch-index to rectify."
(Bool
False, Bool
False) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
createPIWithInterrupt :: (RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
createPIWithInterrupt :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
createPIWithInterrupt Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps = do
let repodir :: FilePath
repodir = forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> FilePath
repoLocation Repository rt p wR wU wT
repo
FilePath -> IO ()
putStrLn FilePath
"Creating a patch index, please wait. To stop press Ctrl-C"
(do
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
createPatchIndexDisk Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps
FilePath -> IO ()
putStrLn FilePath
"Created patch index.") forall a. IO a -> IO a -> IO a
`catchInterrupt` (FilePath -> IO ()
putStrLn FilePath
"Patch Index Disabled" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
deletePatchIndex FilePath
repodir)
isPatchIndexInSync :: Repository rt p wR wU wT -> IO Bool
isPatchIndexInSync :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO Bool
isPatchIndexInSync Repository rt p wR wU wT
repo = do
let repodir :: FilePath
repodir = forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> FilePath
repoLocation Repository rt p wR wU wT
repo
Bool
dpie <- FilePath -> IO Bool
doesPatchIndexExist FilePath
repodir
if Bool
dpie
then do
(Int8
_, FilePath
inv_hash_pindex, Map PatchId Int
_, PatchIndex
_) <- FilePath -> IO (Int8, FilePath, Map PatchId Int, PatchIndex)
loadPatchIndex FilePath
repodir
FilePath
inv_hash <- FilePath -> IO FilePath
getInventoryHash FilePath
repodir
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
inv_hash forall a. Eq a => a -> a -> Bool
== FilePath
inv_hash_pindex)
else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
storePatchIndex :: FilePath -> String -> PatchIndex -> IO ()
storePatchIndex :: FilePath -> FilePath -> PatchIndex -> IO ()
storePatchIndex FilePath
cdir FilePath
inv_hash (PatchIndex [PatchId]
pids FileIdSpans
fidspans FilePathSpans
fpspans InfoMap
infom) = do
FilePath -> IO ()
createDirectory FilePath
cdir forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOError
_ :: IOError) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
FilePath
tmpdir <- forall a. FilePath -> (AbsolutePath -> IO a) -> IO a
withPermDir FilePath
cdir forall a b. (a -> b) -> a -> b
$ \AbsolutePath
dir -> do
FilePath -> IO ()
debugMessage FilePath
"About to create patch index..."
let tmpdir :: FilePath
tmpdir = forall a. FilePathLike a => a -> FilePath
toFilePath AbsolutePath
dir
FilePath -> FilePath -> IO ()
storeRepoState (FilePath
tmpdir FilePath -> ShowS
</> FilePath
repoStateFile) FilePath
inv_hash
FilePath -> [PatchId] -> IO ()
storePatchIds (FilePath
tmpdir FilePath -> ShowS
</> FilePath
pidsFile) [PatchId]
pids
FilePath -> InfoMap -> IO ()
storeInfoMap (FilePath
tmpdir FilePath -> ShowS
</> FilePath
touchMapFile) InfoMap
infom
FilePath -> FileIdSpans -> IO ()
storeFidMap (FilePath
tmpdir FilePath -> ShowS
</> FilePath
fidMapFile) FileIdSpans
fidspans
FilePath -> FilePathSpans -> IO ()
storeFpMap (FilePath
tmpdir FilePath -> ShowS
</> FilePath
fpMapFile) FilePathSpans
fpspans
FilePath -> IO ()
debugMessage FilePath
"Patch index created"
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
tmpdir
FilePath -> IO ()
removeDirectoryRecursive FilePath
cdir forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOError
_ :: IOError) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
FilePath -> FilePath -> IO ()
renameDirectory FilePath
tmpdir FilePath
cdir
decodeFile :: Binary a => FilePath -> IO a
decodeFile :: forall a. Binary a => FilePath -> IO a
decodeFile FilePath
path = do
Either (ByteOffset, FilePath) a
result <- forall a.
Binary a =>
FilePath -> IO (Either (ByteOffset, FilePath) a)
decodeFileOrFail FilePath
path
case Either (ByteOffset, FilePath) a
result of
Left (ByteOffset
offset, FilePath
msg) ->
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$
FilePath
"Patch index is corrupt (file "forall a. [a] -> [a] -> [a]
++FilePath
pathforall a. [a] -> [a] -> [a]
++FilePath
" at offset "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> FilePath
show ByteOffset
offsetforall a. [a] -> [a] -> [a]
++FilePath
"): "forall a. [a] -> [a] -> [a]
++FilePath
msgforall a. [a] -> [a] -> [a]
++
FilePath
"\nPlease remove the corrupt file and then try again."
Right a
r -> forall (m :: * -> *) a. Monad m => a -> m a
return a
r
storeRepoState :: FilePath -> String -> IO ()
storeRepoState :: FilePath -> FilePath -> IO ()
storeRepoState FilePath
fp FilePath
inv_hash = forall a. Binary a => FilePath -> a -> IO ()
encodeFile FilePath
fp (Int8
version,FilePath
inv_hash)
loadRepoState :: FilePath -> IO (Int8, String)
loadRepoState :: FilePath -> IO (Int8, FilePath)
loadRepoState = forall a. Binary a => FilePath -> IO a
decodeFile
storePatchIds :: FilePath -> [PatchId] -> IO ()
storePatchIds :: FilePath -> [PatchId] -> IO ()
storePatchIds = forall a. Binary a => FilePath -> a -> IO ()
encodeFile
loadPatchIds :: FilePath -> IO [PatchId]
loadPatchIds :: FilePath -> IO [PatchId]
loadPatchIds = forall a. Binary a => FilePath -> IO a
decodeFile
storeFidMap :: FilePath -> FileIdSpans -> IO ()
storeFidMap :: FilePath -> FileIdSpans -> IO ()
storeFidMap FilePath
fp FileIdSpans
fidm =
forall a. Binary a => FilePath -> a -> IO ()
encodeFile FilePath
fp forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
M.map (forall a b. (a -> b) -> [a] -> [b]
map (\(FidSpan FileId
a PatchId
b Maybe PatchId
c) -> (FileId
a, PatchId
b, Maybe PatchId -> PatchId
toIdxM Maybe PatchId
c))) FileIdSpans
fidm
where toIdxM :: Maybe PatchId -> PatchId
toIdxM Maybe PatchId
Nothing = PatchId
zero
toIdxM (Just PatchId
pid) = PatchId
pid
loadFidMap :: FilePath -> IO FileIdSpans
loadFidMap :: FilePath -> IO FileIdSpans
loadFidMap FilePath
fp = forall a b k. (a -> b) -> Map k a -> Map k b
M.map (forall a b. (a -> b) -> [a] -> [b]
map (\(FileId
a,PatchId
b,PatchId
c) -> FileId -> PatchId -> Maybe PatchId -> FileIdSpan
FidSpan FileId
a PatchId
b (PatchId -> Maybe PatchId
toPidM PatchId
c))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => FilePath -> IO a
decodeFile FilePath
fp
where toPidM :: PatchId -> Maybe PatchId
toPidM PatchId
pid | PatchId
pid forall a. Eq a => a -> a -> Bool
== PatchId
zero = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just PatchId
pid
storeFpMap :: FilePath -> FilePathSpans -> IO ()
storeFpMap :: FilePath -> FilePathSpans -> IO ()
storeFpMap FilePath
fp FilePathSpans
fidm =
forall a. Binary a => FilePath -> a -> IO ()
encodeFile FilePath
fp forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
M.map (forall a b. (a -> b) -> [a] -> [b]
map (\(FpSpan AnchoredPath
a PatchId
b Maybe PatchId
c) -> (AnchoredPath
a, PatchId
b, Maybe PatchId -> PatchId
toIdxM Maybe PatchId
c))) FilePathSpans
fidm
where toIdxM :: Maybe PatchId -> PatchId
toIdxM Maybe PatchId
Nothing = PatchId
zero
toIdxM (Just PatchId
pid) = PatchId
pid
loadFpMap :: FilePath -> IO FilePathSpans
loadFpMap :: FilePath -> IO FilePathSpans
loadFpMap FilePath
fp = forall a b k. (a -> b) -> Map k a -> Map k b
M.map (forall a b. (a -> b) -> [a] -> [b]
map (\(AnchoredPath
a,PatchId
b,PatchId
c) -> AnchoredPath -> PatchId -> Maybe PatchId -> FilePathSpan
FpSpan AnchoredPath
a PatchId
b (PatchId -> Maybe PatchId
toPidM PatchId
c))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => FilePath -> IO a
decodeFile FilePath
fp
where toPidM :: PatchId -> Maybe PatchId
toPidM PatchId
pid | PatchId
pid forall a. Eq a => a -> a -> Bool
== PatchId
zero = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just PatchId
pid
storeInfoMap :: FilePath -> InfoMap -> IO ()
storeInfoMap :: FilePath -> InfoMap -> IO ()
storeInfoMap FilePath
fp InfoMap
infom =
forall a. Binary a => FilePath -> a -> IO ()
encodeFile FilePath
fp forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\FileInfo
fi -> (FileInfo -> Bool
isFile FileInfo
fi, FileInfo -> Set Word32
touching FileInfo
fi)) InfoMap
infom
loadInfoMap :: FilePath -> IO InfoMap
loadInfoMap :: FilePath -> IO InfoMap
loadInfoMap FilePath
fp = forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\(Bool
isF,Set Word32
pids) -> Bool -> Set Word32 -> FileInfo
FileInfo Bool
isF Set Word32
pids) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => FilePath -> IO a
decodeFile FilePath
fp
indexDir, repoStateFile, pidsFile, fidMapFile, fpMapFile,
touchMapFile, noPatchIndex :: String
indexDir :: FilePath
indexDir = FilePath
darcsdir FilePath -> ShowS
</> FilePath
"patch_index"
repoStateFile :: FilePath
repoStateFile = FilePath
"repo_state"
pidsFile :: FilePath
pidsFile = FilePath
"patch_ids"
fidMapFile :: FilePath
fidMapFile = FilePath
"fid_map"
fpMapFile :: FilePath
fpMapFile = FilePath
"fp_map"
touchMapFile :: FilePath
touchMapFile = FilePath
"touch_map"
noPatchIndex :: FilePath
noPatchIndex = FilePath
"no_patch_index"
deletePatchIndex :: FilePath -> IO ()
deletePatchIndex :: FilePath -> IO ()
deletePatchIndex FilePath
repodir = do
Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
indexDir
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists forall a b. (a -> b) -> a -> b
$
FilePath -> IO ()
removeDirectoryRecursive FilePath
indexDir
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOError
e :: IOError) -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Error: Could not delete patch index\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show IOError
e
(FilePath -> IOMode -> IO Handle
openFile (FilePath
repodir FilePath -> ShowS
</> FilePath
darcsdir FilePath -> ShowS
</> FilePath
noPatchIndex) IOMode
WriteMode forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO ()
hClose)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOError
e :: IOError) -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Error: Could not disable patch index\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show IOError
e
dumpRepoState :: [PatchId] -> String
dumpRepoState :: [PatchId] -> FilePath
dumpRepoState = [FilePath] -> FilePath
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map PatchId -> FilePath
pid2string
dumpFileIdSpans :: FileIdSpans -> String
dumpFileIdSpans :: FileIdSpans -> FilePath
dumpFileIdSpans FileIdSpans
fidspans =
[FilePath] -> FilePath
unlines [AnchoredPath -> FilePath
displayPath AnchoredPath
fnforall a. [a] -> [a] -> [a]
++FilePath
" -> "forall a. [a] -> [a] -> [a]
++FileId -> FilePath
showFileId FileId
fidforall a. [a] -> [a] -> [a]
++FilePath
" from "forall a. [a] -> [a] -> [a]
++PatchId -> FilePath
pid2string PatchId
fromforall a. [a] -> [a] -> [a]
++FilePath
" to "forall a. [a] -> [a] -> [a]
++forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"-" PatchId -> FilePath
pid2string Maybe PatchId
mto
| (AnchoredPath
fn, [FileIdSpan]
fids) <- forall k a. Map k a -> [(k, a)]
M.toList FileIdSpans
fidspans, FidSpan FileId
fid PatchId
from Maybe PatchId
mto <- [FileIdSpan]
fids]
dumpFilePathSpans :: FilePathSpans -> String
dumpFilePathSpans :: FilePathSpans -> FilePath
dumpFilePathSpans FilePathSpans
fpspans =
[FilePath] -> FilePath
unlines [FileId -> FilePath
showFileId FileId
fidforall a. [a] -> [a] -> [a]
++FilePath
" -> "forall a. [a] -> [a] -> [a]
++ AnchoredPath -> FilePath
displayPath AnchoredPath
fnforall a. [a] -> [a] -> [a]
++FilePath
" from "forall a. [a] -> [a] -> [a]
++PatchId -> FilePath
pid2string PatchId
fromforall a. [a] -> [a] -> [a]
++FilePath
" to "forall a. [a] -> [a] -> [a]
++forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"-" PatchId -> FilePath
pid2string Maybe PatchId
mto
| (FileId
fid, [FilePathSpan]
fns) <- forall k a. Map k a -> [(k, a)]
M.toList FilePathSpans
fpspans, FpSpan AnchoredPath
fn PatchId
from Maybe PatchId
mto <- [FilePathSpan]
fns]
dumpTouchingMap :: InfoMap -> String
dumpTouchingMap :: InfoMap -> FilePath
dumpTouchingMap InfoMap
infom = [FilePath] -> FilePath
unlines [FileId -> FilePath
showFileId FileId
fidforall a. [a] -> [a] -> [a]
++(if Bool
isF then FilePath
"" else FilePath
"/")forall a. [a] -> [a] -> [a]
++FilePath
" -> "forall a. [a] -> [a] -> [a]
++ Word32 -> FilePath
showAsHex Word32
w32
| (FileId
fid,FileInfo Bool
isF Set Word32
w32s) <- forall k a. Map k a -> [(k, a)]
M.toList InfoMap
infom, Word32
w32 <- forall a. Set a -> [a]
S.elems Set Word32
w32s]
fpSpans2filePaths :: FilePathSpans -> InfoMap -> [FilePath]
fpSpans2filePaths :: FilePathSpans -> InfoMap -> [FilePath]
fpSpans2filePaths FilePathSpans
fpSpans InfoMap
infom =
forall a. Ord a => [a] -> [a]
sort [AnchoredPath -> FilePath
displayPath AnchoredPath
fn forall a. [a] -> [a] -> [a]
++ (if Bool
isF then FilePath
"" else FilePath
"/") | (FileId
fid,FpSpan AnchoredPath
fn PatchId
_ Maybe PatchId
Nothing:[FilePathSpan]
_) <- forall k a. Map k a -> [(k, a)]
M.toList FilePathSpans
fpSpans,
let Just (FileInfo Bool
isF Set Word32
_) = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FileId
fid InfoMap
infom]
fpSpans2filePaths' :: FileIdSpans -> [AnchoredPath]
fpSpans2filePaths' :: FileIdSpans -> [AnchoredPath]
fpSpans2filePaths' FileIdSpans
fidSpans = [AnchoredPath
fp | (AnchoredPath
fp, [FileIdSpan]
_) <- forall k a. Map k a -> [(k, a)]
M.toList FileIdSpans
fidSpans]
attemptCreatePatchIndex
:: (RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
attemptCreatePatchIndex :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
attemptCreatePatchIndex Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps = do
Bool
canCreate <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO Bool
canCreatePI Repository rt p wR wU wT
repo
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
canCreate forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
createPIWithInterrupt Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps
canCreatePI :: Repository rt p wR wU wT -> IO Bool
canCreatePI :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO Bool
canCreatePI Repository rt p wR wU wT
repo =
(Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *). Foldable t => t Bool -> Bool
or) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ RepoFormat -> IO Bool
doesntHaveHashedInventory (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
repo)
, FilePath -> IO Bool
isPatchIndexDisabled FilePath
repodir
, FilePath -> IO Bool
doesPatchIndexExist FilePath
repodir
]
where
repodir :: FilePath
repodir = forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> FilePath
repoLocation Repository rt p wR wU wT
repo
doesntHaveHashedInventory :: RepoFormat -> IO Bool
doesntHaveHashedInventory = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory
getRelevantSubsequence
:: (RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd rt p)
=> Sealed ((RL a) wK)
-> Repository rt p wR wU wR
-> PatchSet rt p Origin wR
-> [AnchoredPath]
-> IO (Sealed ((RL a) Origin))
getRelevantSubsequence :: forall (p :: * -> * -> *) (a :: * -> * -> *) (rt :: RepoType) wK wR
wU.
(RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd rt p) =>
Sealed (RL a wK)
-> Repository rt p wR wU wR
-> PatchSet rt p Origin wR
-> [AnchoredPath]
-> IO (Sealed (RL a Origin))
getRelevantSubsequence Sealed (RL a wK)
pxes Repository rt p wR wU wR
repository PatchSet rt p Origin wR
ps [AnchoredPath]
fns = do
pi :: PatchIndex
pi@(PatchIndex [PatchId]
_ FileIdSpans
_ FilePathSpans
_ InfoMap
infom) <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> PatchSet rt p Origin wR -> IO PatchIndex
loadSafePatchIndex Repository rt p wR wU wR
repository PatchSet rt p Origin wR
ps
let fids :: [FileId]
fids = forall a b. (a -> b) -> [a] -> [b]
map (\AnchoredPath
fn -> forall s a. State s a -> s -> a
evalState (AnchoredPath -> PIM FileId
lookupFid AnchoredPath
fn) PatchIndex
pi) [AnchoredPath]
fns
pidss :: [Set Word32]
pidss = forall a b. (a -> b) -> [a] -> [b]
map ((\(FileInfo Bool
_ Set Word32
a) -> Set Word32
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` InfoMap
infom)) [FileId]
fids
pids :: Set Word32
pids = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions [Set Word32]
pidss
let flpxes :: FL a wK wZ
flpxes = forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall (a :: * -> * -> *) wX wY1 wY2. a wX wY1 -> a wX wY2
unsafeCoercePEnd Sealed (RL a wK)
pxes
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> *) wX. a wX -> Sealed a
seal forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (a :: * -> * -> *) (rt :: RepoType) wX wY
wB wP wQ.
(RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd rt p) =>
FL a wX wY -> RL a wB wX -> Set Word32 -> RL a wP wQ
keepElems forall {wZ}. FL a wK wZ
flpxes forall (a :: * -> * -> *) wX. RL a wX wX
NilRL Set Word32
pids
where
keepElems :: (RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd rt p)
=> FL a wX wY -> RL a wB wX -> S.Set Word32 -> RL a wP wQ
keepElems :: forall (p :: * -> * -> *) (a :: * -> * -> *) (rt :: RepoType) wX wY
wB wP wQ.
(RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd rt p) =>
FL a wX wY -> RL a wB wX -> Set Word32 -> RL a wP wQ
keepElems FL a wX wY
NilFL RL a wB wX
acc Set Word32
_ = forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP RL a wB wX
acc
keepElems (a wX wY
x :>: FL a wY wY
xs) RL a wB wX
acc Set Word32
pids
| PatchId -> Word32
short (PatchInfo -> PatchId
makePatchID forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info a wX wY
x) forall a. Ord a => a -> Set a -> Bool
`S.member` Set Word32
pids = forall (p :: * -> * -> *) (a :: * -> * -> *) (rt :: RepoType) wX wY
wB wP wQ.
(RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd rt p) =>
FL a wX wY -> RL a wB wX -> Set Word32 -> RL a wP wQ
keepElems FL a wY wY
xs (RL a wB wX
acc forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: a wX wY
x) Set Word32
pids
| Bool
otherwise = forall (p :: * -> * -> *) (a :: * -> * -> *) (rt :: RepoType) wX wY
wB wP wQ.
(RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd rt p) =>
FL a wX wY -> RL a wB wX -> Set Word32 -> RL a wP wQ
keepElems (forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FL a wY wY
xs) RL a wB wX
acc Set Word32
pids
type PatchFilter rt p = [AnchoredPath] -> [Sealed2 (PatchInfoAnd rt p)] -> IO [Sealed2 (PatchInfoAnd rt p)]
maybeFilterPatches
:: (RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wT
-> PatchSet rt p Origin wR
-> PatchFilter rt p
maybeFilterPatches :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> PatchSet rt p Origin wR -> PatchFilter rt p
maybeFilterPatches Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps [AnchoredPath]
fps [Sealed2 (PatchInfoAnd rt p)]
ops = do
Bool
usePI <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO Bool
canUsePatchIndex Repository rt p wR wU wT
repo
if Bool
usePI
then do
pi :: PatchIndex
pi@(PatchIndex [PatchId]
_ FileIdSpans
_ FilePathSpans
_ InfoMap
infom) <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> PatchSet rt p Origin wR -> IO PatchIndex
loadSafePatchIndex Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps
let fids :: [FileId]
fids = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((\AnchoredPath
fn -> forall s a. State s a -> s -> a
evalState (AnchoredPath -> PIM [FileId]
lookupFids' AnchoredPath
fn) PatchIndex
pi)) [AnchoredPath]
fps
npids :: Set Word32
npids = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (FileInfo -> Set Word32
touchingforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. HasCallStack => Maybe a -> a
fromJustforall b c a. (b -> c) -> (a -> b) -> a -> c
.(forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` InfoMap
infom)) [FileId]
fids
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter
(forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> Set a -> Bool
S.member Set Word32
npids forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
unseal2 (PatchId -> Word32
short forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfo -> PatchId
makePatchID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info))) [Sealed2 (PatchInfoAnd rt p)]
ops
else forall (m :: * -> *) a. Monad m => a -> m a
return [Sealed2 (PatchInfoAnd rt p)]
ops
dumpPatchIndex :: FilePath -> IO ()
dumpPatchIndex :: FilePath -> IO ()
dumpPatchIndex FilePath
repodir = do
(Int8
_,FilePath
inv_hash,Map PatchId Int
_,PatchIndex [PatchId]
pids FileIdSpans
fidspans FilePathSpans
fpspans InfoMap
infom) <- FilePath -> IO (Int8, FilePath, Map PatchId Int, PatchIndex)
loadPatchIndex FilePath
repodir
FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines forall a b. (a -> b) -> a -> b
$
[ FilePath
"Inventory hash:" forall a. [a] -> [a] -> [a]
++ FilePath
inv_hash
, FilePath
"================="
, FilePath
"Repo state:"
, FilePath
"==========="
, [PatchId] -> FilePath
dumpRepoState [PatchId]
pids
, FilePath
"Fileid spans:"
, FilePath
"============="
, FileIdSpans -> FilePath
dumpFileIdSpans FileIdSpans
fidspans
, FilePath
"Filepath spans:"
, FilePath
"=============="
, FilePathSpans -> FilePath
dumpFilePathSpans FilePathSpans
fpspans
, FilePath
"Info Map:"
, FilePath
"========="
, InfoMap -> FilePath
dumpTouchingMap InfoMap
infom
, FilePath
"Files:"
, FilePath
"=============="
] forall a. [a] -> [a] -> [a]
++ FilePathSpans -> InfoMap -> [FilePath]
fpSpans2filePaths FilePathSpans
fpspans InfoMap
infom
piTest :: FilePath -> IO ()
piTest :: FilePath -> IO ()
piTest FilePath
repodir = do
(Int8
_,FilePath
_,Map PatchId Int
_,PatchIndex [PatchId]
rpids FileIdSpans
fidspans FilePathSpans
fpspans InfoMap
infom) <- FilePath -> IO (Int8, FilePath, Map PatchId Int, PatchIndex)
loadPatchIndex FilePath
repodir
let pids :: [PatchId]
pids = forall a. [a] -> [a]
reverse [PatchId]
rpids
FilePath -> IO ()
putStrLn FilePath
"fidspans"
FilePath -> IO ()
putStrLn FilePath
"==========="
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
M.toList FileIdSpans
fidspans) forall a b. (a -> b) -> a -> b
$ \(AnchoredPath
fn, [FileIdSpan]
spans) -> do
let g :: FileIdSpan -> [PatchId]
g :: FileIdSpan -> [PatchId]
g (FidSpan FileId
_ PatchId
x (Just PatchId
y)) = [PatchId
y,PatchId
x]
g (FidSpan FileId
_ PatchId
x Maybe PatchId
_) = [PatchId
x]
ascTs :: [PatchId]
ascTs = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map FileIdSpan -> [PatchId]
g [FileIdSpan]
spans
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Eq a => [a] -> [a] -> Bool
isInOrder [PatchId]
ascTs [PatchId]
pids) (forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"In order test failed! filename: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show AnchoredPath
fn)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FileIdSpan]
spans forall a b. (a -> b) -> a -> b
$ \(FidSpan FileId
fid PatchId
_ Maybe PatchId
_) -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall k a. Ord k => k -> Map k a -> Bool
M.member FileId
fid FilePathSpans
fpspans) (forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Valid file id test failed! fid: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FileId
fid)
FilePath -> IO ()
putStrLn FilePath
"fidspans tests passed"
FilePath -> IO ()
putStrLn FilePath
"fpspans"
FilePath -> IO ()
putStrLn FilePath
"==========="
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
M.toList FilePathSpans
fpspans) forall a b. (a -> b) -> a -> b
$ \(FileId
fid, [FilePathSpan]
spans) -> do
let g :: FilePathSpan -> [PatchId]
g :: FilePathSpan -> [PatchId]
g (FpSpan AnchoredPath
_ PatchId
x (Just PatchId
y)) = [PatchId
y,PatchId
x]
g (FpSpan AnchoredPath
_ PatchId
x Maybe PatchId
_) = [PatchId
x]
ascTs :: [PatchId]
ascTs = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map FilePathSpan -> [PatchId]
g [FilePathSpan]
spans
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Eq a => [a] -> [a] -> Bool
isInOrder [PatchId]
ascTs [PatchId]
pids) (forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"In order test failed! fileid: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FileId
fid)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePathSpan]
spans forall a b. (a -> b) -> a -> b
$ \(FpSpan AnchoredPath
fn PatchId
_ Maybe PatchId
_) -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall k a. Ord k => k -> Map k a -> Bool
M.member AnchoredPath
fn FileIdSpans
fidspans) (forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Valid file name test failed! file name: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show AnchoredPath
fn)
let f :: FilePathSpan -> FilePathSpan -> Bool
f :: FilePathSpan -> FilePathSpan -> Bool
f (FpSpan AnchoredPath
_ PatchId
x Maybe PatchId
_) (FpSpan AnchoredPath
_ PatchId
_ (Just PatchId
y)) = PatchId
x forall a. Eq a => a -> a -> Bool
== PatchId
y
f FilePathSpan
_ FilePathSpan
_ = forall a. HasCallStack => FilePath -> a
error FilePath
"adj test of fpspans fail"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith FilePathSpan -> FilePathSpan -> Bool
f [FilePathSpan]
spans (forall a. [a] -> [a]
tail [FilePathSpan]
spans)) (forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Adjcency test failed! fid: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FileId
fid)
FilePath -> IO ()
putStrLn FilePath
"fpspans tests passed"
FilePath -> IO ()
putStrLn FilePath
"infom"
FilePath -> IO ()
putStrLn FilePath
"==========="
FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"Valid fid test: " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> FilePath
showforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall k a. Ord k => k -> Map k a -> Bool
`M.member` FilePathSpans
fpspans) (forall k a. Map k a -> [k]
M.keys InfoMap
infom))
FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"Valid pid test: " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> FilePath
showforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => Set a -> Set a -> Bool
S.isSubsetOf (forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map PatchId -> Word32
short [PatchId]
pids) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map FileInfo -> Set Word32
touching forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
M.elems forall a b. (a -> b) -> a -> b
$ InfoMap
infom)
where
isInOrder :: Eq a => [a] -> [a] -> Bool
isInOrder :: forall a. Eq a => [a] -> [a] -> Bool
isInOrder (a
x:[a]
xs) (a
y:[a]
ys) | a
x forall a. Eq a => a -> a -> Bool
== a
y = forall a. Eq a => [a] -> [a] -> Bool
isInOrder [a]
xs [a]
ys
| Bool
otherwise = forall a. Eq a => [a] -> [a] -> Bool
isInOrder (a
xforall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
isInOrder [] [a]
_ = Bool
True
isInOrder [a]
_ [] = Bool
False