{-# LANGUAGE NamedFieldPuns #-}

{-|
License : GPL-2

The patch-index stores additional information that is extracted from
the PatchSet for the repository to speed up certain commands (namely
@log@ and @annotate@). More precisely, for every file tracked by the
repository, it stores the list of patches that touch it.

When created, patch-index lives in @_darcs\/patch_index\/@, and it
should be automatically maintained each time the set of patches of
the repository is updated.

Patch-index can also be explicitely disabled by creating a file
@_darcs\/no_patch_index@. "Explicitely disabed" means that no command
should attempt to automatically create the patch-index.

See <http://darcs.net/Internals/PatchIndex> for more information.
-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
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 ( mapAccumL, sort, nub, (\\) )
import Data.Maybe ( catMaybes, fromJust, fromMaybe )
import qualified Data.IntSet as I
import qualified Data.Map as M
import qualified Data.Set as S

import Safe ( tailErr )

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, Apply )
import Darcs.Patch.Index.Types
    ( FileId(..)
    , PatchId
    , makePatchID
    , pid2string
    , short
    , showFileId
    , zero
    )
import Darcs.Patch.Index.Monad ( FileMod(..), applyToFileMods )
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.Repository.Paths ( hashedInventoryPath )

import Darcs.Util.Global ( darcsdir )
import Darcs.Util.Hash ( sha256sum, showAsHex )
import Darcs.Util.Lock ( withPermDir )
import Darcs.Util.Path ( AnchoredPath, displayPath, isRoot, parents, toFilePath )
import Darcs.Util.Progress ( debugMessage )
import Darcs.Util.SignalHandler ( catchInterrupt )
import Darcs.Util.Tree ( Tree(..) )

type Map = M.Map
type Set = S.Set
type IntSet = I.IntSet

data FileIdSpan = FidSpan
  !FileId                   -- ^ the fileid has some fixed name in the
  !PatchId                  -- ^ span starting here
  !(Maybe PatchId)          -- ^ and (maybe) ending here
  deriving (Key -> FileIdSpan -> ShowS
[FileIdSpan] -> ShowS
FileIdSpan -> FilePath
(Key -> FileIdSpan -> ShowS)
-> (FileIdSpan -> FilePath)
-> ([FileIdSpan] -> ShowS)
-> Show FileIdSpan
forall a.
(Key -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> FileIdSpan -> ShowS
showsPrec :: Key -> FileIdSpan -> ShowS
$cshow :: FileIdSpan -> FilePath
show :: FileIdSpan -> FilePath
$cshowList :: [FileIdSpan] -> ShowS
showList :: [FileIdSpan] -> ShowS
Show, FileIdSpan -> FileIdSpan -> Bool
(FileIdSpan -> FileIdSpan -> Bool)
-> (FileIdSpan -> FileIdSpan -> Bool) -> Eq FileIdSpan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileIdSpan -> FileIdSpan -> Bool
== :: FileIdSpan -> FileIdSpan -> Bool
$c/= :: FileIdSpan -> FileIdSpan -> Bool
/= :: FileIdSpan -> FileIdSpan -> Bool
Eq, Eq FileIdSpan
Eq FileIdSpan =>
(FileIdSpan -> FileIdSpan -> Ordering)
-> (FileIdSpan -> FileIdSpan -> Bool)
-> (FileIdSpan -> FileIdSpan -> Bool)
-> (FileIdSpan -> FileIdSpan -> Bool)
-> (FileIdSpan -> FileIdSpan -> Bool)
-> (FileIdSpan -> FileIdSpan -> FileIdSpan)
-> (FileIdSpan -> FileIdSpan -> FileIdSpan)
-> Ord 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
$ccompare :: FileIdSpan -> FileIdSpan -> Ordering
compare :: FileIdSpan -> FileIdSpan -> Ordering
$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
>= :: FileIdSpan -> FileIdSpan -> Bool
$cmax :: FileIdSpan -> FileIdSpan -> FileIdSpan
max :: FileIdSpan -> FileIdSpan -> FileIdSpan
$cmin :: FileIdSpan -> FileIdSpan -> FileIdSpan
min :: FileIdSpan -> FileIdSpan -> FileIdSpan
Ord)

data FilePathSpan = FpSpan
  !AnchoredPath             -- ^ the file path has some fixed fileid in the
  !PatchId                  -- ^ span starting here
  !(Maybe PatchId)          -- ^ and (maybe) ending here
  deriving (Key -> FilePathSpan -> ShowS
[FilePathSpan] -> ShowS
FilePathSpan -> FilePath
(Key -> FilePathSpan -> ShowS)
-> (FilePathSpan -> FilePath)
-> ([FilePathSpan] -> ShowS)
-> Show FilePathSpan
forall a.
(Key -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> FilePathSpan -> ShowS
showsPrec :: Key -> FilePathSpan -> ShowS
$cshow :: FilePathSpan -> FilePath
show :: FilePathSpan -> FilePath
$cshowList :: [FilePathSpan] -> ShowS
showList :: [FilePathSpan] -> ShowS
Show, FilePathSpan -> FilePathSpan -> Bool
(FilePathSpan -> FilePathSpan -> Bool)
-> (FilePathSpan -> FilePathSpan -> Bool) -> Eq FilePathSpan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FilePathSpan -> FilePathSpan -> Bool
== :: FilePathSpan -> FilePathSpan -> Bool
$c/= :: FilePathSpan -> FilePathSpan -> Bool
/= :: FilePathSpan -> FilePathSpan -> Bool
Eq, Eq FilePathSpan
Eq FilePathSpan =>
(FilePathSpan -> FilePathSpan -> Ordering)
-> (FilePathSpan -> FilePathSpan -> Bool)
-> (FilePathSpan -> FilePathSpan -> Bool)
-> (FilePathSpan -> FilePathSpan -> Bool)
-> (FilePathSpan -> FilePathSpan -> Bool)
-> (FilePathSpan -> FilePathSpan -> FilePathSpan)
-> (FilePathSpan -> FilePathSpan -> FilePathSpan)
-> Ord 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
$ccompare :: FilePathSpan -> FilePathSpan -> Ordering
compare :: FilePathSpan -> FilePathSpan -> Ordering
$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
>= :: FilePathSpan -> FilePathSpan -> Bool
$cmax :: FilePathSpan -> FilePathSpan -> FilePathSpan
max :: FilePathSpan -> FilePathSpan -> FilePathSpan
$cmin :: FilePathSpan -> FilePathSpan -> FilePathSpan
min :: FilePathSpan -> FilePathSpan -> FilePathSpan
Ord)

-- | info about a given fileid
data FileInfo = FileInfo
  { FileInfo -> Bool
isFile :: Bool          -- ^ whether file or dir
  , FileInfo -> IntSet
touching :: IntSet      -- ^ first words of patch hashes
  } deriving (Key -> FileInfo -> ShowS
[FileInfo] -> ShowS
FileInfo -> FilePath
(Key -> FileInfo -> ShowS)
-> (FileInfo -> FilePath) -> ([FileInfo] -> ShowS) -> Show FileInfo
forall a.
(Key -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> FileInfo -> ShowS
showsPrec :: Key -> FileInfo -> ShowS
$cshow :: FileInfo -> FilePath
show :: FileInfo -> FilePath
$cshowList :: [FileInfo] -> ShowS
showList :: [FileInfo] -> ShowS
Show, FileInfo -> FileInfo -> Bool
(FileInfo -> FileInfo -> Bool)
-> (FileInfo -> FileInfo -> Bool) -> Eq FileInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileInfo -> FileInfo -> Bool
== :: FileInfo -> FileInfo -> Bool
$c/= :: FileInfo -> FileInfo -> Bool
/= :: FileInfo -> FileInfo -> Bool
Eq, Eq FileInfo
Eq FileInfo =>
(FileInfo -> FileInfo -> Ordering)
-> (FileInfo -> FileInfo -> Bool)
-> (FileInfo -> FileInfo -> Bool)
-> (FileInfo -> FileInfo -> Bool)
-> (FileInfo -> FileInfo -> Bool)
-> (FileInfo -> FileInfo -> FileInfo)
-> (FileInfo -> FileInfo -> FileInfo)
-> Ord 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
$ccompare :: FileInfo -> FileInfo -> Ordering
compare :: FileInfo -> FileInfo -> Ordering
$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
>= :: FileInfo -> FileInfo -> Bool
$cmax :: FileInfo -> FileInfo -> FileInfo
max :: FileInfo -> FileInfo -> FileInfo
$cmin :: FileInfo -> FileInfo -> FileInfo
min :: FileInfo -> FileInfo -> FileInfo
Ord)

-- | timespans where a certain filename corresponds to a file with a given id
type FileIdSpans = Map AnchoredPath [FileIdSpan]

-- | timespans where a file with a certain id corresponds to given filenames
type FilePathSpans = Map FileId [FilePathSpan]

-- | information file with a given ID
type InfoMap = Map FileId FileInfo

-- | the patch-index
data PatchIndex = PatchIndex
  { PatchIndex -> [PatchId]
pids :: [PatchId]
    -- ^ all the 'PatchId's tracked by this patch index, with the most
    -- recent patch at the head of the list (note, stored in the
    -- reverse order on disk for backwards compatibility
    -- with an older format).
  , PatchIndex -> FileIdSpans
fidspans :: FileIdSpans
  , PatchIndex -> FilePathSpans
fpspans :: FilePathSpans
  , PatchIndex -> InfoMap
infom :: InfoMap
  }

-- | On-disk version of patch index
--   version 1 is the one introduced in darcs 2.10
--           2 changes the pids order to newer-to-older
--           3 changes FileName to AnchoredPath everywhere, which has
--             different Binary (and Ord) instances
--           4 adds all parent dirs of each file or dir as
--             being touched by a patch
--           5 replaces Set Word32 with IntSet

version :: Int8
version :: Int8
version = Int8
5

type PIM a = State PatchIndex a

-- | 'applyPatchMods pmods pindex' applies a list of PatchMods to the given
--   patch index pindex
applyPatchMods :: [(PatchId, [FileMod AnchoredPath])] -> PatchIndex -> PatchIndex
applyPatchMods :: [(PatchId, [FileMod AnchoredPath])] -> PatchIndex -> PatchIndex
applyPatchMods [(PatchId, [FileMod AnchoredPath])]
pmods PatchIndex
pindex =
  (State PatchIndex () -> PatchIndex -> PatchIndex)
-> PatchIndex -> State PatchIndex () -> PatchIndex
forall a b c. (a -> b -> c) -> b -> a -> c
flip State PatchIndex () -> PatchIndex -> PatchIndex
forall s a. State s a -> s -> s
execState PatchIndex
pindex (State PatchIndex () -> PatchIndex)
-> State PatchIndex () -> PatchIndex
forall a b. (a -> b) -> a -> b
$ ((PatchId, [FileMod AnchoredPath]) -> State PatchIndex ())
-> [(PatchId, [FileMod AnchoredPath])] -> State PatchIndex ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (PatchId, [FileMod AnchoredPath]) -> State PatchIndex ()
goList [(PatchId, [FileMod AnchoredPath])]
pmods
 where goList :: (PatchId, [FileMod AnchoredPath]) -> PIM ()
       goList :: (PatchId, [FileMod AnchoredPath]) -> State PatchIndex ()
goList (PatchId
pid, [FileMod AnchoredPath]
mods) = do
           (PatchIndex -> PatchIndex) -> State PatchIndex ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind{pids = pid:pids pind})
           (FileMod AnchoredPath -> State PatchIndex ())
-> [FileMod AnchoredPath] -> State PatchIndex ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (((PatchId, FileMod AnchoredPath) -> State PatchIndex ())
-> PatchId -> FileMod AnchoredPath -> State PatchIndex ()
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (PatchId, FileMod AnchoredPath) -> State PatchIndex ()
go PatchId
pid) [FileMod AnchoredPath]
mods
       go :: (PatchId, FileMod AnchoredPath) -> PIM ()
       go :: (PatchId, FileMod AnchoredPath) -> State PatchIndex ()
go (PatchId
pid, PCreateFile AnchoredPath
fn) = do
         FileId
fid <- AnchoredPath -> PatchId -> PIM FileId
createFidStartSpan AnchoredPath
fn PatchId
pid
         FileId -> AnchoredPath -> PatchId -> State PatchIndex ()
startFpSpan FileId
fid AnchoredPath
fn PatchId
pid
         FileId -> Bool -> State PatchIndex ()
createInfo FileId
fid Bool
True
         PatchId -> FileId -> State PatchIndex ()
insertTouch PatchId
pid FileId
fid
         PatchId -> AnchoredPath -> State PatchIndex ()
insertParentsTouch PatchId
pid AnchoredPath
fn
       go (PatchId
pid, PCreateDir AnchoredPath
fn) = do
         FileId
fid <- AnchoredPath -> PatchId -> PIM FileId
createFidStartSpan AnchoredPath
fn PatchId
pid
         FileId -> AnchoredPath -> PatchId -> State PatchIndex ()
startFpSpan FileId
fid AnchoredPath
fn PatchId
pid
         FileId -> Bool -> State PatchIndex ()
createInfo FileId
fid Bool
False
         PatchId -> FileId -> State PatchIndex ()
insertTouch PatchId
pid FileId
fid
         PatchId -> AnchoredPath -> State PatchIndex ()
insertParentsTouch PatchId
pid AnchoredPath
fn
       go (PatchId
pid, PTouch AnchoredPath
fn) = do
         FileId
fid <- AnchoredPath -> PIM FileId
lookupFid AnchoredPath
fn
         PatchId -> FileId -> State PatchIndex ()
insertTouch PatchId
pid FileId
fid
         PatchId -> AnchoredPath -> State PatchIndex ()
insertParentsTouch PatchId
pid AnchoredPath
fn
       go (PatchId
pid, PRename AnchoredPath
oldfn AnchoredPath
newfn) = do
         FileId
fid <- AnchoredPath -> PIM FileId
lookupFid AnchoredPath
oldfn
         FileId -> PatchId -> State PatchIndex ()
stopFpSpan FileId
fid PatchId
pid
         FileId -> AnchoredPath -> PatchId -> State PatchIndex ()
startFpSpan FileId
fid AnchoredPath
newfn PatchId
pid
         PatchId -> FileId -> State PatchIndex ()
insertTouch PatchId
pid FileId
fid
         PatchId -> AnchoredPath -> State PatchIndex ()
insertParentsTouch PatchId
pid AnchoredPath
oldfn
         PatchId -> AnchoredPath -> State PatchIndex ()
insertParentsTouch PatchId
pid AnchoredPath
newfn
         AnchoredPath -> PatchId -> State PatchIndex ()
stopFidSpan AnchoredPath
oldfn PatchId
pid
         AnchoredPath -> PatchId -> FileId -> State PatchIndex ()
startFidSpan AnchoredPath
newfn PatchId
pid FileId
fid
       go (PatchId
pid, PRemove AnchoredPath
fn) = do
         FileId
fid <- AnchoredPath -> PIM FileId
lookupFid AnchoredPath
fn
         PatchId -> FileId -> State PatchIndex ()
insertTouch PatchId
pid FileId
fid
         PatchId -> AnchoredPath -> State PatchIndex ()
insertParentsTouch PatchId
pid AnchoredPath
fn
         AnchoredPath -> PatchId -> State PatchIndex ()
stopFidSpan AnchoredPath
fn PatchId
pid
         FileId -> PatchId -> State PatchIndex ()
stopFpSpan FileId
fid PatchId
pid
       go (PatchId
pid, PDuplicateTouch AnchoredPath
fn) = do
         FileIdSpans
fidm <- (PatchIndex -> FileIdSpans)
-> StateT PatchIndex Identity FileIdSpans
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PatchIndex -> FileIdSpans
fidspans
         case AnchoredPath -> FileIdSpans -> Maybe [FileIdSpan]
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]
_) -> do
             PatchId -> FileId -> State PatchIndex ()
insertTouch PatchId
pid FileId
fid
             PatchId -> AnchoredPath -> State PatchIndex ()
insertParentsTouch PatchId
pid AnchoredPath
fn
           Maybe [FileIdSpan]
Nothing -> () -> State PatchIndex ()
forall a. a -> StateT PatchIndex Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
           Just [] -> FilePath -> State PatchIndex ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> State PatchIndex ())
