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
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Issue.Provenance
( Provenance (..),
provenanceFromHEAD,
)
where
import Data.Binary (Binary, Put, get, put)
import Data.ByteString.Lazy.Char8 (toStrict)
import Data.Fixed (Pico)
import Data.Function ((&))
import Data.Text (Text, lines, splitOn, unpack)
import Data.Text.Encoding (decodeUtf8)
import Data.Time.Calendar (Day (..), toModifiedJulianDay)
import Data.Time.Clock (DiffTime, UTCTime (..), picosecondsToDiffTime)
import GHC.Generics (Generic)
import Process (sh)
import System.Process.Typed (setWorkingDir)
import Prelude hiding (lines)
data Provenance = Provenance
{ firstCommit :: Text,
date :: UTCTime,
authorEmail :: Text,
authorName :: Text
}
deriving (Show, Generic, Binary)
-- 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
provenanceFromHEAD :: FilePath -> IO (Maybe Provenance)
provenanceFromHEAD cwd = do
rawProvenance <-
fmap (splitOn "\NUL" . head . lines . decodeUtf8 . toStrict) $
sh $
"git show --quiet --format='%H%x00%ai%x00%ae%x00%an'"
& setWorkingDir cwd
pure $ case rawProvenance of
firstCommit' : rawDate : authorEmail : authorName : _ ->
let date = read (unpack rawDate)
in Just
Provenance
{ firstCommit = firstCommit',
date = date,
authorEmail = authorEmail,
authorName = authorName
}
_ ->
Nothing
|
