{-# LANGUAGE OverloadedStrings #-}

-- Copyright (C) 2010 Petr Rockai
--
-- Permission is hereby granted, free of charge, to any person
-- obtaining a copy of this software and associated documentation
-- files (the "Software"), to deal in the Software without
-- restriction, including without limitation the rights to use, copy,
-- modify, merge, publish, distribute, sublicense, and/or sell copies
-- of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:
--
-- The above copyright notice and this permission notice shall be
-- included in all copies or substantial portions of the Software.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
-- BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
-- ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
-- CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-- SOFTWARE.

-- |
-- Module      : Darcs.Patch.Annotate
-- Copyright   : 2010 Petr Rockai
-- License     : MIT
-- Maintainer  : darcs-devel@darcs.net
-- Stability   : experimental
-- Portability : portable

module Darcs.Patch.Annotate
    (
      annotateFile
    , annotateDirectory
    , format
    , machineFormat
    , AnnotateResult
    , Annotate(..)
    , AnnotateRP
    ) where

import Darcs.Prelude

import Control.Monad.State ( modify, modify', when, gets, State, execState )

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import qualified Data.Map as M
import qualified Data.Vector as V

import Data.Function ( on )
import Data.List( nub, groupBy )
import Data.Maybe( isJust, mapMaybe )

import qualified Darcs.Patch.Prim.FileUUID as FileUUID

import Darcs.Patch.Effect ( Effect(..) )
import Darcs.Patch.FromPrim ( PrimOf(..) )
import Darcs.Patch.Info ( PatchInfo(..), displayPatchInfo, piAuthor, makePatchname )
import Darcs.Patch.Invert ( Invert, invert )
import Darcs.Patch.Named ( patchcontents )
import Darcs.Patch.PatchInfoAnd( info, PatchInfoAnd, hopefully )
import Darcs.Patch.Prim.V1.Core ( Prim(..), DirPatchType(..), FilePatchType(..) )
import Darcs.Patch.TokenReplace ( annotateReplace )
import Darcs.Patch.Witnesses.Ordered

import Darcs.Util.Path ( AnchoredPath, movedirfilename, flatten )
import Darcs.Util.Printer( renderString )
import Darcs.Util.ByteString ( linesPS, decodeLocale )

data FileOrDirectory = File
                     | Directory
                       deriving (Int -> FileOrDirectory -> ShowS
[FileOrDirectory] -> ShowS
FileOrDirectory -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FileOrDirectory] -> ShowS
$cshowList :: [FileOrDirectory] -> ShowS
show :: FileOrDirectory -> [Char]
$cshow :: FileOrDirectory -> [Char]
showsPrec :: Int -> FileOrDirectory -> ShowS
$cshowsPrec :: Int -> FileOrDirectory -> ShowS
Show, FileOrDirectory -> FileOrDirectory -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileOrDirectory -> FileOrDirectory -> Bool
$c/= :: FileOrDirectory -> FileOrDirectory -> Bool
== :: FileOrDirectory -> FileOrDirectory -> Bool
$c== :: FileOrDirectory -> FileOrDirectory -> Bool
Eq)

type AnnotateResult = V.Vector (Maybe PatchInfo, B.ByteString)

data Content2 f g
  = FileContent (f (g B.ByteString))
  | DirContent (f (g AnchoredPath))

data Annotated2 f g = Annotated2
    { forall (f :: * -> *) (g :: * -> *).
Annotated2 f g -> AnnotateResult
annotated     :: !AnnotateResult
    , forall (f :: * -> *) (g :: * -> *). Annotated2 f g -> Content2 f g
current       :: !(Content2 f g)
    , forall (f :: * -> *) (g :: * -> *).
Annotated2 f g -> Maybe AnchoredPath
currentPath   :: (Maybe AnchoredPath)
    , forall (f :: * -> *) (g :: * -> *). Annotated2 f g -> PatchInfo
currentInfo   :: PatchInfo
    }

type Content = Content2 [] ((,) Int)
type Annotated = Annotated2 [] ((,) Int)

deriving instance Eq Content
deriving instance Show Content

deriving instance Eq Annotated
deriving instance Show Annotated

type AnnotatedM = State Annotated

class Annotate p where
  annotate :: p wX wY -> AnnotatedM ()

-- |This constraint expresses what is needed for a repo patch to
-- support the high-level interface to annotation
-- (currently annotateFile and annotateDirectory)
type AnnotateRP p = (Annotate (PrimOf p), Invert (PrimOf p), Effect p)

instance Annotate Prim where
  annotate :: forall wX wY. Prim wX wY -> AnnotatedM ()
annotate (FP AnchoredPath
fn FilePatchType wX wY
fp) = case FilePatchType wX wY
fp of
    FilePatchType wX wY
RmFile -> do
      AnchoredPath -> AnnotatedM () -> AnnotatedM ()
whenPathIs AnchoredPath
fn forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Annotated
s -> Annotated
s { currentPath :: Maybe AnchoredPath
currentPath = forall a. Maybe a
Nothing })
      ([(Int, AnchoredPath)] -> AnnotatedM ()) -> AnnotatedM ()
