{-# 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.
-}
module Darcs.Repository.PatchIndex
    ( doesPatchIndexExist
    , isPatchIndexDisabled
    , isPatchIndexInSync
    , canUsePatchIndex
    , createPIWithInterrupt
    , createOrUpdatePatchIndexDisk
    , deletePatchIndex
    , attemptCreatePatchIndex
    , PatchFilter
    , maybeFilterPatches
    , getRelevantSubsequence
    , dumpPatchIndex
    , piTest
    ) where

import Darcs.Prelude

import Control.Exception ( catch )
import Control.Monad ( forM_, unless, when )
import Control.Monad.State.Strict ( evalState, execState, State, gets, modify )

import Data.Binary ( Binary, encodeFile, decodeFileOrFail )
import qualified Data.ByteString as B
import Data.Int ( Int8 )
import Data.List ( group, mapAccumL, sort, nub, (\\) )
import Data.Maybe ( fromJust, fromMaybe, isJust )
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Word ( Word32 )

import System.Directory
    ( createDirectory
    , doesDirectoryExist
    , doesFileExist
    , removeDirectoryRecursive
    , removeFile
    , renameDirectory
    )
import System.FilePath( (</>) )
import System.IO ( openFile, IOMode(WriteMode), hClose )

import Darcs.Patch ( RepoPatch, listTouchedFiles )
import Darcs.Patch.Apply ( ApplyState(..) )
import Darcs.Patch.Index.Types
import Darcs.Patch.Index.Monad ( applyToFileMods, makePatchID )
import Darcs.Patch.Inspect ( PatchInspect )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info )
import Darcs.Patch.Progress (progressFL )
import Darcs.Patch.Set ( PatchSet, patchSet2FL, Origin, patchSet2FL )
import Darcs.Patch.Witnesses.Ordered ( mapFL, RL(..), FL(..), reverseRL )
import Darcs.Patch.Witnesses.Sealed
    ( Sealed2(..)
    , Sealed(..)
    , seal
    , seal2
    , unseal
    , unseal2
    )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP, unsafeCoercePEnd )

import Darcs.Repository.Format ( formatHas, RepoProperty( HashedInventory ) )
import Darcs.Repository.InternalTypes ( Repository, repoLocation, repoFormat )

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

type Map = M.Map
type Set = S.Set

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

-- | info about a given fileid, e.g.. is a file or a directory
data FileInfo = FileInfo
  { FileInfo -> Bool
isFile :: Bool
  , FileInfo -> Set Word32
touching :: Set Word32  -- ^ first word of patch hash
  } deriving (Int -> FileInfo -> ShowS
[FileInfo] -> ShowS
FileInfo -> String
(Int -> FileInfo -> ShowS)
-> (FileInfo -> String) -> ([FileInfo] -> ShowS) -> Show FileInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileInfo] -> ShowS
$cshowList :: [FileInfo] -> ShowS
show :: FileInfo -> String
$cshow :: FileInfo -> String
showsPrec :: Int -> FileInfo -> ShowS
$cshowsPrec :: Int -> FileInfo -> ShowS
Show, FileInfo -> FileInfo -> Bool
(FileInfo -> FileInfo -> Bool)
-> (FileInfo -> FileInfo -> Bool) -> Eq FileInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileInfo -> FileInfo -> Bool
$c/= :: FileInfo -> FileInfo -> Bool
== :: FileInfo -> FileInfo -> Bool
$c== :: FileInfo -> FileInfo -> Bool
Eq, Eq FileInfo
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
min :: FileInfo -> FileInfo -> FileInfo
$cmin :: FileInfo -> FileInfo -> FileInfo
max :: FileInfo -> FileInfo -> FileInfo
$cmax :: FileInfo -> FileInfo -> FileInfo
>= :: FileInfo -> FileInfo -> Bool
$c>= :: FileInfo -> FileInfo -> Bool
> :: FileInfo -> FileInfo -> Bool
$c> :: FileInfo -> FileInfo -> Bool
<= :: FileInfo -> FileInfo -> Bool
$c<= :: FileInfo -> FileInfo -> Bool
< :: FileInfo -> FileInfo -> Bool
$c< :: FileInfo -> FileInfo -> Bool
compare :: FileInfo -> FileInfo -> Ordering
$ccompare :: FileInfo -> FileInfo -> Ordering
$cp1Ord :: Eq 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 to this 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
version :: Int8
version :: Int8
version = Int8
3

type PIM a = State PatchIndex a

-- | 'applyPatchMods pmods pindex' applies a list of PatchMods to the given
--   patch index pindex
applyPatchMods :: [(PatchId, [PatchMod AnchoredPath])] -> PatchIndex -> PatchIndex
applyPatchMods :: [(PatchId, [PatchMod AnchoredPath])] -> PatchIndex -> PatchIndex
applyPatchMods [(PatchId, [PatchMod 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, [PatchMod AnchoredPath]) -> State PatchIndex ())
-> [(PatchId, [PatchMod AnchoredPath])] -> State PatchIndex ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (PatchId, [PatchMod AnchoredPath]) -> State PatchIndex ()
goList [(PatchId, [PatchMod AnchoredPath])]
pmods
 where goList :: (PatchId, [PatchMod AnchoredPath]) -> PIM ()
       goList :: (PatchId, [PatchMod AnchoredPath]) -> State PatchIndex ()
goList (PatchId
pid, [PatchMod AnchoredPath]
mods) = do
           (PatchIndex -> PatchIndex) -> State PatchIndex ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind{pids :: [PatchId]
pids = PatchId
pidPatchId -> [PatchId] -> [PatchId]
forall a. a -> [a] -> [a]
:PatchIndex -> [PatchId]
pids PatchIndex
pind})
           (PatchMod AnchoredPath -> State PatchIndex ())
-> [PatchMod AnchoredPath] -> State PatchIndex ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (((PatchId, PatchMod AnchoredPath) -> State PatchIndex ())
-> PatchId -> PatchMod AnchoredPath -> State PatchIndex ()
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (PatchId, PatchMod AnchoredPath) -> State PatchIndex ()
go PatchId
pid) ([PatchMod AnchoredPath] -> [PatchMod AnchoredPath]
nubSeq [PatchMod AnchoredPath]
mods)
       -- nubSeq handles invalid patch in darcs repo:
       --   move with identical target name "rename darcs_patcher to darcs-patcher."
       nubSeq :: [PatchMod AnchoredPath] -> [PatchMod AnchoredPath]
nubSeq = ([PatchMod AnchoredPath] -> PatchMod AnchoredPath)
-> [[PatchMod AnchoredPath]] -> [PatchMod AnchoredPath]
forall a b. (a -> b) -> [a] -> [b]
map [PatchMod AnchoredPath] -> PatchMod AnchoredPath
forall a. [a] -> a
head ([[PatchMod AnchoredPath]] -> [PatchMod AnchoredPath])
-> ([PatchMod AnchoredPath] -> [[PatchMod AnchoredPath]])
-> [PatchMod AnchoredPath]
-> [PatchMod AnchoredPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PatchMod AnchoredPath] -> [[PatchMod AnchoredPath]]
forall a. Eq a => [a] -> [[a]]
group
       go :: (PatchId, PatchMod AnchoredPath) -> PIM ()
       go :: (PatchId, PatchMod 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
         FileId -> PatchId -> State PatchIndex ()
insertTouch FileId
fid PatchId
pid
       go (PatchId
pid, PCreateDir AnchoredPath
fn) = do
         FileId
fid <- AnchoredPath -> PatchId -> PIM FileId
createFidStartSpan AnchoredPath
fn PatchId
pid
         FileId -> AnchoredPath -> PatchId -> State PatchIndex ()
startFpSpan FileId
fid AnchoredPath
fn PatchId
pid
         FileId -> Bool -> State PatchIndex ()
createInfo FileId
fid Bool
False
         FileId -> PatchId -> State PatchIndex ()
insertTouch FileId
fid PatchId
pid
       go (PatchId
pid, PTouch AnchoredPath
fn) = do
         FileId
fid <- AnchoredPath -> PIM FileId
lookupFid AnchoredPath
fn
         FileId -> PatchId -> State PatchIndex ()
insertTouch FileId
fid PatchId
pid
       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
         FileId -> PatchId -> State PatchIndex ()
insertTouch FileId
fid PatchId
pid
         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
         FileId -> PatchId -> State PatchIndex ()
insertTouch FileId
fid PatchId
pid
         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]
_) -> FileId -> PatchId -> State PatchIndex ()
insertTouch FileId
fid PatchId
pid
           Maybe [FileIdSpan]
