module Backend
  ( module Backend.CommitHash,
    getCommitHashes,
    getParentCommitHashOf,
    getRootDir,
    getFilesOf,
    getChangedFilesOf,
    Commit (..),
    Author (..),
    getCommitOf,
    readTextFileOfText,
    readTextFileOfBS,
    resolveRef,
    getCommitsBetween,
    diffOf,
  )
where

import Backend.CommitHash
import Control.Exception (IOException, catch, throwIO)
import Data.Binary (Binary)
import Data.Binary.Instances ()
import Data.ByteString.Lazy qualified as LB
import Data.ByteString.UTF8 qualified as B
import Data.List (sort)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Tagged
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.Clock (UTCTime, getCurrentTime)
import Data.Time.LocalTime (zonedTimeToUTC)
import Exception qualified as E
import GHC.Generics (Generic)
import Git qualified as Git
import Git.Libgit2 (LgRepo, lgFactory)
import Patch qualified as A
import Process (proc, sh, sh_)
import Safe (headMay)
import System.Environment (lookupEnv)
import Text.Printf (printf)

getCommitHashes :: Maybe CommitHash -> Maybe CommitHash -> IO [CommitHash]
getCommitHashes maybeBottomCommit Nothing =
  getCommitHashes maybeBottomCommit (Just WorkingTree)
getCommitHashes (Just WorkingTree) (Just WorkingTree) =
  pure [WorkingTree]
getCommitHashes (Just WorkingTree) (Just (Commit _)) =
  pure []
getCommitHashes Nothing (Just WorkingTree) =
  (WorkingTree :) . map (Commit . Git.renderOid . untag) . reverse
    <$> Git.withRepository lgFactory "." do
      Just head <- Git.resolveReference "HEAD"
      Git.listCommits Nothing (Tagged head)
getCommitHashes (Just (Commit bottomHash)) (Just WorkingTree) =
  (WorkingTree :) . map (Commit . Git.renderOid . untag) . reverse
    <$> Git.withRepository lgFactory "." do
      Just headRef <- Git.resolveReference "HEAD"
      bottomRef <- Git.parseOid bottomHash
      Git.listCommits (Just (Tagged bottomRef)) (Tagged headRef)
getCommitHashes Nothing (Just (Commit topHash)) =
  (WorkingTree :) . map (Commit . Git.renderOid . untag) . reverse
    <$> Git.withRepository lgFactory "." do
      topRef <- Git.parseOid topHash
      Git.listCommits Nothing (Tagged topRef)
getCommitHashes (Just (Commit bottomHash)) (Just (Commit topHash)) =
  (WorkingTree :) . map (Commit . Git.renderOid . untag) . reverse
    <$> Git.withRepository lgFactory "." do
      topRef <- Git.parseOid topHash
      bottomRef <- Git.parseOid bottomHash
      Git.listCommits (Just (Tagged bottomRef)) (Tagged topRef)

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

getFilesOf :: CommitHash -> IO [FilePath]
getFilesOf WorkingTree =
  map T.unpack . T.lines
    <$> sh "git ls-files --cached --modified --others --exclude-standard --full-name"
getFilesOf (Commit commit) =
  map snd <$> getFilesWithOidOf commit

getChangedFilesOf :: CommitHash -> IO [FilePath]
getChangedFilesOf WorkingTree =
  map T.unpack . T.lines
    <$> sh "git ls-files --modified --others --exclude-standard --full-name"
