From 6b76050f758917cf3552c20f99a4bfedd66049f2 Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Thu, 5 Oct 2023 10:30:29 +0200
Subject: show single issue by id only
---
app/Issue.hs | 14 +++-
app/Issue/Filter.hs | 6 +-
app/Main.hs | 190 +++++++++++++++++++++++++++-------------------------
3 files changed, 112 insertions(+), 98 deletions(-)
(limited to 'app')
diff --git a/app/Issue.hs b/app/Issue.hs
index 07bddee..d163df7 100644
--- a/app/Issue.hs
+++ b/app/Issue.hs
@@ -3,17 +3,19 @@
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
-module Issue (Issue (..), fromMatch) where
+module Issue (Issue (..), fromMatch, id) where
+import Data.List (find)
import Data.Text (Text)
import Data.Text qualified as T
-import Issue.Tag (Tag)
+import Issue.Tag (Tag (..))
import Issue.Tag qualified as I
import Issue.Text qualified as I
import TreeGrepper.Match (Match (..))
import TreeGrepper.Match qualified as G
import TreeGrepper.Result (Result (..))
import TreeGrepper.Result qualified as G
+import Prelude hiding (id)
data Issue = Issue
{ title :: Text,
@@ -23,6 +25,14 @@ data Issue = Issue
tags :: [Tag],
internalTags :: [Tag]
}
+ deriving (Show)
+
+id :: Issue -> Maybe String
+id issue =
+ (\(Tag _ v) -> T.unpack v)
+ <$> ( find (\(Tag k _) -> k == "id") $
+ issue.tags ++ issue.internalTags
+ )
fromMatch :: G.Result -> G.Match -> Maybe Issue
fromMatch result match =
diff --git a/app/Issue/Filter.hs b/app/Issue/Filter.hs
index 0ce945d..717fa8d 100644
--- a/app/Issue/Filter.hs
+++ b/app/Issue/Filter.hs
@@ -4,7 +4,7 @@
module Issue.Filter
( Filter,
- filterOption,
+ filterArg,
applyFilter,
)
where
@@ -21,8 +21,8 @@ data Filter
| IncludeByTag Text (Maybe Text)
deriving (Show)
-filterOption :: O.Parser [Filter]
-filterOption =
+filterArg :: O.Parser [Filter]
+filterArg =
O.many
( O.option
(O.maybeReader (parse . T.pack))
diff --git a/app/Main.hs b/app/Main.hs
index 30495a5..771fd68 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,6 +1,7 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PartialTypeSignatures #-}
@@ -65,13 +66,12 @@
module Main where
-import Control.Exception (Exception, catch, throw, throwIO)
+import Control.Exception (Exception, catch, handle, throw, throwIO)
import Data.Aeson qualified as A
import Data.ByteString.Lazy qualified as L
import Data.ByteString.Lazy.Char8 qualified as L8
-import Data.List (intercalate)
+import Data.List (find, intercalate)
import Data.Maybe (catMaybes)
-import Data.Maybe qualified as Maybe
import Data.String qualified as String
import Data.Text qualified as T
import Issue (Issue (..))
@@ -85,118 +85,113 @@ import Prettyprinter qualified as P
import Prettyprinter.Render.Terminal qualified as P
import System.Exit (ExitCode (ExitFailure), exitWith)
import System.FilePath qualified as F
-import System.IO (hPutStrLn, stderr)
import System.Process.Typed qualified as P
import Text.Printf
import TreeGrepper.Match qualified as G
import TreeGrepper.Result qualified as G
-
-data Options = Options
- { optCommand :: Command
- }
- deriving (Show)
+import Prelude hiding (id)
data Command
= List
{ files :: [String],
- filters :: [Filter]
+ filters :: [Filter],
+ internalTags :: Bool
}
| Show
- { files :: [String],
- filters :: [Filter]
+ { id :: String
}
deriving (Show)
-commandParser :: O.Parser Command
-commandParser =
- O.hsubparser
- ( O.command "list" (O.info listCommandParser (O.progDesc "List all issues"))
- <> O.command "show" (O.info showCommandParser (O.progDesc "Show details of all issues"))
- )
+cmd :: O.Parser Command
+cmd =
+ O.hsubparser . mconcat $
+ [ O.command "list" . O.info listCmd $
+ O.progDesc "List all issues",
+ O.command "show" . O.info showCmd $
+ O.progDesc "Show details of all issues"
+ ]
+
+listCmd :: O.Parser Command
+listCmd =
+ List
+ <$> filesArg
+ <*> I.filterArg
+ <*> internalTagsFlag
+
+showCmd :: O.Parser Command
+showCmd = Show <$> idArg
-optionsParser :: O.Parser Options
-optionsParser = Options <$> commandParser
+filesArg :: O.Parser [String]
+filesArg = O.many (O.strArgument (O.metavar "FILE" <> O.action "file"))
-listCommandParser :: O.Parser Command
-listCommandParser = List <$> filesArg <*> I.filterOption
+internalTagsFlag :: O.Parser Bool
+internalTagsFlag =
+ O.switch
+ ( O.long "internal-tags"
+ <> O.help "Whether to display internal tags."
+ )
-showCommandParser :: O.Parser Command
-showCommandParser = Show <$> filesArg <*> I.filterOption
+idArg :: O.Parser String
+idArg =
+ O.strArgument
+ ( O.metavar "ID"
+ <> O.completer
+ ( O.listIOCompleter $
+ catMaybes . map I.id <$> listIssues [] []
+ )
+ )
-filesArg :: O.Parser [String]
-filesArg = O.many (O.strArgument (O.metavar "FILE" <> O.action "file"))
+die :: String -> IO a
+die s = do
+ printf "error: %s\n" s
+ exitWith (ExitFailure 1)
main :: IO ()
main = do
- options <- O.execParser (O.info (commandParser <**> O.helper) O.idm)
- let files
- | opts@(List {}) <- options = opts.files
- | opts@(Show {}) <- options = opts.files
- filePaths <- getFiles files
- let filters
- | opts@(List {}) <- options = opts.filters
- | opts@(Show {}) <- options = opts.filters
- issues <-
- filter (I.applyFilter filters)
- . concat
- <$> catch
- ( fmap Maybe.catMaybes $
- mapM
- (\filename -> catch (fmap Just (getIssues filename)) (forgetGetIssuesExceptions))
- filePaths
- )
- ( \(InvalidTreeGrepperResult e) ->
- do
- hPutStrLn stderr e
- exitWith (ExitFailure 1)
- )
- case options of
- List {} -> listMatches issues
- Show {} -> showMatches issues
-
-showMatches :: [Issue] -> IO ()
-showMatches issues = do
- putDoc . P.vsep $
- map
- ( \issue ->
- P.vsep
- ( concat
- [ [P.annotate P.bold (P.pretty issue.title)],
- maybe [] ((: []) . P.pretty) issue.description,
- map
- ( \(I.Tag k v) ->
- P.annotate (P.colorDull P.Yellow) $
- P.pretty ("@" `T.append` k `T.append` " " `T.append` v)
- )
- issue.tags
- ]
- )
- )
- issues
-
-listMatches :: [Issue] -> IO ()
-listMatches issues =
- putDoc . P.vsep $
- map
- ( \issue ->
- P.hsep
- ( concat
- [ [P.annotate P.bold (P.pretty issue.title)],
- map
- ( \(I.Tag k v) ->
- P.annotate (P.colorDull P.Yellow) $
- P.pretty ("@" `T.append` k `T.append` ":" `T.append` v)
- )
- issue.tags
- ]
- )
- )
- issues
+ O.execParser (O.info (cmd <**> O.helper) O.idm) >>= \case
+ List {filters, files, internalTags} -> do
+ issues <- listIssues filters files
+ putDoc . P.vsep $
+ map
+ ( \issue ->
+ P.hsep
+ ( concat
+ [ [P.annotate P.bold (P.pretty issue.title)],
+ map
+ ( \(I.Tag k v) ->
+ P.annotate (P.colorDull P.Yellow) $
+ P.pretty ("@" `T.append` k `T.append` ":" `T.append` v)
+ )
+ ( issue.tags
+ ++ if internalTags then issue.internalTags else []
+ )
+ ]
+ )
+ )
+ issues
+ Show {id} -> do
+ issues <- listIssues [] []
+ case find ((==) (Just id) . I.id) issues of
+ Nothing -> die (printf "no issue with id `%s'\n" id)
+ Just issue ->
+ putDoc $
+ P.vsep
+ ( concat
+ [ [P.annotate P.bold (P.pretty issue.title)],
+ maybe [] ((: []) . P.pretty) issue.description,
+ map
+ ( \(I.Tag k v) ->
+ P.annotate (P.colorDull P.Yellow) $
+ P.pretty ("@" `T.append` k `T.append` " " `T.append` v)
+ )
+ issue.tags
+ ]
+ )
putDoc :: P.Doc P.AnsiStyle -> IO ()
putDoc doc = do
isTty <- (== 1) <$> c_isatty 1
- P.putDoc . (if isTty then id else P.unAnnotate) $ doc
+ P.putDoc . (if isTty then (\x -> x) else P.unAnnotate) $ doc
foreign import ccall "unistd.h isatty" c_isatty :: Int -> IO Int
@@ -214,8 +209,17 @@ data InvalidTreeGrepperResult = InvalidTreeGrepperResult
instance Exception InvalidTreeGrepperResult
-forgetGetIssuesExceptions :: UnknownFileExtension -> IO (Maybe a)
-forgetGetIssuesExceptions _ = pure Nothing
+listIssues :: [Filter] -> [FilePath] -> IO [Issue]
+listIssues filters files =
+ filter (I.applyFilter filters) . concat
+ <$> catch
+ ( mapM (handle forgetGetIssuesExceptions . getIssues)
+ =<< getFiles files
+ )
+ (\(InvalidTreeGrepperResult e) -> die e)
+ where
+ forgetGetIssuesExceptions :: UnknownFileExtension -> IO [a]
+ forgetGetIssuesExceptions _ = pure []
getIssues :: FilePath -> IO [Issue]
getIssues filename =
--
cgit v1.2.3