CommitSearch.hs

module Data.Git.Phoenix.CommitSearch where

import Data.ByteString.Lazy.Char8 qualified as C8
import Data.Git.Phoenix.App as A
import Data.Git.Phoenix.CmdArgs (DaysAfter, DaysBefore, SearchCommitBy (..))
import Data.Git.Phoenix.Commit
import Data.Git.Phoenix.Io
import Data.Git.Phoenix.Object
import Data.Git.Phoenix.Prelude
import Data.Git.Phoenix.Pretty
import Data.Git.Phoenix.Sha
import Data.Git.Phoenix.ShaCollision
import Data.List.NonEmpty (groupWith)
import Data.Time.Clock.System
import Data.Time.Format
import Text.Regex.TDFA.ByteString.Lazy
import Text.Regex.TDFA

data CommitObject
  = CommitObject
    { message :: LByteString
    , sha :: LByteString
    , commitTs :: Int64
    , author :: LByteString
    } deriving (Eq, Show, Generic)

instance NFData CommitObject

readCommitObject :: forall m . PhoenixSearchM m => FilePath -> m [CommitObject]
readCommitObject = go
  where
    -- "commit 192\NULtree 844eaa6a04859d069e9ae10f2c6c293d23efc459\nauthor Daniil Iaitskov <dyaitskov@gmail.com> 1750985584 -0800\ncommitter Daniil Iaitskov <dyaitskov@gmail.com> 1 750 985 584 -0800\n\n init git-phoenix\n"
    goCommit bs =
      case extractAuthor bs of
        ("", _) -> pure []
        (author, bs') ->
          case extractCommitTs bs' of
            Nothing -> pure []
            Just (commitTs, bs'') ->
              case extractMessage bs'' of
                message ->
                  let sha = gitPath2Bs . shaToPath . showDigest $ sha1 bs in
                    pure [CommitObject {message, sha, commitTs, author}]


    go :: FilePath -> m [CommitObject]
    go absGop = do
      lr <- withCompressedH absGop $ \cbs bs ->
        case classifyGitObject bs of
          Just BlobType -> pure $ Right []
          Just TreeType -> pure $ Right []
          Just CommitType -> Right <$> goCommit bs
          Just CollidedHash -> pure $ Left cbs
          Nothing -> pure $ Right []
      case lr of
        Right cmt -> pure cmt
        Left cbs -> do
          disLinks <- disambiguateByPair CommitType . fmap C8.unpack $ parseFileLinks cbs
          concat <$> mapM go disLinks

parseGitObject :: PhoenixSearchM m =>
  Regex ->
  Tagged DaysAfter Int64 ->
  Tagged DaysBefore Int64 ->
  FilePath ->
  m [CommitObject]
parseGitObject authorRegex (Tagged epochSecondsAfter) (Tagged epochSecondsBefore) fp =
  filter commitPredicate <$> readCommitObject fp
  where
    commitPredicate co =
      case execute authorRegex (Data.Git.Phoenix.CommitSearch.author co) of
        Right (Just _) ->
          commitTs co >= epochSecondsAfter && commitTs co <= epochSecondsBefore
        Right _ -> False
        Left _ -> False

dedupOrderedList :: Eq a => [a] -> [a]
dedupOrderedList = fmap head . groupWith id

searchCommit :: PhoenixSearchM m =>
  String -> Tagged DaysAfter Int -> Tagged DaysBefore Int -> m [CommitObject]
searchCommit authorPat daysAfter daysBefore = do
  (Tagged udr) <- asks A.uberRepoDir
  now <- liftIO (systemSeconds <$> getSystemTime)
  let daysToEpochSecs :: forall x. Tagged x Int -> Tagged x Int64
      daysToEpochSecs = fmap ((now -) . (* 86400)) . fromIntegral
  case compile defaultCompOpt (ExecOption False) $ C8.pack authorPat of
    Left e -> fail $ "Invalid author regex pattern due: " <>  e
    Right authorRePat ->
      dedupOrderedList . sortOn commitTs <$> runConduitRes
        (  sourceDirectoryDeep False udr
        .| mapMC (parseGitObject authorRePat
                   (daysToEpochSecs daysAfter)
                   (daysToEpochSecs daysBefore))
        .| foldMC (\l a -> pure $ a <> l) []
        )

commitObjectsToDoc :: [CommitObject] -> Doc
commitObjectsToDoc = \case
  [] -> mempty
  o -> vcat (fmap formatCommit o) <> linebreak

runCommitSearch :: SearchCommitBy -> IO [CommitObject]
runCommitSearch SearchCommitBy2 { author, daysBefore, uberRepoDir, daysAfter } = do
  s <- newQSem =<< liftIO getNumCapabilities
  runReaderT
    (searchCommit author daysAfter daysBefore)
    (PhoenixSearchConf uberRepoDir s)

formatCommit :: CommitObject -> Doc
formatCommit co = hsep
  [ take 8 (binSha2Str (sha co))
  , formatTime defaultTimeLocale "%Y-%m-%d %H:%M" (secondsToUtcTime . fromIntegral $ commitTs co)
  , C8.unpack (Data.Git.Phoenix.CommitSearch.author co)
  , take 60 (C8.unpack (message co))
  ]