-> FilePath -> State PatchIndex ()
forall a b. (a -> b) -> a -> b
$ FilePath
"applyPatchMods: impossible, no entry for "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++AnchoredPath -> FilePath
forall a. Show a => a -> FilePath
show AnchoredPath
fn
                              FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
" in FileIdSpans in duplicate, empty list"

-- | create new filespan for created file
createFidStartSpan :: AnchoredPath -> PatchId -> PIM FileId
createFidStartSpan :: AnchoredPath -> PatchId -> PIM FileId
createFidStartSpan AnchoredPath
fn PatchId
pstart = do
  FileIdSpans
fidspans <- (PatchIndex -> FileIdSpans)
-> StateT PatchIndex Identity FileIdSpans
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PatchIndex -> FileIdSpans
fidspans
  case AnchoredPath -> FileIdSpans -> Maybe [FileIdSpan]
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 -> Key -> FileId
FileId AnchoredPath
fn Key
1
      (PatchIndex -> PatchIndex) -> State PatchIndex ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind {fidspans=M.insert fn [FidSpan fid pstart Nothing] fidspans})
      FileId -> PIM FileId
forall a. a -> StateT PatchIndex Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return FileId
fid
    Just [FileIdSpan]
fspans -> do
      let fid :: FileId
fid = AnchoredPath -> Key -> FileId
FileId AnchoredPath
fn ([FileIdSpan] -> Key
forall a. [a] -> Key
forall (t :: * -> *) a. Foldable t => t a -> Key
length [FileIdSpan]
fspansKey -> Key -> Key
forall a. Num a => a -> a -> a
+Key
1)
      (PatchIndex -> PatchIndex) -> State PatchIndex ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind {fidspans=M.insert fn (FidSpan fid pstart Nothing:fspans) fidspans})
      FileId -> PIM FileId
forall a. a -> StateT PatchIndex Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return FileId
fid

-- | start new span for name fn for file fid starting with patch pid
startFpSpan :: FileId -> AnchoredPath -> PatchId -> PIM ()
startFpSpan :: FileId -> AnchoredPath -> PatchId -> State PatchIndex ()
startFpSpan FileId
fid AnchoredPath
fn PatchId
pstart = (PatchIndex -> PatchIndex) -> State PatchIndex ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind {fpspans=M.alter alt fid (fpspans pind)})
  where alt :: Maybe [FilePathSpan] -> Maybe [FilePathSpan]
alt Maybe [FilePathSpan]
Nothing = [FilePathSpan] -> Maybe [FilePathSpan]
forall a. a -> Maybe a
Just [AnchoredPath -> PatchId -> Maybe PatchId -> FilePathSpan
FpSpan AnchoredPath
fn PatchId
pstart Maybe PatchId
forall a. Maybe a
Nothing]
        alt (Just [FilePathSpan]
spans) = [FilePathSpan] -> Maybe [FilePathSpan]
forall a. a -> Maybe a
Just (AnchoredPath -> PatchId -> Maybe PatchId -> FilePathSpan
FpSpan AnchoredPath
fn PatchId
pstart Maybe PatchId
forall a. Maybe a
NothingFilePathSpan -> [FilePathSpan] -> [FilePathSpan]
forall a. a -> [a] -> [a]
:[FilePathSpan]
spans)

-- | stop current span for file name fn
stopFpSpan :: FileId -> PatchId -> PIM ()
stopFpSpan :: FileId -> PatchId -> State PatchIndex ()
stopFpSpan FileId
fid PatchId
pend = (PatchIndex -> PatchIndex) -> State PatchIndex ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind {fpspans=M.alter alt fid (fpspans pind)})
  where alt :: Maybe [FilePathSpan] -> Maybe [FilePathSpan]
alt Maybe [FilePathSpan]
Nothing = FilePath -> Maybe [FilePathSpan]
forall a. HasCallStack => FilePath -> a
error (FilePath -> Maybe [FilePathSpan])
-> FilePath -> Maybe [FilePathSpan]
forall a b. (a -> b) -> a -> b
$ FilePath
"impossible: no span for " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FileId -> FilePath
forall a. Show a => a -> FilePath
show FileId
fid
        alt (Just []) = FilePath -> Maybe [FilePathSpan]
forall a. HasCallStack => FilePath -> a
error (FilePath -> Maybe [FilePathSpan])
-> FilePath -> Maybe [FilePathSpan]
forall a b. (a -> b) -> a -> b
$ FilePath
"impossible: no span for " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FileId -> FilePath
forall a. Show a => a -> FilePath
show FileId
fidFilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
", empty list"
        alt (Just (FpSpan AnchoredPath
fp PatchId
pstart Maybe PatchId
Nothing:[FilePathSpan]
spans)) =
          [FilePathSpan] -> Maybe [FilePathSpan]
forall a. a -> Maybe a
Just (AnchoredPath -> PatchId -> Maybe PatchId -> FilePathSpan
FpSpan AnchoredPath
fp PatchId
pstart (PatchId -> Maybe PatchId
forall a. a -> Maybe a
Just PatchId
pend)FilePathSpan -> [FilePathSpan] -> [FilePathSpan]
forall a. a -> [a] -> [a]
:[FilePathSpan]
spans)
        alt Maybe [FilePathSpan]
_ = FilePath -> Maybe [FilePathSpan]
forall a. HasCallStack => FilePath -> a
error (FilePath -> Maybe [FilePathSpan])
-> FilePath -> Maybe [FilePathSpan]
forall a b. (a -> b) -> a -> b
$ FilePath
"impossible: span already ended for " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FileId -> FilePath
forall a. Show a => a -> FilePath
show FileId
fid

-- | start new span for name fn for file fid starting with patch pid
startFidSpan :: AnchoredPath -> PatchId -> FileId -> PIM ()
startFidSpan :: AnchoredPath -> PatchId -> FileId -> State PatchIndex ()
startFidSpan AnchoredPath
fn PatchId
pstart FileId
fid = (PatchIndex -> PatchIndex) -> State PatchIndex ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind {fidspans=M.alter alt fn (fidspans pind)})
  where alt :: Maybe [FileIdSpan] -> Maybe [FileIdSpan]
alt Maybe [FileIdSpan]
Nothing = [FileIdSpan] -> Maybe [FileIdSpan]
forall a. a -> Maybe a
Just [FileId -> PatchId -> Maybe PatchId -> FileIdSpan
FidSpan FileId
fid PatchId
pstart Maybe PatchId
forall a. Maybe a
Nothing]
        alt (Just [FileIdSpan]
spans) = [FileIdSpan] -> Maybe [FileIdSpan]
forall a. a -> Maybe a
Just (FileId -> PatchId -> Maybe PatchId -> FileIdSpan
FidSpan FileId
fid PatchId
pstart Maybe PatchId
forall a. Maybe a
NothingFileIdSpan -> [FileIdSpan] -> [FileIdSpan]
forall a. a -> [a] -> [a]
:[FileIdSpan]
spans)

