{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}

module History (getIssues, listIssues) where

import Control.Exception (Exception, catch, handle, throw)
import Data.Aeson (eitherDecode)
import Data.Binary (Binary, decodeFile, encodeFile)
import Data.ByteString.Lazy.Char8 qualified as L8
import Data.Function ((&))
import Data.List (intercalate)
import Data.Maybe (catMaybes, mapMaybe)
import Data.String (fromString)
import Data.Text (Text, lines, unpack)
import Data.Text.Encoding (decodeUtf8)
import Issue (Issue (..), fromMatch, id)
import Issue.Filter (Filter, applyFilter)
import Parallel (parMapM)
import Process (quote, sh, sh_)
import System.Directory (createDirectoryIfMissing, doesFileExist, getCurrentDirectory)
import System.Exit (ExitCode (ExitFailure), exitWith)
import System.FilePath (takeExtension, (</>))
import System.IO.Temp (withSystemTempDirectory)
import System.Process.Typed (setWorkingDir)
import Text.Printf (printf)
import TreeGrepper.Match qualified as G
import TreeGrepper.Result qualified as G
import Prelude hiding (id, lines)
import Prelude qualified as Prelude

listIssues :: [Filter] -> [FilePath] -> IO [Issue]
listIssues filters paths = do
  commitHashes <- getCommitHashes
  issuesWorkingTreeAll <- getIssuesWorkingTreeAll paths
  historicalIssues <- fmap concat $ parMapM (\hash -> cached hash (\_ -> getIssuesCommitChanged hash)) commitHashes
  let currentIssuesFiltered = filter (applyFilter filters) issuesWorkingTreeAll
  pure $ map (fixProvenance historicalIssues) currentIssuesFiltered

getCommitHashes :: IO [Text]
getCommitHashes =
  fmap (lines . decodeUtf8 . L8.toStrict) $ sh "git log --format=%H"

fixProvenance :: [Issue] -> Issue -> Issue
fixProvenance historicalIssues =
  merge . pick historicalIssues

pick :: [Issue] -> Issue -> (Issue, [Issue])
pick issues issue =
  (issue, filter (isSameIssue) issues)
  where
    isSameIssue otherIssue =
      id otherIssue == id issue

merge :: (Issue, [Issue]) -> Issue
merge (issue, issues) =
  case (mapMaybe provenance (reverse issues)) of
    [] ->
      issue
    provenance : _ ->
      issue {provenance = Just provenance}

