--  Copyright (C) 2003 David Roundy, 2010-2011 Petr Rockai
--
--  This program is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2, or (at your option)
--  any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program; see the file COPYING.  If not, write to
--  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
--  Boston, MA 02110-1301, USA.
{-# LANGUAGE OverloadedStrings #-}

module Darcs.UI.Commands.Annotate ( annotate ) where

import Darcs.Prelude

import Control.Monad ( when )

import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, amInHashedRepository )
import Darcs.UI.Completion ( knownFileArgs )
import Darcs.UI.External ( viewDocWith )
import Darcs.UI.Flags ( DarcsFlag, useCache, patchIndexYes, pathsFromArgs )
import Darcs.UI.Options ( parseFlags, (?), (^) )
import qualified Darcs.UI.Options.All as O

import Darcs.Repository.State ( readPristine )
import Darcs.Repository
    ( withRepository
    , withRepoLockCanFail
    , RepoJob(..)
    , readPatches
    )
import Darcs.Repository.PatchIndex ( attemptCreatePatchIndex )
import Darcs.Patch.Set ( patchSet2RL )
import qualified Data.ByteString.Char8 as BC ( pack, concat, intercalate )
import Data.ByteString.Lazy ( toChunks )
import Darcs.Patch.ApplyMonad( withFileNames )
import Darcs.Patch.Match ( patchSetMatch, rollbackToPatchSetMatch  )
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(..) )
import qualified Darcs.Util.Tree as T ( readBlob, list, expand )
import Darcs.Util.Tree.Monad( findM, virtualTreeIO )
import Darcs.Util.Path( AbsolutePath, AnchoredPath, displayPath, catPaths )
import Darcs.Util.Printer ( Doc, simplePrinters, renderString, text )
import Darcs.Util.Exception ( die )

annotateDescription :: String
annotateDescription :: String
annotateDescription = String
"Annotate lines of a file with the last patch that modified it."

annotateHelp :: Doc
annotateHelp :: Doc
annotateHelp = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
 [ String
"When `darcs annotate` is called on a file, it will find the patch that"
 , String
"last modified each line in that file. This also works on directories."
 , String
""
 , String
"The `--machine-readable` option can be used to generate output for"
 , String
"machine postprocessing."
 ]

