{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PartialTypeSignatures #-} -- TODO Add support for ammendments -- -- The user can ammend more information to an issue which is located at -- a different place by referencing the issue's id. Example: -- -- ```bash -- #!/usr/bin/env bash -- -- set -efu -- -- ls -al -- # TODO Original issue -- # -- # @id original-issue -- -- ls -- # @original-issue more information on the issue -- ``` -- TODO Only one issue per comment block -- -- Only the first TODO/FIXME inside a comment block should be considered -- as the start of an issue. -- TODO Add support for other keywords -- -- Additionally to TODO, also FIXME should start an issue. There might -- be more interesting keywords. -- TODO Add tags -- -- Users can add tags inside issue title and description. Tags are slugs -- and start with @ -- -- @assigned aforemny -- TODO Add filter by tags -- -- Users can filter issues for tags with the option -t/--tag @tag. -- -- @assigned kirchner@posteo.de -- TODO Generate and show hash for each issue 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.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 ((<**>)) 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 import TreeGrepper.Match (Match (..), Position (..)) import TreeGrepper.Match qualified as TM data Options = Options { optCommand :: Command } deriving (Show) data Command = List | Show deriving (Show) optionsParser :: O.Parser Options optionsParser = Options <$> commandParser commandParser :: O.Parser Command commandParser = O.subparser ( O.command "list" (O.info listCommandParser (O.progDesc "List all issues")) <> O.command "show" (O.info showCommandParser (O.progDesc "Show details of all issues")) ) listCommandParser :: O.Parser Command listCommandParser = pure List showCommandParser :: O.Parser Command showCommandParser = pure Show main :: IO () main = do options <- O.execParser (O.info (commandParser <**> O.helper) O.idm) files <- getFiles issues <- catch ( fmap Maybe.catMaybes $ mapM (\filename -> catch (fmap Just (getIssues filename)) (forgetGetIssuesExceptions)) files ) ( \(InvalidTreeGrepperResult error) -> do hPutStrLn stderr error exitWith (ExitFailure 1) ) let issuesWithMarker = issues issuesWithTags = issuesWithMarker issuesFilteredByTags = issuesWithTags case options of List -> mapM_ listMatches $ concat issues Show -> mapM_ showMatches $ concat issues showMatches :: TreeGrepperResult -> IO () showMatches treeGrepperResult = mapM_ (putStrLn . (.text)) $ treeGrepperResult.matches listMatches :: TreeGrepperResult -> IO () listMatches treeGrepperResult = mapM_ (putStrLn . unlines . take 1 . lines . (.text)) $ treeGrepperResult.matches data UnknownFileExtension = UnknownFileExtension { extension :: String } deriving (Show) instance Exception UnknownFileExtension data InvalidTreeGrepperResult = InvalidTreeGrepperResult { error :: String } deriving (Show) instance Exception InvalidTreeGrepperResult forgetGetIssuesExceptions :: UnknownFileExtension -> IO (Maybe _) forgetGetIssuesExceptions _ = pure Nothing data Issue = Issue {} data TreeGrepperResult = TreeGrepperResult { file :: String, file_type :: String, matches :: [Match] } deriving (Show, Generic) instance A.FromJSON TreeGrepperResult getIssues :: String -> IO [TreeGrepperResult] getIssues filename = let extension = F.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 A.eitherDecode raw of Left error -> throw (InvalidTreeGrepperResult error) Right treeGrepperResult -> treeGrepperResult in fmap (map fixTreeGrepper) $ fmap (decode . snd) $ P.readProcessStdout ( String.fromString ( "tree-grepper --query '" ++ treeGrepperLanguage ++ "' '" ++ treeGrepperQuery ++ "' --format json '" ++ filename ++ "'" ) ) fixTreeGrepper :: TreeGrepperResult -> TreeGrepperResult fixTreeGrepper treeGrepperResult = treeGrepperResult {matches = TM.merge treeGrepperResult.matches} getFiles :: IO [String] getFiles = fmap (lines . LB8.unpack . snd) $ P.readProcessStdout "git ls-files --cached --exclude-standard --other"