{-# 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.Char8 qualified as LB8 import Data.Maybe (catMaybes) import Data.Maybe qualified as Maybe import Data.String qualified as String import Data.Text.IO qualified as T import Issue (Issue (..)) import Issue qualified as I 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 qualified as G import TreeGrepper.Result qualified as G 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 e) -> do hPutStrLn stderr e exitWith (ExitFailure 1) ) case options of List -> mapM_ listMatches $ concat issues Show -> mapM_ showMatches $ concat issues showMatches :: Issue -> IO () showMatches issue = do T.putStrLn issue.title T.putStrLn "" T.putStrLn issue.description listMatches :: Issue -> IO () listMatches issue = T.putStrLn issue.title data UnknownFileExtension = UnknownFileExtension { extension :: String } deriving (Show) instance Exception UnknownFileExtension data InvalidTreeGrepperResult = InvalidTreeGrepperResult { error :: String } deriving (Show) instance Exception InvalidTreeGrepperResult forgetGetIssuesExceptions :: UnknownFileExtension -> IO (Maybe a) forgetGetIssuesExceptions _ = pure Nothing getIssues :: String -> IO [Issue] 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 e -> throw (InvalidTreeGrepperResult e) Right treeGrepperResult -> treeGrepperResult in catMaybes . map (uncurry I.fromMatch) . concatMap (\result -> map ((,) result) result.matches) . map fixTreeGrepper . decode . snd <$> P.readProcessStdout ( String.fromString ( "tree-grepper --query '" ++ treeGrepperLanguage ++ "' '" ++ treeGrepperQuery ++ "' --format json '" ++ filename ++ "'" ) ) fixTreeGrepper :: G.Result -> G.Result fixTreeGrepper treeGrepperResult = treeGrepperResult {G.matches = G.merge treeGrepperResult.matches} getFiles :: IO [String] getFiles = fmap (lines . LB8.unpack . snd) $ P.readProcessStdout "git ls-files --cached --exclude-standard --other"