-- | stop current span for file name fn
stopFidSpan :: AnchoredPath -> PatchId -> PIM ()
stopFidSpan :: AnchoredPath -> PatchId -> State PatchIndex ()
stopFidSpan AnchoredPath
fn PatchId
pend = (PatchIndex -> PatchIndex) -> State PatchIndex ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind {fidspans=M.alter alt fn (fidspans pind)})
  where alt :: Maybe [FileIdSpan] -> Maybe [FileIdSpan]
alt Maybe [FileIdSpan]
Nothing = FilePath -> Maybe [FileIdSpan]
forall a. HasCallStack => FilePath -> a
error (FilePath -> Maybe [FileIdSpan]) -> FilePath -> Maybe [FileIdSpan]
forall a b. (a -> b) -> a -> b
$ FilePath
"impossible: no span for " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> FilePath
forall a. Show a => a -> FilePath
show AnchoredPath
fn
        alt (Just []) = FilePath -> Maybe [FileIdSpan]
forall a. HasCallStack => FilePath -> a
error (FilePath -> Maybe [FileIdSpan]) -> FilePath -> Maybe [FileIdSpan]
forall a b. (a -> b) -> a -> b
$ FilePath
"impossible: no span for " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> FilePath
forall a. Show a => a -> FilePath
show AnchoredPath
fnFilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
", empty list"
        alt (Just (FidSpan FileId
fid PatchId
pstart Maybe PatchId
Nothing:[FileIdSpan]
spans)) =
          [FileIdSpan] -> Maybe [FileIdSpan]
forall a. a -> Maybe a
Just (FileId -> PatchId -> Maybe PatchId -> FileIdSpan
FidSpan FileId
fid PatchId
pstart (PatchId -> Maybe PatchId
forall a. a -> Maybe a
Just PatchId
pend)FileIdSpan -> [FileIdSpan] -> [FileIdSpan]
forall a. a -> [a] -> [a]
:[FileIdSpan]
spans)
        alt Maybe [FileIdSpan]
_ = FilePath -> Maybe [FileIdSpan]
forall a. HasCallStack => FilePath -> a
error (FilePath -> Maybe [FileIdSpan]) -> FilePath -> Maybe [FileIdSpan]
forall a b. (a -> b) -> a -> b
$ FilePath
"impossible: span already ended for " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> FilePath
forall a. Show a => a -> FilePath
show AnchoredPath
fn

-- | insert touching patchid for given file id
createInfo :: FileId -> Bool -> PIM ()
createInfo :: FileId -> Bool -> State PatchIndex ()
createInfo FileId
fid Bool
isF = (PatchIndex -> PatchIndex) -> State PatchIndex ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind {infom=M.alter alt fid (infom pind)})
  where alt :: Maybe a -> Maybe FileInfo
alt Maybe a
Nothing = FileInfo -> Maybe FileInfo
forall a. a -> Maybe a
Just (Bool -> IntSet -> FileInfo
FileInfo Bool
isF IntSet
I.empty)
        alt (Just a
_) = FileInfo -> Maybe FileInfo
forall a. a -> Maybe a
Just (Bool -> IntSet -> FileInfo
FileInfo Bool
isF IntSet
I.empty) -- forget old false positives

-- | insert touching patchid for given file id
insertTouch :: PatchId -> FileId -> PIM ()
insertTouch :: PatchId -> FileId -> State PatchIndex ()
insertTouch PatchId
pid FileId
fid = (PatchIndex -> PatchIndex) -> State PatchIndex ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind {infom=M.alter alt fid (infom pind)})
  where alt :: Maybe FileInfo -> Maybe FileInfo
alt Maybe FileInfo
Nothing =  FilePath -> Maybe FileInfo
forall a. HasCallStack => FilePath -> a
error FilePath
"impossible: Fileid does not exist"
        alt (Just (FileInfo Bool
isF IntSet
pids)) = FileInfo -> Maybe FileInfo
forall a. a -> Maybe a
Just (Bool -> IntSet -> FileInfo
FileInfo Bool
isF (Key -> IntSet -> IntSet
I.insert (PatchId -> Key
short PatchId
pid) IntSet
pids))

-- | insert touching patchid for the parents of a given path
insertParentsTouch :: PatchId -> AnchoredPath -> PIM ()
insertParentsTouch :: PatchId -> AnchoredPath -> State PatchIndex ()
insertParentsTouch PatchId
pid AnchoredPath
path =
  [AnchoredPath]
-> (AnchoredPath -> State PatchIndex ()) -> State PatchIndex ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((AnchoredPath -> Bool) -> [AnchoredPath] -> [AnchoredPath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (AnchoredPath -> Bool) -> AnchoredPath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredPath -> Bool
isRoot) (AnchoredPath -> [AnchoredPath]
parents AnchoredPath
path)) ((AnchoredPath -> State PatchIndex ()) -> State PatchIndex ())
-> (AnchoredPath -> State PatchIndex ()) -> State PatchIndex ()
forall a b. (a -> b) -> a -> b
$
    AnchoredPath -> PIM FileId
lookupFid (AnchoredPath -> PIM FileId)
-> (FileId -> State PatchIndex ())
-> AnchoredPath
-> State PatchIndex ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> PatchId -> FileId -> State PatchIndex ()
insertTouch PatchId
pid

-- | lookup current fid of filepath
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 -> FilePath -> PIM FileId
forall a. HasCallStack => FilePath -> a
error (FilePath -> PIM FileId) -> FilePath -> PIM FileId
forall a b. (a -> b) -> a -> b
$ FilePath
"couldn't find " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> FilePath
displayPath AnchoredPath
fn FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" in patch index"
        Just FileId
fid -> FileId -> PIM FileId
forall a. a -> StateT PatchIndex Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return FileId
fid

-- | lookup current fid of filepatch, returning a Maybe to allow failure
lookupFid' :: AnchoredPath -> PIM (Maybe FileId)
lookupFid' :: AnchoredPath -> PIM (Maybe FileId)
lookupFid' AnchoredPath
fn = do
   FileIdSpans
fidm <- (PatchIndex -> FileIdSpans)
-> StateT PatchIndex Identity FileIdSpans
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PatchIndex -> FileIdSpans
fidspans
   case AnchoredPath -> FileIdSpans -> Maybe [FileIdSpan]
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]
_) -> Maybe FileId -> PIM (Maybe FileId)
forall a. a -> StateT PatchIndex Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FileId -> PIM (Maybe FileId))
-> Maybe FileId -> PIM (Maybe FileId)
forall a b. (a -> b) -> a -> b
$ FileId -> Maybe FileId
forall a. a -> Maybe a
Just FileId
fid
    Maybe [FileIdSpan]
_ -> Maybe FileId -> PIM (Maybe FileId)
forall a. a -> StateT PatchIndex Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FileId
forall a. Maybe a
Nothing


-- | Creates patch index that corresponds to all patches in repo.
createPatchIndexDisk
  :: (RepoPatch p, ApplyState p ~ Tree)
  => Repository rt p wU wR
  -> PatchSet p Origin wR
  -> IO ()
createPatchIndexDisk :: forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> PatchSet p Origin wR -> IO ()
createPatchIndexDisk Repository rt p wU wR
repository PatchSet p Origin wR
ps = do
  let patches :: [Sealed2 (PatchInfoAnd p)]
patches = (forall wW wZ. PatchInfoAnd p wW wZ -> Sealed2 (PatchInfoAnd p))
-> FL (PatchInfoAnd p) Origin wR -> [Sealed2 (PatchInfoAnd p)]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL PatchInfoAnd p wW wZ -> Sealed2 (PatchInfoAnd p)
forall wW wZ. PatchInfoAnd p wW wZ -> Sealed2 (PatchInfoAnd p)
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
Sealed2 (FL (PatchInfoAnd p) Origin wR -> [Sealed2 (PatchInfoAnd p)])
-> FL (PatchInfoAnd p) Origin wR -> [Sealed2 (PatchInfoAnd p)]
forall a b. (a -> b) -> a -> b
$ FilePath
-> FL (PatchInfoAnd p) Origin wR -> FL (PatchInfoAnd p) Origin wR
forall (a :: * -> * -> *) wX wY.
FilePath -> FL a wX wY -> FL a wX wY
progressFL FilePath
"Create patch index" (FL (PatchInfoAnd p) Origin wR -> FL (PatchInfoAnd p) Origin wR)
-> FL (PatchInfoAnd p) Origin wR -> FL (PatchInfoAnd p) 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
ps
  Repository rt p wU wR
-> [(PatchId, [FileMod AnchoredPath])] -> IO ()
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR
-> [(PatchId, [FileMod AnchoredPath])] -> IO ()
createPatchIndexFrom Repository rt p wU wR
repository ([(PatchId, [FileMod AnchoredPath])] -> IO ())
-> [(PatchId, [FileMod AnchoredPath])] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Sealed2 (PatchInfoAnd p)]
-> Set AnchoredPath -> [(PatchId, [FileMod AnchoredPath])]
forall (p :: * -> * -> *).
(Apply p, PatchInspect p, ApplyState p ~ Tree) =>
[Sealed2 (PatchInfoAnd p)]
-> Set AnchoredPath -> [(PatchId, [FileMod AnchoredPath])]
patches2fileMods [Sealed2 (PatchInfoAnd p)]
patches Set AnchoredPath
forall a. Set a
S.empty

-- | convert patches to patchmods
patches2fileMods :: (Apply p, PatchInspect p, ApplyState p ~ Tree)
                  => [Sealed2 (PatchInfoAnd p)] -> Set AnchoredPath -> [(PatchId, [FileMod AnchoredPath])]
patches2fileMods :: forall (p :: * -> * -> *).
(Apply p, PatchInspect p, ApplyState p ~ Tree) =>
[Sealed2 (PatchInfoAnd p)]
-> Set AnchoredPath -> [(PatchId, [FileMod AnchoredPath])]
patches2fileMods [Sealed2 (PatchInfoAnd p)]
patches Set AnchoredPath
fns = (Set AnchoredPath, [(PatchId, [FileMod AnchoredPath])])
-> [(PatchId, [FileMod AnchoredPath])]
forall a b. (a, b) -> b
snd ((Set AnchoredPath, [(PatchId, [FileMod AnchoredPath])])
 -> [(PatchId, [FileMod AnchoredPath])])
-> (Set AnchoredPath, [(PatchId, [FileMod AnchoredPath])])
-> [(PatchId, [FileMod AnchoredPath])]
forall a b. (a -> b) -> a -> b
$ (Set AnchoredPath
 -> Sealed2 (PatchInfoAnd p)
 -> (Set AnchoredPath, (PatchId, [FileMod AnchoredPath])))
-> Set AnchoredPath
-> [Sealed2 (PatchInfoAnd p)]
-> (Set AnchoredPath, [(PatchId, [FileMod AnchoredPath])])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Set AnchoredPath
-> Sealed2 (PatchInfoAnd p)
-> (Set AnchoredPath, (PatchId, [FileMod AnchoredPath]))
forall {p :: * -> * -> *}.
(ApplyState p ~ Tree, PatchInspect p, Apply p) =>
Set AnchoredPath
-> Sealed2 (PatchInfoAndG p)
-> (Set AnchoredPath, (PatchId, [FileMod AnchoredPath]))
go Set AnchoredPath
fns [Sealed2 (PatchInfoAnd p)]
patches
  where
    go :: Set AnchoredPath