withDirectory forall a b. (a -> b) -> a -> b
$ AnchoredPath -> [(Int, AnchoredPath)] -> AnnotatedM ()
updateDirectory AnchoredPath
fn
    FilePatchType wX wY
AddFile -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Hunk Int
off [ByteString]
o [ByteString]
n -> AnchoredPath -> AnnotatedM () -> AnnotatedM ()
whenPathIs AnchoredPath
fn forall a b. (a -> b) -> a -> b
$ ([(Int, ByteString)] -> AnnotatedM ()) -> AnnotatedM ()
withFile forall a b. (a -> b) -> a -> b
$ \[(Int, ByteString)]
c -> do
      let remove :: Int
remove = forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
o
      let add :: Int
add = forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
n
      PatchInfo
i <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (f :: * -> *) (g :: * -> *). Annotated2 f g -> PatchInfo
currentInfo
      AnnotateResult
a <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (f :: * -> *) (g :: * -> *).
Annotated2 f g -> AnnotateResult
annotated
      -- NOTE patches are inverted and in inverse order
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' forall a b. (a -> b) -> a -> b
$ \Annotated
s ->
        -- NOTE subtract one from offset because darcs counts from one,
        -- whereas vectors and lists count from zero.
        let ([(Int, ByteString)]
to,[(Int, ByteString)]
from) = forall a. Int -> [a] -> ([a], [a])
splitAt (Int
offforall a. Num a => a -> a -> a
-Int
1) [(Int, ByteString)]
c
        in  Annotated
s { current :: Content
current = forall (f :: * -> *) (g :: * -> *).
f (g ByteString) -> Content2 f g
FileContent forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. (Int, a) -> (Int, a)
eval forall a b. (a -> b) -> a -> b
$ [(Int, ByteString)]
to forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
add (-Int
1, ByteString
B.empty) forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
drop Int
remove [(Int, ByteString)]
from
              , annotated :: AnnotateResult
annotated = forall a t.
a
-> Vector (Maybe a, ByteString)
-> [(Int, t)]
-> Vector (Maybe a, ByteString)
merge PatchInfo
i AnnotateResult
a forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. (Int, a) -> (Int, a)
eval forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
remove forall a b. (a -> b) -> a -> b
$ [(Int, ByteString)]
from
              }
    TokReplace [Char]
t [Char]
o [Char]
n -> AnchoredPath -> AnnotatedM () -> AnnotatedM ()
whenPathIs AnchoredPath
fn forall a b. (a -> b) -> a -> b
$ ([(Int, ByteString)] -> AnnotatedM ()) -> AnnotatedM ()
withFile forall a b. (a -> b) -> a -> b
$ \[(Int, ByteString)]
c -> do
      let test :: ByteString -> Bool
