{-# LANGUAGE OverloadedStrings #-}
module Darcs.UI.Commands.Annotate ( annotate ) where
import Prelude ()
import Darcs.Prelude
import Control.Arrow ( first )
import Control.Monad ( when )
import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, amInHashedRepository )
import Darcs.UI.Completion ( knownFileArgs )
import Darcs.UI.Flags ( DarcsFlag, useCache, fixSubPaths, patchIndexYes )
import Darcs.UI.Options ( (^), odesc, ocheck, onormalise
, defaultFlags, parseFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.Repository.State ( readRecorded )
import Darcs.Repository
( withRepository
, withRepoLockCanFail
, RepoJob(..)
, readRepo
, repoPatchType
)
import Darcs.Repository.PatchIndex ( attemptCreatePatchIndex )
import Darcs.Patch.Set ( patchSet2RL )
import Darcs.Patch ( invertRL )
import qualified Data.ByteString.Char8 as BC ( pack, concat, intercalate )
import Data.ByteString.Lazy ( toChunks )
import Darcs.Patch.ApplyMonad( withFileNames )
import System.FilePath.Posix ( (</>) )
import Darcs.Patch.Match ( haveNonrangeMatch, getNonrangeMatchS )
import Darcs.Repository.Match ( getOnePatchset )
import Darcs.Repository.PatchIndex ( getRelevantSubsequence, canUsePatchIndex )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), seal )
import qualified Darcs.Patch.Annotate as A
import Darcs.Util.Tree( TreeItem(..), readBlob, list, expand )
import Darcs.Util.Tree.Monad( findM, virtualTreeIO )
import Darcs.Util.Path( floatPath, anchorPath, fp2fn, toFilePath
, AbsolutePath, SubPath )
import Darcs.Util.Exception ( die )
annotateDescription :: String
annotateDescription :: String
annotateDescription = "Annotate lines of a file with the last patch that modified it."
annotateHelp :: String
annotateHelp :: String
annotateHelp = [String] -> String
unlines
[ "When `darcs annotate` is called on a file, it will find the patch that"
, "last modified each line in that file. This also works on directories."
, ""
, "The `--machine-readable` option can be used to generate output for"
, "machine postprocessing."
]
annotate :: DarcsCommand [DarcsFlag]
annotate :: DarcsCommand [DarcsFlag]
annotate = DarcsCommand :: forall parsedFlags.
String
-> String
-> String
-> String
-> Int
-> [String]
-> ((AbsolutePath, AbsolutePath)
-> parsedFlags -> [String] -> IO ())
-> ([DarcsFlag] -> IO (Either String ()))
-> ((AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String])
-> ([DarcsFlag] -> AbsolutePath -> [String] -> IO [String])
-> [DarcsOptDescr DarcsFlag]
-> [DarcsOptDescr DarcsFlag]
-> [DarcsFlag]
-> ([DarcsFlag] -> [String])
-> ([DarcsFlag] -> parsedFlags)
-> DarcsCommand parsedFlags
DarcsCommand
{ commandProgramName :: String
commandProgramName = "darcs"
, commandName :: String
commandName = "annotate"
, commandHelp :: String
commandHelp = String
annotateHelp
, commandDescription :: String
commandDescription = String
annotateDescription
, commandExtraArgs :: Int
commandExtraArgs = 1
, commandExtraArgHelp :: [String]
commandExtraArgHelp = ["[FILE or DIRECTORY]"]
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
annotateCmd
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
knownFileArgs
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
, commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = OptSpec DarcsOptDescr DarcsFlag Any (WithPatchIndex -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec DarcsOptDescr DarcsFlag Any (WithPatchIndex -> Any)
forall a. PrimOptSpec DarcsOptDescr DarcsFlag a WithPatchIndex
annotateAdvancedOpts
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = OptSpec
DarcsOptDescr
DarcsFlag
Any
(Bool -> [MatchFlag] -> Maybe String -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
DarcsOptDescr
DarcsFlag
Any
(Bool -> [MatchFlag] -> Maybe String -> Any)
forall a.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Bool -> [MatchFlag] -> Maybe String -> a)
annotateBasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> UseCache
-> HooksConfig
-> [DarcsFlag])
-> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> UseCache
-> HooksConfig
-> [DarcsFlag])
forall a.
DarcsOption
a
(Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> UseCache
-> HooksConfig
-> a)
annotateOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = OptSpec
DarcsOptDescr
DarcsFlag
Any
(Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> UseCache
-> HooksConfig
-> Any)
-> [DarcsFlag] -> [String]
forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck OptSpec
DarcsOptDescr
DarcsFlag
Any
(Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> UseCache
-> HooksConfig
-> Any)
forall a.
DarcsOption
a
(Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> UseCache
-> HooksConfig
-> a)
annotateOpts
, commandParseOptions :: [DarcsFlag] -> [DarcsFlag]
commandParseOptions = OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> UseCache
-> HooksConfig
-> [DarcsFlag])
-> [DarcsFlag] -> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f] -> [f]
onormalise OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> UseCache
-> HooksConfig
-> [DarcsFlag])
forall a.
DarcsOption
a
(Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> UseCache
-> HooksConfig
-> a)
annotateOpts
}
where
annotateBasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(Bool -> [MatchFlag] -> Maybe String -> a)
annotateBasicOpts = PrimOptSpec
DarcsOptDescr DarcsFlag ([MatchFlag] -> Maybe String -> a) Bool
PrimDarcsOption Bool
O.machineReadable PrimOptSpec
DarcsOptDescr DarcsFlag ([MatchFlag] -> Maybe String -> a) Bool
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> a)
([MatchFlag] -> Maybe String -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> a)
(Bool -> [MatchFlag] -> Maybe String -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> a)
([MatchFlag] -> Maybe String -> a)
MatchOption
O.matchUpToOne OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> a)
(Bool -> [MatchFlag] -> Maybe String -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (Maybe String -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
a
(Bool -> [MatchFlag] -> Maybe String -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (Maybe String -> a)
PrimDarcsOption (Maybe String)
O.repoDir
annotateAdvancedOpts :: PrimOptSpec DarcsOptDescr DarcsFlag a WithPatchIndex
annotateAdvancedOpts = PrimOptSpec DarcsOptDescr DarcsFlag a WithPatchIndex
forall a. PrimOptSpec DarcsOptDescr DarcsFlag a WithPatchIndex
O.patchIndexYes
annotateOpts :: DarcsOption
a
(Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> UseCache
-> HooksConfig
-> a)
annotateOpts = OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> UseCache
-> HooksConfig
-> a)
(Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> UseCache
-> HooksConfig
-> a)
forall a.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Bool -> [MatchFlag] -> Maybe String -> a)
annotateBasicOpts OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> UseCache
-> HooksConfig
-> a)
(Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> UseCache
-> HooksConfig
-> a)
-> DarcsOption
(UseCache -> HooksConfig -> a)
(WithPatchIndex -> UseCache -> HooksConfig -> a)
-> DarcsOption
a
(Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> UseCache
-> HooksConfig
-> a)
forall b c a.
DarcsOption
(Maybe StdCmdAction -> Bool -> Bool -> Verbosity -> Bool -> b) c
-> DarcsOption (UseCache -> HooksConfig -> a) b -> DarcsOption a c
`withStdOpts` DarcsOption
(UseCache -> HooksConfig -> a)
(WithPatchIndex -> UseCache -> HooksConfig -> a)
forall a. PrimOptSpec DarcsOptDescr DarcsFlag a WithPatchIndex
annotateAdvancedOpts
annotateCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
annotateCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
annotateCmd fps :: (AbsolutePath, AbsolutePath)
fps opts :: [DarcsFlag]
opts args :: [String]
args = do
[SubPath]
fixed_paths <- (AbsolutePath, AbsolutePath) -> [String] -> IO [SubPath]
fixSubPaths (AbsolutePath, AbsolutePath)
fps [String]
args
case [SubPath]
fixed_paths of
[] -> String -> IO ()
forall a. String -> IO a
die "Error: annotate needs a filename to work with"
(fixed_path :: SubPath
fixed_path:_) -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. PrimOptSpec DarcsOptDescr DarcsFlag a WithPatchIndex
patchIndexYes (forall a. PrimOptSpec DarcsOptDescr DarcsFlag a WithPatchIndex)
-> [DarcsFlag] -> WithPatchIndex
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts WithPatchIndex -> WithPatchIndex -> Bool
forall a. Eq a => a -> a -> Bool
== WithPatchIndex
O.YesPatchIndex)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ UseCache -> RepoJob () -> IO ()
withRepoLockCanFail (PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(RepoJob () -> IO ()) -> RepoJob () -> IO ()
forall a b. (a -> b) -> a -> b
$ (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO ())
-> RepoJob ()
forall a.
(forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO a)
-> RepoJob a
RepoJob (\repo :: Repository rt p wR wU wR
repo -> Repository rt p wR wU wR -> IO (PatchSet rt p Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wR
repo IO (PatchSet rt p Origin wR)
-> (PatchSet rt p Origin wR -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Repository rt p wR wU wR -> 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 ()
attemptCreatePatchIndex Repository rt p wR wU wR
repo)
[DarcsFlag] -> SubPath -> IO ()
annotateCmd' [DarcsFlag]
opts SubPath
fixed_path
annotateCmd' :: [DarcsFlag] -> SubPath -> IO ()
annotateCmd' :: [DarcsFlag] -> SubPath -> IO ()
annotateCmd' opts :: [DarcsFlag]
opts fixed_path :: SubPath
fixed_path = UseCache -> RepoJob () -> IO ()
forall a. UseCache -> RepoJob a -> IO a
withRepository (PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob () -> IO ()) -> RepoJob () -> IO ()
forall a b. (a -> b) -> a -> b
$ (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO ())
-> RepoJob ()
forall a.
(forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO a)
-> RepoJob a
RepoJob ((forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO ())
-> RepoJob ())
-> (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO ())
-> RepoJob ()
forall a b. (a -> b) -> a -> b
$ \repository :: Repository rt p wR wU wR
repository -> do
let matchFlags :: [MatchFlag]
matchFlags = MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags MatchOption
O.matchUpToOne [DarcsFlag]
opts
PatchSet rt p Origin wR
r <- Repository rt p wR wU wR -> IO (PatchSet rt p Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wR
repository
Tree IO
recorded <- Repository rt p wR wU wR -> IO (Tree IO)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO (Tree IO)
readRecorded Repository rt p wR wU wR
repository
(patches :: Sealed (RL (PatchInfoAnd rt p) Origin)
patches, initial :: Tree IO
initial, path' :: String
path') <-
if PatchType rt p -> [MatchFlag] -> Bool
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, Matchable p) =>
PatchType rt p -> [MatchFlag] -> Bool
haveNonrangeMatch (Repository rt p wR wU wR -> PatchType rt p
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> PatchType rt p
repoPatchType Repository rt p wR wU wR
repository) [MatchFlag]
matchFlags
then do Sealed x :: PatchSet rt p Origin wX
x <- Repository rt p wR wU wR
-> [MatchFlag] -> IO (Sealed (PatchSet rt p Origin))
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT
-> [MatchFlag] -> IO (SealedPatchSet rt p Origin)
getOnePatchset Repository rt p wR wU wR
repository [MatchFlag]
matchFlags
let fn :: [FileName]
fn = [String -> FileName
fp2fn (String -> FileName) -> String -> FileName
forall a b. (a -> b) -> a -> b
$ SubPath -> String
forall a. FilePathLike a => a -> String
toFilePath SubPath
fixed_path]
nonRangeMatch :: StateT FilePathMonadState Identity ()
nonRangeMatch = [MatchFlag]
-> PatchSet rt p Origin wR -> StateT FilePathMonadState Identity ()
forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX.
(ApplyMonad (ApplyState p) m, MonadProgress m, IsRepoType rt,
Matchable p, ApplyState p ~ Tree) =>
[MatchFlag] -> PatchSet rt p Origin wX -> m ()
getNonrangeMatchS [MatchFlag]
matchFlags PatchSet rt p Origin wR
r
(_, [path :: FileName
path], _) = Maybe [OrigFileNameOf]
-> [FileName]
-> StateT FilePathMonadState Identity ()
-> FilePathMonadState
forall a.
Maybe [OrigFileNameOf]
-> [FileName] -> FilePathMonad a -> FilePathMonadState
withFileNames Maybe [OrigFileNameOf]
forall a. Maybe a
Nothing [FileName]
fn StateT FilePathMonadState Identity ()
nonRangeMatch
Tree IO
initial <- ((), Tree IO) -> Tree IO
forall a b. (a, b) -> b
snd (((), Tree IO) -> Tree IO) -> IO ((), Tree IO) -> IO (Tree IO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` TreeIO () -> Tree IO -> IO ((), Tree IO)
forall a. TreeIO a -> Tree IO -> IO (a, Tree IO)
virtualTreeIO ([MatchFlag] -> PatchSet rt p Origin wR -> TreeIO ()
forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX.
(ApplyMonad (ApplyState p) m, MonadProgress m, IsRepoType rt,
Matchable p, ApplyState p ~ Tree) =>
[MatchFlag] -> PatchSet rt p Origin wX -> m ()
getNonrangeMatchS [MatchFlag]
matchFlags PatchSet rt p Origin wR
r) Tree IO
recorded
(Sealed (RL (PatchInfoAnd rt p) Origin), Tree IO, String)
-> IO (Sealed (RL (PatchInfoAnd rt p) Origin), Tree IO, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (RL (PatchInfoAnd rt p) Origin wX
-> Sealed (RL (PatchInfoAnd rt p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (RL (PatchInfoAnd rt p) Origin wX
-> Sealed (RL (PatchInfoAnd rt p) Origin))
-> RL (PatchInfoAnd rt p) Origin wX
-> Sealed (RL (PatchInfoAnd rt p) Origin)
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wX -> RL (PatchInfoAnd rt p) Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX
patchSet2RL PatchSet rt p Origin wX
x, Tree IO
initial, FileName -> String
forall a. FilePathLike a => a -> String
toFilePath FileName
path)
else (Sealed (RL (PatchInfoAnd rt p) Origin), Tree IO, String)
-> IO (Sealed (RL (PatchInfoAnd rt p) Origin), Tree IO, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (RL (PatchInfoAnd rt p) Origin wR
-> Sealed (RL (PatchInfoAnd rt p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (RL (PatchInfoAnd rt p) Origin wR
-> Sealed (RL (PatchInfoAnd rt p) Origin))
-> RL (PatchInfoAnd rt p) Origin wR
-> Sealed (RL (PatchInfoAnd rt p) Origin)
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wR -> RL (PatchInfoAnd rt p) Origin wR
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX
patchSet2RL PatchSet rt p Origin wR
r, Tree IO
recorded, SubPath -> String
forall a. FilePathLike a => a -> String
toFilePath SubPath
fixed_path)
let path :: String
path = "./" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path'
Maybe (TreeItem IO)
found <- Tree IO -> AnchoredPath -> IO (Maybe (TreeItem IO))
forall (m :: * -> *).
Monad m =>
Tree m -> AnchoredPath -> m (Maybe (TreeItem m))
findM Tree IO
initial (String -> AnchoredPath
floatPath (String -> AnchoredPath) -> String -> AnchoredPath
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. FilePathLike a => a -> String
toFilePath String
path)
let fmt :: ByteString -> AnnotateResult -> String
fmt = if PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimDarcsOption Bool
O.machineReadable [DarcsFlag]
opts then ByteString -> AnnotateResult -> String
A.machineFormat else ByteString -> AnnotateResult -> String
A.format
Bool
usePatchIndex <- (WithPatchIndex -> Bool
forall a. YesNo a => a -> Bool
O.yes (forall a. PrimOptSpec DarcsOptDescr DarcsFlag a WithPatchIndex
O.patchIndexYes (forall a. PrimOptSpec DarcsOptDescr DarcsFlag a WithPatchIndex)
-> [DarcsFlag] -> WithPatchIndex
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) Bool -> Bool -> Bool
&&) (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Repository rt p wR wU wR -> IO Bool
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO Bool
canUsePatchIndex Repository rt p wR wU wR
repository
case Maybe (TreeItem IO)
found of
Nothing -> String -> IO ()
forall a. String -> IO a
die (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Error: no such file or directory: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. FilePathLike a => a -> String
toFilePath String
path
Just (SubTree s :: Tree IO
s) -> do
Tree IO
s' <- Tree IO -> IO (Tree IO)
forall (m :: * -> *). Monad m => Tree m -> m (Tree m)
expand Tree IO
s
let subs :: [FileName]
subs = ((AnchoredPath, TreeItem IO) -> FileName)
-> [(AnchoredPath, TreeItem IO)] -> [FileName]
forall a b. (a -> b) -> [a] -> [b]
map (String -> FileName
fp2fn (String -> FileName)
-> ((AnchoredPath, TreeItem IO) -> String)
-> (AnchoredPath, TreeItem IO)
-> FileName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
path String -> String -> String
</>) (String -> String)
-> ((AnchoredPath, TreeItem IO) -> String)
-> (AnchoredPath, TreeItem IO)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> AnchoredPath -> String
anchorPath "" (AnchoredPath -> String)
-> ((AnchoredPath, TreeItem IO) -> AnchoredPath)
-> (AnchoredPath, TreeItem IO)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnchoredPath, TreeItem IO) -> AnchoredPath
forall a b. (a, b) -> a
fst) ([(AnchoredPath, TreeItem IO)] -> [FileName])
-> [(AnchoredPath, TreeItem IO)] -> [FileName]
forall a b. (a -> b) -> a -> b
$ Tree IO -> [(AnchoredPath, TreeItem IO)]
forall (m :: * -> *). Tree m -> [(AnchoredPath, TreeItem m)]
list Tree IO
s'
showPath :: (String, TreeItem m) -> ByteString
showPath (n :: String
n, File _) = String -> ByteString
BC.pack (String
path String -> String -> String
</> String
n)
showPath (n :: String
n, _) = [ByteString] -> ByteString
BC.concat [String -> ByteString
BC.pack (String
path String -> String -> String
</> String
n), "/"]
(Sealed ans_patches :: RL (PatchInfoAnd rt p) Origin wX
ans_patches) <- do
if Bool -> Bool
not Bool
usePatchIndex
then Sealed (RL (PatchInfoAnd rt p) Origin)
-> IO (Sealed (RL (PatchInfoAnd rt p) Origin))
forall (m :: * -> *) a. Monad m => a -> m a
return Sealed (RL (PatchInfoAnd rt p) Origin)
patches
else Sealed (RL (PatchInfoAnd rt p) Origin)
-> Repository rt p wR wU wR
-> PatchSet rt p Origin wR
-> [FileName]
-> IO (Sealed (RL (PatchInfoAnd rt p) Origin))
forall (p :: * -> * -> *) (a :: * -> * -> *) (rt :: RepoType) wK wR
wU.
(RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd rt p) =>
Sealed (RL a wK)
-> Repository rt p wR wU wR
-> PatchSet rt p Origin wR
-> [FileName]
-> IO (Sealed (RL a Origin))
getRelevantSubsequence Sealed (RL (PatchInfoAnd rt p) Origin)
patches Repository rt p wR wU wR
repository PatchSet rt p Origin wR
r [FileName]
subs
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> AnnotateResult -> String
fmt (ByteString -> [ByteString] -> ByteString
BC.intercalate "\n" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$
((AnchoredPath, TreeItem IO) -> ByteString)
-> [(AnchoredPath, TreeItem IO)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ((String, TreeItem IO) -> ByteString
forall (m :: * -> *). (String, TreeItem m) -> ByteString
showPath ((String, TreeItem IO) -> ByteString)
-> ((AnchoredPath, TreeItem IO) -> (String, TreeItem IO))
-> (AnchoredPath, TreeItem IO)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnchoredPath -> String)
-> (AnchoredPath, TreeItem IO) -> (String, TreeItem IO)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (String -> AnchoredPath -> String
anchorPath "")) ([(AnchoredPath, TreeItem IO)] -> [ByteString])
-> [(AnchoredPath, TreeItem IO)] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Tree IO -> [(AnchoredPath, TreeItem IO)]
forall (m :: * -> *). Tree m -> [(AnchoredPath, TreeItem m)]
list Tree IO
s') (AnnotateResult -> String) -> AnnotateResult -> String
forall a b. (a -> b) -> a -> b
$
FL (PatchInfoAnd rt p) wX Origin
-> FileName -> [FileName] -> AnnotateResult
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
Annotate p =>
FL (PatchInfoAnd rt p) wX wY
-> FileName -> [FileName] -> AnnotateResult
A.annotateDirectory (RL (PatchInfoAnd rt p) Origin wX
-> FL (PatchInfoAnd rt p) wX Origin
forall (p :: * -> * -> *) wX wY.
Invert p =>
RL p wX wY -> FL p wY wX
invertRL RL (PatchInfoAnd rt p) Origin wX
ans_patches) (String -> FileName
fp2fn String
path) [FileName]
subs
Just (File b :: Blob IO
b) -> do (Sealed ans_patches :: RL (PatchInfoAnd rt p) Origin wX
ans_patches) <- do
if Bool -> Bool
not Bool
usePatchIndex
then Sealed (RL (PatchInfoAnd rt p) Origin)
-> IO (Sealed (RL (PatchInfoAnd rt p) Origin))
forall (m :: * -> *) a. Monad m => a -> m a
return Sealed (RL (PatchInfoAnd rt p) Origin)
patches
else Sealed (RL (PatchInfoAnd rt p) Origin)
-> Repository rt p wR wU wR
-> PatchSet rt p Origin wR
-> [FileName]
-> IO (Sealed (RL (PatchInfoAnd rt p) Origin))
forall (p :: * -> * -> *) (a :: * -> * -> *) (rt :: RepoType) wK wR
wU.
(RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd rt p) =>
Sealed (RL a wK)
-> Repository rt p wR wU wR
-> PatchSet rt p Origin wR
-> [FileName]
-> IO (Sealed (RL a Origin))
getRelevantSubsequence Sealed (RL (PatchInfoAnd rt p) Origin)
patches Repository rt p wR wU wR
repository PatchSet rt p Origin wR
r [String -> FileName
fp2fn String
path]
ByteString
con <- [ByteString] -> ByteString
BC.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ByteString -> [ByteString]
toChunks (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Blob IO -> IO ByteString
forall (m :: * -> *). Blob m -> m ByteString
readBlob Blob IO
b
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> AnnotateResult -> String
fmt ByteString
con (AnnotateResult -> String) -> AnnotateResult -> String
forall a b. (a -> b) -> a -> b
$
FL (PatchInfoAnd rt p) wX Origin
-> FileName -> ByteString -> AnnotateResult
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
Annotate p =>
FL (PatchInfoAnd rt p) wX wY
-> FileName -> ByteString -> AnnotateResult
A.annotateFile (RL (PatchInfoAnd rt p) Origin wX
-> FL (PatchInfoAnd rt p) wX Origin
forall (p :: * -> * -> *) wX wY.
Invert p =>
RL p wX wY -> FL p wY wX
invertRL RL (PatchInfoAnd rt p) Origin wX
ans_patches) (String -> FileName
fp2fn String
path) ByteString
con
Just (Stub _ _) -> IO ()
forall a. a
impossible