Nothing -> () -> State PatchIndex ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
           Just [] -> String -> State PatchIndex ()
forall a. HasCallStack => String -> a
error (String -> State PatchIndex ()) -> String -> State PatchIndex ()
forall a b. (a -> b) -> a -> b
$ String
"applyPatchMods: impossible, no entry for "String -> ShowS
forall a. [a] -> [a] -> [a]
++AnchoredPath -> String
forall a. Show a => a -> String
show AnchoredPath
fn
                              String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" 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 -> Int -> FileId
FileId AnchoredPath
fn Int
1
      (PatchIndex -> PatchIndex) -> State PatchIndex ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind {fidspans :: FileIdSpans
fidspans=AnchoredPath -> [FileIdSpan] -> FileIdSpans -> FileIdSpans
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert AnchoredPath
fn [FileId -> PatchId -> Maybe PatchId -> FileIdSpan
FidSpan FileId
fid PatchId
pstart Maybe PatchId
forall a. Maybe a
Nothing] FileIdSpans
fidspans})
      FileId -> PIM FileId
forall (m :: * -> *) a. Monad m => a -> m a
return FileId
fid
    Just [FileIdSpan]
fspans -> do
      let fid :: FileId
fid = AnchoredPath -> Int -> FileId
FileId AnchoredPath
fn ([FileIdSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FileIdSpan]
fspansInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
      (PatchIndex -> PatchIndex) -> State PatchIndex ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PatchIndex
pind -> PatchIndex
pind {fidspans :: FileIdSpans
fidspans=AnchoredPath -> [FileIdSpan] -> FileIdSpans -> FileIdSpans
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert AnchoredPath
fn (FileId -> PatchId -> Maybe PatchId -> FileIdSpan
FidSpan FileId
fid PatchId
pstart Maybe PatchId
forall a. Maybe a
NothingFileIdSpan -> [FileIdSpan] -> [FileIdSpan]
forall a. a -> [a] -> [a]
:[FileIdSpan]
fspans) FileIdSpans
fidspans})
      FileId -> PIM FileId
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 :: FilePathSpans
fpspans=(Maybe [FilePathSpan] -> Maybe [FilePathSpan])
-> FileId -> FilePathSpans -> FilePathSpans
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe [FilePathSpan] -> Maybe [FilePathSpan]
alt FileId
fid (PatchIndex -> FilePathSpans
fpspans PatchIndex
pind)})
  where alt :: Maybe [FilePathSpan] -> Maybe [FilePathSpan]
alt Maybe [FilePathSpan]
Nothing = [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 :: FilePathSpans
fpspans=(Maybe [FilePathSpan] -> Maybe [FilePathSpan])
-> FileId -> FilePathSpans -> FilePathSpans
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe [FilePathSpan] -> Maybe [FilePathSpan]
alt FileId
fid (PatchIndex -> FilePathSpans
fpspans PatchIndex
pind)})
  where alt :: Maybe [FilePathSpan] -> Maybe [FilePathSpan]
alt Maybe [FilePathSpan]
Nothing = String -> Maybe [FilePathSpan]
forall a. HasCallStack => String -> a
error (String -> Maybe [FilePathSpan]) -> String -> Maybe [FilePathSpan]
forall a b. (a -> b) -> a -> b
$ String
"impossible: no span for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FileId -> String
forall a. Show a => a -> String
show FileId
fid
        alt (Just []) = String -> Maybe [FilePathSpan]
forall a. HasCallStack => String -> a
error (String -> Maybe [FilePathSpan]) -> String -> Maybe [FilePathSpan]
forall a b. (a -> b) -> a -> b
$ String
"impossible: no span for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FileId -> String
forall a. Show a => a -> String
show FileId
fidString -> ShowS
forall a. [a] -> [a] -> [a]
++String
", 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]
_ = String -> Maybe [FilePathSpan]
forall a. HasCallStack => String -> a
error (String -> Maybe [FilePathSpan]) -> String -> Maybe [FilePathSpan]
forall a b. (a -> b) -> a -> b
$ String
"impossible: span already ended for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FileId -> String
forall a. Show a => a -> String
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 :: FileIdSpans
fidspans=(Maybe [FileIdSpan] -> Maybe [FileIdSpan])
-> AnchoredPath -> FileIdSpans -> FileIdSpans
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe [FileIdSpan] -> Maybe [FileIdSpan]
alt AnchoredPath
fn (PatchIndex -> FileIdSpans
fidspans PatchIndex
pind)})
  where alt :: Maybe [FileIdSpan] -> Maybe [FileIdSpan]
alt Maybe [FileIdSpan]
Nothing = [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 :: FileIdSpans
fidspans=(Maybe [FileIdSpan] -> Maybe [FileIdSpan])
-> AnchoredPath -> FileIdSpans -> FileIdSpans
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe [FileIdSpan] -> Maybe [FileIdSpan]
alt AnchoredPath
fn (PatchIndex -> FileIdSpans
fidspans PatchIndex
pind)})
  where alt :: Maybe [FileIdSpan] -> Maybe [FileIdSpan]
alt Maybe [FileIdSpan]
Nothing = String -> Maybe [FileIdSpan]
forall a. HasCallStack => String -> a
error (String -> Maybe [FileIdSpan]) -> String -> Maybe [FileIdSpan]
forall a b. (a -> b) -> a -> b
$ String
"impossible: no span for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> String
forall a. Show a => a -> String
show AnchoredPath
fn
        alt (Just []) = String -> Maybe [FileIdSpan]
forall a. HasCallStack => String -> a
error (String -> Maybe [FileIdSpan]) -> String -> Maybe [FileIdSpan]
forall a b. (a -> b) -> a -> b
$ String
"impossible: no span for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> String
forall a. Show a => a -> String
show AnchoredPath
fnString -> ShowS
forall a. [a] -> [a] -> [a]
++String
", 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]
_ = String -> Maybe [FileIdSpan]
forall a. HasCallStack => String -> a
error (String -> Maybe [FileIdSpan]) -> String -> Maybe [FileIdSpan]
forall a b. (a -> b) -> a -> b
$ String
"impossible: span already ended for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> String
forall a. Show a => a -> String
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 :: InfoMap
infom=(Maybe FileInfo -> Maybe FileInfo) -> FileId -> InfoMap -> InfoMap
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe FileInfo -> Maybe FileInfo
forall a. Maybe a -> Maybe FileInfo
alt FileId
fid (PatchIndex -> InfoMap
infom PatchIndex
pind)})
  where alt :: Maybe a -> Maybe FileInfo
alt Maybe a
Nothing = FileInfo -> Maybe FileInfo
forall a. a -> Maybe a
Just (Bool -> Set Word32 -> FileInfo
FileInfo Bool
isF Set Word32
forall a. Set a
S.empty)
        alt (Just a
_) = FileInfo -> Maybe FileInfo
forall a. a -> Maybe a
Just (Bool -> Set Word32 -> FileInfo
FileInfo Bool
isF Set Word32
forall a. Set a
S.empty) -- forget old false positives

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

-- | 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 -> String -> PIM FileId
forall a. HasCallStack => String -> a
error (String -> PIM FileId) -> String -> PIM FileId
forall a b. (a -> b) -> a -> b
$ String
"couldn't find " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> String
displayPath AnchoredPath
fn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in patch index"
        Just FileId
fid -> FileId -> PIM FileId
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 (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 (m :: * -> *) a. Monad m => a -> m a
return Maybe FileId
forall a. Maybe a
Nothing


-- | lookup all the file ids of a given path
lookupFidf' :: AnchoredPath -> PIM [FileId]
lookupFidf' :: AnchoredPath -> PIM [FileId]
lookupFidf' 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 [FileIdSpan]
spans -> [FileId] -> PIM [FileId]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FileId] -> PIM [FileId]) -> [FileId] -> PIM [FileId]
forall a b. (a -> b) -> a -> b
$ (FileIdSpan -> FileId) -> [FileIdSpan] -> [FileId]
forall a b. (a -> b) -> [a] -> [b]
map (\(FidSpan FileId
fid PatchId
_ Maybe PatchId
_) -> FileId
fid) [FileIdSpan]
spans
      Maybe [FileIdSpan]
Nothing ->
         String -> PIM [FileId]
forall a. HasCallStack => String -> a
error (String -> PIM [FileId]) -> String -> PIM [FileId]
forall a b. (a -> b) -> a -> b
$ String
"lookupFidf': no entry for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> String
forall a. Show a => a -> String
show AnchoredPath
fn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in FileIdSpans"