test = [Char] -> ByteString -> ByteString -> ByteString -> Bool
annotateReplace [Char]
t ([Char] -> ByteString
BC.pack [Char]
o) ([Char] -> ByteString
BC.pack [Char]
n)
      PatchInfo
i <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (f :: * -> *) (g :: * -> *). Annotated2 f g -> PatchInfo
currentInfo
      AnnotateResult
a <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (f :: * -> *) (g :: * -> *).
Annotated2 f g -> AnnotateResult
annotated
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' forall a b. (a -> b) -> a -> b
$ \Annotated
s -> Annotated
s
        { current :: Content
current = forall (f :: * -> *) (g :: * -> *).
f (g ByteString) -> Content2 f g
FileContent forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Int
ix,ByteString
b)->if ByteString -> Bool
test ByteString
b then (-Int
1,ByteString
B.empty) else (Int
ix,ByteString
b)) [(Int, ByteString)]
c
        , annotated :: AnnotateResult
annotated = forall a t.
a
-> Vector (Maybe a, ByteString)
-> [(Int, t)]
-> Vector (Maybe a, ByteString)
merge PatchInfo
i AnnotateResult
a forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. (Int, a) -> (Int, a)
eval forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (ByteString -> Bool
test forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ [(Int, ByteString)]
c
        }
    -- TODO what if the status of a file changed from text to binary?
    Binary ByteString
_ ByteString
_ -> AnchoredPath -> AnnotatedM () -> AnnotatedM ()
whenPathIs AnchoredPath
fn forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"annotate: can't handle binary changes"
  annotate (DP AnchoredPath
_ DirPatchType wX wY
AddDir) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
  annotate (DP AnchoredPath
fn DirPatchType wX wY
RmDir) = ([(Int, AnchoredPath)] -> AnnotatedM ()) -> AnnotatedM ()
withDirectory forall a b. (a -> b) -> a -> b
$ \[(Int, AnchoredPath)]
c -> do
    AnchoredPath -> AnnotatedM () -> AnnotatedM ()
whenPathIs AnchoredPath
fn forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Annotated
s -> Annotated
s { currentPath :: Maybe AnchoredPath
currentPath = forall a. Maybe a
Nothing })
    AnchoredPath -> [(Int, AnchoredPath)] -> AnnotatedM ()
updateDirectory AnchoredPath
fn [(Int, AnchoredPath)]
c
  annotate (Move AnchoredPath
fn AnchoredPath
fn') = do
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Annotated
s -> Annotated
s { currentPath :: Maybe AnchoredPath
currentPath = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AnchoredPath -> AnchoredPath -> AnchoredPath -> AnchoredPath
movedirfilename AnchoredPath
fn AnchoredPath
fn') (forall (f :: * -> *) (g :: * -> *).
Annotated2 f g -> Maybe AnchoredPath
currentPath Annotated
s) })
    ([(Int, AnchoredPath)] -> AnnotatedM ()) -> AnnotatedM ()
withDirectory forall a b. (a -> b) -> a -> b
$ \[(Int, AnchoredPath)]
c -> do
      let fix :: (a, AnchoredPath) -> (a, AnchoredPath)
fix (a
i, AnchoredPath
x) = (a
i, AnchoredPath -> AnchoredPath -> AnchoredPath -> AnchoredPath
movedirfilename AnchoredPath
fn AnchoredPath
fn' AnchoredPath
x)
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \Annotated
s -> Annotated
s { current :: Content
current = forall (f :: * -> *) (g :: * -> *).
f (g AnchoredPath) -> Content2 f g
DirContent forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (a, AnchoredPath) -> (a, AnchoredPath)
fix [(Int, AnchoredPath)]
c }
  annotate (ChangePref [Char]
_ [Char]
_ [Char]
_) = forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Annotate FileUUID.Prim where
  annotate :: forall wX wY. Prim wX wY -> AnnotatedM ()
annotate Prim wX wY
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"annotate not implemented for FileUUID patches"

