{- git log
 -
 - Copyright 2023 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

module Git.Log where

import Common
import Git
import Git.Command

import Data.Time
import Data.Time.Clock.POSIX

-- A change made to a file.
data RefChange t = RefChange
	{ changetime :: POSIXTime
	, changed :: t
	, changedfile :: FilePath
	, oldref :: Ref
	, newref :: Ref
	}
	deriving (Show)

-- Get the git log. Note that the returned cleanup action should only be
-- run after processing the returned list.
getGitLog
	:: Ref
	-> [FilePath]
	-> [CommandParam]
	-> (FilePath -> Maybe t)
	-> Repo
	-> IO ([RefChange t], IO Bool)
getGitLog ref fs os fileselector repo = do
	(ls, cleanup) <- pipeNullSplit ps repo
	return (parseGitRawLog fileselector (map decodeBL ls), cleanup)
  where
	ps =
		[ Param "log"
		, Param "-z"
		, Param ("--pretty=format:"++commitinfoFormat)
		, Param "--raw"
		, Param "--no-abbrev"
		, Param "--no-renames"
		] ++ os ++
		[ Param (fromRef ref)
		, Param "--"
		] ++ map Param fs 

-- The commitinfo is the timestamp of the commit, followed by
-- the commit hash and then the commit's parents, separated by spaces.
commitinfoFormat :: String
commitinfoFormat = "%ct"

-- Parses chunked git log --raw output generated by getGitLog, 
-- which looks something like:
--
-- [ "commitinfo\n:changeline"
-- , "filename"
-- , ""
-- , "commitinfo\n:changeline"
-- , "filename"
-- , ":changeline"
-- , "filename"
-- , ""
-- ]
--
-- The commitinfo is not included before all changelines, so
-- keep track of the most recently seen commitinfo.
parseGitRawLog :: (FilePath -> Maybe t) -> [String] -> [RefChange t]
parseGitRawLog fileselector = parse epoch
  where
	epoch = toEnum 0 :: POSIXTime
	parse oldts ([]:rest) = parse oldts rest
	parse oldts (c1:c2:rest) = case mrc of
		Just rc -> rc : parse ts rest
		Nothing -> parse ts (c2:rest)
	  where
		(ts, cl) = case separate (== '\n') c1 of
			(cl', []) -> (oldts, cl')
			(tss, cl') -> (parseTimeStamp tss, cl')
	  	mrc = do
			(old, new) <- parseRawChangeLine cl
			v <- fileselector c2
			return $ RefChange
				{ changetime = ts
				, changed = v
				, changedfile = c2
				, oldref = old
				, newref = new
				}
	parse _ _ = []

-- Parses something like ":100644 100644 oldsha newsha M"
-- extracting the shas.
parseRawChangeLine :: String -> Maybe (Git.Ref, Git.Ref)
parseRawChangeLine = go . words
  where
	go (_:_:oldsha:newsha:_) = 
		Just (Git.Ref (encodeBS oldsha), Git.Ref (encodeBS newsha))
	go _ = Nothing

parseTimeStamp :: String -> POSIXTime
parseTimeStamp = utcTimeToPOSIXSeconds . fromMaybe (giveup "bad timestamp") .
	parseTimeM True defaultTimeLocale "%s"