add match merging, in a hurry

1 files changed, 35 insertions, 7 deletions

diff --git a/app/Main.hs b/app/Main.hs
index 66b0323..74739b8 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -53,7 +53,9 @@ 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.List as L
 import Data.Maybe qualified as Maybe
+import Data.Ord as O
 import Data.String qualified as String
 import GHC.Generics (Generic)
 import Options.Applicative ((<**>))
@@ -112,11 +114,17 @@ main = do
   let issuesWithMarker = issues
       issuesWithTags = issuesWithMarker
       issuesFilteredByTags = issuesWithTags
-  mapM_ printIssue $ concat issues
+  case options of
+    List -> mapM_ listMatches $ concat issues
+    Show -> mapM_ showMatches $ concat issues
 
-printIssue :: TreeGrepperResult -> IO ()
-printIssue treeGrepperResult =
-  putStrLn $ treeGrepperResult.file
+showMatches :: TreeGrepperResult -> IO ()
+showMatches treeGrepperResult =
+  mapM_ (putStrLn . (.text)) $ treeGrepperResult.matches
+
+listMatches :: TreeGrepperResult -> IO ()
+listMatches treeGrepperResult =
+  mapM_ (putStrLn . (.text)) $ treeGrepperResult.matches
 
 data UnknownFileExtension = UnknownFileExtension
   { extension :: String
@@ -176,12 +184,14 @@ getIssues filename =
         -- --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)
@@ -206,9 +216,27 @@ getIssues filename =
             )
 
 fixTreeGrepper :: TreeGrepperResult -> TreeGrepperResult
-fixTreeGrepper =
-  -- TODO implement match merging
-  id
+fixTreeGrepper treeGrepperResult =
+  treeGrepperResult {matches = mergeMatches treeGrepperResult.matches}
+  where
+    mergeMatches matches =
+      Maybe.catMaybes
+        [ subs ms
+          | ms <- L.groupBy eq matches
+        ]
+    eq m n = m.end.row + 1 <= n.start.row
+    subs [] = Nothing
+    subs (mss@(m : _)) =
+      Just
+        ( m
+            { start = start mss,
+              end = end mss,
+              text = unlines (map (.text) mss)
+            }
+        )
+    start ms = minimumBy (O.comparing loc) (map (.start) ms)
+    end ms = maximumBy (O.comparing loc) (map (.end) ms)
+    loc x = (x.row, x.column)
 
 getFiles :: IO [String]
 getFiles =