annotate :: DarcsCommand
annotate :: DarcsCommand
annotate = DarcsCommand
    { commandProgramName :: String
commandProgramName = String
"darcs"
    , commandName :: String
commandName = String
"annotate"
    , commandHelp :: Doc
commandHelp = Doc
annotateHelp
    , commandDescription :: String
commandDescription = String
annotateDescription
    , commandExtraArgs :: Int
commandExtraArgs = Int
1
    , commandExtraArgHelp :: [String]
commandExtraArgHelp = [String
"[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
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
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
PrimDarcsOption WithPatchIndex
O.patchIndexYes
    annotateOpts :: CommandOptions
annotateOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> WithPatchIndex
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Bool
   -> [MatchFlag]
   -> Maybe String
   -> Maybe StdCmdAction
   -> Verbosity
   -> WithPatchIndex
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Bool -> [MatchFlag] -> Maybe String -> a)
annotateBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> WithPatchIndex
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Bool
   -> [MatchFlag]
   -> Maybe String
   -> Maybe StdCmdAction
   -> Verbosity
   -> WithPatchIndex
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (WithPatchIndex
      -> UseCache
      -> UseIndex
      -> HooksConfig
      -> Bool
      -> Bool
      -> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     b
-> CommandOptions
`withStdOpts` DarcsOption
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
  (WithPatchIndex
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
PrimDarcsOption WithPatchIndex
annotateAdvancedOpts

annotateCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
annotateCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
annotateCmd (AbsolutePath, AbsolutePath)
fps [DarcsFlag]
opts [String]
args = do
  [AnchoredPath]
paths <- (AbsolutePath, AbsolutePath) -> [String] -> IO [AnchoredPath]
pathsFromArgs (AbsolutePath, AbsolutePath)
fps [String]
args
  case [AnchoredPath]
paths of
    [AnchoredPath
path] -> do
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PrimOptSpec DarcsOptDescr DarcsFlag a WithPatchIndex
PrimDarcsOption WithPatchIndex
patchIndexYes PrimDarcsOption 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 'RO () -> IO ()
withRepoLockCanFail (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
        (RepoJob 'RO () -> IO ()) -> RepoJob 'RO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TreePatchJob 'RO () -> RepoJob 'RO ()
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
RepoJob (\Repository 'RO p wU wR
repo -> Repository 'RO p wU wR -> IO (PatchSet p Origin wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (PatchSet p Origin wR)
readPatches Repository 'RO p wU wR
repo IO (PatchSet p Origin wR)
-> (PatchSet p Origin wR -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Repository 'RO p wU wR -> PatchSet p Origin wR -> IO ()
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> PatchSet p Origin wR -> IO ()
attemptCreatePatchIndex Repository 'RO p wU wR
repo)
      [DarcsFlag] -> AnchoredPath -> IO ()
annotateCmd' [DarcsFlag]
opts AnchoredPath
path
    [AnchoredPath]
_ -> String -> IO ()
forall a. String -> IO a
die String
"Error: annotate requires a single filepath argument"

annotateCmd' :: [DarcsFlag] -> AnchoredPath -> IO ()
annotateCmd' :: [DarcsFlag] -> AnchoredPath -> IO ()
annotateCmd' [DarcsFlag]
opts AnchoredPath
fixed_path = UseCache -> RepoJob 'RO () -> IO ()
forall a. UseCache -> RepoJob 'RO a -> IO a
withRepository (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob 'RO () -> IO ()) -> RepoJob 'RO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TreePatchJob 'RO () -> RepoJob 'RO ()
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
RepoJob (TreePatchJob 'RO () -> RepoJob 'RO ())
-> TreePatchJob 'RO () -> RepoJob 'RO ()
forall a b. (a -> b) -> a -> b
$ \Repository 'RO p 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 PrimOptSpec DarcsOptDescr DarcsFlag a [MatchFlag]
MatchOption
O.matchUpToOne [DarcsFlag]
opts
  PatchSet p Origin wR
r <- Repository 'RO p wU wR -> IO (PatchSet p Origin wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (PatchSet p Origin wR)
readPatches Repository 'RO p wU wR
repository
  Tree IO
recorded <- Repository 'RO p wU wR -> IO (Tree IO)
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO (Tree IO)
readPristine Repository 'RO p wU wR
repository
  (Sealed (RL (PatchInfoAnd p) Origin)
patches, Tree IO
initial, AnchoredPath
path) <-
    case [MatchFlag] -> Maybe PatchSetMatch
patchSetMatch [MatchFlag]
matchFlags of
      Just PatchSetMatch
psm -> do
        Sealed PatchSet p Origin wX
x <- Repository 'RO p wU wR
-> PatchSetMatch -> IO (Sealed (PatchSet p Origin))
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR
-> PatchSetMatch -> IO (SealedPatchSet p Origin)
getOnePatchset Repository 'RO p wU wR
repository PatchSetMatch
psm
        case Maybe [OrigFileNameOf]
-> [AnchoredPath] -> FilePathMonad () -> FilePathMonadState
forall a.
Maybe [OrigFileNameOf]
-> [AnchoredPath] -> FilePathMonad a -> FilePathMonadState
withFileNames Maybe [OrigFileNameOf]
forall a. Maybe a
Nothing [AnchoredPath
fixed_path] (PatchSetMatch -> PatchSet p Origin wR -> FilePathMonad ()
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ApplyMonad (ApplyState p) m, MatchableRP p,
 ApplyState p ~ Tree) =>
PatchSetMatch -> PatchSet p Origin wX -> m ()
rollbackToPatchSetMatch PatchSetMatch
psm PatchSet p Origin wR
r) of
          ([AnchoredPath]
_, [AnchoredPath
path'], [OrigFileNameOf]
_) -> do
            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 a b. (a -> b) -> IO a -> IO b
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 (PatchSetMatch -> PatchSet p Origin wR -> TreeIO ()
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ApplyMonad (ApplyState p) m, MatchableRP p,
 ApplyState p ~ Tree) =>
PatchSetMatch -> PatchSet p Origin wX -> m ()
rollbackToPatchSetMatch PatchSetMatch
psm PatchSet p Origin wR
r) Tree IO
recorded
            (Sealed (RL (PatchInfoAnd p) Origin), Tree IO, AnchoredPath)
-> IO (Sealed (RL (PatchInfoAnd p) Origin), Tree IO, AnchoredPath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RL (PatchInfoAnd p) Origin wX
-> Sealed (RL (PatchInfoAnd p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (RL (PatchInfoAnd p) Origin wX
 -> Sealed (RL (PatchInfoAnd p) Origin))
-> RL (PatchInfoAnd p) Origin wX
-> Sealed (RL (PatchInfoAnd p) Origin)
forall a b. (a -> b) -> a -> b
$ PatchSet p Origin wX -> RL (PatchInfoAnd p) Origin wX
forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> RL (PatchInfoAnd p) wStart wX
patchSet2RL PatchSet p Origin wX
x, Tree IO
initial, AnchoredPath
path')
          FilePathMonadState
_ -> String
-> IO (Sealed (RL (PatchInfoAnd p) Origin), Tree IO, AnchoredPath)
forall a. HasCallStack => String -> a
error String
"impossible"
      Maybe PatchSetMatch
Nothing ->
        (Sealed (RL (PatchInfoAnd p) Origin), Tree IO, AnchoredPath)
-> IO (Sealed (RL (PatchInfoAnd p) Origin), Tree IO, AnchoredPath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RL (PatchInfoAnd p) Origin wR
-> Sealed (RL (PatchInfoAnd p) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (RL (PatchInfoAnd p) Origin wR
 -> Sealed (RL (PatchInfoAnd p) Origin))
-> RL (PatchInfoAnd p) Origin wR
-> Sealed (RL (PatchInfoAnd p) Origin)
forall a b. (a -> b) -> a -> b
$ PatchSet p Origin wR -> RL (PatchInfoAnd p) Origin wR
forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> RL (PatchInfoAnd p) wStart wX
patchSet2RL PatchSet p Origin wR
r, Tree IO
recorded, AnchoredPath
fixed_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 AnchoredPath
path
  -- TODO need to decide about the --machine flag
  let (ByteString -> AnnotateResult -> String
fmt, Doc -> IO ()
view) = if PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
O.machineReadable [DarcsFlag]
opts
                      then (ByteString -> AnnotateResult -> String
A.machineFormat, String -> IO ()
putStrLn (String -> IO ()) -> (Doc -> String) -> Doc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
renderString)
                      else (ByteString -> AnnotateResult -> String
A.format, Printers -> Doc -> IO ()
viewDocWith Printers
simplePrinters)
  Bool
usePatchIndex <- (WithPatchIndex -> Bool
forall a. YesNo a => a -> Bool
O.yes (PrimOptSpec DarcsOptDescr DarcsFlag a WithPatchIndex
PrimDarcsOption WithPatchIndex
O.patchIndexYes PrimDarcsOption 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 'RO p wU wR -> IO Bool
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO Bool
canUsePatchIndex Repository 'RO p wU wR
repository
  case Maybe (TreeItem IO)
found of
    Maybe (TreeItem IO)
Nothing -> String -> IO ()
forall a. String -> IO a
die (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error: path not found in repository: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> String
displayPath AnchoredPath
fixed_path
    Just (SubTree Tree IO
s) -> do
      -- TODO the semantics and implementation of annotating of directories need to be revised
      Tree IO
s' <- Tree IO -> IO (Tree IO)
forall (m :: * -> *). Monad m => Tree m -> m (Tree m)
T.expand Tree IO
s
      let subs :: [AnchoredPath]
subs = ((AnchoredPath, TreeItem IO) -> AnchoredPath)
-> [(AnchoredPath, TreeItem IO)] -> [AnchoredPath]
forall a b. (a -> b) -> [a] -> [b]
map (AnchoredPath -> AnchoredPath -> AnchoredPath
catPaths AnchoredPath
path (AnchoredPath -> AnchoredPath)
-> ((AnchoredPath, TreeItem IO) -> AnchoredPath)
-> (AnchoredPath, TreeItem IO)
-> AnchoredPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnchoredPath, TreeItem IO) -> AnchoredPath
forall a b. (a, b) -> a
fst) ([(AnchoredPath, TreeItem IO)] -> [AnchoredPath])
-> [(AnchoredPath, TreeItem IO)] -> [AnchoredPath]
forall a b. (a -> b) -> a -> b
$ Tree IO -> [(AnchoredPath, TreeItem IO)]
forall (m :: * -> *). Tree m -> [(AnchoredPath, TreeItem m)]
T.list Tree IO
s'
          showPath :: (AnchoredPath, TreeItem m) -> ByteString
showPath (AnchoredPath
n, File Blob m
_) = String -> ByteString
BC.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> String
displayPath (AnchoredPath -> String) -> AnchoredPath -> String
forall a b. (a -> b) -> a -> b
$ AnchoredPath
path AnchoredPath -> AnchoredPath -> AnchoredPath
`catPaths` AnchoredPath
n
          showPath (AnchoredPath
n, TreeItem m
_) = [ByteString] -> ByteString
BC.concat [String -> ByteString
BC.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> String
displayPath (AnchoredPath -> String) -> AnchoredPath -> String
forall a b. (a -> b) -> a -> b
$ AnchoredPath
path AnchoredPath -> AnchoredPath -> AnchoredPath
`catPaths` AnchoredPath
n, ByteString
"/"]
      (Sealed RL (PatchInfoAnd p) Origin wX
ans_patches) <- do
         if Bool -> Bool
not Bool
usePatchIndex
            then Sealed (RL (PatchInfoAnd p) Origin)
-> IO (Sealed (RL (PatchInfoAnd p) Origin))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Sealed (RL (PatchInfoAnd p) Origin)
patches
            else Sealed (RL (PatchInfoAnd p) Origin)
-> Repository 'RO p wU wR
-> PatchSet p Origin wR
-> [AnchoredPath]
-> IO (Sealed (RL (PatchInfoAnd p) Origin))
forall (p :: * -> * -> *) (a :: * -> * -> *) wK (rt :: AccessType)
       wU wR.
(RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd p) =>
Sealed (RL a wK)
-> Repository rt p wU wR
-> PatchSet p Origin wR
-> [AnchoredPath]
-> IO (Sealed (RL a Origin))
getRelevantSubsequence Sealed (RL (PatchInfoAnd p) Origin)
patches Repository 'RO p wU wR
repository PatchSet p Origin wR
r [AnchoredPath]
subs
      Doc -> IO ()
view (Doc -> IO ()) -> (String -> Doc) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        ByteString -> AnnotateResult -> String
fmt (ByteString -> [ByteString] -> ByteString
BC.intercalate ByteString
"\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 (AnchoredPath, TreeItem IO) -> ByteString
forall {m :: * -> *}. (AnchoredPath, TreeItem m) -> ByteString
showPath ([(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)]
T.list Tree IO
s') (AnnotateResult -> String) -> AnnotateResult -> String
forall a b. (a -> b) -> a -> b
$
        RL (PatchInfoAnd p) Origin wX
-> AnchoredPath -> [AnchoredPath] -> AnnotateResult
forall (p :: * -> * -> *) wX wY.
AnnotateRP p =>
RL (PatchInfoAnd p) wX wY
-> AnchoredPath -> [AnchoredPath] -> AnnotateResult
A.annotateDirectory RL (PatchInfoAnd p) Origin wX
ans_patches AnchoredPath
path [AnchoredPath]
subs
    Just (File Blob IO
b) -> do (Sealed RL (PatchInfoAnd p) Origin wX
ans_patches) <- do
                           if Bool -> Bool
not Bool
usePatchIndex
                              then Sealed (RL (PatchInfoAnd p) Origin)
-> IO (Sealed (RL (PatchInfoAnd p) Origin))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Sealed (RL (PatchInfoAnd p) Origin)
patches
                              else Sealed (RL (PatchInfoAnd p) Origin)
-> Repository 'RO p wU wR
-> PatchSet p Origin wR
-> [AnchoredPath]
-> IO (Sealed (RL (PatchInfoAnd p) Origin))
forall (p :: * -> * -> *) (a :: * -> * -> *) wK (rt :: AccessType)
       wU wR.
(RepoPatch p, ApplyState p ~ Tree, a ~ PatchInfoAnd p) =>
Sealed (RL a wK)
-> Repository rt p wU wR
-> PatchSet p Origin wR
-> [AnchoredPath]
-> IO (Sealed (RL a Origin))
getRelevantSubsequence Sealed (RL (PatchInfoAnd p) Origin)
patches Repository 'RO p wU wR
repository PatchSet p Origin wR
r [AnchoredPath
path]
                        ByteString
con <- [ByteString] -> ByteString
BC.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ByteString -> [ByteString]
toChunks (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Blob IO -> IO ByteString
forall (m :: * -> *). Blob m -> m ByteString
T.readBlob Blob IO
b
                        Doc -> IO ()
view (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text (String -> Doc)
-> (AnnotateResult -> String) -> AnnotateResult -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> AnnotateResult -> String
fmt ByteString
con (AnnotateResult -> Doc) -> AnnotateResult -> Doc
forall a b. (a -> b) -> a -> b
$
                          RL (PatchInfoAnd p) Origin wX
-> AnchoredPath -> ByteString -> AnnotateResult
forall (p :: * -> * -> *) wX wY.
AnnotateRP p =>
RL (PatchInfoAnd p) wX wY
-> AnchoredPath -> ByteString -> AnnotateResult
A.annotateFile RL (PatchInfoAnd p) Origin wX
ans_patches AnchoredPath
path ByteString
con
    Just (Stub IO (Tree IO)
_ Maybe Hash
_) -> String -> IO ()
forall a. HasCallStack => String -> a
error String
"impossible case"