module Issue
  ( Issue (..),
    Provenance (..),
    fromMatch,
    id,
    getIssuesPar,
  )
where

import Control.Arrow qualified as W
import Control.Exception (handle, throw)
import Data.Aeson (eitherDecode)
import Data.Binary (Binary)
import Data.Function ((&))
import Data.List (find)
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Data.Text qualified as T
import Exception qualified as E
import GHC.Generics (Generic)
import Issue.Provenance (Provenance (..), commitFromHEAD)
import Issue.Tag (Tag (..))
import Issue.Tag qualified as I
import Issue.Text qualified as I
import Parallel (parMapM)
import Process (proc, sh)
import System.FilePath (takeExtension)
import System.Process.Typed (setWorkingDir)
import TreeGrepper.Match (Match (..))
import TreeGrepper.Match qualified as G
import TreeGrepper.Result (Result (..))
import TreeGrepper.Result qualified as G
import Prelude hiding (id)

data Issue = Issue
  { title :: Text,
    description :: Maybe Text,
    file :: String,
    -- TODO Make provenance obligatory
    --
    -- I cannot think of instances where an issue exists without a provenance..
    --
    -- @difficulty easy
    provenance :: Maybe Provenance,
    start :: G.Position,
    end :: G.Position,
    tags :: [Tag],
    internalTags :: [Tag]
  }
  deriving (Show, Binary, Generic, Eq)

id :: Issue -> Maybe String
id issue =
  (\(Tag _ v) -> T.unpack <$> v)
    =<< find (\(Tag k _) -> k == "id") (issue.tags ++ issue.internalTags)

-- TODO Refactor non-issues
--
-- This does not return an issue, as provenance is not computed over its
-- history. Maybe this should return a different type, or be internal to
-- `History`? Also, `internalTags` suffer.
fromMatch :: FilePath -> G.Result -> G.Match -> IO (Maybe Issue)
fromMatch cwd result match = do
  commit <- commitFromHEAD cwd
  let provenance = Provenance commit commit

  pure
    ( if any (\marker -> T.isPrefixOf marker title') issueMarkers
        then
          Just
            Issue
              { title = title,
                description = description,
                file = result.file,
                provenance = Just provenance,
                start = match.start,
                end = match.end,
                tags = maybe [] I.extractTags description,
                internalTags = I.internalTags title (Just provenance) markers
              }
        else Nothing
    )
  where
    (title', description) = I.extractText result.file_type match.text
    (markers, title) = stripIssueMarkers title'

issueMarkers :: [Text]
issueMarkers =
  [ "TODO",
    "FIXME",
    "QUESTION"
  ]

stripIssueMarkers :: Text -> ([Text], Text)
stripIssueMarkers text =
  case [marker | marker <- issueMarkers, T.isPrefixOf marker text] of
    (marker : _) ->
      W.first (marker :) . stripIssueMarkers $
        T.stripStart (T.drop (T.length marker) text)
    [] ->
      ([], text)

-- | 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

-- | 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 (E.UnknownFileExtension extension)
      treeGrepperQuery =
        case extension of
          ".elm" -> "([(line_comment) (block_comment)])"
          ".hs" -> "(comment)"
          ".nix" -> "(comment)"
          ".sh" -> "(comment)"
          _ -> throw (E.UnknownFileExtension extension)
      decode raw =
        case eitherDecode raw of
          Left e -> throw (E.InvalidTreeGrepperResult e)
          Right treeGrepperResult -> treeGrepperResult

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

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

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

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