-- |  return all fids of matching subpaths
--    of the given filepath
lookupFids :: AnchoredPath -> PIM [FileId]
lookupFids :: AnchoredPath -> PIM [FileId]
lookupFids AnchoredPath
fn = do
   FileIdSpans
fid_spans <- (PatchIndex -> FileIdSpans)
-> StateT PatchIndex Identity FileIdSpans
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PatchIndex -> FileIdSpans
fidspans
   [[FileId]]
file_idss <- (AnchoredPath -> PIM [FileId])
-> [AnchoredPath] -> StateT PatchIndex Identity [[FileId]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AnchoredPath -> PIM [FileId]
lookupFidf' ([AnchoredPath] -> StateT PatchIndex Identity [[FileId]])
-> [AnchoredPath] -> StateT PatchIndex Identity [[FileId]]
forall a b. (a -> b) -> a -> b
$
      (AnchoredPath -> Bool) -> [AnchoredPath] -> [AnchoredPath]
forall a. (a -> Bool) -> [a] -> [a]
filter (AnchoredPath -> AnchoredPath -> Bool
isPrefix AnchoredPath
fn) (FileIdSpans -> [AnchoredPath]
fpSpans2filePaths' FileIdSpans
fid_spans)
   [FileId] -> PIM [FileId]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FileId] -> PIM [FileId]) -> [FileId] -> PIM [FileId]
forall a b. (a -> b) -> a -> b
$ [FileId] -> [FileId]
forall a. Eq a => [a] -> [a]
nub ([FileId] -> [FileId]) -> [FileId] -> [FileId]
forall a b. (a -> b) -> a -> b
$ [[FileId]] -> [FileId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FileId]]
file_idss

-- | returns a single file id if the given path is a file
--   if it is a directory, if returns all the file ids of all paths inside it,
--   at any point in repository history
lookupFids' :: AnchoredPath -> PIM [FileId]
lookupFids' :: AnchoredPath -> PIM [FileId]
lookupFids' AnchoredPath
fn = do
  InfoMap
info_map <- (PatchIndex -> InfoMap) -> StateT PatchIndex Identity InfoMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PatchIndex -> InfoMap
infom
  FilePathSpans
fps_spans <- (PatchIndex -> FilePathSpans)
-> StateT PatchIndex Identity FilePathSpans
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PatchIndex -> FilePathSpans
fpspans
  Maybe FileId
a <- AnchoredPath -> PIM (Maybe FileId)
lookupFid' AnchoredPath
fn
  if Maybe FileId -> Bool
forall a. Maybe a -> Bool
isJust Maybe FileId
a then do
                let fid :: FileId
fid = Maybe FileId -> FileId
forall a. HasCallStack => Maybe a -> a
fromJust Maybe FileId
a
                case FileId -> InfoMap -> Maybe FileInfo
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FileId
fid InfoMap
info_map of
                  Just (FileInfo Bool
True Set Word32
_) -> [FileId] -> PIM [FileId]
forall (m :: * -> *) a. Monad m => a -> m a
return [FileId
fid]
                  Just (FileInfo Bool
False Set Word32
_) ->
                    let file_names :: [AnchoredPath]
file_names = (FilePathSpan -> AnchoredPath) -> [FilePathSpan] -> [AnchoredPath]
forall a b. (a -> b) -> [a] -> [b]
map (\(FpSpan AnchoredPath
x PatchId
_ Maybe PatchId
_) -> AnchoredPath
x) (FilePathSpans
fps_spans FilePathSpans -> FileId -> [FilePathSpan]
forall k a. Ord k => Map k a -> k -> a
M.! FileId
fid)
                    in [FileId] -> [FileId]
forall a. Eq a => [a] -> [a]
nub ([FileId] -> [FileId])
-> ([[FileId]] -> [FileId]) -> [[FileId]] -> [FileId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[FileId]] -> [FileId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FileId]] -> [FileId])
-> StateT PatchIndex Identity [[FileId]] -> PIM [FileId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AnchoredPath -> PIM [FileId])
-> [AnchoredPath] -> StateT PatchIndex Identity [[FileId]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AnchoredPath -> PIM [FileId]
lookupFids [AnchoredPath]
file_names
                  Maybe FileInfo
Nothing -> String -> PIM [FileId]
forall a. HasCallStack => String -> a
error String
"lookupFids' : could not find file"
              else [FileId] -> PIM [FileId]
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | Creates patch index that corresponds to all patches in repo.
createPatchIndexDisk
  :: (RepoPatch p, ApplyState p ~ Tree)
  => Repository rt p wR wU wT
  -> PatchSet rt p Origin wR
  -> IO ()
createPatchIndexDisk :: Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
createPatchIndexDisk Repository rt p wR wU wT
repository PatchSet rt p Origin wR
ps = do
  let patches :: [Sealed2 (PatchInfoAnd rt p)]
patches = (forall wW wZ.
 PatchInfoAnd rt p wW wZ -> Sealed2 (PatchInfoAnd rt p))
-> FL (PatchInfoAnd rt p) Origin wR
-> [Sealed2 (PatchInfoAnd rt p)]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wW wZ.
PatchInfoAnd rt p wW wZ -> Sealed2 (PatchInfoAnd rt p)
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
Sealed2 (FL (PatchInfoAnd rt p) Origin wR -> [Sealed2 (PatchInfoAnd rt p)])
-> FL (PatchInfoAnd rt p) Origin wR
-> [Sealed2 (PatchInfoAnd rt p)]
forall a b. (a -> b) -> a -> b
$ String
-> FL (PatchInfoAnd rt p) Origin wR
-> FL (PatchInfoAnd rt p) Origin wR
forall (a :: * -> * -> *) wX wY. String -> FL a wX wY -> FL a wX wY
progressFL String
"Create patch index" (FL (PatchInfoAnd rt p) Origin wR
 -> FL (PatchInfoAnd rt p) Origin wR)
-> FL (PatchInfoAnd rt p) Origin wR
-> FL (PatchInfoAnd rt p) Origin wR
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wR -> FL (PatchInfoAnd rt p) Origin wR
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> FL (PatchInfoAnd rt p) wStart wX
patchSet2FL PatchSet rt p Origin wR
ps
  Repository rt p wR wU wT
-> [(PatchId, [PatchMod AnchoredPath])] -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT
-> [(PatchId, [PatchMod AnchoredPath])] -> IO ()
createPatchIndexFrom Repository rt p wR wU wT
repository ([(PatchId, [PatchMod AnchoredPath])] -> IO ())
-> [(PatchId, [PatchMod AnchoredPath])] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Sealed2 (PatchInfoAnd rt p)]
-> Set AnchoredPath -> [(PatchId, [PatchMod AnchoredPath])]
forall (p :: * -> * -> *) (rt :: RepoType).
(Apply p, PatchInspect p, ApplyState p ~ Tree) =>
[Sealed2 (PatchInfoAnd rt p)]
-> Set AnchoredPath -> [(PatchId, [PatchMod AnchoredPath])]
patches2patchMods [Sealed2 (PatchInfoAnd rt p)]
patches Set AnchoredPath
forall a. Set a
S.empty

-- | convert patches to patchmods
patches2patchMods :: (Apply p, PatchInspect p, ApplyState p ~ Tree)
                  => [Sealed2 (PatchInfoAnd rt p)] -> Set AnchoredPath -> [(PatchId, [PatchMod AnchoredPath])]
patches2patchMods :: [Sealed2 (PatchInfoAnd rt p)]
-> Set AnchoredPath -> [(PatchId, [PatchMod AnchoredPath])]
patches2patchMods [Sealed2 (PatchInfoAnd rt p)]
patches Set AnchoredPath
fns = (Set AnchoredPath, [(PatchId, [PatchMod AnchoredPath])])
-> [(PatchId, [PatchMod AnchoredPath])]
forall a b. (a, b) -> b
snd ((Set AnchoredPath, [(PatchId, [PatchMod AnchoredPath])])
 -> [(PatchId, [PatchMod AnchoredPath])])
-> (Set AnchoredPath, [(PatchId, [PatchMod AnchoredPath])])
-> [(PatchId, [PatchMod AnchoredPath])]
forall a b. (a -> b) -> a -> b
$ (Set AnchoredPath
 -> Sealed2 (PatchInfoAnd rt p)
 -> (Set AnchoredPath, (PatchId, [PatchMod AnchoredPath])))