annotatePIAP :: AnnotateRP p => PatchInfoAnd rt p wX wY -> AnnotatedM ()
annotatePIAP :: forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
AnnotateRP p =>
PatchInfoAnd rt p wX wY -> AnnotatedM ()
annotatePIAP =
  forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall (p :: * -> * -> *) wX wY.
Annotate p =>
p wX wY -> AnnotatedM ()
annotate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
patchcontents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully

withDirectory :: ([(Int, AnchoredPath)] -> AnnotatedM ()) -> AnnotatedM ()
withDirectory :: ([(Int, AnchoredPath)] -> AnnotatedM ()) -> AnnotatedM ()
withDirectory [(Int, AnchoredPath)] -> AnnotatedM ()
actions = do
  Content
what <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (f :: * -> *) (g :: * -> *). Annotated2 f g -> Content2 f g
current
  case Content
what of
    DirContent [(Int, AnchoredPath)]
c -> [(Int, AnchoredPath)] -> AnnotatedM ()
actions [(Int, AnchoredPath)]
c
    FileContent [(Int, ByteString)]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

withFile :: ([(Int, B.ByteString)] -> AnnotatedM ()) -> AnnotatedM ()
withFile :: ([(Int, ByteString)] -> AnnotatedM ()) -> AnnotatedM ()
withFile [(Int, ByteString)] -> AnnotatedM ()
actions = do
  Content
what <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (f :: * -> *) (g :: * -> *). Annotated2 f g -> Content2 f g
current
  case Content
what of
    FileContent [(Int, ByteString)]
c -> [(Int, ByteString)] -> AnnotatedM ()
actions [(Int, ByteString)]
c
    DirContent [(Int, AnchoredPath)]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

whenPathIs :: AnchoredPath -> AnnotatedM () -> AnnotatedM ()
whenPathIs :: AnchoredPath -> AnnotatedM () -> AnnotatedM ()
whenPathIs AnchoredPath
fn AnnotatedM ()
actions = do
  Maybe AnchoredPath
p <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (f :: * -> *) (g :: * -> *).
Annotated2 f g -> Maybe AnchoredPath
currentPath
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AnchoredPath
p forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just AnchoredPath
fn) AnnotatedM ()
actions

eval :: (Int, a) -> (Int, a)
eval :: forall a. (Int, a) -> (Int, a)
eval (Int
i,a
b) = seq :: forall a b. a -> b -> b
seq Int
i forall a b. (a -> b) -> a -> b
$ seq :: forall a b. a -> b -> b
seq a
b forall a b. (a -> b) -> a -> b
$ (Int
i,a
b)

merge :: a
      -> V.Vector (Maybe a, BC.ByteString)
      -> [(Int, t)]
      -> V.Vector (Maybe a, BC.ByteString)
merge :: forall a t.
a
-> Vector (Maybe a, ByteString)
-> [(Int, t)]
-> Vector (Maybe a, ByteString)
merge a
i Vector (Maybe a, ByteString)
a [(Int, t)]
l = Vector (Maybe a, ByteString)
a forall a. Vector a -> [(Int, a)] -> Vector a
V.// [ (Int
line, (forall a. a -> Maybe a
Just a
i, ByteString
B.empty))
                     | (Int
line, t
_) <- [(Int, t)]
l, Int
line forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
line forall a. Ord a => a -> a -> Bool
< forall a. Vector a -> Int
V.length Vector (Maybe a, ByteString)
a]

updateDirectory :: AnchoredPath -> [(Int,AnchoredPath)] -> AnnotatedM ()
updateDirectory :: AnchoredPath -> [(Int, AnchoredPath)] -> AnnotatedM ()
updateDirectory AnchoredPath
path [(Int, AnchoredPath)]
files = do
    case forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
==AnchoredPath
path) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Int, AnchoredPath)]
files of
      [match :: (Int, AnchoredPath)
match@(Int
ident, AnchoredPath
_)] -> Int -> (Int, AnchoredPath) -> AnnotatedM ()
reannotate Int
ident (Int, AnchoredPath)
match
      [(Int, AnchoredPath)]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    reannotate :: Int -> (Int, AnchoredPath) -> AnnotatedM ()
    reannotate :: Int -> (Int, AnchoredPath) -> AnnotatedM ()
