module History
  ( History (..),
    getHistory,
  )
where

import CMark qualified as D
import Cache (cachedMaybe)
import Comment qualified as G
import Control.Arrow (first)
import Control.Exception (catch, handle, try)
import Data.Binary (Binary)
import Data.ByteString.Lazy qualified as LB
import Data.Function (on, (&))
import Data.List.NonEmpty qualified as N
import Data.Map qualified as M
import Data.Maybe (catMaybes)
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Text.IO qualified as T
import Data.Text.Lazy qualified as LT
import Data.Text.Lazy.Encoding qualified as LT
import Die (die)
import Exception qualified as E
import GHC.Generics (Generic)
import Git qualified
import Git.CommitHash (CommitHash (..))
import Git.CommitHash qualified as C
import Issue qualified as I
import Issue.Parser qualified as I
import Issue.Tag qualified as I
import Issue.Text qualified as I
import IssueEvent (IssueEvent (..))
import Patch qualified as A
import Process (proc, sh)
import Render qualified as P
import System.FilePath ((</>))
import System.IO.Temp (withSystemTempDirectory)
import System.Process.Typed (setWorkingDir)
import Tuple ()

-- TODO Reduce cached data size
--
-- Right now we are caching complete `Issue` instances, which
-- contain the full issue title and description.  For a fast
-- lookup it may already be enough to only store the issue's
--
-- \* filename
-- \* start position
-- \* end position
--
-- With this information we can use git to quickly look up the
-- complete issue text and parse it.
--
-- @topic caching
-- @backlog

data History = History
  { commitHash :: CommitHash,
    issues :: M.Map T.Text I.Issue,
    issueEvents :: [IssueEvent]
  }
  deriving (Show, Generic, Binary)

getHistory :: IO History
getHistory = getHistoryOf WorkingTree

getHistoryOf :: CommitHash -> IO History
getHistoryOf commitHash = cachedMaybe (C.toText commitHash) do
  maybeParentCommitHash <- getParentCommitHashOf commitHash
  case maybeParentCommitHash of
    Just parentCommitHash -> do
      parentHistory <- getHistoryOf parentCommitHash
      scramble <- getScrambleOf commitHash
      propagate commitHash parentHistory scramble
    Nothing -> unsafeAssume commitHash =<< getScrambleOf commitHash

getParentCommitHashOf :: CommitHash -> IO (Maybe CommitHash)
getParentCommitHashOf commitHash =
  either
    (\_ -> Nothing)
    (Just . Commit . T.strip . T.decodeUtf8 . LB.toStrict)
    <$> try @E.ProcessException
      ( case commitHash of
          WorkingTree -> sh "git show -s --format=%H HEAD"
          Commit hash -> sh (proc "git show -s --format=%%H %^" hash)
      )

-- | `Scramble` records the complete issues ONLY in files that have
-- been changed in the commit.
data Scramble = Scramble
  { commitHash :: CommitHash,
    filesChanged :: [FilePath],
    issues :: M.Map T.Text I.Issue
  }
  deriving (Show, Binary, Generic)

getScrambleOf :: CommitHash -> IO Scramble
getScrambleOf commitHash = do
  (issues, filesChanged) <- first (M.fromList . map (\i -> (i.id, i))) <$> getIssuesAndFilesChanged commitHash
  pure $ Scramble {..}

getIssuesAndFilesChanged :: CommitHash -> IO ([I.Issue], [FilePath])
getIssuesAndFilesChanged commitHash = do
  files <- Git.getChangedFilesOf commitHash
  issues <-
    concat
      <$> catch
        (mapM (getIssues commitHash) files)
        (\(e :: E.InvalidTreeGrepperResult) -> die (show e))
  pure (issues, files)

-- | Get all issues in the given directory and file.
getIssues :: CommitHash -> FilePath -> IO [I.Issue]
getIssues commitHash filename =
  handle (\(_ :: E.UnknownFileExtension) -> pure []) $
    fmap catMaybes . mapM (fromComment commitHash)
      =<< G.getComments commitHash filename