-> Set AnchoredPath
-> [Sealed2 (PatchInfoAnd rt p)]
-> (Set AnchoredPath, [(PatchId, [PatchMod AnchoredPath])])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL Set AnchoredPath
-> Sealed2 (PatchInfoAnd rt p)
-> (Set AnchoredPath, (PatchId, [PatchMod AnchoredPath]))
forall (p :: * -> * -> *) (rt :: RepoType).
(PatchInspect p, Apply p, ApplyState p ~ Tree) =>
Set AnchoredPath
-> Sealed2 (PatchInfoAndG rt p)
-> (Set AnchoredPath, (PatchId, [PatchMod AnchoredPath]))
go Set AnchoredPath
fns [Sealed2 (PatchInfoAnd rt p)]
patches
  where
    go :: Set AnchoredPath
-> Sealed2 (PatchInfoAndG rt p)
-> (Set AnchoredPath, (PatchId, [PatchMod AnchoredPath]))
go Set AnchoredPath
filenames (Sealed2 PatchInfoAndG rt p wX wY
p) = (Set AnchoredPath
filenames', (PatchId
pid, [PatchMod AnchoredPath]
pmods_effect [PatchMod AnchoredPath]
-> [PatchMod AnchoredPath] -> [PatchMod AnchoredPath]
forall a. [a] -> [a] -> [a]
++ [PatchMod AnchoredPath]
pmods_dup))
      where pid :: PatchId
pid = PatchInfo -> PatchId
makePatchID (PatchInfo -> PatchId)
-> (PatchInfoAndG rt p wX wY -> PatchInfo)
-> PatchInfoAndG rt p wX wY
-> PatchId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAndG rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info (PatchInfoAndG rt p wX wY -> PatchId)
-> PatchInfoAndG rt p wX wY -> PatchId
forall a b. (a -> b) -> a -> b
$ PatchInfoAndG rt p wX wY
p
            (Set AnchoredPath
filenames', [PatchMod AnchoredPath]
pmods_effect) = PatchInfoAndG rt p wX wY
-> Set AnchoredPath -> (Set AnchoredPath, [PatchMod AnchoredPath])
forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY
-> Set AnchoredPath -> (Set AnchoredPath, [PatchMod AnchoredPath])
applyToFileMods PatchInfoAndG rt p wX wY
p Set AnchoredPath
filenames
            -- applyToFileMods only returns patchmods that actually modify a file,
            -- i.e., never duplicate patches
            touched :: PatchMod a -> [a]
touched PatchMod a
pm = case PatchMod a
pm of {PTouch a
f -> [a
f]; PRename a
a a
b -> [a
a,a
b];
                                     PCreateDir a
f -> [a
f]; PCreateFile a
f -> [a
f];
                                     PRemove a
f -> [a
f]; PatchMod a
_ -> []}
            touched_all :: [AnchoredPath]
touched_all = PatchInfoAndG rt p wX wY -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles PatchInfoAndG rt p wX wY
p
            touched_effect :: [AnchoredPath]
