aboutsummaryrefslogtreecommitdiffstats
path: root/app
diff options
context:
space:
mode:
Diffstat (limited to 'app')
-rw-r--r--app/Main.hs77
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