module Darcs.Annotate ( annotate, annotateDirectory, format, machineFormat ) where
import Darcs.Patch.ApplyMonad( ApplyMonad(..) )
import Data.Maybe( isJust, catMaybes )
import Data.List( nub, groupBy )
import qualified Data.Vector as V
import Darcs.Patch.FileName( FileName, movedirfilename, fn2ps, ps2fn )
import Darcs.Patch.Patchy ( Apply, apply )
import Darcs.Patch.Info ( PatchInfo(..), humanFriendly, piAuthor, makeFilename )
import Darcs.Patch.PatchInfoAnd( info, PatchInfoAnd )
import Lcs( getChanges )
import Printer( renderString )
import Darcs.Witnesses.Ordered
import ByteStringUtils ( linesPS, unlinesPS )
import Control.Monad.State ( modify, when, gets, State, execState )
import Control.Applicative( (<$>) )
import qualified Data.Map as M
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
#include "gadts.h"
#include "impossible.h"
data FileOrDirectory = File | Directory deriving (Show, Eq)
data Annotated = Annotated { annotated :: V.Vector (Maybe PatchInfo, B.ByteString)
, current :: [(Int, B.ByteString)]
, path :: Maybe FileName
, what :: FileOrDirectory
, currentInfo :: PatchInfo }
deriving Show
type AnnotatedM = State Annotated
instance ApplyMonad AnnotatedM where
mDoesDirectoryExist _ = return True
mReadFilePS = fail "mReadFilePS undefined for Annotated"
mCreateDirectory _ = return ()
mCreateFile _ = return ()
mRemoveFile f = do p <- gets path
when (p == Just f) $ modify (\x -> x { path = Nothing })
updateDirectory f
mRemoveDirectory = mRemoveFile
mRename a b =
do p <- gets path
w <- gets what
when (isJust p) $
modify $ \st -> st { path = Just $ movedirfilename a b (fromJust p) }
when (w == Directory) $ do
let fix (i, x) = (i, fn2ps $ movedirfilename a b (ps2fn x))
modify $ \st -> st { current = map fix $ current st }
mModifyFilePS f job = do p <- gets path
when (p == Just f) $ updateFile (fmap linesPS . job . unlinesPS)
mModifyFilePSs f job = do p <- gets path
when (p == Just f) $ updateFile job
updateFile :: ([B.ByteString] -> AnnotatedM [B.ByteString]) -> AnnotatedM ()
updateFile job = (==File) <$> gets what >>= flip when go
where go = do before <- map snd `fmap` gets current
after <- job before
reannotate $ getChanges before after
reannotate [] = return ()
reannotate ((off, remove, add):rest) = do
i <- gets currentInfo
c <- gets current
a <- gets annotated
modify $ \s -> s { current = take off c ++ [ (1, x) | x <- add ] ++
drop (off + length remove) c
, annotated = merge i a $ take (length remove) $ drop off c }
reannotate rest
merge i a l = a V.// [ (line, (Just i, B.empty))
| (line, _) <- l, line >= 0 && line < V.length a]
updateDirectory :: FileName -> AnnotatedM ()
updateDirectory p = (==Directory) <$> gets what >>= flip when go
where go = do let line = fn2ps p
files <- gets current
case filter ((==line) . snd) files of
[match@(ident, _)] -> reannotate ident match line
_ -> return ()
reannotate ident match line =
modify $ \x -> x { annotated = annotated x V.// [ (ident, update line $ currentInfo x) ]
, current = filter (/= match) $ current x }
update line inf = (Just inf, BC.concat [ " -- created as: ", line ])
complete :: Annotated -> Bool
complete x = V.all (isJust . fst) $ annotated x
annotate' :: (Apply p) =>
FL (PatchInfoAnd p) C(x y) -> Annotated -> Annotated
annotate' NilFL ann = ann
annotate' (p :>: ps) ann
| complete ann = ann
| otherwise = annotate' ps $ execState (apply p) (ann { currentInfo = info p })
annotate :: (Apply p) => FL (PatchInfoAnd p) C(x y) -> FileName -> B.ByteString -> Annotated
annotate patches inipath inicontent = annotate' patches initial
where initial = Annotated { path = Just inipath
, currentInfo = error "There is no currentInfo."
, current = zip [0..] (linesPS inicontent)
, what = File
, annotated = V.replicate (length $ breakLines inicontent)
(Nothing, B.empty) }
annotateDirectory :: (Apply p) => FL (PatchInfoAnd p) C(x y) -> FileName -> [FileName] -> Annotated
annotateDirectory patches inipath inicontent = annotate' patches initial
where initial = Annotated { path = Just inipath
, currentInfo = error "There is no currentInfo."
, current = zip [0..] (map fn2ps inicontent)
, what = Directory
, annotated = V.replicate (length inicontent) (Nothing, B.empty) }
machineFormat :: B.ByteString -> Annotated -> String
machineFormat d a = unlines [ case i of
Just inf -> makeFilename inf
Nothing ->
"19700101000000-0000-0000000000000000000000000000000000000000.gz"
++ " | " ++ BC.unpack line ++ " " ++ BC.unpack add
| ((i, add), line) <- zip (V.toList $ annotated a) (breakLines d) ]
format :: B.ByteString -> Annotated -> String
format d a = pi_list ++ "\n" ++ file
where pis = nub $ catMaybes . map fst $ V.toList (annotated a)
pi_list = unlines $ [ show n ++ ": " ++ renderString (humanFriendly i)
| (n :: Int, i) <- zip [1..] pis ]
pi_map = M.fromList (zip pis [1 :: Int ..])
file_ann = groupBy (\a b -> fst a == fst b) $ zip (V.toList $ annotated a) (breakLines d)
file = concat [ annotation (fst $ head chunk) ++ " | " ++ line (head chunk) ++
"\n" ++ unlines [ indent 25 (" | " ++ line l) | l <- tail chunk ]
| chunk <- file_ann ]
line ((_, add), l) = BC.unpack $ BC.concat [l, " ", add]
annotation (Just i, _) | Just n <- M.lookup i pi_map =
pad 20 (piMail i) ++ " " ++ pad 4 ("#" ++ show n)
annotation _ = pad 25 "unknown"
pad n str = replicate (n length str) ' ' ++ (take n str)
indent n str = replicate n ' ' ++ str
piMail pi
| '<' `elem` piAuthor pi = takeWhile (/= '>') . drop 1 . dropWhile (/= '<') $ piAuthor pi
| otherwise = piAuthor pi
breakLines s = case BC.split '\n' s of
[] -> []
split | BC.null (last split) -> init split
| otherwise -> split