diff options
Diffstat (limited to 'app')
| -rw-r--r-- | app/History.hs | 74 | ||||
| -rw-r--r-- | app/Main.hs | 66 |
2 files changed, 76 insertions, 64 deletions
diff --git a/app/History.hs b/app/History.hs new file mode 100644 index 0000000..fc3b156 --- /dev/null +++ b/app/History.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE OverloadedRecordDot #-} + +module History (getIssues, InvalidTreeGrepperResult (..), UnknownFileExtension (..)) where + +import Control.Exception (Exception, throw) +import Data.Aeson (eitherDecode) +import Data.Maybe (catMaybes) +import Data.String (fromString) +import Issue (Issue (..), fromMatch) +import Process (quote, sh) +import System.FilePath (takeExtension) +import Text.Printf (printf) +import TreeGrepper.Match qualified as G +import TreeGrepper.Result qualified as G + +data UnknownFileExtension = UnknownFileExtension + { extension :: String + } + deriving (Show) + +instance Exception UnknownFileExtension + +data InvalidTreeGrepperResult = InvalidTreeGrepperResult + { error :: String + } + deriving (Show) + +instance Exception InvalidTreeGrepperResult + +getIssues :: FilePath -> IO [Issue] +getIssues 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 (UnknownFileExtension extension) + treeGrepperQuery = + case extension of + ".elm" -> "([(line_comment) (block_comment)])" + ".hs" -> "(comment)" + ".nix" -> "(comment)" + ".sh" -> "(comment)" + _ -> throw (UnknownFileExtension extension) + decode raw = + case eitherDecode raw of + Left e -> throw (InvalidTreeGrepperResult e) + Right treeGrepperResult -> treeGrepperResult + + matches <- + concatMap (\result -> map ((,) result) result.matches) + . map fixTreeGrepper + . decode + <$> sh + ( fromString + ( printf + "tree-grepper --query %s %s --format json %s" + (quote treeGrepperLanguage) + (quote treeGrepperQuery) + (quote filename) + ) + ) + + catMaybes <$> mapM (uncurry fromMatch) matches + +fixTreeGrepper :: G.Result -> G.Result +fixTreeGrepper treeGrepperResult = + treeGrepperResult {G.matches = G.merge treeGrepperResult.matches} diff --git a/app/Main.hs b/app/Main.hs index bd3d7ff..5e48568 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -74,13 +74,13 @@ module Main where -import Control.Exception (Exception, catch, handle, throw) -import Data.Aeson qualified as A +import Control.Exception (catch, handle) import Data.ByteString.Lazy.Char8 qualified as L8 import Data.List (find, intercalate) import Data.Maybe (catMaybes, fromMaybe) import Data.String qualified as String import Data.Text qualified as T +import History (InvalidTreeGrepperResult (..), UnknownFileExtension (..), getIssues) import Issue (Issue (..)) import Issue qualified as I import Issue.Filter (Filter) @@ -92,11 +92,9 @@ import Prettyprinter qualified as P import Prettyprinter.Render.Terminal qualified as P import Process (quote, sh, sh_) import System.Exit (ExitCode (ExitFailure), exitWith) -import System.FilePath qualified as F import System.Process.Typed qualified as P import Text.Printf import TreeGrepper.Match qualified as G -import TreeGrepper.Result qualified as G import Prelude hiding (id) data Command @@ -249,20 +247,6 @@ putDoc doc = do foreign import ccall "unistd.h isatty" c_isatty :: Int -> IO Int -data UnknownFileExtension = UnknownFileExtension - { extension :: String - } - deriving (Show) - -instance Exception UnknownFileExtension - -data InvalidTreeGrepperResult = InvalidTreeGrepperResult - { error :: String - } - deriving (Show) - -instance Exception InvalidTreeGrepperResult - listIssues :: [Filter] -> [FilePath] -> IO [Issue] listIssues filters files = filter (I.applyFilter filters) . concat @@ -275,52 +259,6 @@ listIssues filters files = forgetGetIssuesExceptions :: UnknownFileExtension -> IO [a] forgetGetIssuesExceptions _ = pure [] -getIssues :: FilePath -> IO [Issue] -getIssues filename = do - let extension = F.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 (UnknownFileExtension extension) - treeGrepperQuery = - case extension of - ".elm" -> "([(line_comment) (block_comment)])" - ".hs" -> "(comment)" - ".nix" -> "(comment)" - ".sh" -> "(comment)" - _ -> throw (UnknownFileExtension extension) - decode raw = - case A.eitherDecode raw of - Left e -> throw (InvalidTreeGrepperResult e) - Right treeGrepperResult -> treeGrepperResult - - 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 = - treeGrepperResult {G.matches = G.merge treeGrepperResult.matches} - getFiles :: [String] -> IO [FilePath] getFiles files = lines . L8.unpack |