touched_effect = (PatchMod AnchoredPath -> [AnchoredPath])
-> [PatchMod AnchoredPath] -> [AnchoredPath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PatchMod AnchoredPath -> [AnchoredPath]
forall a. PatchMod a -> [a]
touched [PatchMod 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 :: [PatchMod AnchoredPath]
pmods_dup = (AnchoredPath -> PatchMod AnchoredPath)
-> [AnchoredPath] -> [PatchMod AnchoredPath]
forall a b. (a -> b) -> [a] -> [b]
map AnchoredPath -> PatchMod AnchoredPath
forall a. a -> PatchMod a
PDuplicateTouch ([AnchoredPath] -> [PatchMod AnchoredPath])
-> (Set AnchoredPath -> [AnchoredPath])
-> Set AnchoredPath
-> [PatchMod AnchoredPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set AnchoredPath -> [AnchoredPath]
forall a. Set a -> [a]
S.elems
                            (Set AnchoredPath -> [PatchMod AnchoredPath])
-> Set AnchoredPath -> [PatchMod 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 Int -> [PatchId] -> PatchIndex -> PatchIndex
removePidSuffix Map PatchId Int
_ [] PatchIndex
pindex = PatchIndex
pindex
removePidSuffix Map PatchId Int
pid2idx oldpids :: [PatchId]
oldpids@(PatchId
oldpid:[PatchId]
_) (PatchIndex [PatchId]
pids FileIdSpans
fidspans FilePathSpans
fpspans InfoMap
infom) =
    [PatchId] -> FileIdSpans -> FilePathSpans -> InfoMap -> PatchIndex
PatchIndex ([PatchId]
pids [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 -> Int
findIdx PatchId
pid = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (String -> Int
forall a. HasCallStack => String -> a
error String
"impossible case") (PatchId -> Map PatchId Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PatchId
pid Map PatchId Int
pid2idx)
    oldidx :: Int
oldidx = PatchId -> Int
findIdx PatchId
oldpid
    PatchId
from after :: PatchId -> Int -> Bool
`after` Int
idx = PatchId -> Int
findIdx PatchId
from Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
idx
    Maybe PatchId
mto afterM :: Maybe PatchId -> Int -> Bool
`afterM` Int
idx | Just PatchId
to <- Maybe PatchId
mto, PatchId -> Int
findIdx PatchId
to Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
idx = Bool
True
                     | Bool
otherwise = Bool
False
    removefid :: t FileIdSpan -> Maybe [FileIdSpan]
removefid t FileIdSpan
fidsps = if [FileIdSpan] -> 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 -> Int -> Bool
`after` Int
oldidx Bool -> Bool -> Bool
&& Maybe PatchId
mto Maybe PatchId -> Int -> Bool
`afterM` Int
oldidx = [FileId -> PatchId -> Maybe PatchId -> FileIdSpan
FidSpan FileId
fid PatchId
from Maybe PatchId
mto]
          | PatchId
from PatchId -> Int -> Bool
`after` Int
oldidx = [FileId -> PatchId -> Maybe PatchId -> FileIdSpan
FidSpan FileId
fid PatchId
from Maybe PatchId
forall a. Maybe a
Nothing]
          | Bool
otherwise = []
    removefp :: t FilePathSpan -> Maybe [FilePathSpan]
removefp t FilePathSpan
fpsps = if [FilePathSpan] -> 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 -> Int -> Bool
`after` Int
oldidx Bool -> Bool -> Bool
&& Maybe PatchId
mto Maybe PatchId -> Int -> Bool
`afterM` Int
oldidx = [AnchoredPath -> PatchId -> Maybe PatchId -> FilePathSpan
FpSpan AnchoredPath
fn PatchId
from Maybe PatchId
mto]
          | PatchId
from PatchId -> Int -> Bool
`after` Int
oldidx = [AnchoredPath -> PatchId -> Maybe PatchId -> FilePathSpan
FpSpan AnchoredPath
fn PatchId
from 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 wR wU wT
    -> PatchSet rt p Origin wR
    -> IO ()
updatePatchIndexDisk :: Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
updatePatchIndexDisk Repository rt p wR wU wT
repo PatchSet rt p Origin wR
patches = do
    let repodir :: String
repodir = Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
repoLocation Repository rt p wR wU wT
repo
    (Int8
_,String
_,Map PatchId Int
pid2idx,PatchIndex
pindex) <- String -> IO (Int8, String, Map PatchId Int, PatchIndex)
loadPatchIndex String
repodir
    -- check that patch index is up to date
    let flpatches :: FL (PatchInfoAnd rt p) Origin wR
flpatches = String
-> FL (PatchInfoAnd rt p) Origin wR
-> FL (PatchInfoAnd rt p) Origin wR
forall (a :: * -> * -> *) wX wY. String -> FL a wX wY -> FL a wX wY
progressFL String
"Update patch index" (FL (PatchInfoAnd rt p) Origin wR
 -> FL (PatchInfoAnd rt p) Origin wR)
-> FL (PatchInfoAnd rt p) Origin wR
-> FL (PatchInfoAnd rt p) Origin wR
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wR -> FL (PatchInfoAnd rt p) Origin wR
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> FL (PatchInfoAnd rt p) wStart wX
patchSet2FL PatchSet rt p Origin wR
patches
    let pidsrepo :: [PatchId]
pidsrepo = (forall wW wZ. PatchInfoAnd rt p wW wZ -> PatchId)
-> FL (PatchInfoAnd rt 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)
-> (PatchInfoAndG rt (Named p) wW wZ -> PatchInfo)
-> PatchInfoAndG rt (Named p) wW wZ
-> PatchId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAndG rt (Named p) wW wZ -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info) FL (PatchInfoAnd rt p) Origin wR
flpatches
        ([PatchId]
oldpids,[PatchId]
_,Int
len_common) = [PatchId] -> [PatchId] -> ([PatchId], [PatchId], Int)
uncommon ([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 Int -> [PatchId] -> PatchIndex -> PatchIndex
removePidSuffix Map PatchId Int
pid2idx [PatchId]
oldpids PatchIndex
pindex
        filenames :: Set AnchoredPath
filenames = FilePathSpans -> Set AnchoredPath
fpSpans2fileNames (PatchIndex -> FilePathSpans
fpspans PatchIndex
pindex')
        cdir :: String
cdir = String
repodir String -> ShowS
</> String
indexDir
    -- reread to prevent holding onto patches for too long
    let newpatches :: [Sealed2 (PatchInfoAnd rt p)]
newpatches = Int
-> [Sealed2 (PatchInfoAnd rt p)] -> [Sealed2 (PatchInfoAnd rt p)]
forall a. Int -> [a] -> [a]
drop Int
len_common ([Sealed2 (PatchInfoAnd rt p)] -> [Sealed2 (PatchInfoAnd rt p)])
-> [Sealed2 (PatchInfoAnd rt p)] -> [Sealed2 (PatchInfoAnd rt p)]
forall a b. (a -> b) -> a -> b
$ (forall wW wZ.
 PatchInfoAnd rt p wW wZ -> Sealed2 (PatchInfoAnd rt p))
-> FL (PatchInfoAnd rt p) Origin wR
-> [Sealed2 (PatchInfoAnd rt p)]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wW wZ.
PatchInfoAnd rt p wW wZ -> Sealed2 (PatchInfoAnd rt p)
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
seal2 FL (PatchInfoAnd rt p) Origin wR
flpatches
        newpmods :: [(PatchId, [PatchMod AnchoredPath])]
newpmods = [Sealed2 (PatchInfoAnd rt p)]
-> Set AnchoredPath -> [(PatchId, [PatchMod AnchoredPath])]
forall (p :: * -> * -> *) (rt :: RepoType).
(Apply p, PatchInspect p, ApplyState p ~ Tree) =>
[Sealed2 (PatchInfoAnd rt p)]
-> Set AnchoredPath -> [(PatchId, [PatchMod AnchoredPath])]
patches2patchMods [Sealed2 (PatchInfoAnd rt p)]
newpatches Set AnchoredPath
filenames
    String
inv_hash <- String -> IO String
getInventoryHash String
repodir
    String -> String -> PatchIndex -> IO ()
storePatchIndex String
cdir String
inv_hash ([(PatchId, [PatchMod AnchoredPath])] -> PatchIndex -> PatchIndex
applyPatchMods [(PatchId, [PatchMod AnchoredPath])]
newpmods PatchIndex
pindex')
  where
    -- return uncommon suffixes and length of common prefix of as and bs
    uncommon :: [PatchId] -> [PatchId] -> ([PatchId], [PatchId], Int)
uncommon = Int -> [PatchId] -> [PatchId] -> ([PatchId], [PatchId], Int)
forall a c. (Eq a, Num c) => c -> [a] -> [a] -> ([a], [a], c)
uncommon' Int
0
    uncommon' :: c -> [a] -> [a] -> ([a], [a], c)
uncommon' c
x (a
a:[a]
as) (a
b:[a]
bs)
      | a
a 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 wR wU wT
                     -> [(PatchId, [PatchMod AnchoredPath])] -> IO ()
createPatchIndexFrom :: Repository rt p wR wU wT
-> [(PatchId, [PatchMod AnchoredPath])] -> IO ()
createPatchIndexFrom Repository rt p wR wU wT
repo [(PatchId, [PatchMod AnchoredPath])]
pmods = do
    String
inv_hash <- String -> IO String
getInventoryHash String
repodir
    String -> String -> PatchIndex -> IO ()
storePatchIndex String
cdir String
inv_hash ([(PatchId, [PatchMod AnchoredPath])] -> PatchIndex -> PatchIndex
applyPatchMods [(PatchId, [PatchMod AnchoredPath])]
pmods PatchIndex
emptyPatchIndex)
  where repodir :: String
repodir = Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
repoLocation Repository rt p wR wU wT
repo
        cdir :: String
cdir = String
repodir String -> ShowS
</> String
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 :: String -> IO String
getInventoryHash String
repodir = do
  ByteString
inv <- String -> IO ByteString
B.readFile (String
repodir String -> ShowS
</> String
darcsdir String -> ShowS
</> String
"hashed_inventory")
  String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
sha256sum ByteString
inv

-- | Load patch-index from disk along with some meta data.
loadPatchIndex :: FilePath -> IO (Int8, String, Map PatchId Int, PatchIndex)
loadPatchIndex :: String -> IO (Int8, String, Map PatchId Int, PatchIndex)
loadPatchIndex String
repodir = do
  let pindex_dir :: String
pindex_dir = String
repodir String -> ShowS
</> String
indexDir
  (Int8
v,String
inv_hash) <- String -> IO (Int8, String)
loadRepoState (String
pindex_dir String -> ShowS
</> String
repoStateFile)
  [PatchId]
pids <- String -> IO [PatchId]
loadPatchIds (String
pindex_dir String -> ShowS
</> String
pidsFile)
  let pid2idx :: Map PatchId Int
pid2idx  = [(PatchId, Int)] -> Map PatchId Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PatchId, Int)] -> Map PatchId Int)
-> [(PatchId, Int)] -> Map PatchId Int
forall a b. (a -> b) -> a -> b
$ [PatchId] -> [Int] -> [(PatchId, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [PatchId]
pids [(Int
1::Int)..]
  InfoMap
infom <- String -> IO InfoMap
loadInfoMap (String
pindex_dir String -> ShowS
</> String
touchMapFile)
  FileIdSpans
fidspans <- String -> IO FileIdSpans
loadFidMap (String
pindex_dir String -> ShowS
</> String
fidMapFile)
  FilePathSpans
fpspans <- String -> IO FilePathSpans
loadFpMap (String
pindex_dir String -> ShowS
</> String
fpMapFile)
  (Int8, String, Map PatchId Int, PatchIndex)
-> IO (Int8, String, Map PatchId Int, PatchIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8
v, String
inv_hash, Map PatchId Int
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 wR wU wT
                   -> PatchSet rt p Origin wR     -- ^ PatchSet of the repository, used if we need to create the patch-index.
                   -> IO PatchIndex
loadSafePatchIndex :: Repository rt p wR wU wT
-> PatchSet rt p Origin wR -> IO PatchIndex
loadSafePatchIndex Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps = do
   let repodir :: String
repodir = Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
repoLocation Repository rt p wR wU wT
repo
   Bool
can_use <- Repository rt p wR wU wT -> IO Bool
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO Bool
isPatchIndexInSync Repository rt p wR wU wT
repo
   (Int8
_,String
_,Map PatchId Int
_,PatchIndex
pi) <-
     if Bool
can_use
       then String -> IO (Int8, String, Map PatchId Int, PatchIndex)
loadPatchIndex String
repodir
       else do Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
createOrUpdatePatchIndexDisk Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps
               String -> IO (Int8, String, Map PatchId Int, PatchIndex)
loadPatchIndex String
repodir
   PatchIndex -> IO PatchIndex
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 :: String -> IO Bool
doesPatchIndexExist String
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
<$> (String -> IO Bool) -> [String] -> IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> IO Bool
doesFileExist (String -> IO Bool) -> ShowS -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
pindex_dir String -> ShowS
</>))
                    [String
repoStateFile, String
pidsFile, String
touchMapFile, String
fidMapFile, String
fpMapFile]
 if Bool
filesArePresent
  then do Int8
v <- IO Int8
piVersion
          Bool -> IO Bool
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 (m :: * -> *) a. Monad m => a -> m a
return Bool
False
   where pindex_dir :: String
pindex_dir = String
repodir String -> ShowS
</> String
indexDir
         piVersion :: IO Int8
piVersion = (Int8, String) -> Int8
forall a b. (a, b) -> a
fst ((Int8, String) -> Int8) -> IO (Int8, String) -> IO Int8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Int8, String)
loadRepoState (String
pindex_dir String -> ShowS
</> String
repoStateFile)

-- | Read-only. Checks if @_darcs\/noPatchIndex@ exists, that is, if patch-index is explicitely disabled.
isPatchIndexDisabled :: FilePath -> IO Bool
isPatchIndexDisabled :: String -> IO Bool
isPatchIndexDisabled String
repodir = String -> IO Bool
doesFileExist (String
repodir String -> ShowS
</> String
darcsdir  String -> ShowS
</> String
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 wR wU wT -> PatchSet rt p Origin wR -> IO ()
createOrUpdatePatchIndexDisk :: Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
createOrUpdatePatchIndexDisk Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps = do
   let repodir :: String
repodir = Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
repoLocation Repository rt p wR wU wT
repo
   String -> IO ()
removeFile (String
repodir String -> ShowS
</> String
darcsdir String -> ShowS
</> String
noPatchIndex) IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOError
_ :: IOError) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
   Bool
dpie <- String -> IO Bool
doesPatchIndexExist String
repodir
   if Bool
dpie
      then Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
updatePatchIndexDisk Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps
      else Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
createPatchIndexDisk Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps

-- | 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 wR wU wT -> IO Bool
canUsePatchIndex :: Repository rt p wR wU wT -> IO Bool
canUsePatchIndex Repository rt p wR wU wT
repo = do
     let repodir :: String
repodir = Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
repoLocation Repository rt p wR wU wT
repo
     Bool
piExists <- String -> IO Bool
doesPatchIndexExist String
repodir
     Bool
piDisabled <- String -> IO Bool
isPatchIndexDisabled String
repodir
     case (Bool
piExists, Bool
piDisabled) of
        (Bool
True, Bool
False) -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        (Bool
False, Bool
True) -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        (Bool
True, Bool
True) -> String -> IO Bool
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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 (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 wR wU wT -> PatchSet rt p Origin wR -> IO ()
createPIWithInterrupt :: Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
createPIWithInterrupt Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps = do
    let repodir :: String
repodir = Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
repoLocation Repository rt p wR wU wT
repo
    String -> IO ()
putStrLn String
"Creating a patch index, please wait. To stop press Ctrl-C"
    (do
      Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
createPatchIndexDisk Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps
      String -> IO ()
putStrLn String
"Created patch index.") IO () -> IO () -> IO ()
forall a. IO a -> IO a -> IO a
`catchInterrupt` (String -> IO ()
putStrLn String
"Patch Index Disabled" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
deletePatchIndex String
repodir)

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

-- | Stores patch-index on disk.
storePatchIndex :: FilePath -> String -> PatchIndex -> IO ()
storePatchIndex :: String -> String -> PatchIndex -> IO ()
storePatchIndex String
cdir String
inv_hash (PatchIndex [PatchId]
pids FileIdSpans
fidspans FilePathSpans
fpspans InfoMap
infom) = do
  String -> IO ()
createDirectory String
cdir IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOError
_ :: IOError) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  String
tmpdir <- String -> (AbsolutePath -> IO String) -> IO String
forall a. String -> (AbsolutePath -> IO a) -> IO a
withPermDir String
cdir ((AbsolutePath -> IO String) -> IO String)
-> (AbsolutePath -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \AbsolutePath
dir -> do
              String -> IO ()
debugMessage String
"About to create patch index..."
              let tmpdir :: String
tmpdir = AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
dir
              String -> String -> IO ()
storeRepoState (String
tmpdir String -> ShowS
</> String
repoStateFile) String
inv_hash
              String -> [PatchId] -> IO ()
storePatchIds (String
tmpdir String -> ShowS
</> String
pidsFile) [PatchId]
pids
              String -> InfoMap -> IO ()
storeInfoMap (String
tmpdir String -> ShowS
</> String
touchMapFile) InfoMap
infom
              String -> FileIdSpans -> IO ()
storeFidMap (String
tmpdir String -> ShowS
</> String
fidMapFile) FileIdSpans
fidspans
              String -> FilePathSpans -> IO ()
storeFpMap (String
tmpdir String -> ShowS
</> String
fpMapFile) FilePathSpans
fpspans
              String -> IO ()
debugMessage String
"Patch index created"
              String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
tmpdir
  String -> IO ()
removeDirectoryRecursive String
cdir IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOError
_ :: IOError) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  String -> String -> IO ()
renameDirectory String
tmpdir String
cdir

decodeFile :: Binary a => FilePath -> IO a
decodeFile :: String -> IO a
decodeFile String
path = do
  Either (ByteOffset, String) a
result <- String -> IO (Either (ByteOffset, String) a)
forall a. Binary a => String -> IO (Either (ByteOffset, String) a)
decodeFileOrFail String
path
  case Either (ByteOffset, String) a
result of
    Left (ByteOffset
offset, String
msg) ->
      String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$
        String
"Patch index is corrupt (file "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
pathString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" at offset "String -> ShowS
forall a. [a] -> [a] -> [a]
++ByteOffset -> String
forall a. Show a => a -> String
show ByteOffset
offsetString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"): "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
msgString -> ShowS
forall a. [a] -> [a] -> [a]
++
        String
"\nPlease remove the corrupt file and then try again."
    Right a
r -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

storeRepoState :: FilePath -> String -> IO ()
storeRepoState :: String -> String -> IO ()
storeRepoState String
fp String
inv_hash = String -> (Int8, String) -> IO ()
forall a. Binary a => String -> a -> IO ()
encodeFile String
fp (Int8
version,String
inv_hash)

loadRepoState :: FilePath -> IO (Int8, String)
loadRepoState :: String -> IO (Int8, String)
loadRepoState = String -> IO (Int8, String)
forall a. Binary a => String -> IO a
decodeFile

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

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

storeFidMap :: FilePath -> FileIdSpans -> IO ()
storeFidMap :: String -> FileIdSpans -> IO ()
storeFidMap String
fp FileIdSpans
fidm =
  String -> Map AnchoredPath [(FileId, PatchId, PatchId)] -> IO ()
forall a. Binary a => String -> a -> IO ()
encodeFile String
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 :: String -> IO FileIdSpans
loadFidMap String
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
<$> String -> IO (Map AnchoredPath [(FileId, PatchId, PatchId)])
forall a. Binary a => String -> IO a
decodeFile String
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 :: String -> FilePathSpans -> IO ()
storeFpMap String
fp FilePathSpans
fidm =
  String -> Map FileId [(AnchoredPath, PatchId, PatchId)] -> IO ()
forall a. Binary a => String -> a -> IO ()
encodeFile String
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 :: String -> IO FilePathSpans
loadFpMap String
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
<$> String -> IO (Map FileId [(AnchoredPath, PatchId, PatchId)])
forall a. Binary a => String -> IO a
decodeFile String
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 :: String -> InfoMap -> IO ()
storeInfoMap String
fp InfoMap
infom =
  String -> Map FileId (Bool, Set Word32) -> IO ()
forall a. Binary a => String -> a -> IO ()
encodeFile String
fp (Map FileId (Bool, Set Word32) -> IO ())
-> Map FileId (Bool, Set Word32) -> IO ()
forall a b. (a -> b) -> a -> b
$ (FileInfo -> (Bool, Set Word32))
-> InfoMap -> Map FileId (Bool, Set Word32)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\FileInfo
fi -> (FileInfo -> Bool
isFile FileInfo
fi, FileInfo -> Set Word32
touching FileInfo
fi)) InfoMap
infom

loadInfoMap :: FilePath -> IO InfoMap
loadInfoMap :: String -> IO InfoMap
loadInfoMap String
fp = ((Bool, Set Word32) -> FileInfo)
-> Map FileId (Bool, Set Word32) -> InfoMap
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\(Bool
isF,Set Word32
pids) -> Bool -> Set Word32 -> FileInfo
FileInfo Bool
isF Set Word32
pids) (Map FileId (Bool, Set Word32) -> InfoMap)
-> IO (Map FileId (Bool, Set Word32)) -> IO InfoMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Map FileId (Bool, Set Word32))
forall a. Binary a => String -> IO a
decodeFile String
fp

indexDir, repoStateFile, pidsFile, fidMapFile, fpMapFile,
  touchMapFile, noPatchIndex :: String
indexDir :: String
indexDir = String
darcsdir String -> ShowS
</> String
"patch_index"
repoStateFile :: String
repoStateFile = String
"repo_state"
pidsFile :: String
pidsFile = String
"patch_ids"
fidMapFile :: String
fidMapFile = String
"fid_map"
fpMapFile :: String
fpMapFile = String
"fp_map"
touchMapFile :: String
touchMapFile = String
"touch_map"
noPatchIndex :: String
noPatchIndex = String
"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 :: String -> IO ()
deletePatchIndex String
repodir = do
    Bool
exists <- String -> IO Bool
doesDirectoryExist String
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
$
         String -> IO ()
removeDirectoryRecursive String
indexDir
            IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOError
e :: IOError) -> String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error: Could not delete patch index\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ IOError -> String
forall a. Show a => a -> String
show IOError
e
    (String -> IOMode -> IO Handle
openFile (String
repodir String -> ShowS
</> String
darcsdir String -> ShowS
</> String
noPatchIndex) IOMode
WriteMode IO Handle -> (Handle -> IO ()) -> IO ()
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) -> String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error: Could not disable patch index\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ IOError -> String
forall a. Show a => a -> String
show IOError
e

dumpRepoState :: [PatchId] -> String
dumpRepoState :: [PatchId] -> String
dumpRepoState = [String] -> String
unlines ([String] -> String)
-> ([PatchId] -> [String]) -> [PatchId] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PatchId -> String) -> [PatchId] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map PatchId -> String
pid2string

dumpFileIdSpans :: FileIdSpans -> String
dumpFileIdSpans :: FileIdSpans -> String
dumpFileIdSpans FileIdSpans
fidspans =
  [String] -> String
unlines [AnchoredPath -> String
displayPath AnchoredPath
fnString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" -> "String -> ShowS
forall a. [a] -> [a] -> [a]
++FileId -> String
showFileId FileId
fidString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" from "String -> ShowS
forall a. [a] -> [a] -> [a]
++PatchId -> String
pid2string PatchId
fromString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" to "String -> ShowS
forall a. [a] -> [a] -> [a]
++String -> (PatchId -> String) -> Maybe PatchId -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"-" PatchId -> String
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 -> String
dumpFilePathSpans FilePathSpans
fpspans =
  [String] -> String
unlines [FileId -> String
showFileId FileId
fidString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" -> "String -> ShowS
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> String
displayPath AnchoredPath
fnString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" from "String -> ShowS
forall a. [a] -> [a] -> [a]
++PatchId -> String
pid2string PatchId
fromString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" to "String -> ShowS
forall a. [a] -> [a] -> [a]
++String -> (PatchId -> String) -> Maybe PatchId -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"-" PatchId -> String
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 -> String
dumpTouchingMap InfoMap
infom = [String] -> String
unlines [FileId -> String
showFileId FileId
fidString -> ShowS
forall a. [a] -> [a] -> [a]
++(if Bool
isF then String
"" else String
"/")String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" -> "String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
showAsHex Word32
w32
                                | (FileId
fid,FileInfo Bool
isF Set Word32
w32s) <- InfoMap -> [(FileId, FileInfo)]
forall k a. Map k a -> [(k, a)]
M.toList InfoMap
infom, Word32
w32 <- Set Word32 -> [Word32]
forall a. Set a -> [a]
S.elems Set Word32
w32s]

-- | return set of current filepaths in patch index
fpSpans2filePaths :: FilePathSpans -> InfoMap -> [FilePath]
fpSpans2filePaths :: FilePathSpans -> InfoMap -> [String]
fpSpans2filePaths FilePathSpans
fpSpans InfoMap
infom =
  [String] -> [String]
forall a. Ord a => [a] -> [a]
sort [AnchoredPath -> String
displayPath AnchoredPath
fn String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Bool
isF then String
"" else String
"/") | (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 Set Word32
_) = FileId -> InfoMap -> Maybe FileInfo
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FileId
fid InfoMap
infom]

-- | return set of current filepaths in patch index, for internal use
fpSpans2filePaths' :: FileIdSpans -> [AnchoredPath]
fpSpans2filePaths' :: FileIdSpans -> [AnchoredPath]
fpSpans2filePaths' FileIdSpans
fidSpans = [AnchoredPath
fp | (AnchoredPath
fp, [FileIdSpan]
_)  <- FileIdSpans -> [(AnchoredPath, [FileIdSpan])]
forall k a. Map k a -> [(k, a)]
M.toList FileIdSpans
fidSpans]

-- | Checks if patch index can be created and build it with interrupt.
attemptCreatePatchIndex
  :: (RepoPatch p, ApplyState p ~ Tree)
  => Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
attemptCreatePatchIndex :: Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
attemptCreatePatchIndex Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps = do
  Bool
canCreate <- Repository rt p wR wU wT -> IO Bool
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO Bool
canCreatePI Repository rt p wR wU wT
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 wR wU wT -> PatchSet rt p Origin wR -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
createPIWithInterrupt Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps

-- | 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 wR wU wT -> IO Bool
canCreatePI :: Repository rt p wR wU wT -> IO Bool
canCreatePI Repository rt p wR wU wT
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)
sequence [ RepoFormat -> IO Bool
doesntHaveHashedInventory (Repository rt p wR wU wT -> RepoFormat
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
repo)
                            , String -> IO Bool
isPatchIndexDisabled String
repodir
                            , String -> IO Bool
doesPatchIndexExist String
repodir
                            ]
  where
    repodir :: String
repodir = Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
repoLocation Repository rt p wR wU wT
repo
    doesntHaveHashedInventory :: RepoFormat -> IO Bool
doesntHaveHashedInventory = Bool -> IO Bool
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 rt p)
    => Sealed ((RL a) wK)
    -- ^ Sequence of patches you want to filter
    -> Repository rt p wR wU wR
    -- ^ The repository (to attempt loading patch-index from its path)
    -> PatchSet rt 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 :: Sealed (RL a wK)
-> Repository rt p wR wU wR
-> PatchSet rt p Origin wR
-> [AnchoredPath]
-> IO (Sealed (RL a Origin))
getRelevantSubsequence Sealed (RL a wK)
pxes Repository rt p wR wU wR
repository PatchSet rt p Origin wR
ps [AnchoredPath]
fns = do
    pi :: PatchIndex
pi@(PatchIndex [PatchId]
_ FileIdSpans
_ FilePathSpans
_ InfoMap
infom) <- Repository rt p wR wU wR
-> PatchSet rt p Origin wR -> IO PatchIndex
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> PatchSet rt p Origin wR -> IO PatchIndex
loadSafePatchIndex Repository rt p wR wU wR
repository PatchSet rt p Origin wR
ps
    let fids :: [FileId]
fids = (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 :: [Set Word32]
pidss = (FileId -> Set Word32) -> [FileId] -> [Set Word32]
forall a b. (a -> b) -> [a] -> [b]
map ((\(FileInfo Bool
_ Set Word32
a) -> Set Word32
a) (FileInfo -> Set Word32)
-> (FileId -> FileInfo) -> FileId -> Set Word32
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 :: Set Word32
pids = [Set Word32] -> Set Word32
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions [Set Word32]
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 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 (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 -> Set Word32 -> RL a Origin Any
forall (p :: * -> * -> *) (a :: * -> * -> *) (rt :: RepoType) wX wY
       wB wP wQ.
(RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd rt p) =>
FL a wX wY -> RL a wB wX -> Set Word32 -> RL a wP wQ
keepElems FL a wK Any
forall wZ. FL a wK wZ
flpxes RL a wK wK
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL Set Word32
pids
  where
    keepElems :: (RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd rt p)
              => FL a wX wY -> RL a wB wX -> S.Set Word32 -> RL a wP wQ
    keepElems :: FL a wX wY -> RL a wB wX -> Set Word32 -> RL a wP wQ
keepElems FL a wX wY
NilFL RL a wB wX
acc Set Word32
_ = 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 Set Word32
pids
      | PatchId -> Word32
short (PatchInfo -> PatchId
makePatchID (PatchInfo -> PatchId) -> PatchInfo -> PatchId
forall a b. (a -> b) -> a -> b
$ PatchInfoAndG rt (Named p) wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info a wX wY
PatchInfoAndG rt (Named p) wX wY
x) Word32 -> Set Word32 -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Word32
pids = FL a wY wY -> RL a wB wY -> Set Word32 -> RL a wP wQ
forall (p :: * -> * -> *) (a :: * -> * -> *) (rt :: RepoType) wX wY
       wB wP wQ.
(RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd rt p) =>
FL a wX wY -> RL a wB wX -> Set Word32 -> RL a wP wQ
keepElems FL a wY wY
xs (RL a wB wX
acc 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) Set Word32
pids
      | Bool
otherwise = FL a wX Any -> RL a wB wX -> Set Word32 -> RL a wP wQ
forall (p :: * -> * -> *) (a :: * -> * -> *) (rt :: RepoType) wX wY
       wB wP wQ.
(RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd rt p) =>
FL a wX wY -> RL a wB wX -> Set Word32 -> RL a wP wQ
keepElems (FL a wY wY -> 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 Set Word32
pids

type PatchFilter rt p = [AnchoredPath] -> [Sealed2 (PatchInfoAnd rt p)] -> IO [Sealed2 (PatchInfoAnd rt 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 wR wU wT  -- ^ The repository
    -> PatchSet rt p Origin wR   -- ^ PatchSet of patches of repository (in case patch-index needs to be created)
    -> PatchFilter rt p          -- ^ PatchFilter ready to be used by SelectChanges.
maybeFilterPatches :: Repository rt p wR wU wT
-> PatchSet rt p Origin wR -> PatchFilter rt p
maybeFilterPatches Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps [AnchoredPath]
fps [Sealed2 (PatchInfoAnd rt p)]
ops = do
    Bool
usePI <- Repository rt p wR wU wT -> IO Bool
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO Bool
canUsePatchIndex Repository rt p wR wU wT
repo
    if Bool
usePI
      then do
        pi :: PatchIndex
pi@(PatchIndex [PatchId]
_ FileIdSpans
_ FilePathSpans
_ InfoMap
infom) <- Repository rt p wR wU wT
-> PatchSet rt p Origin wR -> IO PatchIndex
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> PatchSet rt p Origin wR -> IO PatchIndex
loadSafePatchIndex Repository rt p wR wU wT
repo PatchSet rt p Origin wR
ps
        let fids :: [FileId]
fids = (AnchoredPath -> [FileId]) -> [AnchoredPath] -> [FileId]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((\AnchoredPath
fn -> PIM [FileId] -> PatchIndex -> [FileId]
forall s a. State s a -> s -> a
evalState (AnchoredPath -> PIM [FileId]
lookupFids' AnchoredPath
fn) PatchIndex
pi)) [AnchoredPath]
fps
            npids :: Set Word32
npids = [Set Word32] -> Set Word32
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ([Set Word32] -> Set Word32) -> [Set Word32] -> Set Word32
forall a b. (a -> b) -> a -> b
$ (FileId -> Set Word32) -> [FileId] -> [Set Word32]
forall a b. (a -> b) -> [a] -> [b]
map (FileInfo -> Set Word32
touching(FileInfo -> Set Word32)
-> (FileId -> FileInfo) -> FileId -> Set Word32
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 rt p)] -> IO [Sealed2 (PatchInfoAnd rt p)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Sealed2 (PatchInfoAnd rt p)] -> IO [Sealed2 (PatchInfoAnd rt p)])
-> [Sealed2 (PatchInfoAnd rt p)]
-> IO [Sealed2 (PatchInfoAnd rt p)]
forall a b. (a -> b) -> a -> b
$ (Sealed2 (PatchInfoAnd rt p) -> Bool)
-> [Sealed2 (PatchInfoAnd rt p)] -> [Sealed2 (PatchInfoAnd rt p)]
forall a. (a -> Bool) -> [a] -> [a]
filter
          ((Word32 -> Set Word32 -> Bool) -> Set Word32 -> Word32 -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word32 -> Set Word32 -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Set Word32
npids (Word32 -> Bool)
-> (Sealed2 (PatchInfoAnd rt p) -> Word32)
-> Sealed2 (PatchInfoAnd rt p)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall wX wY. PatchInfoAnd rt p wX wY -> Word32)
-> Sealed2 (PatchInfoAnd rt p) -> Word32
forall (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
unseal2 (PatchId -> Word32
short (PatchId -> Word32)
-> (PatchInfoAndG rt (Named p) wX wY -> PatchId)
-> PatchInfoAndG rt (Named p) wX wY
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfo -> PatchId
makePatchID (PatchInfo -> PatchId)
-> (PatchInfoAndG rt (Named p) wX wY -> PatchInfo)
-> PatchInfoAndG rt (Named p) wX wY
-> PatchId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAndG rt (Named p) wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info))) [Sealed2 (PatchInfoAnd rt p)]
ops
      else [Sealed2 (PatchInfoAnd rt p)] -> IO [Sealed2 (PatchInfoAnd rt p)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Sealed2 (PatchInfoAnd rt p)]
ops

-- | Dump information in patch index. Patch-index should be checked to exist beforehand. Read-only.
dumpPatchIndex :: FilePath -> IO ()
dumpPatchIndex :: String -> IO ()
dumpPatchIndex String
repodir = do
  (Int8
_,String
inv_hash,Map PatchId Int
_,PatchIndex [PatchId]
pids FileIdSpans
fidspans FilePathSpans
fpspans InfoMap
infom) <- String -> IO (Int8, String, Map PatchId Int, PatchIndex)
loadPatchIndex String
repodir
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    [ String
"Inventory hash:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
inv_hash
    , String
"================="
    , String
"Repo state:"
    , String
"==========="
    , [PatchId] -> String
dumpRepoState [PatchId]
pids
    , String
"Fileid spans:"
    , String
"============="
    , FileIdSpans -> String
dumpFileIdSpans FileIdSpans
fidspans
    , String
"Filepath spans:"
    , String
"=============="
    , FilePathSpans -> String
dumpFilePathSpans FilePathSpans
fpspans
    , String
"Info Map:"
    , String
"========="
    , InfoMap -> String
dumpTouchingMap InfoMap
infom
    , String
"Files:"
    , String
"=============="
    ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ FilePathSpans -> InfoMap -> [String]
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 :: String -> IO ()
piTest String
repodir = do
   (Int8
_,String
_,Map PatchId Int
_,PatchIndex [PatchId]
rpids FileIdSpans
fidspans FilePathSpans
fpspans InfoMap
infom) <- String -> IO (Int8, String, Map PatchId Int, PatchIndex)
loadPatchIndex String
repodir
   let pids :: [PatchId]
pids = [PatchId] -> [PatchId]
forall a. [a] -> [a]
reverse [PatchId]
rpids

   -- test fidspans
   String -> IO ()
putStrLn String
"fidspans"
   String -> IO ()
putStrLn String
"==========="
   [(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) (String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"In order test failed! filename: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> String
forall a. Show a => a -> String
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) (String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Valid file id test failed! fid: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FileId -> String
forall a. Show a => a -> String
show FileId
fid)
   String -> IO ()
putStrLn String
"fidspans tests passed"

   -- test fpspans
   String -> IO ()
putStrLn String
"fpspans"
   String -> IO ()
putStrLn String
"==========="
   [(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) (String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"In order test failed! fileid: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FileId -> String
forall a. Show a => a -> String
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) (String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Valid file name test failed! file name: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> String
forall a. Show a => a -> String
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
_ = String -> Bool
forall a. HasCallStack => String -> a
error String
"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. [a] -> [a]
tail [FilePathSpan]
spans)) (String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Adjcency test failed! fid: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FileId -> String
forall a. Show a => a -> String
show FileId
fid)
   String -> IO ()
putStrLn String
"fpspans tests passed"

   -- test infomap
   String -> IO ()
putStrLn String
"infom"
   String -> IO ()
putStrLn String
"==========="
   String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Valid fid test: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Bool -> String
forall a. Show a => a -> String
show(Bool -> String) -> ([Bool] -> Bool) -> [Bool] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> String) -> [Bool] -> String
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))
   String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Valid pid test: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Bool -> String
forall a. Show a => a -> String
show(Bool -> String) -> (InfoMap -> Bool) -> InfoMap -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Set Word32 -> Set Word32 -> Bool)
-> Set Word32 -> Set Word32 -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Set Word32 -> Set Word32 -> Bool
forall a. Ord a => Set a -> Set a -> Bool
S.isSubsetOf ([Word32] -> Set Word32
forall a. Ord a => [a] -> Set a
S.fromList ([Word32] -> Set Word32) -> [Word32] -> Set Word32
forall a b. (a -> b) -> a -> b
$ (PatchId -> Word32) -> [PatchId] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map PatchId -> Word32
short [PatchId]
pids)  (Set Word32 -> Bool) -> (InfoMap -> Set Word32) -> InfoMap -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Set Word32] -> Set Word32
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ([Set Word32] -> Set Word32)
-> (InfoMap -> [Set Word32]) -> InfoMap -> Set Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileInfo -> Set Word32) -> [FileInfo] -> [Set Word32]
forall a b. (a -> b) -> [a] -> [b]
map FileInfo -> Set Word32
touching ([FileInfo] -> [Set Word32])
-> (InfoMap -> [FileInfo]) -> InfoMap -> [Set Word32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InfoMap -> [FileInfo]
forall k a. Map k a -> [a]
M.elems (InfoMap -> String) -> InfoMap -> String
forall a b. (a -> b) -> a -> b
$ InfoMap
infom)
   where
          isInOrder :: Eq a => [a] -> [a] -> Bool
          isInOrder :: [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