{-# OPTIONS_GHC -fno-warn-orphans #-}

module Git
  ( module Git.CommitHash,
    getCommitHashes,
    getRootDir,
    getChangedFilesOf,
    Commit (..),
    Author (..),
    getCommitOf,
    readTextFileOf,
  )
where

import Control.Exception (throw, throwIO)
import Data.Binary (Binary, Put, get, put)
import Data.ByteString.Lazy qualified as LB
import Data.Fixed (Pico)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as N
import Data.Maybe (fromMaybe)
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Text.Lazy qualified as LT
import Data.Text.Lazy.Encoding qualified as LT
import Data.Text.Lazy.IO qualified as LT
import Data.Time.Calendar (Day (..), toModifiedJulianDay)
import Data.Time.Clock (DiffTime, UTCTime (..), getCurrentTime, picosecondsToDiffTime)
import Exception qualified as E
import GHC.Generics (Generic)
import Git.CommitHash
import Process (proc, sh)
import Prelude hiding (lines)

getCommitHashes :: IO (NonEmpty T.Text)
getCommitHashes = fromMaybe (throw E.NoCommits) . N.nonEmpty . reverse . T.lines . T.decodeUtf8 . LB.toStrict <$> sh "git log --format=%H"

getRootDir :: IO FilePath
getRootDir = T.unpack . stripTrailingNL . T.decodeUtf8 . LB.toStrict <$> sh (proc "git rev-parse --show-toplevel")
  where
    stripTrailingNL s = fromMaybe s $ T.stripSuffix "\n" s

getChangedFilesOf :: CommitHash -> IO [FilePath]
getChangedFilesOf WorkingTree = do
  map T.unpack . T.lines . T.decodeUtf8 . LB.toStrict
    <$> sh "git ls-files --modified"
getChangedFilesOf (Commit hash) = do
  map T.unpack . T.lines . T.decodeUtf8 . LB.toStrict
    <$> sh (proc "git show -p --name-only --format= %" hash)

data Commit = Commit'
  { commitHash :: 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

getCommitOf :: CommitHash -> IO Commit
getCommitOf commitHash@WorkingTree = do
  date <- getCurrentTime
  authorName <- T.decodeUtf8 . LB.toStrict <$> sh "git config user.name"
  authorEmail <- T.decodeUtf8 . LB.toStrict <$> sh "git config user.email"
  pure
    Commit'
      { author = Author authorName authorEmail,
        ..
      }
getCommitOf commitHash@(Commit hash) = do
  ( T.splitOn "\NUL" . head . T.lines . T.decodeUtf8 . LB.toStrict
      <$> sh
        ( proc
            "git show --quiet --format=%%ai%%x00%%ae%%x00%%an %"
            hash
        )
    )
    >>= \case
      rawDate : authorEmail : authorName : _ ->
        let date = read (T.unpack rawDate)
         in pure
              Commit'
                { author = Author authorName authorEmail,
                  ..
                }
      _ -> throwIO E.NoCommits

-- TODO Fix `readTextFileOf`
--
-- Handle file does not exist in `WorkingTree` case.
readTextFileOf :: CommitHash -> FilePath -> IO LT.Text
readTextFileOf WorkingTree filePath = LT.readFile filePath
readTextFileOf (Commit hash) filePath =
  LT.decodeUtf8 <$> sh (proc "git show %:%" hash filePath)