aboutsummaryrefslogtreecommitdiffstats
path: root/app/History.hs
diff options
context:
space:
mode:
Diffstat (limited to 'app/History.hs')
-rw-r--r--app/History.hs74
1 files changed, 74 insertions, 0 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}