allow passing files to `git ls-files`

1 files changed, 50 insertions, 27 deletions

diff --git a/app/Main.hs b/app/Main.hs
index ebe9856..630ba89 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PartialTypeSignatures #-}
@@ -52,6 +53,7 @@ import Control.Exception (Exception, catch, throw, throwIO)
 import Data.Aeson qualified as A
 import Data.ByteString.Lazy qualified as L
 import Data.ByteString.Lazy.Char8 qualified as L8
+import Data.List (intercalate)
 import Data.Maybe (catMaybes)
 import Data.Maybe qualified as Maybe
 import Data.String qualified as String
@@ -61,9 +63,10 @@ import Issue qualified as I
 import Options.Applicative ((<**>))
 import Options.Applicative qualified as O
 import System.Exit (ExitCode (ExitFailure), exitWith)
-import System.FilePath as F
+import System.FilePath qualified as F
 import System.IO (hPutStrLn, stderr)
 import System.Process.Typed qualified as P
+import Text.Printf
 import TreeGrepper.Match qualified as G
 import TreeGrepper.Result qualified as G
 
@@ -74,39 +77,45 @@ data Options = Options
 
 data Command
   = List
+      { files :: [String]
+      }
   | Show
+      { files :: [String]
+      }
   deriving (Show)
 
-optionsParser :: O.Parser Options
-optionsParser =
-  Options
-    <$> commandParser
-
 commandParser :: O.Parser Command
 commandParser =
-  O.subparser
+  O.hsubparser
     ( O.command "list" (O.info listCommandParser (O.progDesc "List all issues"))
         <> O.command "show" (O.info showCommandParser (O.progDesc "Show details of all issues"))
     )
 
+optionsParser :: O.Parser Options
+optionsParser = Options <$> commandParser
+
 listCommandParser :: O.Parser Command
-listCommandParser =
-  pure List
+listCommandParser = List <$> filesArg
 
 showCommandParser :: O.Parser Command
-showCommandParser =
-  pure Show
+showCommandParser = Show <$> filesArg
+
+filesArg :: O.Parser [String]
+filesArg = O.many (O.strArgument (O.metavar "FILE"))
 
 main :: IO ()
 main = do
   options <- O.execParser (O.info (commandParser <**> O.helper) O.idm)
-  files <- getFiles
+  let files
+        | opts@(List {}) <- options = opts.files
+        | opts@(Show {}) <- options = opts.files
+  filePaths <- getFiles files
   issues <-
     catch
       ( fmap Maybe.catMaybes $
           mapM
             (\filename -> catch (fmap Just (getIssues filename)) (forgetGetIssuesExceptions))
-            files
+            filePaths
       )
       ( \(InvalidTreeGrepperResult e) ->
           do
@@ -114,8 +123,8 @@ main = do
             exitWith (ExitFailure 1)
       )
   case options of
-    List -> mapM_ listMatches $ concat issues
-    Show -> mapM_ showMatches $ concat issues
+    List _ -> mapM_ listMatches $ concat issues
+    Show _ -> mapM_ showMatches $ concat issues
 
 showMatches :: Issue -> IO ()
 showMatches issue = do
@@ -144,7 +153,7 @@ instance Exception InvalidTreeGrepperResult
 forgetGetIssuesExceptions :: UnknownFileExtension -> IO (Maybe a)
 forgetGetIssuesExceptions _ = pure Nothing
 
-getIssues :: String -> IO [Issue]
+getIssues :: FilePath -> IO [Issue]
 getIssues filename =
   let extension = F.takeExtension filename
       treeGrepperLanguage =
@@ -176,13 +185,11 @@ getIssues filename =
         . decode
         <$> sh
           ( String.fromString
-              ( "tree-grepper --query '"
-                  ++ treeGrepperLanguage
-                  ++ "' '"
-                  ++ treeGrepperQuery
-                  ++ "' --format json '"
-                  ++ filename
-                  ++ "'"
+              ( printf
+                  "tree-grepper --query %s %s --format json %s"
+                  (quote treeGrepperLanguage)
+                  (quote treeGrepperQuery)
+                  (quote filename)
               )
           )
 
@@ -202,7 +209,23 @@ fixTreeGrepper :: G.Result -> G.Result
 fixTreeGrepper treeGrepperResult =
   treeGrepperResult {G.matches = G.merge treeGrepperResult.matches}
 
-getFiles :: IO [String]
-getFiles =
-  fmap (lines . L8.unpack) $
-    sh "git ls-files --cached --exclude-standard --other"
+getFiles :: [String] -> IO [FilePath]
+getFiles files =
+  lines . L8.unpack
+    <$> sh
+      ( String.fromString
+          ( (printf "git ls-files --cached --exclude-standard --other%s")
+              ( case files of
+                  [] -> ""
+                  _ -> " -- " ++ intercalate " " (map quote files)
+              )
+          )
+      )
+  where
+
+quote :: String -> String
+quote s = "'" ++ escape s ++ "'"
+  where
+    escape [] = []
+    escape ('\'' : cs) = '\\' : '\'' : escape cs
+    escape (c : cs) = c : escape cs