diff options
Diffstat (limited to 'app')
| -rw-r--r-- | app/History.hs | 23 | ||||
| -rw-r--r-- | app/Issue.hs | 12 |
2 files changed, 18 insertions, 17 deletions
diff --git a/app/History.hs b/app/History.hs index 0621fd8..1604760 100644 --- a/app/History.hs +++ b/app/History.hs @@ -7,6 +7,7 @@ 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) @@ -15,10 +16,11 @@ import Data.Text.Encoding (decodeUtf8) import Issue (Issue (..), fromMatch, id) import Issue.Filter (Filter, applyFilter) import Process (quote, sh, sh_) -import System.Directory (createDirectoryIfMissing, doesFileExist, getCurrentDirectory, setCurrentDirectory) +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 @@ -81,25 +83,22 @@ cached commit func = do listIssuesOf :: Text -> [Filter] -> [FilePath] -> IO [Issue] listIssuesOf commit filters files = do - cwd <- getCurrentDirectory issue <- withSystemTempDirectory "history" $ \tmp -> do let worktree = tmp </> unpack commit sh_ (fromString (printf "git worktree add --detach %s %s" (quote worktree) (quote (unpack commit)))) - setCurrentDirectory worktree filter (applyFilter filters) . concat <$> catch - ( mapM (handle forgetGetIssuesExceptions . getIssues) - =<< getFiles files + ( parMapM (handle forgetGetIssuesExceptions . getIssues worktree) + =<< getFiles worktree files ) (\(InvalidTreeGrepperResult e) -> die e) - setCurrentDirectory cwd pure issue where forgetGetIssuesExceptions :: UnknownFileExtension -> IO [a] forgetGetIssuesExceptions _ = pure [] -getFiles :: [String] -> IO [FilePath] -getFiles files = +getFiles :: FilePath -> [String] -> IO [FilePath] +getFiles cwd files = Prelude.lines . L8.unpack <$> sh ( fromString @@ -109,10 +108,11 @@ getFiles files = _ -> " -- " ++ intercalate " " (map quote files) ) ) + & setWorkingDir cwd ) -getIssues :: FilePath -> IO [Issue] -getIssues filename = do +getIssues :: FilePath -> FilePath -> IO [Issue] +getIssues cwd filename = do let extension = takeExtension filename treeGrepperLanguage = -- TODO Add support for all tree-grepper supported files @@ -149,9 +149,10 @@ getIssues filename = do (quote treeGrepperQuery) (quote filename) ) + & setWorkingDir cwd ) - catMaybes <$> mapM (uncurry fromMatch) matches + catMaybes <$> mapM (uncurry (fromMatch cwd)) matches fixTreeGrepper :: G.Result -> G.Result fixTreeGrepper treeGrepperResult = diff --git a/app/Issue.hs b/app/Issue.hs index f7227f1..c9d18f8 100644 --- a/app/Issue.hs +++ b/app/Issue.hs @@ -8,9 +8,8 @@ module Issue (Issue (..), Provenance (..), fromMatch, id) where import Data.Binary (Binary, get, put) import Data.ByteString.Lazy (toStrict) -import Data.ByteString.Lazy.Char8 (unpack) +import Data.Function ((&)) import Data.List (find, foldl') -import Data.String (fromString) import Data.Text (Text) import Data.Text qualified as T import Data.Text.Encoding (decodeUtf8) @@ -19,8 +18,8 @@ import GHC.Generics (Generic) 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 Process (sh) +import System.Process.Typed (setWorkingDir) import TreeGrepper.Match (Match (..)) import TreeGrepper.Match qualified as G import TreeGrepper.Result (Result (..)) @@ -59,12 +58,13 @@ id issue = issue.tags ++ issue.internalTags ) -fromMatch :: G.Result -> G.Match -> IO (Maybe Issue) -fromMatch result match = do +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 : _ -> |