{-# 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 History.CommitHash (CommitHash)
import History.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