module Issue ( Issue (..), Provenance (..), fromMatch, id, getIssuesPar, ) where import Control.Exception (handle, throw) import Data.Aeson (eitherDecode) import Data.Binary (Binary) import Data.Function ((&)) import Data.List (find, foldl') 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 (..), provenanceFromHEAD) 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, 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) fromMatch :: FilePath -> G.Result -> G.Match -> IO (Maybe Issue) fromMatch cwd result match = do provenance <- provenanceFromHEAD cwd 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 provenance } 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) -- | 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 []