module Trace.Hpc.Coveralls.GitInfo (getGitInfo, GitInfo) where
import Control.Applicative ((<$>), (<*>))
import Control.Monad (guard)
import Data.Aeson
import Data.List (nubBy)
import Data.Function (on)
import System.Process (readProcess)
data GitInfo = GitInfo { headRef :: Commit
, branch :: String
, remotes :: [Remote] }
instance ToJSON GitInfo where
toJSON i = object [ "head" .= headRef i
, "branch" .= branch i
, "remotes" .= remotes i]
data Commit = Commit { hash :: String
, authorName :: String
, authorEmail :: String
, committerName :: String
, committerEmail :: String
, message :: String }
instance ToJSON Commit where
toJSON c = object [ "id" .= hash c
, "author_name" .= authorName c
, "author_email" .= authorEmail c
, "committer_name" .= committerName c
, "committer_email" .= committerEmail c
, "message" .= message c ]
data Remote = Remote { name :: String
, url :: String }
instance ToJSON Remote where
toJSON r = object [ "name" .= name r
, "url" .= url r ]
git :: [String] -> IO String
git args = init <$> readProcess "git" args []
getGitInfo :: IO GitInfo
getGitInfo = GitInfo <$> headRef <*> branch <*> getRemotes where
headRef = Commit <$> git ["rev-parse", "HEAD"]
<*> git ["log", "-1", "--pretty=%aN"] <*> git ["log", "-1", "--pretty=%aE"]
<*> git ["log", "-1", "--pretty=%cN"] <*> git ["log", "-1", "--pretty=%cE"]
<*> git ["log", "-1", "--pretty=%s"]
branch = git ["rev-parse", "--abbrev-ref", "HEAD"]
getRemotes :: IO [Remote]
getRemotes = nubBy ((==) `on` name) <$> parseRemotes <$> git ["remote", "-v"] where
parseRemotes :: String -> [Remote]
parseRemotes input = do
line <- lines input
let fields = words line
guard $ length fields >= 2
return $ Remote (head fields) (fields !! 1)