-> Sealed2 (PatchInfoAndG p)
-> (Set AnchoredPath, (PatchId, [FileMod AnchoredPath]))
go Set AnchoredPath
filenames (Sealed2 PatchInfoAndG p wX wY
p) = (Set AnchoredPath
filenames', (PatchId
pid, [FileMod AnchoredPath]
pmods_effect [FileMod AnchoredPath]
-> [FileMod AnchoredPath] -> [FileMod AnchoredPath]
forall a. [a] -> [a] -> [a]
++ [FileMod AnchoredPath]
pmods_dup))
      where pid :: PatchId
pid = PatchInfo -> PatchId
makePatchID (PatchInfo -> PatchId)
-> (PatchInfoAndG p wX wY -> PatchInfo)
-> PatchInfoAndG p wX wY
-> PatchId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAndG p wX wY -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info (PatchInfoAndG p wX wY -> PatchId)
-> PatchInfoAndG p wX wY -> PatchId
forall a b. (a -> b) -> a -> b
$ PatchInfoAndG p wX wY
p
            (Set AnchoredPath
filenames', [FileMod AnchoredPath]
pmods_effect) = PatchInfoAndG p wX wY
-> Set AnchoredPath -> (Set AnchoredPath, [FileMod AnchoredPath])
forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY
-> Set AnchoredPath -> (Set AnchoredPath, [FileMod AnchoredPath])
applyToFileMods PatchInfoAndG p wX wY
p Set AnchoredPath
filenames
            -- applyToFileMods only returns patchmods that actually modify a file,
            -- i.e., never duplicate patches
            touched :: FileMod a -> [a]
touched FileMod a
pm = case FileMod 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]; FileMod a
_ -> []}
            touched_all :: [AnchoredPath]
touched_all = PatchInfoAndG p wX wY -> [AnchoredPath]
forall wX wY. PatchInfoAndG p wX wY -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles PatchInfoAndG p wX wY
p
            touched_effect :: [AnchoredPath]
touched_effect = (FileMod AnchoredPath -> [AnchoredPath])
-> [FileMod AnchoredPath] -> [AnchoredPath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FileMod AnchoredPath -> [AnchoredPath]
forall {a}. FileMod a -> [a]
touched [FileMod AnchoredPath]
pmods_effect
            -- listTouchedFiles returns all files that touched by these
            --  patches, even if they have no effect, e.g. by duplicate patches
            pmods_dup :: [FileMod AnchoredPath]
pmods_dup = (AnchoredPath -> FileMod AnchoredPath)
-> [AnchoredPath] -> [FileMod AnchoredPath]
forall a b. (a -> b) -> [a] -> [b]
map AnchoredPath -> FileMod AnchoredPath
forall a. a -> FileMod a
PDuplicateTouch ([AnchoredPath] -> [FileMod AnchoredPath])
-> (Set AnchoredPath -> [AnchoredPath])
-> Set AnchoredPath
-> [FileMod AnchoredPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set AnchoredPath -> [AnchoredPath]
forall a. Set a -> [a]
S.elems
                            (Set AnchoredPath -> [FileMod AnchoredPath])
-> Set AnchoredPath -> [FileMod AnchoredPath]
forall a b. (a -> b) -> a -> b
$ Set AnchoredPath -> Set AnchoredPath -> Set AnchoredPath
forall a. Ord a => Set a -> Set a -> Set a
S.difference ([AnchoredPath] -> Set AnchoredPath
forall a. Ord a => [a] -> Set a
S.fromList [AnchoredPath]
touched_all)
                                           ([AnchoredPath] -> Set AnchoredPath
forall a. Ord a => [a] -> Set a
S.fromList [AnchoredPath]
touched_effect)

-- | return set of current filenames in patch index
fpSpans2fileNames :: FilePathSpans -> Set AnchoredPath
fpSpans2fileNames :: FilePathSpans -> Set AnchoredPath
fpSpans2fileNames FilePathSpans
fpSpans =
  [AnchoredPath] -> Set AnchoredPath
forall a. Ord a => [a] -> Set a
S.fromList [AnchoredPath
fn | (FpSpan AnchoredPath
fn PatchId
_ Maybe PatchId
Nothing:[FilePathSpan]
_)<- FilePathSpans -> [[FilePathSpan]]
forall k a. Map k a -> [a]
M.elems FilePathSpans
fpSpans]

-- | remove all patch effects of given patches from patch index.
--   assumes that the given list of patches is a suffix of the
--   patches tracked by the patch-index
removePidSuffix :: Map PatchId Int -> [PatchId] -> PatchIndex -> PatchIndex
removePidSuffix :: Map PatchId Key -> [PatchId] -> PatchIndex -> PatchIndex
removePidSuffix Map PatchId Key
_ [] PatchIndex
pindex = PatchIndex
pindex
removePidSuffix Map PatchId Key
pid2idx oldpids :: [PatchId]
oldpids@(PatchId
oldpid:[PatchId]
_) (PatchIndex [PatchId]
pids FileIdSpans
fidspans FilePathSpans
fpspans InfoMap
infom) =
    [PatchId] -> FileIdSpans -> FilePathSpans -> InfoMap -> PatchIndex
PatchIndex ([PatchId]
pids [PatchId] -> [PatchId] -> [PatchId]
forall a. Eq a => [a] -> [a] -> [a]
\\ [PatchId]
oldpids)
               (([FileIdSpan] -> Maybe [FileIdSpan]) -> FileIdSpans -> FileIdSpans
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
M.mapMaybe [FileIdSpan] -> Maybe [FileIdSpan]
forall {t :: * -> *}.
Foldable t =>
t FileIdSpan -> Maybe [FileIdSpan]
removefid FileIdSpans
fidspans)
               (([FilePathSpan] -> Maybe [FilePathSpan])
-> FilePathSpans -> FilePathSpans
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
M.mapMaybe [FilePathSpan] -> Maybe [FilePathSpan]
forall {t :: * -> *}.
Foldable t =>
t FilePathSpan -> Maybe [FilePathSpan]
removefp FilePathSpans
fpspans)
               InfoMap
infom -- leave hashes in infom, false positives are harmless
  where
    findIdx :: PatchId -> Key
findIdx PatchId
pid = Key -> Maybe Key -> Key
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Key
forall a. HasCallStack => FilePath -> a
error FilePath
"impossible case") (PatchId -> Map PatchId Key -> Maybe Key
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PatchId
pid Map PatchId Key
pid2idx)
    oldidx :: Key
oldidx = PatchId -> Key
findIdx PatchId
oldpid
    PatchId
from after :: PatchId -> Key -> Bool
`after` Key
idx = PatchId -> Key
findIdx PatchId
from Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
> Key
idx
    Maybe PatchId
mto afterM :: Maybe PatchId -> Key -> Bool
`afterM` Key
idx | Just PatchId
to <- Maybe PatchId
mto, PatchId -> Key
findIdx PatchId
to Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
> Key
idx = Bool
True
                     | Bool
otherwise = Bool
False
    removefid :: t FileIdSpan -> Maybe [FileIdSpan]
removefid t FileIdSpan
fidsps = if [FileIdSpan] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FileIdSpan]
fidsps' then Maybe [FileIdSpan]
forall a. Maybe a
Nothing else [FileIdSpan] -> Maybe [FileIdSpan]
forall a. a -> Maybe a
Just [FileIdSpan]
fidsps'
      where
        fidsps' :: [FileIdSpan]
fidsps' = (FileIdSpan -> [FileIdSpan]) -> t FileIdSpan -> [FileIdSpan]
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 -> Key -> Bool
`after` Key
oldidx Bool -> Bool -> Bool
&& Maybe PatchId
mto Maybe PatchId -> Key -> Bool
`afterM` Key
oldidx = [FileId -> PatchId -> Maybe PatchId -> FileIdSpan
FidSpan FileId
fid PatchId
from Maybe PatchId
mto]
          | PatchId
from PatchId -> Key -> Bool
`after` Key
oldidx = [FileId -> PatchId -> Maybe PatchId -> FileIdSpan
FidSpan FileId
fid PatchId
from Maybe PatchId
forall a. Maybe a
Nothing]
          | Bool
otherwise = []
    removefp :: t FilePathSpan -> Maybe [FilePathSpan]
removefp t FilePathSpan
fpsps = if [FilePathSpan] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePathSpan]
fpsps' then Maybe [FilePathSpan]
forall a. Maybe a
Nothing else [FilePathSpan] -> Maybe [FilePathSpan]
forall a. a -> Maybe a
Just [FilePathSpan]
fpsps'
      where
        fpsps' :: [FilePathSpan]
fpsps' = (FilePathSpan -> [FilePathSpan])
-> t FilePathSpan -> [FilePathSpan]
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 -> Key -> Bool
`after` Key
oldidx Bool -> Bool -> Bool
&& Maybe PatchId
mto Maybe PatchId -> Key -> Bool
`afterM` Key
oldidx = [AnchoredPath -> PatchId -> Maybe PatchId -> FilePathSpan
FpSpan AnchoredPath
fn PatchId
from Maybe PatchId
mto]
          | PatchId
from PatchId -> Key -> Bool
`after` Key
oldidx = [AnchoredPath -> PatchId -> Maybe PatchId -> FilePathSpan
FpSpan AnchoredPath
fn PatchId
from Maybe PatchId
forall a. Maybe a
Nothing]
          | Bool
otherwise = []

-- | update the patch index to the current state of the repository
updatePatchIndexDisk
    :: (RepoPatch p, ApplyState p ~ Tree)
    => Repository rt p wU wR
    -> PatchSet p Origin wR
    -> IO ()
updatePatchIndexDisk :: forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> PatchSet p Origin wR -> IO ()
updatePatchIndexDisk Repository rt p wU wR
repo PatchSet p Origin wR
patches = do
    let repodir :: FilePath
repodir = Repository rt p wU wR -> FilePath
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> FilePath
repoLocation Repository rt p wU wR
repo
    (Int8
_,FilePath
_,Map PatchId Key
pid2idx,PatchIndex
pindex) <- FilePath -> IO (Int8, FilePath, Map PatchId Key, PatchIndex)
loadPatchIndex FilePath
repodir
    -- check that patch index is up to date
    let flpatches :: FL (PatchInfoAnd p) Origin wR
flpatches = FilePath
-> FL (PatchInfoAnd p) Origin wR -> FL (PatchInfoAnd p) Origin wR
forall (a :: * -> * -> *) wX wY.
FilePath -> FL a wX wY -> FL a wX wY
progressFL FilePath
"Update patch index" (FL (PatchInfoAnd p) Origin wR -> FL (PatchInfoAnd p) Origin wR)
-> FL (PatchInfoAnd p) Origin wR -> FL (PatchInfoAnd p) 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
patches
    let pidsrepo :: [PatchId]
pidsrepo = (forall wW wZ. PatchInfoAnd p wW wZ -> PatchId)
-> FL (PatchInfoAnd p) Origin wR -> [PatchId]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (PatchInfo -> PatchId
makePatchID (PatchInfo -> PatchId)
-> (PatchInfoAnd p wW wZ -> PatchInfo)
-> PatchInfoAnd p wW wZ
-> PatchId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAnd p wW wZ -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info) FL (PatchInfoAnd p) Origin wR
flpatches
        ([PatchId]
oldpids,[PatchId]
_,Key
len_common) = [PatchId] -> [PatchId] -> ([PatchId], [PatchId], Key)
uncommon ([PatchId] -> [PatchId]
forall a. [a] -> [a]
reverse ([PatchId] -> [PatchId]) -> [PatchId] -> [PatchId]
forall a b. (a -> b) -> a -> b
$ PatchIndex -> [PatchId]
pids PatchIndex
pindex) [PatchId]
pidsrepo
        pindex' :: PatchIndex
