{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

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

import Data.Binary (Binary, Put, get, put)
import Data.ByteString.Lazy (toStrict)
import Data.Fixed (Pico)
import Data.Function ((&))
import Data.List (find, foldl')
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding (decodeUtf8)
import Data.Time.Calendar (Day (..), toModifiedJulianDay)
import Data.Time.Clock (DiffTime, UTCTime (..), picosecondsToDiffTime)
import GHC.Generics (Generic)
import Issue.Tag (Tag (..))
import Issue.Tag qualified as I
import Issue.Text qualified as I
import Process (sh)
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,
    provenance :: Maybe Provenance,
    start :: G.Position,
    end :: G.Position,
    tags :: [Tag],
    internalTags :: [Tag]
  }
  deriving (Show, Binary, Generic)

data Provenance = Provenance
  { firstCommit :: Text,
    date :: UTCTime,
    authorEmail :: Text,
    authorName :: Text
  }
  deriving (Show, Generic, Binary)

-- XXX These are taken from `Data.Binary.Orphans` [1]. I cannot get importing
-- the instance from the package to work.. so we use `-fno-warn-orphans` here.
--
-- [1] https://hackage.haskell.org/package/binary-orphans-0.1.5.1/docs/src/Data-Binary-Orphans.html#line-132
instance Binary UTCTime where
  get = UTCTime <$> get <*> get
  put (UTCTime d dt) = put d >> put dt

instance Binary Day where
  get = fmap ModifiedJulianDay get
  put = put . toModifiedJulianDay

instance Binary DiffTime where
  get = fmap picosecondsToDiffTime get
  put = (put :: Pico -> Put) . realToFrac

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

fromMatch :: FilePath -> G.Result -> G.Match -> IO (Maybe Issue)
fromMatch cwd result match = do
  rawProvenance <-
    fmap (T.splitOn "\NUL" . head . T.lines . decodeUtf8 . toStrict) $
      sh $
        "git show --quiet --format='%H%x00%ai%x00%ae%x00%an'"
          & setWorkingDir cwd
  let provenance =
        case rawProvenance of
          firstCommit' : rawDate : authorEmail : authorName : _ ->
            let date = read (T.unpack rawDate)
             in Just
                  Provenance
                    { firstCommit = firstCommit',
                      date = date,
                      authorEmail = authorEmail,
                      authorName = authorName
                    }
          _ ->
            Nothing

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

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

stripIssueMarkers :: Text -> Text
stripIssueMarkers text =
  foldl' (stripIssueMarker) text issueMarkers

stripIssueMarker :: Text -> Text -> Text
stripIssueMarker text marker =
  maybe text T.stripStart (T.stripPrefix marker text)