-- | Note that `provenance` is trivial and needs to be fixed up later.
fromComment :: CommitHash -> G.Comment -> IO (Maybe I.Issue)
fromComment commitHash comment = do
  commit <- Git.getCommitOf commitHash
  let provenance = I.Provenance commit commit

  pure $
    ( \parseResult ->
        let (markers, title) =
              I.stripIssueMarkers (T.pack (show (P.render parseResult.heading)))
         in I.Issue
              { title = title,
                description = N.nonEmpty parseResult.paragraphs,
                file = comment.filePath,
                provenance = provenance,
                startPoint = comment.startPoint,
                endPoint = comment.endPoint,
                tags = I.extractTags parseResult.tags,
                markers = markers,
                rawText = rawText,
                commentStyle = commentStyle,
                comments = N.nonEmpty parseResult.comments,
                closed = False
              }
    )
      <$> I.parse I.issueMarkers (D.commonmarkToNode [] rawText)
  where
    (commentStyle, rawText) = G.uncomment comment.language comment.text

propagate :: CommitHash -> History -> Scramble -> IO History
propagate commitHash oldHistory scramble = do
  let issues = propagateIssues oldHistory.issues scramble
  issueEvents <- propagateIssueEvents oldHistory.issueEvents oldHistory.issues commitHash issues
  pure $ History {..}

propagateIssues :: M.Map T.Text I.Issue -> Scramble -> M.Map T.Text I.Issue
propagateIssues oldIssues scramble =
  M.mergeWithKey
    ( \_ old new ->
        Just $
          new
            { I.provenance =
                I.Provenance
                  { first = old.provenance.first,
                    last =
                      if ((/=) `on` (.rawText)) old new
                        then new.provenance.last
                        else old.provenance.last
                  },
              I.closed = False
            }
    )
    ( M.map
        ( \old ->
            if M.member old.id scramble.issues
              || not (old.file `elem` scramble.filesChanged)
              then old
              else old {I.closed = True}
        )
    )
    id
    oldIssues
    scramble.issues

propagateIssueEvents :: [IssueEvent] -> M.Map T.Text I.Issue -> CommitHash -> M.Map T.Text I.Issue -> IO [IssueEvent]
propagateIssueEvents oldIssueEvents oldIssues commitHash issues =
  fmap (oldIssueEvents ++) $ newIssueEvents oldIssues commitHash issues

newIssueEvents :: M.Map T.Text I.Issue -> CommitHash -> M.Map T.Text I.Issue -> IO [IssueEvent]
newIssueEvents oldIssues' commitHash issues' =
  sequence $
    concat
      [ [ IssueCreated commitHash issue <$> patchCreated issue
          | issue <- M.elems (issues `M.difference` oldIssues)
        ],
        [ IssueChanged commitHash oldIssue newIssue <$> patchChanged oldIssue newIssue
          | (newIssue, oldIssue) <- M.elems (M.intersectionWith (,) issues oldIssues),
            newIssue `neq` oldIssue
        ],
        [ IssueDeleted commitHash issue {I.closed = True} <$> patchDeleted issue
          | issue <- M.elems (oldIssues `M.difference` issues)
        ]
      ]
  where
    issues = M.filter (not . (.closed)) issues'
    oldIssues = M.filter (not . (.closed)) oldIssues'

    patchCreated new = diff "" new.rawText
    patchChanged old new = diff old.rawText new.rawText
    patchDeleted old = diff old.rawText ""

    diff old new = withSystemTempDirectory "diff" $ \tmp -> do
      let cwd = tmp
      T.writeFile (tmp </> "old") old
      T.writeFile (tmp </> "new") new
      A.parse . LT.toStrict . LT.decodeUtf8 <$> sh ("git diff --no-index -- old new || :" & setWorkingDir cwd)

    neq = (/=) `on` (.rawText)

unsafeAssume :: CommitHash -> Scramble -> IO History
unsafeAssume commitHash scramble = do
  let issues = scramble.issues
  issueEvents <- propagateIssueEvents [] M.empty commitHash issues
  pure $ History {..}