pindex' = Map PatchId Key -> [PatchId] -> PatchIndex -> PatchIndex
removePidSuffix Map PatchId Key
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
    -- reread to prevent holding onto patches for too long
    let newpatches :: [Sealed2 (PatchInfoAnd p)]
newpatches = Key -> [Sealed2 (PatchInfoAnd p)] -> [Sealed2 (PatchInfoAnd p)]
forall a. Key -> [a] -> [a]
drop Key
len_common ([Sealed2 (PatchInfoAnd p)] -> [Sealed2 (PatchInfoAnd p)])
-> [Sealed2 (PatchInfoAnd p)] -> [Sealed2 (PatchInfoAnd p)]
forall a b. (a -> b) -> a -> b
$ (forall wW wZ. PatchInfoAnd p wW wZ -> Sealed2 (PatchInfoAnd p))
-> FL (PatchInfoAnd p) Origin wR -> [Sealed2 (PatchInfoAnd p)]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL PatchInfoAnd p wW wZ -> Sealed2 (PatchInfoAnd p)
forall wW wZ. PatchInfoAnd p wW wZ -> Sealed2 (PatchInfoAnd p)
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
seal2 FL (PatchInfoAnd p) Origin wR
flpatches
        newpmods :: [(PatchId, [FileMod AnchoredPath])]
newpmods = [Sealed2 (PatchInfoAnd p)]
-> Set AnchoredPath -> [(PatchId, [FileMod AnchoredPath])]
forall (p :: * -> * -> *).
(Apply p, PatchInspect p, ApplyState p ~ Tree) =>
[Sealed2 (PatchInfoAnd p)]
-> Set AnchoredPath -> [(PatchId, [FileMod AnchoredPath])]
patches2fileMods [Sealed2 (PatchInfoAnd 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, [FileMod AnchoredPath])] -> PatchIndex -> PatchIndex
applyPatchMods [(PatchId, [FileMod AnchoredPath])]
newpmods PatchIndex
pindex')
  where
    -- return uncommon suffixes and length of common prefix of as and bs
    uncommon :: [PatchId] -> [PatchId] -> ([PatchId], [PatchId], Key)
uncommon = Key -> [PatchId] -> [PatchId] -> ([PatchId], [PatchId], Key)
forall {a} {c}. (Eq a, Num c) => c -> [a] -> [a] -> ([a], [a], c)
uncommon' Key
0
    uncommon' :: c -> [a] -> [a] -> ([a], [a], c)
uncommon' c
x (a
a:[a]
as) (a
b:[a]
bs)
      | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b     = c -> [a] -> [a] -> ([a], [a], c)
uncommon' (c
xc -> c -> c
forall a. Num a => a -> a -> a
+c
1) [a]
as [a]
bs
      | Bool
otherwise  =  (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as,a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
bs,c
x)
    uncommon' c
x [a]
as [a]
bs = ([a]
as,[a]
bs,c
x)

-- | 'createPatchIndexFrom repo pmods' creates a patch index from the given
--   patchmods.
createPatchIndexFrom :: Repository rt p wU wR
                     -> [(PatchId, [FileMod AnchoredPath])] -> IO ()
createPatchIndexFrom :: forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR
-> [(PatchId, [FileMod AnchoredPath])] -> IO ()
createPatchIndexFrom Repository rt p wU wR
repo [(PatchId, [FileMod AnchoredPath])]
pmods = do
    FilePath
inv_hash <- FilePath -> IO FilePath
getInventoryHash FilePath
repodir
    FilePath -> FilePath -> PatchIndex -> IO ()
storePatchIndex FilePath
cdir FilePath
inv_hash ([(PatchId, [FileMod AnchoredPath])] -> PatchIndex -> PatchIndex
applyPatchMods [(PatchId, [FileMod AnchoredPath])]
pmods PatchIndex
emptyPatchIndex)
  where repodir :: FilePath
repodir = Repository rt p wU wR -> FilePath
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> FilePath
repoLocation Repository rt p wU wR
repo
        cdir :: FilePath
cdir = FilePath
repodir FilePath -> ShowS
</> FilePath
indexDir
        emptyPatchIndex :: PatchIndex
emptyPatchIndex = [PatchId] -> FileIdSpans -> FilePathSpans -> InfoMap -> PatchIndex
PatchIndex [] FileIdSpans
forall k a. Map k a
M.empty FilePathSpans
forall k a. Map k a
M.empty InfoMap
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
hashedInventoryPath)
  FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
sha256sum ByteString
inv

-- | Load patch-index from disk along with some meta data.
loadPatchIndex :: FilePath -> IO (Int8, String, Map PatchId Int, PatchIndex)
loadPatchIndex :: FilePath -> IO (Int8, FilePath, Map PatchId Key, 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 Key
pid2idx  = [(PatchId, Key)] -> Map PatchId Key
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PatchId, Key)] -> Map PatchId Key)
-> [(PatchId, Key)] -> Map PatchId Key
forall a b. (a -> b) -> a -> b
$ [PatchId] -> [Key] -> [(PatchId, Key)]
forall a b. [a] -> [b] -> [(a, b)]
zip [PatchId]
pids [(Key
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)
  (Int8, FilePath, Map PatchId Key, PatchIndex)
-> IO (Int8, FilePath, Map PatchId Key, PatchIndex)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8
v, FilePath
inv_hash, Map PatchId Key
pid2idx, [PatchId] -> FileIdSpans -> FilePathSpans -> InfoMap -> PatchIndex
PatchIndex [PatchId]
pids FileIdSpans
fidspans FilePathSpans
fpspans InfoMap
infom)

-- | If patch-index is useful as it is now, read it. If not, create or update it, then read it.
loadSafePatchIndex :: (RepoPatch p, ApplyState p ~ Tree)
                   => Repository rt p wU wR
                   -> PatchSet p Origin wR     -- ^ PatchSet of the repository, used if we need to create the patch-index.
                   -> IO PatchIndex
loadSafePatchIndex :: forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> PatchSet p Origin wR -> IO PatchIndex
loadSafePatchIndex Repository rt p wU wR
repo PatchSet p Origin wR
ps = do
   let repodir :: FilePath
repodir = Repository rt p wU wR -> FilePath
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> FilePath
repoLocation Repository rt p wU wR
repo
   Bool
can_use <- Repository rt p wU wR -> IO Bool
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO Bool
isPatchIndexInSync Repository rt p wU wR
repo
   (Int8
_,FilePath
_,Map PatchId Key
_,PatchIndex
pi) <-
     if Bool
can_use
       then do
          FilePath -> IO ()
debugMessage FilePath
"Loading patch index..."
          (Int8, FilePath, Map PatchId Key, PatchIndex)
r <- FilePath -> IO (Int8, FilePath, Map PatchId Key, PatchIndex)
loadPatchIndex FilePath
repodir
          FilePath -> IO ()
debugMessage FilePath
"Done."
          (Int8, FilePath, Map PatchId Key, PatchIndex)
-> IO (Int8, FilePath, Map PatchId Key, PatchIndex)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8, FilePath, Map PatchId Key, PatchIndex)
r
       else do Repository rt p wU wR -> PatchSet p Origin wR -> IO ()
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> PatchSet p Origin wR -> IO ()
createOrUpdatePatchIndexDisk Repository rt p wU wR
repo PatchSet p Origin wR
ps
               FilePath -> IO (Int8, FilePath, Map PatchId Key, PatchIndex)
loadPatchIndex FilePath
repodir
   PatchIndex -> IO PatchIndex
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PatchIndex
pi

-- | Read-only. Checks if patch-index exists for this repository
--   it works by checking if:
--
--     1. @_darcs\/patch_index\/@ and its corresponding files are all present
--     2. patch index version is the one handled by this version of Darcs
doesPatchIndexExist :: FilePath -> IO Bool
doesPatchIndexExist :: FilePath -> IO Bool
doesPatchIndexExist FilePath
repodir = do
 Bool
filesArePresent <- [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> IO [Bool] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO Bool) -> [FilePath] -> IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> ShowS -> FilePath -> IO Bool
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
          Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8
v Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
version)   -- consider PI only of on-disk format is the current one
  else Bool -> IO Bool
forall a. a -> IO a
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 = (Int8, FilePath) -> Int8
forall a b. (a, b) -> a
fst ((Int8, FilePath) -> Int8) -> IO (Int8, FilePath) -> IO Int8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Int8, FilePath)
loadRepoState (FilePath
pindex_dir FilePath -> ShowS
</> FilePath
repoStateFile)

-- | Read-only. Checks if @_darcs\/noPatchIndex@ exists, that is, if patch-index is explicitely disabled.
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)

-- | Create or update patch index
--
--   1. if @_darcs\/no_patch_index@ exists, delete it
--   2. if patch index exists, update it
--   3. if not, create it from scratch
createOrUpdatePatchIndexDisk :: (RepoPatch p, ApplyState p ~ Tree)
                             => Repository rt p wU wR -> PatchSet p Origin wR -> IO ()
createOrUpdatePatchIndexDisk :: forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> PatchSet p Origin wR -> IO ()
createOrUpdatePatchIndexDisk Repository rt p wU wR
repo PatchSet p Origin wR
ps = do
   FilePath -> IO ()
debugMessage FilePath
"createOrUpdatePatchIndexDisk: start"
   let repodir :: FilePath
repodir = Repository rt p wU wR -> FilePath
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> FilePath
repoLocation Repository rt p wU wR
repo
   FilePath -> IO ()
removeFile (FilePath
repodir FilePath -> ShowS
</> FilePath
darcsdir FilePath -> ShowS
</> FilePath
noPatchIndex) IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOError
_ :: IOError) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
   Bool
dpie <- FilePath -> IO Bool
doesPatchIndexExist FilePath
repodir
   if Bool
dpie
      then Repository rt p wU wR -> PatchSet p Origin wR -> IO ()
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> PatchSet p Origin wR -> IO ()
updatePatchIndexDisk Repository rt p wU wR
repo PatchSet p Origin wR
ps
      else Repository rt p wU wR -> PatchSet p Origin wR -> IO ()
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> PatchSet p Origin wR -> IO ()
createPatchIndexDisk Repository rt p wU wR
repo PatchSet p Origin wR
ps
   FilePath -> IO ()
debugMessage FilePath
"createOrUpdatePatchIndexDisk: done"

-- | Read-only. Checks the two following things:
--
--   1. 'doesPatchIndexExist'
--   2. 'isPatchIndexDisabled'
--
-- Then only if it exists and it is not explicitely disabled, returns @True@, else returns @False@
-- (or an error if it exists and is explicitely disabled at the same time).
canUsePatchIndex :: Repository rt p wU wR -> IO Bool
canUsePatchIndex :: forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO Bool
canUsePatchIndex Repository rt p wU wR
repo = do
     let repodir :: FilePath
repodir = Repository rt p wU wR -> FilePath
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> FilePath
repoLocation Repository rt p wU wR
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) -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        (Bool
False, Bool
True) -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        (Bool
True, Bool
True) -> FilePath -> IO Bool
forall a. FilePath -> IO a
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) -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Creates patch-index (ignoring whether it is explicitely disabled).
--   If it is ctrl-c'ed, then aborts, delete patch-index and mark it as disabled.
createPIWithInterrupt :: (RepoPatch p, ApplyState p ~ Tree)
                      => Repository rt p wU wR -> PatchSet p Origin wR -> IO ()
