diff options
Diffstat (limited to 'app')
| -rw-r--r-- | app/Issue.hs | 67 | ||||
| -rw-r--r-- | app/Main.hs | 35 |
2 files changed, 70 insertions, 32 deletions
diff --git a/app/Issue.hs b/app/Issue.hs index 2674a7c..e37c20e 100644 --- a/app/Issue.hs +++ b/app/Issue.hs @@ -3,25 +3,29 @@ {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} -module Issue (Issue (..), fromMatch, id) where +module Issue (Issue (..), Provenance (..), fromMatch, id) where +import Data.ByteString.Lazy.Char8 (unpack) import Data.List (find, foldl') +import Data.String (fromString) import Data.Text (Text) import Data.Text qualified as T import Issue.Tag (Tag (..)) import Issue.Tag qualified as I import Issue.Text qualified as I +import Process (quote, sh) +import Text.Printf (printf) import TreeGrepper.Match (Match (..)) import TreeGrepper.Match qualified as G import TreeGrepper.Result (Result (..)) import TreeGrepper.Result qualified as G import Prelude hiding (id) -import Process qualified as P data Issue = Issue { title :: Text, description :: Maybe Text, file :: String, + provenance :: Provenance, start :: G.Position, end :: G.Position, tags :: [Tag], @@ -29,6 +33,11 @@ data Issue = Issue } deriving (Show) +data Provenance = Provenance + { firstCommit :: Maybe String + } + deriving (Show) + id :: Issue -> Maybe String id issue = (\(Tag _ v) -> T.unpack v) @@ -36,21 +45,47 @@ id issue = issue.tags ++ issue.internalTags ) -fromMatch :: G.Result -> G.Match -> Maybe Issue -fromMatch result match = - if any (\marker -> T.isPrefixOf marker title') issueMarkers - then - Just - Issue - { title = title, - description = description, - file = result.file, - start = match.start, - end = match.end, - tags = maybe [] I.extractTags description, - internalTags = I.internalTags title +fromMatch :: G.Result -> G.Match -> IO (Maybe Issue) +fromMatch result match = do + firstCommits <- + fmap (lines . unpack) $ + sh $ + ( fromString + ( printf + "git --no-pager log --reverse -S\"$(cat %s | tail -n+%d | head -%d)\" --format=%%H -- %s" + (quote result.file) + match.start.row + (match.end.row - match.start.row + 1) + (quote result.file) + ) + ) + let firstCommit = + case firstCommits of + [] -> + Nothing + firstCommit' : _ -> + Just firstCommit' + + provenance = + Provenance + { firstCommit = firstCommit } - else 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' diff --git a/app/Main.hs b/app/Main.hs index 9e838c8..334f3ce 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -178,7 +178,8 @@ main = do ( \issue -> P.hsep ( concat - [ [P.annotate P.bold (P.pretty issue.title)], + [ [P.pretty issue.provenance.firstCommit, P.pretty (" " :: String)], + [P.annotate P.bold (P.pretty issue.title)], map ( \(I.Tag k v) -> P.annotate (P.colorDull P.Yellow) $ @@ -261,7 +262,7 @@ listIssues filters files = forgetGetIssuesExceptions _ = pure [] getIssues :: FilePath -> IO [Issue] -getIssues filename = +getIssues filename = do let extension = F.takeExtension filename treeGrepperLanguage = -- TODO Add support for all tree-grepper supported files @@ -285,20 +286,22 @@ getIssues filename = case A.eitherDecode raw of Left e -> throw (InvalidTreeGrepperResult e) Right treeGrepperResult -> treeGrepperResult - in catMaybes - . map (uncurry I.fromMatch) - . concatMap (\result -> map ((,) result) result.matches) - . map fixTreeGrepper - . decode - <$> sh - ( String.fromString - ( printf - "tree-grepper --query %s %s --format json %s" - (quote treeGrepperLanguage) - (quote treeGrepperQuery) - (quote filename) - ) - ) + + matches <- + concatMap (\result -> map ((,) result) result.matches) + . map fixTreeGrepper + . decode + <$> sh + ( String.fromString + ( printf + "tree-grepper --query %s %s --format json %s" + (quote treeGrepperLanguage) + (quote treeGrepperQuery) + (quote filename) + ) + ) + + catMaybes <$> mapM (uncurry I.fromMatch) matches fixTreeGrepper :: G.Result -> G.Result fixTreeGrepper treeGrepperResult = |