1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
module Git
( module Git.CommitHash,
getCommitHashes,
getRootDir,
getChangedFilesOf,
Commit (..),
Author (..),
getCommitOf,
readTextFileOfText,
readTextFileOfBS,
)
where
import Control.Exception (IOException, catch, throw, throwIO)
import Data.Binary (Binary)
import Data.Binary.Instances ()
import Data.ByteString.Lazy qualified as LB
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as N
import Data.Maybe (fromMaybe)
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Text.Lazy qualified as LT
import Data.Text.Lazy.Encoding qualified as LT
import Data.Text.Lazy.IO qualified as LT
import Data.Time.Clock (UTCTime, getCurrentTime)
import Exception qualified as E
import GHC.Generics (Generic)
import Git.CommitHash
import Process (proc, sh)
import Text.Printf (printf)
getCommitHashes :: IO (NonEmpty T.Text)
getCommitHashes = fromMaybe (throw E.NoCommits) . N.nonEmpty . reverse . T.lines . T.decodeUtf8 . LB.toStrict <$> sh "git log --format=%H"
getRootDir :: IO FilePath
getRootDir = T.unpack . stripTrailingNL . T.decodeUtf8 . LB.toStrict <$> sh (proc "git rev-parse --show-toplevel")
where
stripTrailingNL s = fromMaybe s $ T.stripSuffix "\n" s
getChangedFilesOf :: CommitHash -> IO [FilePath]
getChangedFilesOf WorkingTree = do
map T.unpack . T.lines . T.decodeUtf8 . LB.toStrict
<$> sh "git ls-files --modified"
getChangedFilesOf (Commit hash) = do
map T.unpack . T.lines . T.decodeUtf8 . LB.toStrict
<$> sh (proc "git show -p --name-only --format= %" hash)
data Commit = Commit'
{ commitHash :: CommitHash,
date :: UTCTime,
author :: Author
}
deriving (Show, Generic, Binary, Eq)
data Author = Author
{ name :: T.Text,
email :: T.Text
}
deriving (Show, Generic, Binary, Eq)
getCommitOf :: CommitHash -> IO Commit
getCommitOf commitHash@WorkingTree = do
date <- getCurrentTime
authorName <- T.decodeUtf8 . LB.toStrict <$> sh "git config user.name"
authorEmail <- T.decodeUtf8 . LB.toStrict <$> sh "git config user.email"
pure
Commit'
{ author = Author authorName authorEmail,
..
}
getCommitOf commitHash@(Commit hash) = do
( T.splitOn "\NUL" . head . T.lines . T.decodeUtf8 . LB.toStrict
<$> sh
( proc
"git show --quiet --format=%%ai%%x00%%ae%%x00%%an %"
hash
)
)
>>= \case
rawDate : authorEmail : authorName : _ ->
let date = read (T.unpack rawDate)
in pure
Commit'
{ author = Author authorName authorEmail,
..
}
_ -> throwIO E.NoCommits
readTextFileOfText :: CommitHash -> FilePath -> IO LT.Text
readTextFileOfText = readTextFileOf LT.readFile LT.decodeUtf8
readTextFileOfBS :: CommitHash -> FilePath -> IO LB.ByteString
readTextFileOfBS = readTextFileOf LB.readFile (\x->x)
readTextFileOf :: (FilePath -> IO a) -> (LB.ByteString -> a) -> CommitHash -> FilePath -> IO a
readTextFileOf readFile _ WorkingTree filePath =
catch
(readFile filePath)
(\(_ :: IOException) -> throwIO (E.CannotReadFile filePath))
readTextFileOf _ decode (Commit hash) filePath =
catch
(decode <$> sh (proc "git show %:%" hash filePath))
(\(_ :: E.ProcessException) -> throwIO (E.CannotReadFile (printf "%s:%s" hash filePath)))
|