reannotate Int
ident (Int, AnchoredPath)
match =
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \Annotated
x -> Annotated
x { annotated :: AnnotateResult
annotated = forall (f :: * -> *) (g :: * -> *).
Annotated2 f g -> AnnotateResult
annotated Annotated
x forall a. Vector a -> [(Int, a)] -> Vector a
V.// [ (Int
ident, forall {a}. a -> (Maybe a, ByteString)
update forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (g :: * -> *). Annotated2 f g -> PatchInfo
currentInfo Annotated
x) ]
                       , current :: Content
current = forall (f :: * -> *) (g :: * -> *).
f (g AnchoredPath) -> Content2 f g
DirContent forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= (Int, AnchoredPath)
match) [(Int, AnchoredPath)]
files }
    update :: a -> (Maybe a, ByteString)
update a
inf = (forall a. a -> Maybe a
Just a
inf, AnchoredPath -> ByteString
flatten AnchoredPath
path)

complete :: Annotated -> Bool
complete :: Annotated -> Bool
complete Annotated
x = forall a. (a -> Bool) -> Vector a -> Bool
V.all (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (g :: * -> *).
Annotated2 f g -> AnnotateResult
annotated Annotated
x

annotate' :: AnnotateRP p
          => RL (PatchInfoAnd rt p) wX wY
          -> Annotated
          -> Annotated
annotate' :: forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
AnnotateRP p =>
RL (PatchInfoAnd rt p) wX wY -> Annotated -> Annotated
annotate' RL (PatchInfoAnd rt p) wX wY
NilRL Annotated
ann = Annotated
ann
annotate' (RL (PatchInfoAnd rt p) wX wY
ps :<: PatchInfoAnd rt p wY wY
p) Annotated
ann
    | Annotated -> Bool
complete Annotated
ann = Annotated
ann
    | Bool
otherwise = forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
AnnotateRP p =>
RL (PatchInfoAnd rt p) wX wY -> Annotated -> Annotated
annotate' RL (PatchInfoAnd rt p) wX wY
ps forall a b. (a -> b) -> a -> b
$ forall s a. State s a -> s -> s
execState (forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
AnnotateRP p =>
PatchInfoAnd rt p wX wY -> AnnotatedM ()
annotatePIAP PatchInfoAnd rt p wY wY
p) (Annotated
ann { currentInfo :: PatchInfo
currentInfo = forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wY wY
p })

annotateFile :: AnnotateRP p
             => RL (PatchInfoAnd rt p) wX wY
             -> AnchoredPath
             -> B.ByteString
             -> AnnotateResult
annotateFile :: forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
AnnotateRP p =>
RL (PatchInfoAnd rt p) wX wY
-> AnchoredPath -> ByteString -> AnnotateResult
annotateFile RL (PatchInfoAnd rt p) wX wY
patches AnchoredPath
inipath ByteString
inicontent = forall (f :: * -> *) (g :: * -> *).
Annotated2 f g -> AnnotateResult
annotated forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
AnnotateRP p =>
RL (PatchInfoAnd rt p) wX wY -> Annotated -> Annotated
annotate' RL (PatchInfoAnd rt p) wX wY
patches Annotated
initial
  where
    initial :: Annotated
initial = Annotated2 { currentPath :: Maybe AnchoredPath
currentPath = forall a. a -> Maybe a
Just AnchoredPath
inipath
                        , currentInfo :: PatchInfo
currentInfo = forall a. HasCallStack => [Char] -> a
error [Char]
"There is no currentInfo."
                        , current :: Content
current = forall (f :: * -> *) (g :: * -> *).
f (g ByteString) -> Content2 f g
FileContent forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (ByteString -> [ByteString]
linesPS ByteString
inicontent)
                        , annotated :: AnnotateResult
annotated = forall a. Int -> a -> Vector a
V.replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
breakLines ByteString
inicontent)
                                                      (forall a. Maybe a
Nothing, ByteString
B.empty)
                        }

