aboutsummaryrefslogtreecommitdiffstats
path: root/app/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'app/Main.hs')
-rw-r--r--app/Main.hs69
1 files changed, 61 insertions, 8 deletions
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 '"