From f66e075e3ff72f1c648ed984c6a6af436aea19ea Mon Sep 17 00:00:00 2001
From: Fabian Kirchner <kirchner@posteo.de>
Date: Fri, 13 Oct 2023 23:36:52 +0200
Subject: refactor: extract getIssues into History

---
 app/History.hs | 74 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 74 insertions(+)
 create mode 100644 app/History.hs

(limited to 'app/History.hs')

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}
-- 
cgit v1.2.3