108 lines
2.6 KiB
Haskell
108 lines
2.6 KiB
Haskell
|
{- 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"
|