From 1e49477c1268deaf519ad9ca051c3b34f503cb84 Mon Sep 17 00:00:00 2001
From: Fabian Kirchner <kirchner@posteo.de>
Date: Mon, 2 Oct 2023 16:21:10 +0200
Subject: parse tree-grepper results

---
 anissue.cabal |  1 +
 app/Main.hs   | 69 ++++++++++++++++++++++++++++++++++++++++++++++++++++-------
 2 files changed, 62 insertions(+), 8 deletions(-)

diff --git a/anissue.cabal b/anissue.cabal
index c528361..97afdbb 100644
--- a/anissue.cabal
+++ b/anissue.cabal
@@ -72,6 +72,7 @@ executable anissue
 
     -- Other library packages from which modules are imported.
     build-depends:    base ^>=4.16.4.0,
+                      aeson,
                       bytestring,
                       filepath,
                       optparse-applicative,
diff --git a/app/Main.hs b/app/Main.hs
index 179c214..39387cc 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,16 +1,21 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PartialTypeSignatures #-}
 
 module Main where
 
 import Control.Exception (Exception, catch, throw)
+import Data.Aeson qualified as A
 import Data.ByteString.Lazy (ByteString)
 import Data.ByteString.Lazy qualified as LB
 import Data.ByteString.Lazy.Char8 qualified as LB8
 import Data.Maybe qualified as Maybe
 import Data.String qualified as String
+import GHC.Generics (Generic)
 import Options.Applicative ((<**>))
 import Options.Applicative qualified as O
+import System.Exit (ExitCode (ExitFailure), exitWith)
 import System.FilePath as F
+import System.IO (hPutStrLn, stderr)
 import System.Process.Typed qualified as P
 
 data Options = Options
@@ -48,11 +53,18 @@ main = do
   options <- O.execParser (O.info (commandParser <**> O.helper) O.idm)
   files <- getFiles
   issues <-
-    fmap Maybe.catMaybes $
-      mapM
-        (\filename -> catch (fmap Just (getIssues filename)) (forgetGetIssuesExceptions))
-        files
-  print issues
+    catch
+      ( fmap Maybe.catMaybes $
+          mapM
+            (\filename -> catch (fmap Just (getIssues filename)) (forgetGetIssuesExceptions))
+            files
+      )
+      ( \(InvalidTreeGrepperResult error) ->
+          do
+            hPutStrLn stderr error
+            exitWith (ExitFailure 1)
+      )
+  mapM_ putStrLn $ fmap file $ concat issues
 
 data UnknownFileExtension = UnknownFileExtension
   { extension :: String
@@ -61,13 +73,48 @@ data UnknownFileExtension = UnknownFileExtension
 
 instance Exception UnknownFileExtension
 
-forgetGetIssuesExceptions :: UnknownFileExtension -> IO (Maybe String)
+data InvalidTreeGrepperResult = InvalidTreeGrepperResult
+  { error :: String
+  }
+  deriving (Show)
+
+instance Exception InvalidTreeGrepperResult
+
+forgetGetIssuesExceptions :: UnknownFileExtension -> IO (Maybe _)
 forgetGetIssuesExceptions _ =
   pure Nothing
 
 data Issue = Issue {}
 
-getIssues :: String -> IO String
+data TreeGrepperResult = TreeGrepperResult
+  { file :: String,
+    file_type :: String,
+    matches :: [Match]
+  }
+  deriving (Show, Generic)
+
+instance A.FromJSON TreeGrepperResult
+
+data Match = Match
+  { kind :: String,
+    name :: String,
+    text :: String,
+    start :: Position,
+    end :: Position
+  }
+  deriving (Show, Generic)
+
+instance A.FromJSON Match
+
+data Position = Position
+  { row :: Int,
+    column :: Int
+  }
+  deriving (Show, Generic)
+
+instance A.FromJSON Position
+
+getIssues :: String -> IO [TreeGrepperResult]
 getIssues filename =
   let extension = F.takeExtension filename
       treeGrepperLanguage =
@@ -82,7 +129,13 @@ getIssues filename =
           ".nix" -> "(comment)"
           ".sh" -> "(comment)"
           _ -> throw (UnknownFileExtension extension)
-   in fmap (LB8.unpack . snd) $
+      decode raw =
+        case A.eitherDecode raw of
+          Left error ->
+            throw (InvalidTreeGrepperResult error)
+          Right treeGrepperResult ->
+            treeGrepperResult
+   in fmap (decode . snd) $
         P.readProcessStdout
           ( String.fromString
               ( "tree-grepper --query '"
-- 
cgit v1.2.3