annotateDirectory :: AnnotateRP p
                  => RL (PatchInfoAnd rt p) wX wY
                  -> AnchoredPath
                  -> [AnchoredPath]
                  -> AnnotateResult
annotateDirectory :: forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
AnnotateRP p =>
RL (PatchInfoAnd rt p) wX wY
-> AnchoredPath -> [AnchoredPath] -> AnnotateResult
annotateDirectory RL (PatchInfoAnd rt p) wX wY
patches AnchoredPath
inipath [AnchoredPath]
inicontent = forall (f :: * -> *) (g :: * -> *).
Annotated2 f g -> AnnotateResult
annotated forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
AnnotateRP p =>
RL (PatchInfoAnd rt p) wX wY -> Annotated -> Annotated
annotate' RL (PatchInfoAnd rt p) wX wY
patches Annotated
initial
  where
    initial :: Annotated
initial = Annotated2 { currentPath :: Maybe AnchoredPath
currentPath = forall a. a -> Maybe a
Just AnchoredPath
inipath
                        , currentInfo :: PatchInfo
currentInfo = forall a. HasCallStack => [Char] -> a
error [Char]
"There is no currentInfo."
                        , current :: Content
current = forall (f :: * -> *) (g :: * -> *).
f (g AnchoredPath) -> Content2 f g
DirContent forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [AnchoredPath]
inicontent
                        , annotated :: AnnotateResult
annotated = forall a. Int -> a -> Vector a
V.replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [AnchoredPath]
inicontent) (forall a. Maybe a
Nothing, ByteString
B.empty)
                        }

machineFormat :: B.ByteString -> AnnotateResult -> String
machineFormat :: ByteString -> AnnotateResult -> [Char]
machineFormat ByteString
d AnnotateResult
a = [[Char]] -> [Char]
unlines [ case Maybe PatchInfo
i of
                                 Just PatchInfo
inf -> forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ PatchInfo -> SHA1
makePatchname PatchInfo
inf
                                 Maybe PatchInfo
Nothing -> -- make unknowns uniform, for easier parsing
                                   forall a. Int -> [a] -> [a]
take Int
40 ( forall a. a -> [a]
repeat Char
'0' ) -- fake hash of the right size
                              forall a. [a] -> [a] -> [a]
++ [Char]
" | " forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BC.unpack ByteString
line forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BC.unpack ByteString
add
                            | ((Maybe PatchInfo
i, ByteString
add), ByteString
line) <- forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Vector a -> [a]
V.toList AnnotateResult
a) (ByteString -> [ByteString]
breakLines ByteString
d) ]

format :: B.ByteString -> AnnotateResult -> String
format :: ByteString -> AnnotateResult -> [Char]
format ByteString
d AnnotateResult
a = [Char]
pi_list forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++ [Char]
numbered
  where
    numberedLines :: [(Int, [Char])]
numberedLines = forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
1 :: Int)..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines forall a b. (a -> b) -> a -> b
$ [Char]
file

    prependNum :: (a, [Char]) -> [Char]
prependNum (a
lnum, [Char]
annLine) =
        let maxDigits :: Int
maxDigits = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ [(Int, [Char])]
numberedLines
            lnumStr :: [Char]
lnumStr = forall a. Show a => a -> [Char]
show a
lnum
            paddingNum :: Int
paddingNum = Int
maxDigits forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
lnumStr
        in forall a. Int -> a -> [a]
replicate Int
paddingNum Char
' ' forall a. [a] -> [a] -> [a]
++ [Char]
lnumStr forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ [Char]
annLine

    numbered :: [Char]
numbered = [[Char]] -> [Char]
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (a, [Char]) -> [Char]
prependNum forall a b. (a -> b) -> a -> b
$ [(Int, [Char])]
numberedLines

    pi_list :: [Char]