createPIWithInterrupt :: forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> PatchSet p Origin wR -> IO ()
createPIWithInterrupt Repository rt p wU wR
repo PatchSet p Origin wR
ps = do
    let repodir :: FilePath
repodir = Repository rt p wU wR -> FilePath
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> FilePath
repoLocation Repository rt p wU wR
repo
    FilePath -> IO ()
putStrLn FilePath
"Creating a patch index, please wait. To stop press Ctrl-C"
    (do
      Repository rt p wU wR -> PatchSet p Origin wR -> IO ()
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> PatchSet p Origin wR -> IO ()
createPatchIndexDisk Repository rt p wU wR
repo PatchSet p Origin wR
ps
      FilePath -> IO ()
putStrLn FilePath
"Created patch index.") IO () -> IO () -> IO ()
forall a. IO a -> IO a -> IO a
`catchInterrupt` (FilePath -> IO ()
putStrLn FilePath
"Patch Index Disabled" IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
deletePatchIndex FilePath
repodir)

-- | Checks if patch-index exists and is in sync with repository.
--   That is, checks if patch-index can be used as it is now.
isPatchIndexInSync :: Repository rt p wU wR -> IO Bool
isPatchIndexInSync :: forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO Bool
isPatchIndexInSync Repository rt p wU wR
repo = do
   let repodir :: FilePath
repodir = Repository rt p wU wR -> FilePath
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> FilePath
repoLocation Repository rt p wU wR
repo
   Bool
dpie <- FilePath -> IO Bool
doesPatchIndexExist FilePath
repodir
   if Bool
dpie
    then do
      (Int8
_, FilePath
inv_hash_pindex, Map PatchId Key
_, PatchIndex
_) <- FilePath -> IO (Int8, FilePath, Map PatchId Key, PatchIndex)
loadPatchIndex FilePath
repodir
      FilePath
inv_hash <- FilePath -> IO FilePath
getInventoryHash FilePath
repodir
      Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
inv_hash FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
inv_hash_pindex)
    else Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Stores patch-index on disk.
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 IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOError
_ :: IOError) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  FilePath
tmpdir <- FilePath -> (AbsolutePath -> IO FilePath) -> IO FilePath
forall a. FilePath -> (AbsolutePath -> IO a) -> IO a
withPermDir FilePath
cdir ((AbsolutePath -> IO FilePath) -> IO FilePath)
-> (AbsolutePath -> IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \AbsolutePath
dir -> do
              FilePath -> IO ()
debugMessage FilePath
"About to create patch index..."
              let tmpdir :: FilePath
tmpdir = AbsolutePath -> FilePath
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"
              FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
tmpdir
  FilePath -> IO ()
removeDirectoryRecursive FilePath
cdir IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOError
_ :: IOError) -> () -> IO ()
forall a. a -> IO a
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 <- FilePath -> IO (Either (ByteOffset, FilePath) a)
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) ->
      FilePath -> IO a
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO a) -> FilePath -> IO a
forall a b. (a -> b) -> a -> b
$
        FilePath
"Patch index is corrupt (file "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
pathFilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
" at offset "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ByteOffset -> FilePath
forall a. Show a => a -> FilePath
show ByteOffset
offsetFilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
"): "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
msgFilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
        FilePath
"\nPlease remove the corrupt file and then try again."
    Right a
r -> a -> IO a
forall a. a -> IO a
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 = FilePath -> (Int8, FilePath) -> IO ()
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 = FilePath -> IO (Int8, FilePath)
forall a. Binary a => FilePath -> IO a
decodeFile

storePatchIds :: FilePath -> [PatchId] -> IO ()
storePatchIds :: FilePath -> [PatchId] -> IO ()
storePatchIds = FilePath -> [PatchId] -> IO ()
forall a. Binary a => FilePath -> a -> IO ()
encodeFile

loadPatchIds :: FilePath -> IO [PatchId]
loadPatchIds :: FilePath -> IO [PatchId]
loadPatchIds = FilePath -> IO [PatchId]
forall a. Binary a => FilePath -> IO a
decodeFile

storeFidMap :: FilePath -> FileIdSpans -> IO ()
storeFidMap :: FilePath -> FileIdSpans -> IO ()
storeFidMap FilePath
fp FileIdSpans
fidm =
  FilePath -> Map AnchoredPath [(FileId, PatchId, PatchId)] -> IO ()
forall a. Binary a => FilePath -> a -> IO ()
encodeFile FilePath
fp (Map AnchoredPath [(FileId, PatchId, PatchId)] -> IO ())
-> Map AnchoredPath [(FileId, PatchId, PatchId)] -> IO ()
forall a b. (a -> b) -> a -> b
$ ([FileIdSpan] -> [(FileId, PatchId, PatchId)])
-> FileIdSpans -> Map AnchoredPath [(FileId, PatchId, PatchId)]
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((FileIdSpan -> (FileId, PatchId, PatchId))
-> [FileIdSpan] -> [(FileId, PatchId, PatchId)]
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 = ([(FileId, PatchId, PatchId)] -> [FileIdSpan])
-> Map AnchoredPath [(FileId, PatchId, PatchId)] -> FileIdSpans
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (((FileId, PatchId, PatchId) -> FileIdSpan)
-> [(FileId, PatchId, PatchId)] -> [FileIdSpan]
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))) (Map AnchoredPath [(FileId, PatchId, PatchId)] -> FileIdSpans)
-> IO (Map AnchoredPath [(FileId, PatchId, PatchId)])
-> IO FileIdSpans
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Map AnchoredPath [(FileId, PatchId, PatchId)])
forall a. Binary a => FilePath -> IO a
decodeFile FilePath
fp
  where toPidM :: PatchId -> Maybe PatchId
toPidM PatchId
pid | PatchId
pid PatchId -> PatchId -> Bool
forall a. Eq a => a -> a -> Bool
== PatchId
zero = Maybe PatchId
forall a. Maybe a
Nothing
                   | Bool
otherwise   = PatchId -> Maybe PatchId
forall a. a -> Maybe a
Just PatchId
pid

storeFpMap :: FilePath -> FilePathSpans -> IO ()
storeFpMap :: FilePath -> FilePathSpans -> IO ()
storeFpMap FilePath
fp FilePathSpans
fidm =
  FilePath -> Map FileId [(AnchoredPath, PatchId, PatchId)] -> IO ()
forall a. Binary a => FilePath -> a -> IO ()
encodeFile FilePath
fp (Map FileId [(AnchoredPath, PatchId, PatchId)] -> IO ())
-> Map FileId [(AnchoredPath, PatchId, PatchId)] -> IO ()
forall a b. (a -> b) -> a -> b
$ ([FilePathSpan] -> [(AnchoredPath, PatchId, PatchId)])
-> FilePathSpans -> Map FileId [(AnchoredPath, PatchId, PatchId)]
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((FilePathSpan -> (AnchoredPath, PatchId, PatchId))
-> [FilePathSpan] -> [(AnchoredPath, PatchId, PatchId)]
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 = ([(AnchoredPath, PatchId, PatchId)] -> [FilePathSpan])
-> Map FileId [(AnchoredPath, PatchId, PatchId)] -> FilePathSpans
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (((AnchoredPath, PatchId, PatchId) -> FilePathSpan)
-> [(AnchoredPath, PatchId, PatchId)] -> [FilePathSpan]
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))) (Map FileId [(AnchoredPath, PatchId, PatchId)] -> FilePathSpans)
-> IO (Map FileId [(AnchoredPath, PatchId, PatchId)])
-> IO FilePathSpans
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Map FileId [(AnchoredPath, PatchId, PatchId)])
forall a. Binary a => FilePath -> IO a
decodeFile FilePath
fp
  where toPidM :: PatchId -> Maybe PatchId
toPidM PatchId
pid | PatchId
pid PatchId -> PatchId -> Bool
forall a. Eq a => a -> a -> Bool
== PatchId
zero = Maybe PatchId
forall a. Maybe a
Nothing
                   | Bool
otherwise   = PatchId -> Maybe PatchId
forall a. a -> Maybe a
Just PatchId
pid

storeInfoMap :: FilePath -> InfoMap -> IO ()
storeInfoMap :: FilePath -> InfoMap -> IO ()
storeInfoMap FilePath
fp InfoMap
infom =
  FilePath -> Map FileId (Bool, IntSet) -> IO ()
forall a. Binary a => FilePath -> a -> IO ()
encodeFile FilePath
fp (Map FileId (Bool, IntSet) -> IO ())
-> Map FileId (Bool, IntSet) -> IO ()
forall a b. (a -> b) -> a -> b
$ (FileInfo -> (Bool, IntSet))
-> InfoMap -> Map FileId (Bool, IntSet)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\FileInfo
fi -> (FileInfo -> Bool
isFile FileInfo
fi, FileInfo -> IntSet
touching FileInfo
fi)) InfoMap
infom

loadInfoMap :: FilePath -> IO InfoMap
loadInfoMap :: FilePath -> IO InfoMap
loadInfoMap FilePath
fp = ((Bool, IntSet) -> FileInfo)
-> Map FileId (Bool, IntSet) -> InfoMap
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\(Bool
isF,IntSet
pids) -> Bool -> IntSet -> FileInfo
FileInfo Bool
isF IntSet
pids) (Map FileId (Bool, IntSet) -> InfoMap)
-> IO (Map FileId (Bool, IntSet)) -> IO InfoMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Map FileId (Bool, IntSet))
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"

-- | Deletes patch-index (@_darcs\/patch_index\/@ and its contents) and mark repository as disabled (creates @_darcs\/no_patch_index@).
deletePatchIndex :: FilePath -> IO ()
deletePatchIndex :: FilePath -> IO ()
deletePatchIndex FilePath
repodir = do
    Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
indexDir
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
         FilePath -> IO ()
removeDirectoryRecursive FilePath
indexDir
            IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOError
e :: IOError) -> FilePath -> IO ()
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Error: Could not delete patch index\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ IOError -> FilePath
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 IO Handle -> (Handle -> 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
>>= Handle -> IO ()
hClose)
            IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOError
e :: IOError) -> FilePath -> IO ()
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Error: Could not disable patch index\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ IOError -> FilePath
forall a. Show a => a -> FilePath
show IOError
e

dumpRepoState :: [PatchId] -> String
dumpRepoState :: [PatchId] -> FilePath
dumpRepoState = [FilePath] -> FilePath
unlines ([FilePath] -> FilePath)
-> ([PatchId] -> [FilePath]) -> [PatchId] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PatchId -> FilePath) -> [PatchId] -> [FilePath]
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
fnFilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
" -> "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FileId -> FilePath
showFileId FileId
fidFilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
" from "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++PatchId -> FilePath
pid2string PatchId
fromFilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
" to "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath -> (PatchId -> FilePath) -> Maybe PatchId -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"-" PatchId -> FilePath
pid2string Maybe PatchId
mto
           | (AnchoredPath
fn, [FileIdSpan]
fids) <- FileIdSpans -> [(AnchoredPath, [FileIdSpan])]
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
fidFilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
" -> "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> FilePath
displayPath AnchoredPath
fnFilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
" from "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++PatchId -> FilePath
pid2string PatchId
fromFilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
" to "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath -> (PatchId -> FilePath) -> Maybe PatchId -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"-" PatchId -> FilePath
pid2string Maybe PatchId
mto
           | (FileId
fid, [FilePathSpan]
fns) <- FilePathSpans -> [(FileId, [FilePathSpan])]
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
fidFilePath -> ShowS
forall a. [a] -> [a] -> [a]
++(if Bool
isF then FilePath
"" else FilePath
"/")FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
" -> "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> FilePath
showAsHex (Key -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Key
i)
                                | (FileId
fid,FileInfo Bool
isF IntSet
w32s) <- InfoMap -> [(FileId, FileInfo)]
forall k a. Map k a -> [(k, a)]
M.toList InfoMap
infom, Key
i <- IntSet -> [Key]
I.elems IntSet
w32s]