-- | Gets issues in all files in your current [working
-- - tree](https://git-scm.com/docs/gitglossary#Documentation/gitglossary.txt-aiddefworkingtreeaworkingtree)
getIssuesWorkingTreeAll :: [FilePath] -> IO [Issue]
getIssuesWorkingTreeAll paths = do
  cwd <- getCurrentDirectory
  files <- gitLsFilesAllIn cwd paths
  concat <$> catch (getIssuesPar cwd files) dieOfInvalidTreeGrepperResult

-- | Gets issues in all files which have been changed in your current
-- [working
-- - tree](https://git-scm.com/docs/gitglossary#Documentation/gitglossary.txt-aiddefworkingtreeaworkingtree)
getIssuesWorkingTreeChanged :: [FilePath] -> IO [Issue]
getIssuesWorkingTreeChanged paths = do
  cwd <- getCurrentDirectory
  files <- gitLsFilesModifiedIn cwd paths
  concat <$> catch (getIssuesPar cwd files) dieOfInvalidTreeGrepperResult

-- | Given the hash of a commit, get all issues in all files at the
-- [tree](https://git-scm.com/docs/gitglossary#Documentation/gitglossary.txt-aiddeftreeatree)
-- of this commit.
getIssuesCommitAll :: Text -> IO [Issue]
getIssuesCommitAll hash = do
  withSystemTempDirectory "history" $ \tmp -> do
    cwd <- do
      let cwd = tmp </> unpack hash
      sh_ $ fromString $ printf "git worktree add --detach %s %s" (quote cwd) (quote $ unpack hash)
      pure cwd
    files <- gitLsFilesAll cwd
    concat <$> catch (getIssuesPar cwd files) (dieOfInvalidTreeGrepperResult)

-- | Given the hash of a commit, get all issues in the files which have
-- been changed by this commit.
getIssuesCommitChanged :: Text -> IO [Issue]
getIssuesCommitChanged hash = do
  withSystemTempDirectory "history" $ \tmp -> do
    cwd <- do
      let cwd = tmp </> unpack hash
      sh_ $ fromString $ printf "git worktree add --detach %s %s" (quote cwd) (quote $ unpack hash)
      pure cwd
    files <- gitShowChanged cwd
    concat <$> catch (getIssuesPar cwd files) (dieOfInvalidTreeGrepperResult)

gitLsFilesAll :: FilePath -> IO [FilePath]
gitLsFilesAll cwd =
  Prelude.lines . L8.unpack
    <$> sh ("git ls-files --cached --exclude-standard --other" & setWorkingDir cwd)

gitLsFilesAllIn :: FilePath -> [String] -> IO [FilePath]
gitLsFilesAllIn cwd paths =
  Prelude.lines . L8.unpack
    <$> sh
      ( fromString
          ( (printf "git ls-files --cached --exclude-standard --other%s")
              ( case paths of
                  [] -> ""
                  _ -> " -- " ++ intercalate " " (map quote paths)
              )
          )
          & setWorkingDir cwd
      )

gitShowChanged :: FilePath -> IO [FilePath]
gitShowChanged cwd =
  Prelude.lines . L8.unpack
    <$> sh ("git show -p --name-only --format=''" & setWorkingDir cwd)

gitLsFilesModifiedIn :: FilePath -> [FilePath] -> IO [FilePath]
gitLsFilesModifiedIn cwd paths =
  Prelude.lines . L8.unpack
    <$> sh
      ( fromString
          ( (printf "git ls-files --modified%s")
              ( case paths of
                  [] -> ""
                  _ -> " -- " ++ intercalate " " (map quote paths)
              )
          )
          & setWorkingDir cwd
      )

-- | Get all issues in the given directory and files.  Runs
-- parallelized.
getIssuesPar :: FilePath -> [FilePath] -> IO [[Issue]]
getIssuesPar cwd files =
  parMapM (handle forgetGetIssuesExceptions . getIssues cwd) files

data UnknownFileExtension = UnknownFileExtension
  { extension :: String
  }
  deriving (Show)

instance Exception UnknownFileExtension

forgetGetIssuesExceptions :: UnknownFileExtension -> IO [a]
forgetGetIssuesExceptions _ = pure []

data InvalidTreeGrepperResult = InvalidTreeGrepperResult
  { error :: String
  }
  deriving (Show)

instance Exception InvalidTreeGrepperResult

dieOfInvalidTreeGrepperResult :: InvalidTreeGrepperResult -> IO a
dieOfInvalidTreeGrepperResult (InvalidTreeGrepperResult e) =
  die e

-- | Get all issues in the given directory and file.
getIssues :: FilePath -> FilePath -> IO [Issue]
getIssues cwd filename = do
  let extension = takeExtension filename
      treeGrepperLanguage =
        -- TODO Add support for all tree-grepper supported files
        --
        -- tree-grepper supported files can be listed through `tree-grepper
        -- --languages`.
        case extension of
          ".elm" -> "elm"
          ".hs" -> "haskell"
          ".nix" -> "nix"
          ".sh" -> "sh"
          _ -> throw (UnknownFileExtension extension)
      treeGrepperQuery =
        case extension of
          ".elm" -> "([(line_comment) (block_comment)])"
          ".hs" -> "(comment)"
          ".nix" -> "(comment)"
          ".sh" -> "(comment)"
          _ -> throw (UnknownFileExtension extension)
      decode raw =
        case eitherDecode raw of
          Left e -> throw (InvalidTreeGrepperResult e)
          Right treeGrepperResult -> treeGrepperResult

  matches <-
    concatMap (\result -> map ((,) result) result.matches)
      . map fixTreeGrepper
      . decode
      <$> sh
        ( fromString
            ( printf
                "tree-grepper --query %s %s --format json %s"
                (quote treeGrepperLanguage)
                (quote treeGrepperQuery)
                (quote filename)
            )
            & setWorkingDir cwd
        )

  catMaybes <$> mapM (uncurry (fromMatch cwd)) matches

fixTreeGrepper :: G.Result -> G.Result
fixTreeGrepper treeGrepperResult =
  treeGrepperResult {G.matches = G.merge treeGrepperResult.matches}

cached :: Binary a => Text -> (Text -> IO a) -> IO a
cached hash func = do
  cwd <- getCurrentDirectory
  createDirectoryIfMissing True (cwd ++ "/.anissue")
  let file = (cwd ++ "/.anissue/" ++ unpack hash)
  fileExists <- doesFileExist file
  if fileExists
    then decodeFile file
    else do
      blob <- func hash
      encodeFile file blob
      pure blob

die :: String -> IO a
die s = do
  printf "error: %s\n" s
  exitWith (ExitFailure 1)