-- TODO Parse issues as markdown -- -- There are several issues related to the fact that we are not parsing -- issues as markdown. -- -- (1) We cannot easily page `show` output, as we are mixing direct output -- with shell commands highlighting markdown. -- -- (2) We cannot easily ignore markup (tags) in code blocks. -- -- (3) We cannot easily determine the first and last markdown content when -- augmenting the issue body with meta information. -- -- I am neither for nor against replacing `mdcat` with our own markdown -- rendering. -- -- @supersedes make-show-page-able -- @supersedes only-separate-generated-tags-with-a-blank-line-when-description-does-not-end-with-tags -- -- @difficulty medium -- @priority medium -- @topic markdown -- @topic tags -- TODO Tag improvements (OR-filtering) -- -- Currently it is not possible to filter for an issue satisfying one filter or another. We could add the following syntax allowing it: -- -- `--filter '(@assigned aforemny) OR (@due 2023-10-4)'` -- @topic tags -- @backlog -- TODO Tag improvements (globbing) -- -- I would like to filter `--filter '@assigned *@posteo.de'`. -- @topic tags -- @backlog -- 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 -- -- edited -- ``` -- -- @priority high -- @backlog -- -- COMMENT Ammendments should generate IssueEvents which can be shown in the issue's log. -- TODO Add options to show command to display source code around the issue -- -- The `show` command should have the command line arguments -- `--after/-A`, `--before/-B` and `--context/-C` which take an integer -- n and change the output to contain n lines after, before or around -- the issue. -- -- @topic show -- @topic options -- @backlog -- -- COMMENT Do we expect the code BEFORE an issue to be ever relevant? -- -- COMMENT Hm, this would make it possible for users to use anissue in -- that way at least. I guess most people would assume a comment to go -- before (or for a short comment at the end) the relecant line(s), so -- maybe an `--after/-A` option would suffice. Not sure what's best -- here to be honest. =) -- -- COMMENT I don't mind the `--before|-B` option. I was just wondering out -- loud, also related to whether we want to extract some closed part of the -- AST, seeing that we already have tree sitter, instead of showing context. -- -- But I don't have a good proposal for that myself. It is not my intention to -- block on this issue. -- TODO Expose all command line options as environment variables -- -- It should be possible to provide a default for any command line -- argument via an environment variable. The name of the variable -- should be all upper case and prefixed with `ANISSUE_`, e.g. the -- default value for the command line option `--internal-tags` should be -- settable via `ANISSUE_INTERNAL_TAGS`. -- -- @topic options -- @topic settings -- @backlog -- -- COMMENT Can/ should this be made a feature of optparse-applicative, which we -- could fork? Like, can this work transparently if we fork -- optparse-applicative? -- -- COMMENT Hm, this would only apply to options and flags, but not sub -- commands, I guess. I would say, we could first start by just -- manually adding these env variables and see if we run into -- options/flags, where a env variable does not make sense. But then, -- this would be an optional feature in the library, as well, i guess? -- :D -- -- COMMENT I could imagine it not too difficult adding a `fromEnv` modifier -- into `O.Parser`. In any case, this does not have to block on that, as, -- should we decide to do that, we can always migrate to it later. -- TODO Add a subcommand which appends the generated ids to the issue in the sourcecode -- -- Given the following issue -- -- ``` -- # TODO Some title -- # -- # Some description -- ``` -- -- After running `anissue lint`, the issue will be changed to -- -- ``` -- # TODO Some title -- # -- # Some description -- # -- # @id some-title -- ``` -- -- @topic ids -- @backlog -- -- COMMENT Can you elaborate on why this would be useful? I am expecting us to -- do some renaming detection regarding provenance. After that, will it be -- useful still? -- -- COMMENT I think, I mostly find this useful for ammendments, as I then -- neither would have to think about what the generated id was, nor -- would I have to come up with an id. And if we would decide for -- randomized (but easily typeable) generated ids, this would be useful, -- I believe. -- -- COMMENT Assuming the we append **the title** as the ID, I don't see much -- point of this. Maybe better editor integration that auto-completes `@<>` -- would be more appropriate? -- -- I am sympathetic to random identifiers, cf. -- should-automatically-generated-ids-be-random, as long as they are an -- additional mechanisam (so that we can ditch them, should they not work out). -- TODO Only separate generated tags with a blank line when description does not end with tags -- -- An issue like -- -- ``` -- # TODO Some title -- # -- # @id some-title -- ``` -- -- Should be rendered as -- -- ``` -- # TODO Some title -- -- @id some-title -- @file the-file.sh -- @row 42 -- ``` -- -- @topic markdown -- @topic tags -- @backlog -- QUESTION Should automatically generated ids be random? -- -- Right now default id of an issue is the slugification of it's title. -- Once we have a command to automatically append this id to the issue -- within the source code, users might feel tempted to change the id -- after they have adjusted the title. This then would break the -- provenance of the issue. If the generated id was something like -- `tooth-cherry-switch`, it would be just a random string and noone -- would feel the need to change it. -- -- I imagine a workflow where I add issues in the source code. And -- before commiting, I run `anissue lint` to generate ids for all new -- issues. -- -- @topic ids -- @backlog -- -- COMMENT I am not sure we want to automatically append `@id`s to the issue -- description. We probably want to append `@pastId` to an issue if we notice a -- change in the title. I feel users are not as likely change that. -- -- That being said, I am up for experimenting with random IDs *alongside* the -- current design. Maybe we could add a `@uuid` tag automatically that is -- generated from the issues first `@id`, and append that? -- -- COMMENT I think I like the idea of adding an id, once we see a change in the -- title. I'm not sure though, when in the workflow this would happen. -- I think the id generation topic needs some syncronous discussion. :D -- -- COMMENT ACK -- TODO Dependencies between issues -- -- The user should be able to specify that an issue is blocked by -- a different issue by adding `@blocker id-of-blocking-issue`. -- -- When running `anissue list --show-dependencies`, the output should -- render a list of trees deduced from these blocker-relations. E.g. -- -- ``` -- Issue A -- ├ Issue A1 (blocked by A) -- │ ├ Issue A11 (blocked by A1) -- ├─┴ Issue A3A11 (blocked by A and A1) -- └ Issue A2B1 (blocked by A and B) -- Issue B -- └ Issue A2B1 (blocked by A and B) -- Issue C -- ``` -- -- The items should be ordered with the most blocking issues at the top. -- -- @topic dependencies -- @backlog -- TODO Add fulltext search -- -- Additional to `--filter` it should be possible to search for issues -- using `--search 'some query'` using a search-engine like full text -- search. -- -- To make this fast, we could use a package like -- and make sure -- to persist the index in a local cache. -- -- @topic search -- @backlog -- TODO Display issue type in list and show views -- -- Depending on the type of issue (TODO, FIXME, ...) there should be -- either a prefix in the list view (e.g. 🏗️, 🐞, ...), or the list -- should be grouped by the type. -- -- @difficulty easy -- @backlog -- -- COMMENT I imagine emojis might be off-putting to some potential users. I -- would like a configuration option to disable emojis and display the marker -- instead. -- -- I am fine with having emojis by default. However, seeing that markers are -- extendable, maybe we should make it an opt-in configuration in the first -- place? -- -- COMMENT Yes, thinking about this again, putting the written marker -- instead, might be better. So sth like. -- -- ``` -- FIXME Issue A -- FIXME Issue B -- TODO Story A -- QUESTION Question A -- FIXME Issue C -- ``` -- -- We could still additionally color code them. -- -- COMMENT I propose adding the issue marker as an internal @marker tag. There -- can be several such tags if several markers are specified (and we want to -- allow that). The first marker should have priority in case we have to pick -- one. -- TODO Add command for (re)generating the cache -- -- When running `anissue cache generate`, we will only generated the -- issue cache, starting from the initial commit. This will not -- re-generate already existing cache entries. To delete the old cache -- first, one has to add `--clean`. -- -- By adding `--first-commit ` the cache will only -- generated starting at the specified commit. -- -- By adding `--full` the cache will be generated for **all** commits in -- the repository. -- -- When running `anissue cache clean`, the local cache will be deleted. -- -- @topic options -- @topic cache -- @backlog -- -- COMMENT What is the point of this command? Can't caches be handled -- transparently to the user? -- -- COMMENT Hm, I think I don't exactly know, what you mean by -- transparently. ':) So cache invalidation would be like how e.g. elm -- does it with the elm-stuff folder? -- -- The idea for the cache generation command could be e.g. used in -- environment setup scripts. And then the first-commit option would -- make it possible to use very old repostories without a too long -- initial delay. -- -- COMMENT The caching works *transparently* for the user if the user is not -- aware of the cache at all. If there are cache commands (or options), then it -- is not transparent. -- -- I get that we want to limit provenance generation somewhat, and that will -- have to be solved in an intransparent manner.. but I am not fully -- understanding the proposal. -- -- Maybe you could walk me through it in our next session? -- TODO Add global option for specifying first considered commit -- -- Every command offers the option `--first-commit `, which -- tells anissue to only consider commits stargin with the provided -- commit. The default is the first commit HEAD eventually points to; -- this will also happen when the provided commit is not in the history -- of HEAD. -- -- @topic options -- @topic cache -- @backlog -- TODO Add format option (Text, JSON, ...) -- -- Add an option `--format` to the list and show commands which adjust -- the output format: -- -- text -- : this is the default -- -- json -- : render all information as json so that it can be used, e.g. by -- other tools -- -- @topic rendering -- @topic options -- @backlog -- TODO Add HTTP server -- -- When running `anissue server`, an HTTP server should be started, -- which serves a JSON-API as well as a HTML-frontend for the current -- directory. -- -- The HTML frontend should display the output of `anissue list` where -- each item links to a separate page containing the infos of `anissue -- show`. -- -- The JSON-Api offers endpoints `GET //` which returns `anissue -- list` as `GET ///` which returns `anissue show`. -- All command line arguments are exposed via query parameters. -- -- @backlog module Main where import Control.Applicative ((<|>)) import Control.Monad (when) import Data.Function ((&)) import Data.List (find, intersperse, isPrefixOf) import Data.List.Extra (list) import Data.Map qualified as M import Data.Maybe (maybeToList) import Data.Set qualified as S import Data.Text qualified as T import Data.Text.IO qualified as T import Data.Text.Lazy qualified as LT import Data.Text.Lazy.IO qualified as LT import Data.Time.Clock (UTCTime (utctDay)) import History (getHistory) import History.CommitHash qualified as C import History.IssueEvent (IssueEvent (..)) import Issue (Issue (..)) import Issue qualified as I import Issue.Filter (Filter, applyFilters) import Issue.Filter qualified as I import Issue.Group qualified as I import Issue.Meta qualified as I import Issue.Provenance qualified as I import Issue.Sort (Sort, applySorts) import Issue.Sort qualified as I import Issue.Tag qualified as I import Options.Applicative ((<**>)) import Options.Applicative qualified as O import Prettyprinter ((<+>)) import Prettyprinter qualified as P import Prettyprinter.Render.Terminal qualified as P import Process (proc, sh_, textInput) import Settings (Settings (..), readSettings) import System.Console.Terminal.Size qualified as Terminal import System.Exit (ExitCode (ExitFailure), exitWith) import System.IO (hClose, hFlush) import System.IO.Temp (withSystemTempFile) import System.Process.Typed qualified as P import Text.Printf import TreeGrepper.Match qualified as G import Tuple () import Prelude hiding (id) data Options = Options { command :: Command, internalTags :: Bool, colorize :: Color, noPager :: Bool, width :: Maybe Int } deriving (Show) data Color = Always | Auto | Never deriving (Show, Eq) options :: O.Parser Options options = Options <$> cmd <*> internalTagsFlag <*> colorOption <*> noPagerFlag <*> widthOption internalTagsFlag :: O.Parser Bool internalTagsFlag = O.switch ( O.long "internal-tags" <> O.help "Whether to display internal tags." ) colorOption :: O.Parser Color colorOption = O.option (O.maybeReader parse) ( O.long "color" <> O.short 'c' <> O.help "Wether to colorize output. (Default: auto)" <> O.value Auto ) where parse "auto" = pure Auto parse "always" = pure Always parse "never" = pure Never parse _ = Nothing noPagerFlag :: O.Parser Bool noPagerFlag = O.switch ( O.long "no-pager" <> O.short 'P' <> O.help "Don't pipe long output to $PAGER." ) widthOption :: O.Parser (Maybe Int) widthOption = O.optional ( O.option O.auto ( O.long "width" <> O.short 'w' <> O.metavar "INT" <> O.help "Wheather to insert line breaks after at most that many characters." ) ) data Command = List { files :: [String], filters :: [Filter], sort :: [Sort], group :: Maybe T.Text, closed :: Bool } | Log { patch :: Bool } | Show { id :: String, edit :: Bool } | Tags deriving (Show) cmd :: O.Parser Command cmd = O.hsubparser . mconcat $ [ O.command "list" . O.info listCmd $ O.progDesc "List all issues", O.command "log" . O.info logCmd $ O.progDesc "Show a log of all issues", O.command "show" . O.info showCmd $ O.progDesc "Show details of all issues", O.command "tags" . O.info tagsCmd $ O.progDesc "Show all tags" ] listCmd :: O.Parser Command listCmd = List <$> filesArg <*> I.filterArg <*> I.sortArg <*> I.groupArg <*> closedArg logCmd :: O.Parser Command logCmd = Log <$> patchFlag showCmd :: O.Parser Command showCmd = Show <$> idArg <*> editFlag tagsCmd :: O.Parser Command tagsCmd = pure Tags filesArg :: O.Parser [String] filesArg = O.many (O.strArgument (O.metavar "FILE" <> O.action "file")) closedArg :: O.Parser Bool closedArg = O.switch ( O.long "closed" <> O.help "Show closed issues." ) idArg :: O.Parser String idArg = O.strArgument ( O.metavar "ID" <> O.completer (O.listIOCompleter $ map (T.unpack . I.id) . (._3) . last <$> getHistory) ) editFlag :: O.Parser Bool editFlag = O.switch ( O.long "edit" <> O.help "Edit issue in $EDITOR." ) patchFlag :: O.Parser Bool patchFlag = O.switch ( O.short 'p' <> O.long "patch" <> O.help "Show patches." ) die :: String -> IO a die s = do printf "error: %s\n" s exitWith (ExitFailure 1) main :: IO () main = do settings <- readSettings O.execParser (O.info (options <**> O.helper) O.idm) >>= \case Options {internalTags, colorize, noPager, width, command = List {sort, filters, files, group = Just group, closed}} -> do let withinPath issue = if null files then True else any (\file -> file `isPrefixOf` issue.file) files ungroupedIssues <- applySorts sort . applyFilters filters . filter withinPath . applyClosed closed . (._3) . last <$> getHistory let groupedIssues = I.groupIssuesBy group ungroupedIssues putDoc colorize noPager width . P.vsep . intersperse ("" :: P.Doc ann) $ concatMap ( \(name, issues) -> ( P.annotate P.underlined $ ( ( (("@" :: P.Doc ann) <> P.pretty group) <+> P.pretty name ) <+> ("(" :: P.Doc ann) <> P.pretty (length issues) <> (")" :: P.Doc ann) ) ) : map (P.indent 4) ( map ( \issue -> let title = map (P.annotate P.bold . P.pretty) (T.words issue.title) tags = prettyTags (issue.tags ++ if internalTags then issue.internalTags else []) openedBy = P.annotate (P.color P.Black) ("by" <+> P.pretty issue.provenance.first.author.name) openedOn = P.annotate (P.color P.Black) ("on" <+> P.pretty (show (utctDay issue.provenance.first.date))) in P.nest 4 $ P.fillSep ( concat $ [ title, tags, [ openedOn, openedBy ] ] ) ) issues ) ) (M.toList groupedIssues) Options {internalTags, colorize, noPager, width, command = List {sort, filters, files, group = Nothing, closed}} -> do let withinPath issue = if null files then True else any (\file -> file `isPrefixOf` issue.file) files issues <- applySorts sort . applyFilters filters . filter withinPath . applyClosed closed . (._3) . last <$> getHistory putDoc colorize noPager width . P.vsep $ map ( \issue -> let title = map (P.annotate P.bold . P.pretty) (T.words issue.title) tags = prettyTags (issue.tags ++ if internalTags then issue.internalTags else []) openedBy = P.annotate (P.color P.Black) ("by" <+> (P.pretty (issue.provenance.first.author.name))) openedOn = P.annotate (P.color P.Black) ("on" <+> (P.pretty (show (utctDay ((issue.provenance.first.date)))))) in P.nest 4 $ P.fillSep ( concat $ [ title, tags, [ openedOn, openedBy ] ] ) ) issues Options {colorize, noPager, width, command = Log {patch}} -> do ess' <- map (\(commitHash, issueEvents, _) -> (commitHash, issueEvents)) <$> getHistory putDoc colorize noPager width . P.vsep $ concatMap ( \(hash, es') -> let shortHash = P.annotate (P.color P.Yellow) . P.pretty $ C.toShortText hash in map ( \e -> let kwd = P.annotate (P.color P.Green) . P.pretty . T.pack title issue = P.annotate (P.color P.Blue) . P.annotate P.bold $ P.pretty issue.title in ( case e of IssueCreated {issue} -> shortHash <+> kwd "created" <+> title issue IssueChanged {issue} -> shortHash <+> kwd "changed" <+> title issue IssueDeleted {issue} -> shortHash <+> kwd "deleted" <+> title issue ) <+> if patch then P.pretty e.patch else P.emptyDoc ) es' ) (reverse ess') Options {colorize, width, command = Show {id, edit}} -> do issues <- (._3) . last <$> getHistory issue <- case find ((==) id . T.unpack . I.id) issues of Nothing -> die (printf "no issue with id `%s'\n" id) Just issue -> pure issue let meta = I.getMeta issues issue let s = ( (if issue.closed then "**(CLOSED)** " else "") <> LT.fromStrict (T.intercalate " " issue.markers) <> " " <> LT.fromStrict issue.title ) <> maybe "" (("\n\n" <>) . LT.fromStrict) issue.description <> LT.intercalate "\n" (map ((("***\n" :: LT.Text) <>) . LT.fromStrict) issue.comments) if edit then do withSystemTempFile (printf "%s.md" id) $ \fp h -> do LT.hPutStr h s hFlush h hClose h sh_ (proc "${EDITOR-vi} -- %" fp) I.replaceText issue =<< T.readFile fp else do -- TODO Make `show` page-able -- -- We have to set `noPager` unconditionally to `True` for now, as not -- all output is `mdcat` compatible. -- -- @topic markdown putDoc colorize True width $ P.annotate (P.color P.Green) $ P.pretty $ issue.file ++ ":" ++ show issue.start.row ++ "\nvia " ++ T.unpack (C.toText issue.provenance.first.hash) ++ "\nby " ++ T.unpack issue.provenance.first.author.name ++ " <" ++ T.unpack issue.provenance.first.author.email ++ ">\nat " ++ show issue.provenance.first.date ++ "\n\n" sh_ ( ( case width of Nothing -> "mdcat --local" Just width' -> proc "mdcat --columns % --local" width' ) & P.setStdin (textInput s) ) putDoc colorize True width $ P.pretty $ "\n@file " ++ issue.file ++ "\n@row " ++ show issue.start.row ++ "\n" when (not $ null meta.referencedBy) $ putDoc colorize True width . P.annotate (P.color P.Black) . P.vsep $ P.pretty ("" :: T.Text) : map ( \(otherIssue, tag) -> P.pretty ("This commit was referenced by issue " :: T.Text) <> P.annotate P.bold (P.pretty otherIssue.id) <> P.pretty (" (" :: T.Text) <> P.annotate P.bold (P.pretty ("@" <> I.tagKey tag)) <> P.pretty (")." :: T.Text) ) meta.referencedBy Options {colorize, noPager, width, internalTags, command = Tags} -> do issues <- (._3) . last <$> getHistory let tags = concatMap ( \issue -> issue.tags ++ ( if internalTags then issue.internalTags else [] ) ) issues tagsAndValues = M.toList . M.map (S.toList . S.fromList) . foldl ( flip ( \tag -> let vs = maybe [] (: []) (I.tagValue tag) in (M.alter (Just . maybe vs (vs ++))) (I.tagKey tag) ) ) M.empty $ tags putDoc colorize noPager width . P.vsep $ map ( \(tagKey, tagValues) -> P.annotate P.bold (P.pretty ("@" <> tagKey)) <+> P.hsep (map P.pretty tagValues) ) tagsAndValues applyClosed :: Bool -> [Issue] -> [Issue] applyClosed closed = filter (\issue -> closed || not issue.closed) prettyTags :: [I.Tag] -> [P.Doc P.AnsiStyle] prettyTags = map ( \(key, values) -> maybe ( P.annotate P.bold . P.annotate (P.color P.Yellow) $ P.pretty ("@" <> key) ) ( P.annotate P.bold . P.annotate (P.color P.Yellow) . (P.pretty ("@" <> key) <+>) . P.annotate (P.color P.Yellow) . P.pretty ) (list Nothing (Just . T.intercalate ",") values) ) . M.toList . M.map S.toList . foldl ( \dict tag -> let value = S.fromList (maybeToList (I.tagValue tag)) in M.alter (Just . maybe value (S.union value)) (I.tagKey tag) dict ) M.empty putDoc :: Color -> Bool -> Maybe Int -> P.Doc P.AnsiStyle -> IO () putDoc colorize noPager width doc = do isTty <- (== 1) <$> c_isatty 1 term <- Terminal.size let s = P.renderLazy $ P.layoutSmart P.defaultLayoutOptions { P.layoutPageWidth = maybe P.Unbounded (\n -> P.AvailablePerLine n 1) (width <|> (Terminal.width <$> term)) } $ ( if colorize == Always || (colorize == Auto && isTty) then (\x -> x) else P.unAnnotate ) $ doc if not noPager && maybe False (length (LT.lines s) >) (Terminal.height <$> term) then sh_ ( "${PAGER-less}" & P.shell & P.setStdin (textInput s) ) else LT.putStr s foreign import ccall "unistd.h isatty" c_isatty :: Int -> IO Int