-- | return set of current filepaths in patch index
fpSpans2filePaths :: FilePathSpans -> InfoMap -> [FilePath]
fpSpans2filePaths :: FilePathSpans -> InfoMap -> [FilePath]
fpSpans2filePaths FilePathSpans
fpSpans InfoMap
infom =
  [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [AnchoredPath -> FilePath
displayPath AnchoredPath
fn FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Bool
isF then FilePath
"" else FilePath
"/") | (FileId
fid,FpSpan AnchoredPath
fn PatchId
_ Maybe PatchId
Nothing:[FilePathSpan]
_) <- FilePathSpans -> [(FileId, [FilePathSpan])]
forall k a. Map k a -> [(k, a)]
M.toList FilePathSpans
fpSpans,
                                                let Just (FileInfo Bool
isF IntSet
_) = FileId -> InfoMap -> Maybe FileInfo
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FileId
fid InfoMap
infom]

-- | Checks if patch index can be created and build it with interrupt.
attemptCreatePatchIndex
  :: (RepoPatch p, ApplyState p ~ Tree)
  => Repository rt p wU wR -> PatchSet p Origin wR -> IO ()
attemptCreatePatchIndex :: forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> PatchSet p Origin wR -> IO ()
attemptCreatePatchIndex Repository rt p wU wR
repo PatchSet p Origin wR
ps = do
  Bool
canCreate <- Repository rt p wU wR -> IO Bool
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO Bool
canCreatePI Repository rt p wU wR
repo
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
canCreate (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Repository rt p wU wR -> PatchSet p Origin wR -> IO ()
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> PatchSet p Origin wR -> IO ()
createPIWithInterrupt Repository rt p wU wR
repo PatchSet p Origin wR
ps

-- | Checks whether a patch index can (and should) be created. If we are not in
-- an old-fashioned repo, and if we haven't been told not to, then we should
-- create a patch index if it doesn't already exist.
canCreatePI :: Repository rt p wU wR -> IO Bool
canCreatePI :: forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO Bool
canCreatePI Repository rt p wU wR
repo =
    (Bool -> Bool
not (Bool -> Bool) -> ([Bool] -> Bool) -> [Bool] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or) ([Bool] -> Bool) -> IO [Bool] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IO Bool] -> IO [Bool]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [ RepoFormat -> IO Bool
doesntHaveHashedInventory (Repository rt p wU wR -> RepoFormat
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> RepoFormat
repoFormat Repository rt p wU wR
repo)
                            , FilePath -> IO Bool
isPatchIndexDisabled FilePath
repodir
                            , FilePath -> IO Bool
doesPatchIndexExist FilePath
repodir
                            ]
  where
    repodir :: FilePath
repodir = Repository rt p wU wR -> FilePath
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> FilePath
repoLocation Repository rt p wU wR
repo
    doesntHaveHashedInventory :: RepoFormat -> IO Bool
doesntHaveHashedInventory = Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> (RepoFormat -> Bool) -> RepoFormat -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (RepoFormat -> Bool) -> RepoFormat -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory

-- | Returns an RL in which the order of patches matters. Useful for the
-- @annotate@ command. If patch-index does not exist and is not explicitely
-- disabled, silently create it. (Also, if it is out-of-sync, which should not
-- happen, silently update it).
getRelevantSubsequence
    :: (RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd p)
    => Sealed ((RL a) wK)
    -- ^ Sequence of patches you want to filter
    -> Repository rt p wU wR
    -- ^ The repository (to attempt loading patch-index from its path)
    -> PatchSet p Origin wR
    -- ^ PatchSet of repository (in case we need to create patch-index)
    -> [AnchoredPath]
    -- ^ File(s) about which you want patches from given sequence
    -> IO (Sealed ((RL a) Origin))
    -- ^ Filtered sequence of patches
getRelevantSubsequence :: forall (p :: * -> * -> *) (a :: * -> * -> *) wK (rt :: AccessType)
       wU wR.
(RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd p) =>
Sealed (RL a wK)
-> Repository rt p wU wR
-> PatchSet p Origin wR
-> [AnchoredPath]
-> IO (Sealed (RL a Origin))
getRelevantSubsequence Sealed (RL a wK)
pxes Repository rt p wU wR
repository PatchSet p Origin wR
ps [AnchoredPath]
fns = do
    pi :: PatchIndex
pi@(PatchIndex [PatchId]
_ FileIdSpans
_ FilePathSpans
_ InfoMap
infom) <- Repository rt p wU wR -> PatchSet p Origin wR -> IO PatchIndex
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> PatchSet p Origin wR -> IO PatchIndex
loadSafePatchIndex Repository rt p wU wR
repository PatchSet p Origin wR
ps
    let fids :: [FileId]
fids = (AnchoredPath -> FileId) -> [AnchoredPath] -> [FileId]
forall a b. (a -> b) -> [a] -> [b]
map (\AnchoredPath
fn -> PIM FileId -> PatchIndex -> FileId
forall s a. State s a -> s -> a
evalState (AnchoredPath -> PIM FileId
lookupFid AnchoredPath
fn) PatchIndex
pi) [AnchoredPath]
fns
        pidss :: [IntSet]
pidss = (FileId -> IntSet) -> [FileId] -> [IntSet]
forall a b. (a -> b) -> [a] -> [b]
map ((\(FileInfo Bool
_ IntSet
a) -> IntSet
a) (FileInfo -> IntSet) -> (FileId -> FileInfo) -> FileId -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FileInfo -> FileInfo
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe FileInfo -> FileInfo)
-> (FileId -> Maybe FileInfo) -> FileId -> FileInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileId -> InfoMap -> Maybe FileInfo
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` InfoMap
infom)) [FileId]
fids
        pids :: IntSet
pids = [IntSet] -> IntSet
forall (f :: * -> *). Foldable f => f IntSet -> IntSet
I.unions [IntSet]
pidss
    let flpxes :: FL a wK wZ
flpxes = RL a wK wZ -> FL a wK wZ
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL (RL a wK wZ -> FL a wK wZ) -> RL a wK wZ -> FL a wK wZ
forall a b. (a -> b) -> a -> b
$ (forall wX. RL a wK wX -> RL a wK wZ)
-> Sealed (RL a wK) -> RL a wK wZ
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal RL a wK wX -> RL a wK wZ
forall wX. RL a wK wX -> RL a wK wZ
forall (a :: * -> * -> *) wX wY1 wY2. a wX wY1 -> a wX wY2
unsafeCoercePEnd Sealed (RL a wK)
pxes
    Sealed (RL a Origin) -> IO (Sealed (RL a Origin))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RL a Origin) -> IO (Sealed (RL a Origin)))
-> (RL a Origin Any -> Sealed (RL a Origin))
-> RL a Origin Any
-> IO (Sealed (RL a Origin))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RL a Origin Any -> Sealed (RL a Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (RL a Origin Any -> IO (Sealed (RL a Origin)))
-> RL a Origin Any -> IO (Sealed (RL a Origin))
forall a b. (a -> b) -> a -> b
$ FL a wK Any -> RL a wK wK -> IntSet -> RL a Origin Any
forall (p :: * -> * -> *) (a :: * -> * -> *) wX wY wB wP wQ.
(RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd p) =>
FL a wX wY -> RL a wB wX -> IntSet -> RL a wP wQ
keepElems FL a wK Any
forall {wZ}. FL a wK wZ
flpxes RL a wK wK
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL IntSet
pids
  where
    keepElems :: (RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd p)
              => FL a wX wY -> RL a wB wX -> IntSet -> RL a wP wQ
    keepElems :: forall (p :: * -> * -> *) (a :: * -> * -> *) wX wY wB wP wQ.
(RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd p) =>
FL a wX wY -> RL a wB wX -> IntSet -> RL a wP wQ
keepElems FL a wX wY
NilFL RL a wB wX
acc IntSet
_ = RL a wB wX -> RL a wP wQ
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 IntSet
pids
      | PatchId -> Key
short (PatchInfo -> PatchId
makePatchID (PatchInfo -> PatchId) -> PatchInfo -> PatchId
forall a b. (a -> b) -> a -> b
$ PatchInfoAndG (Named p) wX wY -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info a wX wY
PatchInfoAndG (Named p) wX wY
x) Key -> IntSet -> Bool
`I.member` IntSet
pids = FL a wY wY -> RL a wB wY -> IntSet -> RL a wP wQ
forall (p :: * -> * -> *) (a :: * -> * -> *) wX wY wB wP wQ.
(RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd p) =>
FL a wX wY -> RL a wB wX -> IntSet -> RL a wP wQ
keepElems FL a wY wY
xs (RL a wB wX
acc RL a wB wX -> a wX wY -> RL a wB wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: a wX wY
x) IntSet
pids
      | Bool
otherwise = FL a wX Any -> RL a wB wX -> IntSet -> RL a wP wQ
forall (p :: * -> * -> *) (a :: * -> * -> *) wX wY wB wP wQ.
(RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd p) =>
FL a wX wY -> RL a wB wX -> IntSet -> RL a wP wQ
keepElems (FL a wY wY -> FL a wX Any
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FL a wY wY
xs) RL a wB wX
acc IntSet
pids

type PatchFilter p = [AnchoredPath] -> [Sealed2 (PatchInfoAnd p)] -> IO [Sealed2 (PatchInfoAnd p)]

-- | If a patch index is available, returns a filter that takes a list of files
--   and returns a @PatchFilter@ that only keeps patches that modify the given
--   list of files. If patch-index cannot be used, return the original input.
--   If patch-index does not exist and is not explicitely disabled, silently
--   create it. (Also, if it is out-of-sync, which should not happen, silently
--   update it).
maybeFilterPatches
    :: (RepoPatch p, ApplyState p ~ Tree)
    => Repository rt p wU wR  -- ^ The repository
    -> PatchSet p Origin wR   -- ^ PatchSet of patches of repository (in case patch-index needs to be created)
    -> PatchFilter p          -- ^ PatchFilter ready to be used by SelectChanges.
maybeFilterPatches :: forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> PatchSet p Origin wR -> PatchFilter p
maybeFilterPatches Repository rt p wU wR
repo PatchSet p Origin wR
ps [AnchoredPath]
fps [Sealed2 (PatchInfoAnd p)]
ops = do
    Bool
usePI <- Repository rt p wU wR -> IO Bool
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO Bool
canUsePatchIndex Repository rt p wU wR
repo
    if Bool
usePI
      then do
        pi :: PatchIndex
pi@(PatchIndex [PatchId]
_ FileIdSpans
_ FilePathSpans
_ InfoMap
infom) <- Repository rt p wU wR -> PatchSet p Origin wR -> IO PatchIndex
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> PatchSet p Origin wR -> IO PatchIndex
loadSafePatchIndex Repository rt p wU wR
repo PatchSet p Origin wR
ps
        let fids :: [FileId]
fids = [Maybe FileId] -> [FileId]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe FileId] -> [FileId]) -> [Maybe FileId] -> [FileId]
forall a b. (a -> b) -> a -> b
$ (AnchoredPath -> Maybe FileId) -> [AnchoredPath] -> [Maybe FileId]
forall a b. (a -> b) -> [a] -> [b]
map ((\AnchoredPath
fn -> PIM (Maybe FileId) -> PatchIndex -> Maybe FileId
forall s a. State s a -> s -> a
evalState (AnchoredPath -> PIM (Maybe FileId)
lookupFid' AnchoredPath
fn) PatchIndex
pi)) [AnchoredPath]
fps
            npids :: IntSet
npids = [IntSet] -> IntSet
forall (f :: * -> *). Foldable f => f IntSet -> IntSet
I.unions ([IntSet] -> IntSet) -> [IntSet] -> IntSet
forall a b. (a -> b) -> a -> b
$ (FileId -> IntSet) -> [FileId] -> [IntSet]
forall a b. (a -> b) -> [a] -> [b]
map (FileInfo -> IntSet
touching(FileInfo -> IntSet) -> (FileId -> FileInfo) -> FileId -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Maybe FileInfo -> FileInfo
forall a. HasCallStack => Maybe a -> a
fromJust(Maybe FileInfo -> FileInfo)
-> (FileId -> Maybe FileInfo) -> FileId -> FileInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FileId -> InfoMap -> Maybe FileInfo
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` InfoMap
infom)) [FileId]
fids
        [Sealed2 (PatchInfoAnd p)] -> IO [Sealed2 (PatchInfoAnd p)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Sealed2 (PatchInfoAnd p)] -> IO [Sealed2 (PatchInfoAnd p)])
