{-# 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