content: {-# LANGUAGE OverloadedStrings #-}
  
  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 []  -- init to strip trailing \n
  
  -- | Get information about the Git repo in the current directory.
  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)
  