{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, MultiParamTypeClasses #-}

-- 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(..)
    ) where

import Prelude ()
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.Info ( PatchInfo(..), displayPatchInfo, piAuthor, makePatchname )
import Darcs.Patch.Named ( Named(..) )
import Darcs.Patch.Named.Wrapped ( WrappedNamed(..) )
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 ( FileName, movedirfilename, fn2ps, ps2fn )
import Darcs.Util.Printer( renderString )
import Darcs.Util.ByteString ( linesPS, decodeLocale )

data FileOrDirectory = File
                     | Directory
                       deriving (Show, Eq)

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

data Annotated = Annotated
    { annotated     :: !AnnotateResult
    , current       :: ![(Int, B.ByteString)]
    , path          :: (Maybe FileName)
    , what          :: FileOrDirectory
    , currentInfo   :: PatchInfo
    } deriving Show

type AnnotatedM = State Annotated

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

instance Annotate Prim where
  annotate (FP fn fp) = case fp of
    RmFile -> do
      whenPathIs fn $ modify' (\s -> s { path = Nothing })
      whenWhatIs Directory $ updateDirectory fn
    AddFile -> return ()
    Hunk off o n -> whenPathIs fn $ whenWhatIs File $ do
      let remove = length o
      let add = length n
      i <- gets currentInfo
      c <- gets current
      a <- gets annotated
      -- NOTE patches are inverted and in inverse order
      modify' $ \s ->
        -- NOTE subtract one from offset because darcs counts from one,
        -- whereas vectors and lists count from zero.
        let (to,from) = splitAt (off-1) c
        in  s { current = map eval $ to ++ replicate add (-1, B.empty) ++ drop remove from
              , annotated = merge i a $ map eval $ take remove $ from
              }
    TokReplace t o n -> whenPathIs fn $ whenWhatIs File $ do
      let test = annotateReplace t (BC.pack o) (BC.pack n)
      i <- gets currentInfo
      c <- gets current
      a <- gets annotated
      modify' $ \s -> s
        { current = map (\(ix,b)->if test b then (-1,B.empty) else (ix,b)) c
        , annotated = merge i a $ map eval $ filter (test . snd) $ c
        }
    -- TODO what if the status of a file changed from text to binary?
    Binary _ _ -> whenPathIs fn $ bug "annotate: can't handle binary changes"
  annotate (DP _ AddDir) = return ()
  annotate (DP fn RmDir) = whenWhatIs Directory $ do
    whenPathIs fn $ modify' (\s -> s { path = Nothing })
    updateDirectory fn
  annotate (Move fn fn') = do
    modify' (\s -> s { path = fmap (movedirfilename fn fn') (path s) })
    whenWhatIs Directory $ do
      let fix (i, x) = (i, fn2ps $ movedirfilename fn fn' (ps2fn x))
      modify $ \s -> s { current = map fix $ current s }
  annotate (ChangePref _ _ _) = return ()

instance Annotate FileUUID.Prim where
  annotate _ = bug "annotate not implemented for FileUUID patches"

instance Annotate p => Annotate (FL p) where
  annotate = sequence_ . mapFL annotate

instance Annotate p => Annotate (Named p) where
  annotate (NamedP _ _ p) = annotate p

instance Annotate p => Annotate (WrappedNamed rt p) where
  annotate (NormalP n) = annotate n
  annotate (RebaseP _ _) = bug "annotate not implemented for Rebase patches"

instance Annotate p => Annotate (PatchInfoAnd rt p) where
  annotate = annotate . hopefully

whenWhatIs :: FileOrDirectory -> AnnotatedM () -> AnnotatedM ()
whenWhatIs w actions = do
  w' <- gets what
  when (w == w') actions

whenPathIs :: FileName -> AnnotatedM () -> AnnotatedM ()
whenPathIs fn actions = do
  p <- gets path
  when (p == Just fn) actions

eval :: (Int, B.ByteString) -> (Int, B.ByteString)
eval (i,b) = seq i $ seq b $ (i,b)

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

updateDirectory :: FileName -> AnnotatedM ()
updateDirectory p = whenWhatIs Directory $ do
    let line = fn2ps p
    files <- gets current
    case filter ((==line) . snd) files of
      [match@(ident, _)] -> reannotate ident match line
      _ -> return ()
  where
    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' :: Annotate p
          => FL (PatchInfoAnd rt p) wX wY
          -> Annotated
          -> Annotated
annotate' NilFL ann = ann
annotate' (p :>: ps) ann
    | complete ann = ann
    | otherwise = annotate' ps $ execState (annotate p) (ann { currentInfo = info p })

annotateFile :: Annotate p
             => FL (PatchInfoAnd rt p) wX wY
             -> FileName
             -> B.ByteString
             -> AnnotateResult
annotateFile patches inipath inicontent = annotated $ annotate' patches initial
  where
    initial = Annotated { path = Just inipath
                        , currentInfo = bug "There is no currentInfo."
                        , current = zip [0..] (linesPS inicontent)
                        , what = File
                        , annotated = V.replicate (length $ breakLines inicontent)
                                                      (Nothing, B.empty)
                        }

annotateDirectory :: Annotate p
                  => FL (PatchInfoAnd rt p) wX wY
                  -> FileName
                  -> [FileName]
                  -> AnnotateResult
annotateDirectory patches inipath inicontent = annotated $ annotate' patches initial
  where
    initial = Annotated { path = Just inipath
                        , currentInfo = bug "There is no currentInfo."
                        , current = zip [0..] (map fn2ps inicontent)
                        , what = Directory
                        , annotated = V.replicate (length inicontent) (Nothing, B.empty)
                        }

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

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

    prependNum (lnum, annLine) =
        let maxDigits = length . show . length $ numberedLines
            lnumStr = show lnum
            paddingNum = maxDigits - length lnumStr
        in replicate paddingNum ' ' ++ lnumStr ++ ": " ++ annLine

    numbered = unlines . map prependNum $ numberedLines

    pi_list = unlines [ show n ++ ": " ++ renderString (displayPatchInfo i)
                      | (n :: Int, i) <- zip [1..] pis ]

    file = concat [ annotation (fst $ head chunk) ++ " | " ++ line (head chunk) ++
                    "\n" ++ unlines [ indent 25 (" | " ++ line l) | l <- tail chunk ]
                  | chunk <- file_ann ]

    pis = nub $ mapMaybe fst $ V.toList a

    pi_map = M.fromList (zip pis [1 :: Int ..])

    file_ann = groupBy ((==) `on` fst) $ zip (V.toList a) (breakLines d)

    line ((_, add), l) = decodeLocale $ 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 :: BC.ByteString -> [BC.ByteString]
breakLines s = case BC.split '\n' s of
    [] -> []
    split | BC.null (last split) -> init split
          | otherwise -> split