path: root/app/Main.hs

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PartialTypeSignatures #-}

-- TODO Edit issues.
--
-- I would like to edit issues from the command line.
--
-- `anissue edit @id` should bring up the issue inside `$EDITOR`, updating the issue with any changes made within `$EDITOR`.
--
-- Comment markers should be stripped, and the file format should be Markdown. Issue markers could be stripped.
--
-- I am personally anticipating that this is used most frequently in response to `anissue show @id`. So, maybe `anissue show @id --edit` should be a synonym?
-- Rationale: the latter is typing `<UP> --edit<CR>`. The former, after show, is typing `<UP><ESC>^wcwedit<CR>`, the former obviously being more palatable.

-- 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

-- TODO Tag improvements (globbing).
--
-- I would like to filter `--filter '@assigned *@posteo.de'`.
-- @topic tags

-- TODO Tag improvements (priorities)
--
-- I would like anissue to support priorities when filtering. Let's for a first implementation say that priorities are represented by an integer-values `@priority` tag on an issue. The `--filter` can be extended for filtering integer-valued tags, and the following syntax:
--
-- - `--filter '@priority >1'`, `--filter '@priority <1`
-- - `--filter '@priority >=1'`, `--filter '@priority <=1`
--
-- At some later point, we can configure `high`, `medium`, `low` to mean
-- `1,2,3`, `4,5,6`, `7,8,9` respectively.
--
-- Issues having a `@priority` tag whose value is not an integer should be regarded not matching the filter.
-- @topic tags

-- TODO Tag improvements (dates).
--
-- I would like anissue to support due dates when filtering. Let's for a first implementation add the following filter syntax:
--
-- `--filter '@due 2023-10-04'` for all issues that are marked `@due 2023-10-04` or with an earlier `@due` date.
--
-- Issues having a `@due` tag whose value does not follow that date format precisely should be regarded not matching the filter.
-- @topic tags

-- 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
-- ```

-- 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

-- 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

-- 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

-- FIXME Exclude tags in code blocks
--
-- Tags which appear in markdown code blocks should not be considered
-- tags.
--
-- @topic tags

-- 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 tags

-- 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

-- 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

-- FIXME Render all unicode symbols correctly
--
-- Some symbols like e.g. `╬` are not rendered properly.

-- 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
-- <https://hackage.haskell.org/package/full-text-search> and make sure
-- to persist the index in a local cache.
--
-- @topic search

-- 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.

-- TODO Add option to group issue list
--
-- When running `anissue list` with the `--group-by` option, the output
-- will be grouped.  E.g. running `anissue list --group-by topic` would
-- produce
--
-- ```
-- Issue D
-- Issue E
--
-- @topic tags
-- Issue A
-- Issue B @topic ids
--
-- @topic ids
-- Issue B @topic tags
-- Issue C
-- ```
--
-- Other possible grouping options could be
--
-- type
-- : the issue type, i.e. `TODO`, `FIXME`, `QUESTION`, etc.
--
-- priority
-- : the priority, groups should be sorted with the highest priority
-- first
--
-- @topic options

-- FIXME Crash when displaying some unicode emojis
--
-- Running `anissue show tool-crashes-when-displaying-unicode-emojis`
-- will crash because of 🏗️.

module Main where

import Data.List (find)
import Data.Maybe (catMaybes, fromMaybe)
import Data.String qualified as String
import Data.Text qualified as T
import History (listIssues)
import Issue (Issue (..))
import Issue qualified as I
import Issue.Filter (Filter)
import Issue.Filter qualified as I
import Issue.Tag qualified as I
import Options.Applicative ((<**>))
import Options.Applicative qualified as O
import Prettyprinter qualified as P
import Prettyprinter.Render.Terminal qualified as P
import Process (sh_)
import System.Exit (ExitCode (ExitFailure), exitWith)
import System.Process.Typed qualified as P
import Text.Printf
import TreeGrepper.Match qualified as G
import Prelude hiding (id)

data Command
  = List
      { files :: [String],
        filters :: [Filter],
        internalTags :: Bool
      }
  | Show
      { id :: String,
        width :: Maybe Int
      }
  deriving (Show)

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
    <*> widthOption

filesArg :: O.Parser [String]
filesArg = O.many (O.strArgument (O.metavar "FILE" <> O.action "file"))

internalTagsFlag :: O.Parser Bool
internalTagsFlag =
  O.switch
    ( O.long "internal-tags"
        <> O.help "Whether to display internal tags."
    )

idArg :: O.Parser String
idArg =
  O.strArgument
    ( O.metavar "ID"
        <> O.completer
          ( O.listIOCompleter $
              catMaybes . map I.id <$> listIssues [] []
          )
    )

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."
        )
    )

die :: String -> IO a
die s = do
  printf "error: %s\n" s
  exitWith (ExitFailure 1)

main :: IO ()
main = do
  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, width} -> do
      issues <- listIssues [] []
      case find ((==) (Just id) . I.id) issues of
        Nothing -> die (printf "no issue with id `%s'\n" id)
        Just issue -> do
          putDoc $
            P.annotate (P.color P.Green) $
              P.pretty $
                issue.file
                  ++ ":"
                  ++ show issue.start.row
                  ++ ( case issue.provenance of
                         Nothing ->
                           "HEAD"
                         Just provenance ->
                           "\nvia "
                             ++ T.unpack provenance.firstCommit
                             ++ "\nby "
                             ++ T.unpack provenance.authorName
                             ++ " <"
                             ++ T.unpack provenance.authorEmail
                             ++ ">\nat "
                             ++ show provenance.date
                     )
                  ++ "\n\n"
          sh_
            ( P.setStdin
                ( String.fromString
                    ( "# "
                        ++ T.unpack issue.title
                        ++ "\n\n"
                        ++ fromMaybe "" (fmap T.unpack issue.description)
                    )
                )
                ( case width of
                    Nothing ->
                      "mdcat --local"
                    Just width' ->
                      String.fromString (printf "mdcat --columns %d --local" width')
                )
            )
          putDoc $
            P.pretty $
              "\n@file "
                ++ issue.file
                ++ "\n@row "
                ++ show issue.start.row
                ++ "\n"

putDoc :: P.Doc P.AnsiStyle -> IO ()
putDoc doc = do
  isTty <- (== 1) <$> c_isatty 1
  P.putDoc . (if isTty then (\x -> x) else P.unAnnotate) $ doc

foreign import ccall "unistd.h isatty" c_isatty :: Int -> IO Int