-- 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 Relations between issues -- -- Issues should be able to refer to other issues (via id) within their tags, -- ie. `@supersedes target-issue-id`. Such relations should create issue -- events on the target issue, and recording the source issue id that created -- the relation. -- -- This might serve as ground work for dependencies-between-issues. -- -- @related dependencies-between-issues -- @priority high -- 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 Support issue comments -- Currently, comments do not get picked up in issue descriptions; see the -- issue below. -- -- I would like to parse comments (much like issues), and associate them with -- the preceding issue. -- -- `anissue show` should then show all comments below the current output. -- -- @priority high -- 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 Data.Function ((&)) import Data.List (find, intersperse, isPrefixOf) import Data.List.Extra (list) import Data.Map qualified as M import Data.Maybe (catMaybes, 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 CH 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.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 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 } | Log | 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 logCmd :: O.Parser Command logCmd = pure Log 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")) idArg :: O.Parser String idArg = O.strArgument ( O.metavar "ID" <> O.completer (O.listIOCompleter $ catMaybes . map I.id . fst <$> getHistory) ) editFlag :: O.Parser Bool editFlag = O.switch ( O.long "edit" <> O.help "Edit issue in $EDITOR." ) 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}} -> do let withinPath issue = if null files then True else any (\file -> file `isPrefixOf` issue.file) files ungroupedIssues <- applySorts sort . applyFilters filters . filter withinPath . fst <$> 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}} -> do let withinPath issue = if null files then True else any (\file -> file `isPrefixOf` issue.file) files issues <- applySorts sort . applyFilters filters . filter withinPath . fst <$> 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} -> do (_, ess') <- getHistory putDoc colorize noPager width . P.vsep $ concatMap ( \(hash, es') -> let shortHash = P.annotate (P.color P.Yellow) . P.pretty $ CH.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 ) es' ) (reverse ess') Options {colorize, width, command = Show {id, edit}} -> do issues <- fst <$> getHistory issue <- case find ((==) (Just id) . I.id) issues of Nothing -> die (printf "no issue with id `%s'\n" id) Just issue -> pure issue let s = -- TODO Hardcoded issue marker. ("TODO " <> LT.fromStrict issue.title) <> maybe "" (("\n\n" <>) . LT.fromStrict) issue.description 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) 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 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" Options {colorize, noPager, width, internalTags, command = Tags} -> do issues <- fst <$> 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 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 -- TODO Move `replaceText` to `Issue` -- TODO `replaceFile` hardcodes comment -- -- @difficulty easy replaceText :: Issue -> T.Text -> IO () replaceText issue s' = T.writeFile issue.file . replace (indent (comment s')) =<< T.readFile issue.file where comment = T.intercalate "\n" . map T.strip . map ("-- " <>) . T.lines indent = T.intercalate "\n" . mapButFirst (T.replicate (issue.start.column - 1) " " <>) . T.lines replace s t = before <> s <> after where t' = T.lines t before = T.intercalate "\n" (mapLast (T.take (issue.start.column - 1)) (take issue.start.row t')) after = T.unlines (mapFirst (T.drop issue.end.column) (drop (issue.end.row - 1) t')) mapFirst _ [] = [] mapFirst f (x : xs) = f x : xs mapLast _ [] = [] mapLast f [x] = [f x] mapLast f (x : xs) = x : mapLast f xs mapButFirst _ [] = [] mapButFirst f (x : xs) = x : map f xs 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