pi_list = [[Char]] -> [Char]
unlines [ forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ Doc -> [Char]
renderString (PatchInfo -> Doc
displayPatchInfo PatchInfo
i)
                      | (Int
n :: Int, PatchInfo
i) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [PatchInfo]
pis ]

    file :: [Char]
file = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ forall {b}. (Maybe PatchInfo, b) -> [Char]
annotation (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [((Maybe PatchInfo, ByteString), ByteString)]
chunk) forall a. [a] -> [a] -> [a]
++ [Char]
" | " forall a. [a] -> [a] -> [a]
++ forall {a}. ((a, ByteString), ByteString) -> [Char]
line (forall a. [a] -> a
head [((Maybe PatchInfo, ByteString), ByteString)]
chunk) forall a. [a] -> [a] -> [a]
++
                    [Char]
"\n" forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unlines [ Int -> ShowS
indent Int
25 ([Char]
" | " forall a. [a] -> [a] -> [a]
++ forall {a}. ((a, ByteString), ByteString) -> [Char]
line ((Maybe PatchInfo, ByteString), ByteString)
l) | ((Maybe PatchInfo, ByteString), ByteString)
l <- forall a. [a] -> [a]
tail [((Maybe PatchInfo, ByteString), ByteString)]
chunk ]
                  | [((Maybe PatchInfo, ByteString), ByteString)]
chunk <- [[((Maybe PatchInfo, ByteString), ByteString)]]
file_ann ]

    pis :: [PatchInfo]
pis = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList AnnotateResult
a

    pi_map :: Map PatchInfo Int
pi_map = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip [PatchInfo]
pis [Int
1 :: Int ..])

    file_ann :: [[((Maybe PatchInfo, ByteString), ByteString)]]
file_ann = forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Vector a -> [a]
V.toList AnnotateResult
a) (ByteString -> [ByteString]
breakLines ByteString
d)

    line :: ((a, ByteString), ByteString) -> [Char]
line ((a
_, ByteString
add), ByteString
l) = ByteString -> [Char]
decodeLocale forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BC.concat [ByteString
l, ByteString
" ", ByteString
add]

    annotation :: (Maybe PatchInfo, b) -> [Char]
annotation (Just PatchInfo
i, b
_) | Just Int
n <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PatchInfo
i Map PatchInfo Int
pi_map =
        Int -> ShowS
pad Int
20 (PatchInfo -> [Char]
piMail PatchInfo
i) forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ Int -> ShowS
pad Int
4 (Char
'#' forall a. a -> [a] -> [a]
: forall a. Show a => a -> [Char]
show Int
n)
    annotation (Maybe PatchInfo, b)
_ = Int -> ShowS
pad Int
25 [Char]
"unknown"

    pad :: Int -> ShowS
pad Int
n [Char]
str = forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
str) Char
' ' forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
take Int
n [Char]
str

    indent :: Int -> ShowS
indent Int
n [Char]
str = forall a. Int -> a -> [a]
replicate Int
n Char
' ' forall a. [a] -> [a] -> [a]
++ [Char]
str

    piMail :: PatchInfo -> [Char]
piMail PatchInfo
pi
        | Char
'<' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` PatchInfo -> [Char]
piAuthor PatchInfo
pi = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'>') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'<') forall a b. (a -> b) -> a -> b
$ PatchInfo -> [Char]
piAuthor PatchInfo
pi
        | Bool
otherwise = PatchInfo -> [Char]
piAuthor PatchInfo
pi

breakLines :: BC.ByteString -> [BC.ByteString]
breakLines :: ByteString -> [ByteString]
breakLines ByteString
s = case Char -> ByteString -> [ByteString]
BC.split Char
'\n' ByteString
s of
    [] -> []
    [ByteString]
split | ByteString -> Bool
BC.null (forall a. [a] -> a
last [ByteString]
split) -> forall a. [a] -> [a]
init [ByteString]
split
          | Bool
otherwise -> [ByteString]
split