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
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Issue.Provenance
( Provenance (..),
Commit (..),
Author (..),
commitFromHEAD,
)
where
import Control.Exception (throwIO)
import Data.Binary (Binary, Put, get, put)
import Data.ByteString.Lazy.Char8 (toStrict)
import Data.Fixed (Pico)
import Data.Function ((&))
import Data.Text (lines, splitOn, unpack)
import Data.Text qualified as T
import Data.Text.Encoding (decodeUtf8)
import Data.Time.Calendar (Day (..), toModifiedJulianDay)
import Data.Time.Clock (DiffTime, UTCTime (..), picosecondsToDiffTime)
import Exception qualified as E
import GHC.Generics (Generic)
import Git.CommitHash (CommitHash)
import Git.CommitHash qualified as C
import Process (sh)
import System.Process.Typed (setWorkingDir)
import Prelude hiding (lines)
data Provenance = Provenance
{ first :: Commit,
last :: Commit
}
deriving (Show, Generic, Binary, Eq)
data Commit = Commit
{ hash :: CommitHash,
date :: UTCTime,
author :: Author
}
deriving (Show, Generic, Binary, Eq)
data Author = Author
{ name :: T.Text,
email :: T.Text
}
deriving (Show, Generic, Binary, Eq)
-- XXX These are taken from `Data.Binary.Orphans` [1]. I cannot get importing
-- the instance from the package to work.. so we use `-fno-warn-orphans` here.
--
-- [1] https://hackage.haskell.org/package/binary-orphans-0.1.5.1/docs/src/Data-Binary-Orphans.html#line-132
instance Binary UTCTime where
get = UTCTime <$> get <*> get
put (UTCTime d dt) = put d >> put dt
instance Binary Day where
get = fmap ModifiedJulianDay get
put = put . toModifiedJulianDay
instance Binary DiffTime where
get = fmap picosecondsToDiffTime get
put = (put :: Pico -> Put) . realToFrac
commitFromHEAD :: FilePath -> IO Commit
commitFromHEAD cwd = do
rawProvenance <-
fmap (splitOn "\NUL" . head . lines . decodeUtf8 . toStrict) $
sh $
"git show --quiet --format='%H%x00%ai%x00%ae%x00%an'"
& setWorkingDir cwd
case rawProvenance of
hash : rawDate : authorEmail : authorName : _ ->
let date = read (unpack rawDate)
in pure
Commit
{ hash = C.Commit hash,
date = date,
author = Author authorName authorEmail
}
_ -> throwIO E.NoCommits
|