-> [Sealed2 (PatchInfoAnd p)] -> IO [Sealed2 (PatchInfoAnd p)]
forall a b. (a -> b) -> a -> b
$ (Sealed2 (PatchInfoAnd p) -> Bool)
-> [Sealed2 (PatchInfoAnd p)] -> [Sealed2 (PatchInfoAnd p)]
forall a. (a -> Bool) -> [a] -> [a]
filter
          ((Key -> IntSet -> Bool) -> IntSet -> Key -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Key -> IntSet -> Bool
I.member IntSet
npids (Key -> Bool)
-> (Sealed2 (PatchInfoAnd p) -> Key)
-> Sealed2 (PatchInfoAnd p)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall wX wY. PatchInfoAnd p wX wY -> Key)
-> Sealed2 (PatchInfoAnd p) -> Key
forall (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
unseal2 (PatchId -> Key
short (PatchId -> Key)
-> (PatchInfoAnd p wX wY -> PatchId) -> PatchInfoAnd p wX wY -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfo -> PatchId
makePatchID (PatchInfo -> PatchId)
-> (PatchInfoAnd p wX wY -> PatchInfo)
-> PatchInfoAnd p wX wY
-> PatchId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAnd p wX wY -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info))) [Sealed2 (PatchInfoAnd p)]
ops
      else [Sealed2 (PatchInfoAnd p)] -> IO [Sealed2 (PatchInfoAnd p)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Sealed2 (PatchInfoAnd p)]
ops

-- | Dump information in patch index. Patch-index should be checked to exist beforehand. Read-only.
dumpPatchIndex :: FilePath -> IO ()
dumpPatchIndex :: FilePath -> IO ()
dumpPatchIndex FilePath
repodir = do
  (Int8
_,FilePath
inv_hash,Map PatchId Key
_,PatchIndex [PatchId]
pids FileIdSpans
fidspans FilePathSpans
fpspans InfoMap
infom) <- FilePath -> IO (Int8, FilePath, Map PatchId Key, PatchIndex)
loadPatchIndex FilePath
repodir
  FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$
    [ FilePath
"Inventory hash:" FilePath -> ShowS
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
"=============="
    ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePathSpans -> InfoMap -> [FilePath]
fpSpans2filePaths FilePathSpans
fpspans InfoMap
infom

-- | Read-only sanity check on patch-index. Patch-index should be checked to exist beforehand. It may not be in sync with repository.
piTest :: FilePath -> IO ()
piTest :: FilePath -> IO ()
piTest FilePath
repodir = do
   (Int8
_,FilePath
_,Map PatchId Key
_,PatchIndex [PatchId]
rpids FileIdSpans
fidspans FilePathSpans
fpspans InfoMap
infom) <- FilePath -> IO (Int8, FilePath, Map PatchId Key, PatchIndex)
loadPatchIndex FilePath
repodir
   let pids :: [PatchId]
pids = [PatchId] -> [PatchId]
forall a. [a] -> [a]
reverse [PatchId]
rpids

   -- test fidspans
   FilePath -> IO ()
putStrLn FilePath
"fidspans"
   FilePath -> IO ()
putStrLn FilePath
"==========="
   [(AnchoredPath, [FileIdSpan])]
-> ((AnchoredPath, [FileIdSpan]) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (FileIdSpans -> [(AnchoredPath, [FileIdSpan])]
forall k a. Map k a -> [(k, a)]
M.toList FileIdSpans
fidspans) (((AnchoredPath, [FileIdSpan]) -> IO ()) -> IO ())
-> ((AnchoredPath, [FileIdSpan]) -> IO ()) -> IO ()
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 = [PatchId] -> [PatchId]
forall a. [a] -> [a]
reverse ([PatchId] -> [PatchId])
-> ([[PatchId]] -> [PatchId]) -> [[PatchId]] -> [PatchId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PatchId] -> [PatchId]
forall a. Eq a => [a] -> [a]
nub ([PatchId] -> [PatchId])
-> ([[PatchId]] -> [PatchId]) -> [[PatchId]] -> [PatchId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[PatchId]] -> [PatchId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[PatchId]] -> [PatchId]) -> [[PatchId]] -> [PatchId]
forall a b. (a -> b) -> a -> b
$ (FileIdSpan -> [PatchId]) -> [FileIdSpan] -> [[PatchId]]
forall a b. (a -> b) -> [a] -> [b]
map FileIdSpan -> [PatchId]
g [FileIdSpan]
spans
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PatchId] -> [PatchId] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInOrder [PatchId]
ascTs [PatchId]
pids) (FilePath -> IO ()
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"In order test failed! filename: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> FilePath
forall a. Show a => a -> FilePath
show AnchoredPath
fn)
      [FileIdSpan] -> (FileIdSpan -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FileIdSpan]
spans ((FileIdSpan -> IO ()) -> IO ()) -> (FileIdSpan -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(FidSpan FileId
fid PatchId
_ Maybe PatchId
_) -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FileId -> FilePathSpans -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member FileId
fid FilePathSpans
fpspans) (FilePath -> IO ()
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Valid file id test failed! fid: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FileId -> FilePath
forall a. Show a => a -> FilePath
show FileId
fid)
   FilePath -> IO ()
putStrLn FilePath
"fidspans tests passed"

   -- test fpspans
   FilePath -> IO ()
putStrLn FilePath
"fpspans"
   FilePath -> IO ()
putStrLn FilePath
"==========="
   [(FileId, [FilePathSpan])]
-> ((FileId, [FilePathSpan]) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (FilePathSpans -> [(FileId, [FilePathSpan])]
forall k a. Map k a -> [(k, a)]
M.toList FilePathSpans
fpspans) (((FileId, [FilePathSpan]) -> IO ()) -> IO ())
-> ((FileId, [FilePathSpan]) -> IO ()) -> IO ()
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 = [PatchId] -> [PatchId]
forall a. [a] -> [a]
reverse ([PatchId] -> [PatchId])
-> ([[PatchId]] -> [PatchId]) -> [[PatchId]] -> [PatchId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PatchId] -> [PatchId]
forall a. Eq a => [a] -> [a]
nub ([PatchId] -> [PatchId])
-> ([[PatchId]] -> [PatchId]) -> [[PatchId]] -> [PatchId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[PatchId]] -> [PatchId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[PatchId]] -> [PatchId]) -> [[PatchId]] -> [PatchId]
forall a b. (a -> b) -> a -> b
$ (FilePathSpan -> [PatchId]) -> [FilePathSpan] -> [[PatchId]]
forall a b. (a -> b) -> [a] -> [b]
map FilePathSpan -> [PatchId]
g [FilePathSpan]
spans
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PatchId] -> [PatchId] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInOrder [PatchId]
ascTs [PatchId]
pids) (FilePath -> IO ()
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"In order test failed! fileid: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FileId -> FilePath
forall a. Show a => a -> FilePath
show FileId
fid)
      [FilePathSpan] -> (FilePathSpan -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePathSpan]
spans ((FilePathSpan -> IO ()) -> IO ())
-> (FilePathSpan -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(FpSpan AnchoredPath
fn PatchId
_ Maybe PatchId
_) -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (AnchoredPath -> FileIdSpans -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member AnchoredPath
fn FileIdSpans
fidspans) (FilePath -> IO ()
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Valid file name test failed! file name: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> FilePath
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 PatchId -> PatchId -> Bool
forall a. Eq a => a -> a -> Bool
== PatchId
y
          f FilePathSpan
_ FilePathSpan
_ = FilePath -> Bool
forall a. HasCallStack => FilePath -> a
error FilePath
"adj test of fpspans fail"
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (FilePathSpan -> FilePathSpan -> Bool)
-> [FilePathSpan] -> [FilePathSpan] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith FilePathSpan -> FilePathSpan -> Bool
f [FilePathSpan]
spans ([FilePathSpan] -> [FilePathSpan]
forall a. HasCallStack => [a] -> [a]
tailErr [FilePathSpan]
spans)) (FilePath -> IO ()
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Adjcency test failed! fid: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FileId -> FilePath
forall a. Show a => a -> FilePath
show FileId
fid)
   FilePath -> IO ()
putStrLn FilePath
"fpspans tests passed"

   -- test infomap
   FilePath -> IO ()
putStrLn FilePath
"infom"
   FilePath -> IO ()
putStrLn FilePath
"==========="
   FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Valid fid test: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ (Bool -> FilePath
forall a. Show a => a -> FilePath
show(Bool -> FilePath) -> ([Bool] -> Bool) -> [Bool] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> FilePath) -> [Bool] -> FilePath
forall a b. (a -> b) -> a -> b
$ (FileId -> Bool) -> [FileId] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (FileId -> FilePathSpans -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` FilePathSpans
fpspans) (InfoMap -> [FileId]
forall k a. Map k a -> [k]
M.keys InfoMap
infom))
   FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Valid pid test: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ (Bool -> FilePath
forall a. Show a => a -> FilePath
show(Bool -> FilePath) -> (InfoMap -> Bool) -> InfoMap -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(IntSet -> IntSet -> Bool) -> IntSet -> IntSet -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip IntSet -> IntSet -> Bool
I.isSubsetOf ([Key] -> IntSet
I.fromList ([Key] -> IntSet) -> [Key] -> IntSet
forall a b. (a -> b) -> a -> b
$ (PatchId -> Key) -> [PatchId] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map PatchId -> Key
short [PatchId]
pids)  (IntSet -> Bool) -> (InfoMap -> IntSet) -> InfoMap -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IntSet] -> IntSet
forall (f :: * -> *). Foldable f => f IntSet -> IntSet
I.unions ([IntSet] -> IntSet) -> (InfoMap -> [IntSet]) -> InfoMap -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileInfo -> IntSet) -> [FileInfo] -> [IntSet]
forall a b. (a -> b) -> [a] -> [b]
map FileInfo -> IntSet
touching ([FileInfo] -> [IntSet])
-> (InfoMap -> [FileInfo]) -> InfoMap -> [IntSet]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InfoMap -> [FileInfo]
forall k a. Map k a -> [a]
M.elems (InfoMap -> FilePath) -> InfoMap -> FilePath
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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInOrder [a]
xs [a]
ys
                                  | Bool
otherwise = [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInOrder (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
          isInOrder [] [a]
_ = Bool
True
          isInOrder [a]
_ [] = Bool
False