getChangedFilesOf (Commit commit) = do
  maybeParentCommit <- getParentCommitHashOf (Commit commit)
  case maybeParentCommit of
    Nothing -> getFilesOf (Commit commit)
    Just parentCommit -> do
      files <- getFilesWithOidOf commit
      parentFiles <- getFilesWithOidOf parentCommit
      let addedFiles =
            map snd
              . filter
                ( \(_, filePath) ->
                    all
                      (\(_, filePath') -> filePath /= filePath')
                      parentFiles
                )
              $ files
          deletedFiles =
            map snd
              . filter
                ( \(_, filePath) ->
                    all
                      (\(_, filePath') -> filePath /= filePath')
                      files
                )
              $ parentFiles
          changedFiles =
            [ snd file
              | file <- files,
                parentFile <- parentFiles,
                snd file == snd parentFile,
                fst file /= fst parentFile
            ]
      pure $ sort $ addedFiles ++ deletedFiles ++ changedFiles

getParentCommitHashOf :: CommitHash -> IO (Maybe T.Text)
getParentCommitHashOf commitHash =
  fmap Git.renderOid
    <$> case commitHash of
      WorkingTree -> Git.withRepository lgFactory "." do
        Git.resolveReference "HEAD"
      Commit hash -> Git.withRepository lgFactory "." do
        hashRef <- Git.parseOid hash
        commit <- Git.lookupCommit (Tagged hashRef)
        pure (untag <$> (headMay (Git.commitParents commit)))

getFilesWithOidOf :: T.Text -> IO [(Git.BlobOid LgRepo, FilePath)]
getFilesWithOidOf hash = do
  mapMaybe
    ( \(filePath, treeEntry) ->
        case treeEntry of
          Git.BlobEntry {Git.blobEntryOid, Git.blobEntryKind = Git.PlainBlob} ->
            Just (blobEntryOid, B.toString filePath)
          _ ->
            Nothing
    )
    <$> ( Git.withRepository lgFactory "." $ do
            head <- Git.parseOid hash
            commit <- Git.lookupCommit (Tagged head)
            tree <- Git.lookupTree (Git.commitTree commit)
            Git.listTreeEntries tree
        )

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)

getCommitOf :: CommitHash -> IO Commit
getCommitOf commitHash@WorkingTree = do
  date <- maybe getCurrentTime (pure . read) =<< lookupEnv "FAKETIME"
  authorName <- T.strip <$> sh "git config user.name"
  authorEmail <- T.strip <$> sh "git config user.email"
  pure
    Commit'
      { author = Author authorName authorEmail,
        ..
      }
getCommitOf commitHash@(Commit hash) = do
  Git.withRepository lgFactory "." $ do
    head <- Git.parseOid hash
    commit <- Git.lookupCommit (Tagged head)
    let authorName = Git.signatureName (Git.commitAuthor commit)
        authorEmail = Git.signatureEmail (Git.commitAuthor commit)
        date = zonedTimeToUTC (Git.signatureWhen (Git.commitAuthor commit))
    pure
      Commit'
        { author = Author authorName authorEmail,
          ..
        }

readTextFileOfText :: CommitHash -> FilePath -> IO LT.Text
readTextFileOfText = readTextFileOf LT.readFile LT.decodeUtf8

readTextFileOfBS :: CommitHash -> FilePath -> IO LB.ByteString
readTextFileOfBS = readTextFileOf LB.readFile id

readTextFileOf :: (FilePath -> IO a) -> (LB.ByteString -> a) -> CommitHash -> FilePath -> IO a
readTextFileOf readFile _ WorkingTree filePath =
  catch
    (readFile filePath)
    (\(_ :: IOException) -> throwIO (E.CannotReadFile filePath))
readTextFileOf _ decode (Commit hash) filePath =
  maybe
    (throwIO (E.CannotReadFile (printf "%s:%s" hash filePath)))
    (pure . decode)
    =<< Git.withRepository lgFactory "." do
      hashRef <- Git.parseOid hash
      commit <- Git.lookupCommit (Tagged hashRef)
      Git.commitTreeEntry commit (B.fromString filePath) >>= \case
        Just
          ( Git.BlobEntry
              { Git.blobEntryOid,
                Git.blobEntryKind = Git.PlainBlob
              }
            ) -> Just <$> Git.catBlobLazy blobEntryOid
        _ -> pure Nothing

resolveRef :: T.Text -> IO CommitHash
resolveRef =
  fmap (Commit . T.strip . T.decodeUtf8 . LB.toStrict)
    . sh
    . proc "git rev-parse %"

-- | `getCommitsBetween prevCommit commit` returns the commits from `prevCommit` to `commit`. The result excludes `prevCommit`, but includes `commit`.
--
-- If `prevCommit` is  not an ancestor of `commit`, this functions throws `NoAncestor commit prevCommit`.
getCommitsBetween :: CommitHash -> CommitHash -> IO [CommitHash]
getCommitsBetween WorkingTree commit@(Commit _) =
  throwIO (E.NoAncestor WorkingTree commit)
getCommitsBetween WorkingTree WorkingTree = pure [WorkingTree]
getCommitsBetween prevCommit WorkingTree =
  fmap (++ [WorkingTree]) . getCommitsBetween prevCommit
    =<< resolveRef "HEAD"
getCommitsBetween prevCommit@(Commit prevHash) commit@(Commit hash) = do
  catch
    (sh_ (proc "git merge-base --is-ancestor % %" prevHash hash))
    (\(_ :: E.ProcessException) -> throwIO (E.NoAncestor commit prevCommit))
  map (Commit . T.strip) . T.lines . T.decodeUtf8 . LB.toStrict
    <$> sh (proc "git log --format=%%H %..%" prevHash hash)

diffOf :: CommitHash -> CommitHash -> IO A.Patch
diffOf prevHash hash =
  A.parse . T.decodeUtf8 . LB.toStrict
    <$> sh (proc "git diff % %" (toTextUnsafe prevHash) (toTextUnsafe hash))