From 941f0d4ccb688d42c0438e05051ed78a410431b6 Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Fri, 1 Mar 2024 06:44:00 +0100 Subject: chore: pin nixpkgs to nixos-23.05 --- default.nix | 2 +- nix/sources.json | 14 ++++ nix/sources.nix | 198 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 213 insertions(+), 1 deletion(-) create mode 100644 nix/sources.json create mode 100644 nix/sources.nix diff --git a/default.nix b/default.nix index 758626b..a7b5672 100644 --- a/default.nix +++ b/default.nix @@ -1,4 +1,4 @@ -{ pkgs ? import { +{ pkgs ? import (import ./nix/sources.nix).nixpkgs { overlays = [ (self: super: { tree-sitter = super.tree-sitter.overrideAttrs (oldAttrs: { diff --git a/nix/sources.json b/nix/sources.json new file mode 100644 index 0000000..926d13a --- /dev/null +++ b/nix/sources.json @@ -0,0 +1,14 @@ +{ + "nixpkgs": { + "branch": "nixos-23.05", + "description": "Nix Packages collection", + "homepage": null, + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "70bdadeb94ffc8806c0570eb5c2695ad29f0e421", + "sha256": "05cbl1k193c9la9xhlz4y6y8ijpb2mkaqrab30zij6z4kqgclsrd", + "type": "tarball", + "url": "https://github.com/NixOS/nixpkgs/archive/70bdadeb94ffc8806c0570eb5c2695ad29f0e421.tar.gz", + "url_template": "https://github.com///archive/.tar.gz" + } +} diff --git a/nix/sources.nix b/nix/sources.nix new file mode 100644 index 0000000..fe3dadf --- /dev/null +++ b/nix/sources.nix @@ -0,0 +1,198 @@ +# This file has been generated by Niv. + +let + + # + # The fetchers. fetch_ fetches specs of type . + # + + fetch_file = pkgs: name: spec: + let + name' = sanitizeName name + "-src"; + in + if spec.builtin or true then + builtins_fetchurl { inherit (spec) url sha256; name = name'; } + else + pkgs.fetchurl { inherit (spec) url sha256; name = name'; }; + + fetch_tarball = pkgs: name: spec: + let + name' = sanitizeName name + "-src"; + in + if spec.builtin or true then + builtins_fetchTarball { name = name'; inherit (spec) url sha256; } + else + pkgs.fetchzip { name = name'; inherit (spec) url sha256; }; + + fetch_git = name: spec: + let + ref = + spec.ref or ( + if spec ? branch then "refs/heads/${spec.branch}" else + if spec ? tag then "refs/tags/${spec.tag}" else + abort "In git source '${name}': Please specify `ref`, `tag` or `branch`!" + ); + submodules = spec.submodules or false; + submoduleArg = + let + nixSupportsSubmodules = builtins.compareVersions builtins.nixVersion "2.4" >= 0; + emptyArgWithWarning = + if submodules + then + builtins.trace + ( + "The niv input \"${name}\" uses submodules " + + "but your nix's (${builtins.nixVersion}) builtins.fetchGit " + + "does not support them" + ) + { } + else { }; + in + if nixSupportsSubmodules + then { inherit submodules; } + else emptyArgWithWarning; + in + builtins.fetchGit + ({ url = spec.repo; inherit (spec) rev; inherit ref; } // submoduleArg); + + fetch_local = spec: spec.path; + + fetch_builtin-tarball = name: throw + ''[${name}] The niv type "builtin-tarball" is deprecated. You should instead use `builtin = true`. + $ niv modify ${name} -a type=tarball -a builtin=true''; + + fetch_builtin-url = name: throw + ''[${name}] The niv type "builtin-url" will soon be deprecated. You should instead use `builtin = true`. + $ niv modify ${name} -a type=file -a builtin=true''; + + # + # Various helpers + # + + # https://github.com/NixOS/nixpkgs/pull/83241/files#diff-c6f540a4f3bfa4b0e8b6bafd4cd54e8bR695 + sanitizeName = name: + ( + concatMapStrings (s: if builtins.isList s then "-" else s) + ( + builtins.split "[^[:alnum:]+._?=-]+" + ((x: builtins.elemAt (builtins.match "\\.*(.*)" x) 0) name) + ) + ); + + # The set of packages used when specs are fetched using non-builtins. + mkPkgs = sources: system: + let + sourcesNixpkgs = + import (builtins_fetchTarball { inherit (sources.nixpkgs) url sha256; }) { inherit system; }; + hasNixpkgsPath = builtins.any (x: x.prefix == "nixpkgs") builtins.nixPath; + hasThisAsNixpkgsPath = == ./.; + in + if builtins.hasAttr "nixpkgs" sources + then sourcesNixpkgs + else if hasNixpkgsPath && ! hasThisAsNixpkgsPath then + import { } + else + abort + '' + Please specify either (through -I or NIX_PATH=nixpkgs=...) or + add a package called "nixpkgs" to your sources.json. + ''; + + # The actual fetching function. + fetch = pkgs: name: spec: + + if ! builtins.hasAttr "type" spec then + abort "ERROR: niv spec ${name} does not have a 'type' attribute" + else if spec.type == "file" then fetch_file pkgs name spec + else if spec.type == "tarball" then fetch_tarball pkgs name spec + else if spec.type == "git" then fetch_git name spec + else if spec.type == "local" then fetch_local spec + else if spec.type == "builtin-tarball" then fetch_builtin-tarball name + else if spec.type == "builtin-url" then fetch_builtin-url name + else + abort "ERROR: niv spec ${name} has unknown type ${builtins.toJSON spec.type}"; + + # If the environment variable NIV_OVERRIDE_${name} is set, then use + # the path directly as opposed to the fetched source. + replace = name: drv: + let + saneName = stringAsChars (c: if (builtins.match "[a-zA-Z0-9]" c) == null then "_" else c) name; + ersatz = builtins.getEnv "NIV_OVERRIDE_${saneName}"; + in + if ersatz == "" then drv else + # this turns the string into an actual Nix path (for both absolute and + # relative paths) + if builtins.substring 0 1 ersatz == "/" then /. + ersatz else /. + builtins.getEnv "PWD" + "/${ersatz}"; + + # Ports of functions for older nix versions + + # a Nix version of mapAttrs if the built-in doesn't exist + mapAttrs = builtins.mapAttrs or ( + f: set: with builtins; + listToAttrs (map (attr: { name = attr; value = f attr set.${attr}; }) (attrNames set)) + ); + + # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/lists.nix#L295 + range = first: last: if first > last then [ ] else builtins.genList (n: first + n) (last - first + 1); + + # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L257 + stringToCharacters = s: map (p: builtins.substring p 1 s) (range 0 (builtins.stringLength s - 1)); + + # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L269 + stringAsChars = f: s: concatStrings (map f (stringToCharacters s)); + concatMapStrings = f: list: concatStrings (map f list); + concatStrings = builtins.concatStringsSep ""; + + # https://github.com/NixOS/nixpkgs/blob/8a9f58a375c401b96da862d969f66429def1d118/lib/attrsets.nix#L331 + optionalAttrs = cond: as: if cond then as else { }; + + # fetchTarball version that is compatible between all the versions of Nix + builtins_fetchTarball = { url, name ? null, sha256 }@attrs: + let + inherit (builtins) lessThan nixVersion fetchTarball; + in + if lessThan nixVersion "1.12" then + fetchTarball ({ inherit url; } // (optionalAttrs (name != null) { inherit name; })) + else + fetchTarball attrs; + + # fetchurl version that is compatible between all the versions of Nix + builtins_fetchurl = { url, name ? null, sha256 }@attrs: + let + inherit (builtins) lessThan nixVersion fetchurl; + in + if lessThan nixVersion "1.12" then + fetchurl ({ inherit url; } // (optionalAttrs (name != null) { inherit name; })) + else + fetchurl attrs; + + # Create the final "sources" from the config + mkSources = config: + mapAttrs + ( + name: spec: + if builtins.hasAttr "outPath" spec + then + abort + "The values in sources.json should not have an 'outPath' attribute" + else + spec // { outPath = replace name (fetch config.pkgs name spec); } + ) + config.sources; + + # The "config" used by the fetchers + mkConfig = + { sourcesFile ? if builtins.pathExists ./sources.json then ./sources.json else null + , sources ? if sourcesFile == null then { } else builtins.fromJSON (builtins.readFile sourcesFile) + , system ? builtins.currentSystem + , pkgs ? mkPkgs sources system + }: rec { + # The sources, i.e. the attribute set of spec name to spec + inherit sources; + + # The "pkgs" (evaluated nixpkgs) to use for e.g. non-builtin fetchers + inherit pkgs; + }; + +in +mkSources (mkConfig { }) // { __functor = _: settings: mkSources (mkConfig settings); } -- cgit v1.2.3 From f92c593a3d2c4bdb023fdd834b6e8c874d063cc8 Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Thu, 29 Feb 2024 04:11:10 +0100 Subject: feat: add `review` command Prototype of the `review` command, cf. `anissue review -h`. Also adds the `status` command. --- anissue.cabal | 7 +- app/Data/List/NonEmpty/Zipper/Extra.hs | 8 ++ app/Git.hs | 23 +++- app/Git/CommitHash.hs | 5 + app/Main.hs | 64 ++++++++- app/Patch.hs | 29 ++++- app/Render.hs | 16 +-- app/Review.hs | 232 +++++++++++++++++++++++++++++++++ app/Status.hs | 122 +++++++++++++++++ default.nix | 6 +- diff-parse.patch | 39 ++++++ 11 files changed, 532 insertions(+), 19 deletions(-) create mode 100644 app/Data/List/NonEmpty/Zipper/Extra.hs create mode 100644 app/Review.hs create mode 100644 app/Status.hs create mode 100644 diff-parse.patch diff --git a/anissue.cabal b/anissue.cabal index 434f4b2..78d5e96 100644 --- a/anissue.cabal +++ b/anissue.cabal @@ -71,6 +71,7 @@ executable anissue Comment Comment.Language Data.List.Extra + Data.List.NonEmpty.Zipper.Extra Debug Die Exception @@ -93,7 +94,9 @@ executable anissue Patch Process Render + Review Settings + Status Text.Diff.Extra TreeSitter Tuple @@ -206,7 +209,7 @@ executable anissue -- other-extensions: -- Other library packages from which modules are imported. - build-depends: base ^>=4.16.4.0, + build-depends: base, aeson, attoparsec, binary, @@ -220,6 +223,8 @@ executable anissue generic-deriving, lingo, megaparsec, + mtl, + nonempty-zipper, optparse-applicative, parallel-io, prettyprinter, diff --git a/app/Data/List/NonEmpty/Zipper/Extra.hs b/app/Data/List/NonEmpty/Zipper/Extra.hs new file mode 100644 index 0000000..638a9bd --- /dev/null +++ b/app/Data/List/NonEmpty/Zipper/Extra.hs @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Data.List.NonEmpty.Zipper.Extra where + +import Data.Binary (Binary) +import Data.List.NonEmpty.Zipper (Zipper) + +instance Binary a => Binary (Zipper a) diff --git a/app/Git.hs b/app/Git.hs index 6431259..7859503 100644 --- a/app/Git.hs +++ b/app/Git.hs @@ -8,6 +8,9 @@ module Git getCommitOf, readTextFileOfText, readTextFileOfBS, + resolveRef, + getCommitsBetween, + diffOf, ) where @@ -27,6 +30,7 @@ import Data.Time.Clock (UTCTime, getCurrentTime) import Exception qualified as E import GHC.Generics (Generic) import Git.CommitHash +import Patch qualified as A import Process (proc, sh) import Text.Printf (printf) @@ -91,7 +95,7 @@ readTextFileOfText :: CommitHash -> FilePath -> IO LT.Text readTextFileOfText = readTextFileOf LT.readFile LT.decodeUtf8 readTextFileOfBS :: CommitHash -> FilePath -> IO LB.ByteString -readTextFileOfBS = readTextFileOf LB.readFile (\x->x) +readTextFileOfBS = readTextFileOf LB.readFile (\x -> x) readTextFileOf :: (FilePath -> IO a) -> (LB.ByteString -> a) -> CommitHash -> FilePath -> IO a readTextFileOf readFile _ WorkingTree filePath = @@ -102,3 +106,20 @@ readTextFileOf _ decode (Commit hash) filePath = catch (decode <$> sh (proc "git show %:%" hash filePath)) (\(_ :: E.ProcessException) -> throwIO (E.CannotReadFile (printf "%s:%s" hash filePath))) + +resolveRef :: T.Text -> IO CommitHash +resolveRef = + fmap (Commit . T.strip . T.decodeUtf8 . LB.toStrict) + . sh + . proc "git rev-parse %" + +-- TODO Throw if `prevHash` is not an ancestor of `hash`. +getCommitsBetween :: CommitHash -> CommitHash -> IO [CommitHash] +getCommitsBetween (Commit prevHash) (Commit hash) = do + map (Commit . T.strip) . T.lines . T.decodeUtf8 . LB.toStrict + <$> sh (proc "git log --format=%%H %..%" prevHash hash) + +diffOf :: CommitHash -> CommitHash -> IO A.Patch +diffOf prevHash hash = + A.parse . T.decodeUtf8 . LB.toStrict + <$> sh (proc "git diff % %" (toTextUnsafe prevHash) (toTextUnsafe hash)) diff --git a/app/Git/CommitHash.hs b/app/Git/CommitHash.hs index db7a478..0caecf4 100644 --- a/app/Git/CommitHash.hs +++ b/app/Git/CommitHash.hs @@ -2,6 +2,7 @@ module Git.CommitHash ( CommitHash (..), toShortText, toText, + toTextUnsafe, ) where @@ -23,6 +24,10 @@ toText :: CommitHash -> Maybe T.Text toText WorkingTree = Nothing toText (Commit hash) = Just hash +toTextUnsafe :: CommitHash -> T.Text +toTextUnsafe (Commit hash) = hash +toTextUnsafe _ = error "toTextUnsafe: WorkingDir" + instance P.Render CommitHash where render = P.render . P.Detailed diff --git a/app/Main.hs b/app/Main.hs index 52a316d..5d29923 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,5 +1,5 @@ -- TODO Compute history from the top --- +-- _ -- Currently we are computing the history from the bottom (ie. earliest commit -- first). When computing history from the top, it might allow us to interrupt -- the process and present slightly inaccurate information earlier. @@ -319,6 +319,7 @@ module Main where import Comment qualified as G import Control.Applicative ((<|>)) +import Control.Exception (catch) import Data.Function ((&)) import Data.List (find, intersperse) import Data.Map qualified as M @@ -327,6 +328,7 @@ 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 Exception qualified as E import Git qualified import History qualified as H import Issue (Issue (..)) @@ -341,7 +343,9 @@ import Options.Applicative qualified as O import Process (proc, sh_, textInput) import Render ((<<<)) import Render qualified as P +import Review qualified as R import Settings (Settings (..), readSettings) +import Status qualified as S import System.Console.Terminal.Size qualified as Terminal import System.Exit (ExitCode (ExitFailure), exitWith) import System.FilePath (()) @@ -424,6 +428,12 @@ data Command | Open { id :: String } + | Status + | Review + { baseBranch :: T.Text, + featureBranch :: T.Text, + granularity :: R.Granularity + } | Search { pattern :: R.RE, closed :: Bool, @@ -444,10 +454,14 @@ cmd = O.progDesc "Show a log of all issues", O.command "open" . O.info openCmd $ O.progDesc "Open file containing an issue", + O.command "review" . O.info reviewCmd $ + O.progDesc "Review changes", O.command "search" . O.info searchCmd $ O.progDesc "List issues matching a pattern", O.command "show" . O.info showCmd $ O.progDesc "Show details of all issues", + O.command "status" . O.info statusCmd $ + O.progDesc "Describe the current anissue action.", O.command "tags" . O.info tagsCmd $ O.progDesc "Show all tags" ] @@ -480,6 +494,36 @@ openCmd = Open <$> idArg +reviewCmd :: O.Parser Command +reviewCmd = + Review + <$> baseBranchArg + <*> featureBranchArg + <*> granularityArg + +baseBranchArg :: O.Parser T.Text +baseBranchArg = + O.option O.auto $ + O.long "base" + <> O.short 'b' + <> O.metavar "BRANCH" + <> O.help "Base branch from which to review changes. Defaults to `main`." + <> O.value "main" + +featureBranchArg :: O.Parser T.Text +featureBranchArg = + O.strArgument (O.metavar "BRANCH_NAME" <> O.value "HEAD") + +granularityArg :: O.Parser R.Granularity +granularityArg = + O.option + O.auto + ( O.long "granularity" + <> O.metavar "GRANULARITY" + <> O.help "Granularity of the review. One of `as-one`, `per-commit`, `per-file` or `per-hunk`. Default: `as-one`." + <> O.value R.AsOne + ) + showCmd :: O.Parser Command showCmd = Show @@ -492,6 +536,10 @@ patternArg = (O.maybeReader R.compileRegex) (O.metavar "PATTERN") +statusCmd :: O.Parser Command +statusCmd = + pure Status + tagsCmd :: O.Parser Command tagsCmd = pure Tags @@ -548,6 +596,20 @@ main :: IO () main = do settings <- readSettings O.execParser (O.info (options <**> O.helper) O.idm) >>= \case + Options {colorize, noPager, width, command = Status} -> do + status <- S.readStatus ".anissue/status" + putDoc colorize noPager width status + Options {colorize, noPager, width, command = Review {baseBranch, featureBranch, granularity}} -> do + sh_ "test -z $(git status --porcelain --untracked-files=no)" + `catch` \(_ :: E.ProcessException) -> + error "working directory not clean, aborting.." + S.withReviewing + (putDoc colorize noPager width) + granularity + baseBranch + featureBranch + ".anissue/status" + S.continueReview Options {colorize, noPager, width, command = List {sort, filters, files, group = Just group, closed}} -> do ungroupedIssues <- I.applySorts sort diff --git a/app/Patch.hs b/app/Patch.hs index 9e6ed88..a301382 100644 --- a/app/Patch.hs +++ b/app/Patch.hs @@ -1,11 +1,12 @@ {-# LANGUAGE DerivingStrategies #-} module Patch - ( Patch, + ( Patch (..), parse, ) where +import Prettyprinter (pretty) import Control.Exception (throw) import Data.Binary (Binary (..)) import Data.Text qualified as T @@ -31,14 +32,28 @@ instance P.Render Patch where instance P.Render (P.Detailed Patch) where render (P.Detailed (Patch {..})) = - P.vsep $ map prettyFileDelta fileDeltas + P.vsep (map prettyFileDelta fileDeltas) <<< ("\n" :: T.Text) where - prettyFileDelta (D.FileDelta {..}) = prettyContent fileDeltaContent + prettyFileDelta (D.FileDelta {..}) = + ("diff --git " <> fileDeltaSourceFile <> " " <> fileDeltaDestFile <> "\n") + <<< (prettySourceFile fileDeltaSourceFile <<< ("\n" :: T.Text)) + <<< (prettyDestFile fileDeltaDestFile <<< ("\n" :: T.Text)) + <<< prettyContent fileDeltaContent + prettySourceFile file = P.styled [P.bold] $ ("---" :: T.Text) <<< file + prettyDestFile file = P.styled [P.bold] $ ("+++" :: T.Text) <<< file prettyContent D.Binary = P.emptyDoc prettyContent (D.Hunks hunks) = P.vsep (map prettyHunk hunks) - prettyHunk (D.Hunk {..}) = P.vsep $ map prettyLine hunkLines + prettyHunk (D.Hunk {..}) = + P.styled [P.color P.Blue] $ + (prettySourceRange hunkSourceRange hunkDestRange <<< ("\n" :: T.Text)) + <<< P.vsep (map prettyLine hunkLines) + prettySourceRange srcRange dstRange = + ("" :: T.Text) <<< ("@@ -" <> prettyRange srcRange <> " +" <> prettyRange dstRange <> " @@") + prettyRange (D.Range line lineNo) = + T.pack (show line) <> "," <> T.pack (show lineNo) prettyLine (D.Line {..}) = case lineAnnotation of - D.Added -> P.styled [P.color P.Green] $ P.plus @P.AnsiStyle <<< lineContent - D.Removed -> P.styled [P.color P.Red] $ P.minus @P.AnsiStyle <<< lineContent - D.Context -> P.styled [P.color P.White] $ P.space @P.AnsiStyle <<< lineContent + D.Added -> P.styled [P.color P.Green] $ P.plus @P.AnsiStyle <> pretty lineContent + D.Removed -> P.styled [P.color P.Red] $ P.minus @P.AnsiStyle <> pretty lineContent + D.Context -> P.styled [P.color P.White] $ P.space @P.AnsiStyle <> pretty lineContent + D.Comment -> P.styled [P.color P.White] $ P.hash @P.AnsiStyle <> pretty lineContent diff --git a/app/Render.hs b/app/Render.hs index 907ef15..56d78aa 100644 --- a/app/Render.hs +++ b/app/Render.hs @@ -24,8 +24,9 @@ module Render renderAsMarkdown, -- * Additional symbols - plus, + hash, minus, + plus, ) where @@ -81,15 +82,15 @@ instance Render a => Render (IO a) where (Just a, Nothing) -> a (Nothing, Just b) -> b (Just a, Just b) -> - if endsWithNL a || startsWithNL b + if endsWithWS a || startsWithWS b then a <> b else a <> space <> b where nonEmpty x' = let x = render x' in if not (null (show x)) then Just (render x) else Nothing - startsWithNL = ("\n" `isPrefixOf`) . show . render - endsWithNL = ("\n" `isSuffixOf`) . show . render + startsWithWS = ((||) <$> ("\n" `isPrefixOf`) <*> (" " `isPrefixOf`)) . show . render + endsWithWS = ((||) <$> ("\n" `isSuffixOf`) <*> (" " `isSuffixOf`)) . show . render (===) :: (Render a, Render b) => a -> b -> Doc AnsiStyle (===) a' b' = @@ -244,8 +245,7 @@ instance Render D.Node where pretty ("\")" :: T.Text) ] -plus :: Doc ann -plus = pretty ("+" :: T.Text) - -minus :: Doc ann +hash, minus, plus :: Doc ann +hash = pretty ("#" :: T.Text) minus = pretty ("-" :: T.Text) +plus = pretty ("+" :: T.Text) diff --git a/app/Review.hs b/app/Review.hs new file mode 100644 index 0000000..e296cee --- /dev/null +++ b/app/Review.hs @@ -0,0 +1,232 @@ +module Review + ( Plan (..), + Granularity (..), + PlanStep (..), + formulatePlan, + reviewPatch, + separateReview, + ) +where + +import Control.Exception (SomeException, catch) +import Control.Monad (ap, forM, forM_) +import Data.Binary qualified as B +import Data.ByteString.Lazy qualified as LB +import Data.Function (on, (&)) +import Data.List (groupBy, sortOn) +import Data.List.NonEmpty qualified as NE +import Data.List.NonEmpty.Zipper qualified as Z +import Data.List.NonEmpty.Zipper.Extra () +import Data.Maybe (fromMaybe) +import Data.Text qualified as T +import Data.Text.Encoding qualified as T +import Data.Text.IO qualified as T +import GHC.Generics (Generic) +import Git qualified +import Patch qualified as A +import Process (proc, sh, sh_) +import Render (renderAsText) +import System.Directory (createDirectoryIfMissing) +import System.FilePath (takeDirectory, ()) +import System.IO.Temp (withSystemTempDirectory) +import System.Process.Typed qualified as P +import Text.Diff.Extra () +import Text.Diff.Parse.Types qualified as D +import Text.Read (Lexeme (Ident, Symbol), choice, lexP, readPrec) + +data Plan = Plan + { baseBranch :: BranchName, + granularity :: Granularity, + steps :: Z.Zipper PlanStep + } + deriving (Show, Generic, B.Binary) + +type BranchName = T.Text + +data Granularity + = AsOne + | PerCommit + | PerFile + | PerHunk + deriving (Eq, Ord, Generic, B.Binary) + +instance Show Granularity where + show AsOne = "as-one" + show PerCommit = "per-commit" + show PerFile = "per-file" + show PerHunk = "per-hunk" + +instance Read Granularity where + readPrec = + choice + [ do + Ident "as" <- lexP + Symbol "-" <- lexP + Ident "one" <- lexP + pure AsOne, + do + Ident "per" <- lexP + Symbol "-" <- lexP + choice + [ do + Ident "commit" <- lexP + pure PerCommit, + do + Ident "file" <- lexP + pure PerFile, + do + Ident "hunk" <- lexP + pure PerHunk + ] + ] + +data PlanStep = PlanStep + { id :: [Int], + commit :: Git.CommitHash, + changes :: D.FileDeltas + } + deriving (Show, Generic, B.Binary) + +formulatePlan :: Granularity -> T.Text -> T.Text -> IO Plan +formulatePlan granularity baseBranch featureBranch = do + baseCommit <- Git.resolveRef baseBranch + featureCommit <- Git.resolveRef featureBranch + + commits <- + if granularity >= PerCommit + then do + commits <- + reverse <$> Git.getCommitsBetween baseCommit featureCommit + pure $ zipWith (,) commits (baseCommit : commits) + else pure [(featureCommit, baseCommit)] + + fileDeltas <- + fmap concat . forM commits $ + \(commit, earlierCommit) -> + map (earlierCommit,) + . if + | granularity >= PerHunk -> splitPerHunk + | granularity >= PerFile -> splitPerFile + | otherwise -> (: []) + . (.fileDeltas) + <$> Git.diffOf earlierCommit commit + + pure + Plan + { steps = + Z.fromNonEmpty . fromMaybe (error "TODO") . NE.nonEmpty $ + map (uncurry (PlanStep {- TODO -} [])) fileDeltas, + .. + } + +splitPerFile :: D.FileDeltas -> [D.FileDeltas] +splitPerFile = + groupBy + ((==) `on` (.fileDeltaSourceFile)) + . sortOn (.fileDeltaSourceFile) + +splitPerHunk :: D.FileDeltas -> [D.FileDeltas] +splitPerHunk = + concatMap + ( \fileDeltas -> + [ hunkToFileDeltas fileDelta hunk + | fileDelta <- fileDeltas, + let D.Hunks hunks = fileDelta.fileDeltaContent, + hunk <- hunks + ] + ) + . splitPerFile + +hunkToFileDeltas :: D.FileDelta -> D.Hunk -> D.FileDeltas +hunkToFileDeltas fileDelta hunk = + [ fileDelta + { D.fileDeltaContent = D.Hunks [hunk] + } + ] + +reviewPatch :: D.FileDeltas -> IO D.FileDeltas +reviewPatch fileDeltas = + withSystemTempDirectory "anissue" $ \tmp -> do + let patchFile = tmp "a.patch" + loop = + ( do + sh_ (proc "${EDITOR-vi} %" patchFile) + T.writeFile patchFile + . (renderAsText . A.Patch) + . addComments + . ((.fileDeltas) . A.parse) + =<< T.readFile patchFile + ((.fileDeltas) . A.parse . T.decodeUtf8 . LB.toStrict) + <$> sh (proc "recountdiff %" patchFile) + ) + `catch` (\(_ :: SomeException) -> loop) + T.writeFile patchFile (renderAsText (A.Patch fileDeltas)) + loop + +addComments :: D.FileDeltas -> D.FileDeltas +addComments = + map . mapContent . mapHunks . mapLines $ \line@(D.Line {..}) -> + if lineAnnotation == D.Comment + then -- TODO Haskell comment + D.Line D.Added ("--" <> lineContent) + else line + where + mapContent f x = x {D.fileDeltaContent = f x.fileDeltaContent} + mapHunks _ D.Binary = D.Binary + mapHunks f (D.Hunks hs) = D.Hunks (map f hs) + mapLines f x = x {D.hunkLines = map f x.hunkLines} + +separateReview :: + Git.CommitHash -> + D.FileDeltas -> + D.FileDeltas -> + IO D.FileDeltas +separateReview commit fileDeltas fileDeltas' = + withTempSourceFiles commit fileDeltas $ \tmp -> do + T.writeFile (tmp patchFile) (renderAsText (A.Patch fileDeltas)) + T.writeFile (tmp patchFile') (renderAsText (A.Patch fileDeltas')) + sh_ + ( proc "patch --quiet -p0 <../%" patchFile + & P.setWorkingDir (tmp "a") + ) + sh_ + ( proc "patch --quiet -p0 <../%" patchFile' + & P.setWorkingDir (tmp "b") + ) + ( ap (flip if' [] . LB.null) $ + (.fileDeltas) . A.parse . T.decodeUtf8 . LB.toStrict + ) + <$> sh + ( proc "git diff --no-index -- a b || :" + & P.setWorkingDir tmp + ) + where + patchFile = "a.patch" + patchFile' = "b.patch" + +withTempSourceFiles :: + Git.CommitHash -> + D.FileDeltas -> + (FilePath -> IO a) -> + IO a +withTempSourceFiles (Git.Commit hash) fileDeltas action = do + withSystemTempDirectory "anissue" $ \tmp -> do + createDirectoryIfMissing False (tmp "a") + createDirectoryIfMissing False (tmp "b") + forM_ sourceFiles $ \sourceFile -> do + let sourceDir = takeDirectory sourceFile + fileContents <- + if sourceFile /= "/dev/null" + then sh (proc "git show %:%" hash sourceFile) + else pure "" + createDirectoryIfMissing True (tmp "a" sourceDir) + LB.writeFile (tmp "a" sourceFile) fileContents + createDirectoryIfMissing True (tmp "b" sourceDir) + LB.writeFile (tmp "b" sourceFile) fileContents + action tmp + where + sourceFiles = map (T.unpack . (.fileDeltaSourceFile)) fileDeltas + +if' :: Bool -> a -> a -> a +if' True a _ = a +if' False _ b = b diff --git a/app/Status.hs b/app/Status.hs new file mode 100644 index 0000000..1a0fd4c --- /dev/null +++ b/app/Status.hs @@ -0,0 +1,122 @@ +{-# LANGUAGE DerivingStrategies #-} + +module Status + ( Status, + writeStatus, + readStatus, + deleteStatus, + withReviewing, + continueReview, + ) +where + +import Control.Exception (SomeException, catch) +import Control.Monad.State (MonadState, StateT, get, put, runStateT) +import Control.Monad.Trans (MonadIO, liftIO) +import Control.Monad.Writer (MonadWriter, WriterT, runWriterT, tell) +import Data.Binary qualified as B +import Data.List.NonEmpty.Zipper qualified as Z +import Data.List.NonEmpty.Zipper.Extra () +import Data.Text qualified as T +import Data.Text.IO qualified as T +import GHC.Generics (Generic) +import Patch qualified as A +import Render (Render, Summarized (Summarized), render, renderAsText, (<<<), (===)) +import Review qualified as R +import System.Directory (removeFile) +import Text.Diff.Extra () +import Text.Diff.Parse.Types qualified as D + +data Status = Reviewing {plan :: R.Plan, changes :: D.FileDeltas} + deriving (Show, Generic, B.Binary) + +writeStatus :: FilePath -> Status -> IO () +writeStatus = B.encodeFile + +readStatus :: FilePath -> IO Status +readStatus = B.decodeFile + +deleteStatus :: FilePath -> IO () +deleteStatus fp = removeFile fp + +instance Render Status where + render (Reviewing {..}) = + render ("review in progress\n" :: T.Text) + <<< (render (" " :: T.Text) <<< render (Z.lefts plan.steps) <<< render ("\n" :: T.Text)) + <<< (render ("*" :: T.Text) <<< render (Z.current plan.steps) <<< render ("\n" :: T.Text)) + <<< (render (" " :: T.Text) <<< render (Z.rights plan.steps) <<< render ("\n" :: T.Text)) + <<< (render ("run `anissue review` to continue" :: T.Text)) + +instance Render R.PlanStep where + render (R.PlanStep {..}) = + render id <<< render (Summarized commit) + +instance Render [R.PlanStep] where + render [] = render ("" :: T.Text) + render (x : xs) = render x === render xs + +instance Render [Int] where + render [] = render ("[]" :: T.Text) + render (x : xs) = render (show x) <<< render xs + +newtype ReviewingT m a = ReviewingT + { runReviewingT :: StateT (Maybe R.Plan) (WriterT D.FileDeltas m) a + } + deriving newtype + ( Functor, + Applicative, + Monad, + MonadIO, + MonadFail, + MonadState (Maybe R.Plan), + MonadWriter D.FileDeltas + ) + +type BranchName = T.Text + +withReviewing :: + (forall a. Render a => a -> IO ()) -> + R.Granularity -> + BranchName -> + BranchName -> + FilePath -> + ReviewingT IO a -> + IO a +withReviewing putDoc granularity baseBranch featureBranch fp action = do + (plan, changes) <- + (Just <$> readStatus fp) + `catch` (\(_ :: SomeException) -> pure Nothing) + >>= \case + Nothing -> do + plan <- R.formulatePlan granularity baseBranch featureBranch + let changes = [] + writeStatus fp $ Reviewing plan changes + pure (plan, changes) + Just (Reviewing plan changes) -> pure (plan, changes) + ((result, maybePlan), ((++) changes) -> changes') <- + runWriterT (runStateT (runReviewingT action) (Just plan)) + case maybePlan of + Just plan' -> do + let status' = Reviewing plan' changes' + writeStatus fp status' + putDoc status' + Nothing -> do + T.writeFile "review.patch" (renderAsText (A.Patch changes')) + putDoc $ + render ("your review has been put into `review.patch`\n" :: T.Text) + <<< render ("please apply it manually (`patch -p0 put $ Just $ plan {R.steps = steps'} + Nothing -> put Nothing diff --git a/default.nix b/default.nix index a7b5672..4caf76a 100644 --- a/default.nix +++ b/default.nix @@ -44,7 +44,10 @@ let haskellPackages = pkgs.haskellPackages.override { overrides = self: super: { - lingo = pkgs.haskell.lib.doJailbreak (pkgs.haskell.lib.markUnbroken super.lingo); + diff-parse = pkgs.haskell.lib.appendPatch super.diff-parse + ./diff-parse.patch; + lingo = pkgs.haskell.lib.doJailbreak + (pkgs.haskell.lib.markUnbroken super.lingo); anissue = (super.callCabal2nix "anissue" ./. ({ inherit (pkgs) tree-sitter; } // pkgs.lib.filterAttrs (_: pkgs.lib.isDerivation) @@ -56,6 +59,7 @@ let dependencies = [ pkgs.coreutils pkgs.git + pkgs.patchutils ]; }; postInstall = '' diff --git a/diff-parse.patch b/diff-parse.patch new file mode 100644 index 0000000..d3fac03 --- /dev/null +++ b/diff-parse.patch @@ -0,0 +1,39 @@ +diff --git a/src/Text/Diff/Parse/Internal.hs b/src/Text/Diff/Parse/Internal.hs +index 99302b8..715686c 100644 +--- a/src/Text/Diff/Parse/Internal.hs ++++ b/src/Text/Diff/Parse/Internal.hs +@@ -50,12 +50,12 @@ fileDelta = do + fileDeltaHeader :: Parser (FileStatus, Text, Text) + fileDeltaHeader = do + _ <- string "diff --git " +- source <- path <* space +- dest <- path <* endOfLine ++ _ <- path <* space ++ _ <- path <* endOfLine + status <- fileStatus + _ <- option "" (string "index" >> takeLine) +- _ <- option "" (string "--- " >> takeLine) +- _ <- option "" (string "+++ " >> takeLine) ++ source <- string "--- " >> path <* endOfLine ++ dest <- string "+++ " >> path <* endOfLine + return $ (status, source, dest) + + takeLine :: Parser Text +@@ -97,3 +97,4 @@ annotation :: Parser Annotation + annotation = (char '+' >> return Added) + <|> (char '-' >> return Removed) + <|> (char ' ' >> return Context) ++ <|> (char '#' >> return Comment) +diff --git a/src/Text/Diff/Parse/Types.hs b/src/Text/Diff/Parse/Types.hs +index a658ae4..3901575 100644 +--- a/src/Text/Diff/Parse/Types.hs ++++ b/src/Text/Diff/Parse/Types.hs +@@ -2,7 +2,7 @@ module Text.Diff.Parse.Types where + + import Data.Text (Text) + +-data Annotation = Added | Removed | Context deriving (Show, Eq) ++data Annotation = Added | Removed | Context | Comment deriving (Show, Eq) + + data Line = Line { + lineAnnotation :: Annotation -- cgit v1.2.3 From a2f401ca9839b6041b7d94f77de4530f168b12ad Mon Sep 17 00:00:00 2001 From: Fabian Kirchner Date: Wed, 6 Mar 2024 13:47:17 +0100 Subject: review(feature/review): approve lgtm, possible splitting some non-business-logic stuff into separate commits would be nice commit 9a49ec0dcd6f75736949350844f85d80fe48a662 --- app/Git.hs | 1 + app/Git/CommitHash.hs | 1 + app/Main.hs | 1 + 3 files changed, 3 insertions(+) diff --git a/app/Git.hs b/app/Git.hs index 7859503..fd4fa53 100644 --- a/app/Git.hs +++ b/app/Git.hs @@ -96,6 +96,7 @@ readTextFileOfText = readTextFileOf LT.readFile LT.decodeUtf8 readTextFileOfBS :: CommitHash -> FilePath -> IO LB.ByteString readTextFileOfBS = readTextFileOf LB.readFile (\x -> x) +-- REVIEW Suggestion: we could use `id` instead of `\x -> x` readTextFileOf :: (FilePath -> IO a) -> (LB.ByteString -> a) -> CommitHash -> FilePath -> IO a readTextFileOf readFile _ WorkingTree filePath = diff --git a/app/Git/CommitHash.hs b/app/Git/CommitHash.hs index 0caecf4..c53e2d8 100644 --- a/app/Git/CommitHash.hs +++ b/app/Git/CommitHash.hs @@ -28,6 +28,7 @@ toTextUnsafe :: CommitHash -> T.Text toTextUnsafe (Commit hash) = hash toTextUnsafe _ = error "toTextUnsafe: WorkingDir" +-- REVIEW Why is this unsafe? instance P.Render CommitHash where render = P.render . P.Detailed diff --git a/app/Main.hs b/app/Main.hs index 5d29923..a28f4a6 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -610,6 +610,7 @@ main = do featureBranch ".anissue/status" S.continueReview +-- REVIEW Why is withReviewing in the Status module and not the Review module? Options {colorize, noPager, width, command = List {sort, filters, files, group = Just group, closed}} -> do ungroupedIssues <- I.applySorts sort -- cgit v1.2.3 From e7450765081e31341496a3f8ac91bda119b55f5a Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Wed, 13 Mar 2024 04:36:20 +0100 Subject: chore: drop `--granularity` for `--per-commit` --- app/Main.hs | 24 ++++++++--------- app/Patch.hs | 2 +- app/Review.hs | 82 +++++------------------------------------------------------ app/Status.hs | 6 ++--- 4 files changed, 20 insertions(+), 94 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index a28f4a6..634e085 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,5 +1,5 @@ -- TODO Compute history from the top --- _ +-- -- Currently we are computing the history from the bottom (ie. earliest commit -- first). When computing history from the top, it might allow us to interrupt -- the process and present slightly inaccurate information earlier. @@ -343,7 +343,6 @@ import Options.Applicative qualified as O import Process (proc, sh_, textInput) import Render ((<<<)) import Render qualified as P -import Review qualified as R import Settings (Settings (..), readSettings) import Status qualified as S import System.Console.Terminal.Size qualified as Terminal @@ -432,7 +431,7 @@ data Command | Review { baseBranch :: T.Text, featureBranch :: T.Text, - granularity :: R.Granularity + perCommit :: Bool } | Search { pattern :: R.RE, @@ -499,7 +498,7 @@ reviewCmd = Review <$> baseBranchArg <*> featureBranchArg - <*> granularityArg + <*> perCommitArg baseBranchArg :: O.Parser T.Text baseBranchArg = @@ -514,14 +513,11 @@ featureBranchArg :: O.Parser T.Text featureBranchArg = O.strArgument (O.metavar "BRANCH_NAME" <> O.value "HEAD") -granularityArg :: O.Parser R.Granularity -granularityArg = - O.option - O.auto - ( O.long "granularity" - <> O.metavar "GRANULARITY" - <> O.help "Granularity of the review. One of `as-one`, `per-commit`, `per-file` or `per-hunk`. Default: `as-one`." - <> O.value R.AsOne +perCommitArg :: O.Parser Bool +perCommitArg = + O.switch + ( O.long "per-commit" + <> O.help "Review commits individually. (Default: review combined patches)" ) showCmd :: O.Parser Command @@ -599,13 +595,13 @@ main = do Options {colorize, noPager, width, command = Status} -> do status <- S.readStatus ".anissue/status" putDoc colorize noPager width status - Options {colorize, noPager, width, command = Review {baseBranch, featureBranch, granularity}} -> do + Options {colorize, noPager, width, command = Review {baseBranch, featureBranch, perCommit}} -> do sh_ "test -z $(git status --porcelain --untracked-files=no)" `catch` \(_ :: E.ProcessException) -> error "working directory not clean, aborting.." S.withReviewing (putDoc colorize noPager width) - granularity + perCommit baseBranch featureBranch ".anissue/status" diff --git a/app/Patch.hs b/app/Patch.hs index a301382..f170817 100644 --- a/app/Patch.hs +++ b/app/Patch.hs @@ -6,12 +6,12 @@ module Patch ) where -import Prettyprinter (pretty) import Control.Exception (throw) import Data.Binary (Binary (..)) import Data.Text qualified as T import Exception qualified as E import GHC.Generics (Generic) +import Prettyprinter (pretty) import Render ((<<<)) import Render qualified as P import Text.Diff.Extra () diff --git a/app/Review.hs b/app/Review.hs index e296cee..91f4baf 100644 --- a/app/Review.hs +++ b/app/Review.hs @@ -1,6 +1,5 @@ module Review ( Plan (..), - Granularity (..), PlanStep (..), formulatePlan, reviewPatch, @@ -12,8 +11,7 @@ import Control.Exception (SomeException, catch) import Control.Monad (ap, forM, forM_) import Data.Binary qualified as B import Data.ByteString.Lazy qualified as LB -import Data.Function (on, (&)) -import Data.List (groupBy, sortOn) +import Data.Function ((&)) import Data.List.NonEmpty qualified as NE import Data.List.NonEmpty.Zipper qualified as Z import Data.List.NonEmpty.Zipper.Extra () @@ -32,54 +30,16 @@ import System.IO.Temp (withSystemTempDirectory) import System.Process.Typed qualified as P import Text.Diff.Extra () import Text.Diff.Parse.Types qualified as D -import Text.Read (Lexeme (Ident, Symbol), choice, lexP, readPrec) data Plan = Plan { baseBranch :: BranchName, - granularity :: Granularity, + perCommit :: Bool, steps :: Z.Zipper PlanStep } deriving (Show, Generic, B.Binary) type BranchName = T.Text -data Granularity - = AsOne - | PerCommit - | PerFile - | PerHunk - deriving (Eq, Ord, Generic, B.Binary) - -instance Show Granularity where - show AsOne = "as-one" - show PerCommit = "per-commit" - show PerFile = "per-file" - show PerHunk = "per-hunk" - -instance Read Granularity where - readPrec = - choice - [ do - Ident "as" <- lexP - Symbol "-" <- lexP - Ident "one" <- lexP - pure AsOne, - do - Ident "per" <- lexP - Symbol "-" <- lexP - choice - [ do - Ident "commit" <- lexP - pure PerCommit, - do - Ident "file" <- lexP - pure PerFile, - do - Ident "hunk" <- lexP - pure PerHunk - ] - ] - data PlanStep = PlanStep { id :: [Int], commit :: Git.CommitHash, @@ -87,13 +47,13 @@ data PlanStep = PlanStep } deriving (Show, Generic, B.Binary) -formulatePlan :: Granularity -> T.Text -> T.Text -> IO Plan -formulatePlan granularity baseBranch featureBranch = do +formulatePlan :: Bool -> T.Text -> T.Text -> IO Plan +formulatePlan perCommit baseBranch featureBranch = do baseCommit <- Git.resolveRef baseBranch featureCommit <- Git.resolveRef featureBranch commits <- - if granularity >= PerCommit + if perCommit then do commits <- reverse <$> Git.getCommitsBetween baseCommit featureCommit @@ -103,12 +63,7 @@ formulatePlan granularity baseBranch featureBranch = do fileDeltas <- fmap concat . forM commits $ \(commit, earlierCommit) -> - map (earlierCommit,) - . if - | granularity >= PerHunk -> splitPerHunk - | granularity >= PerFile -> splitPerFile - | otherwise -> (: []) - . (.fileDeltas) + map (earlierCommit,) . (: []) . (.fileDeltas) <$> Git.diffOf earlierCommit commit pure @@ -119,31 +74,6 @@ formulatePlan granularity baseBranch featureBranch = do .. } -splitPerFile :: D.FileDeltas -> [D.FileDeltas] -splitPerFile = - groupBy - ((==) `on` (.fileDeltaSourceFile)) - . sortOn (.fileDeltaSourceFile) - -splitPerHunk :: D.FileDeltas -> [D.FileDeltas] -splitPerHunk = - concatMap - ( \fileDeltas -> - [ hunkToFileDeltas fileDelta hunk - | fileDelta <- fileDeltas, - let D.Hunks hunks = fileDelta.fileDeltaContent, - hunk <- hunks - ] - ) - . splitPerFile - -hunkToFileDeltas :: D.FileDelta -> D.Hunk -> D.FileDeltas -hunkToFileDeltas fileDelta hunk = - [ fileDelta - { D.fileDeltaContent = D.Hunks [hunk] - } - ] - reviewPatch :: D.FileDeltas -> IO D.FileDeltas reviewPatch fileDeltas = withSystemTempDirectory "anissue" $ \tmp -> do diff --git a/app/Status.hs b/app/Status.hs index 1a0fd4c..13effa4 100644 --- a/app/Status.hs +++ b/app/Status.hs @@ -76,19 +76,19 @@ type BranchName = T.Text withReviewing :: (forall a. Render a => a -> IO ()) -> - R.Granularity -> + Bool -> BranchName -> BranchName -> FilePath -> ReviewingT IO a -> IO a -withReviewing putDoc granularity baseBranch featureBranch fp action = do +withReviewing putDoc perCommit baseBranch featureBranch fp action = do (plan, changes) <- (Just <$> readStatus fp) `catch` (\(_ :: SomeException) -> pure Nothing) >>= \case Nothing -> do - plan <- R.formulatePlan granularity baseBranch featureBranch + plan <- R.formulatePlan perCommit baseBranch featureBranch let changes = [] writeStatus fp $ Reviewing plan changes pure (plan, changes) -- cgit v1.2.3 From b9f4ee069228e80dda60bc10436693df0aee77ea Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Wed, 13 Mar 2024 04:46:13 +0100 Subject: chore: drop `Status` --- anissue.cabal | 1 - app/Main.hs | 40 +++++++++---------- app/Review.hs | 35 +++++++---------- app/Status.hs | 122 ---------------------------------------------------------- 4 files changed, 32 insertions(+), 166 deletions(-) delete mode 100644 app/Status.hs diff --git a/anissue.cabal b/anissue.cabal index 78d5e96..1d23cf3 100644 --- a/anissue.cabal +++ b/anissue.cabal @@ -96,7 +96,6 @@ executable anissue Render Review Settings - Status Text.Diff.Extra TreeSitter Tuple diff --git a/app/Main.hs b/app/Main.hs index 634e085..0154840 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -322,6 +322,7 @@ import Control.Applicative ((<|>)) import Control.Exception (catch) import Data.Function ((&)) import Data.List (find, intersperse) +import Data.List.NonEmpty qualified as NE import Data.Map qualified as M import Data.Maybe (fromMaybe) import Data.Text qualified as T @@ -340,11 +341,12 @@ import Issue.Render () import Issue.Sort qualified as I import Options.Applicative ((<**>)) import Options.Applicative qualified as O +import Patch qualified as A import Process (proc, sh_, textInput) -import Render ((<<<)) +import Render (renderAsText, (<<<)) import Render qualified as P +import Review qualified as R import Settings (Settings (..), readSettings) -import Status qualified as S import System.Console.Terminal.Size qualified as Terminal import System.Exit (ExitCode (ExitFailure), exitWith) import System.FilePath (()) @@ -427,7 +429,6 @@ data Command | Open { id :: String } - | Status | Review { baseBranch :: T.Text, featureBranch :: T.Text, @@ -459,8 +460,6 @@ cmd = O.progDesc "List issues matching a pattern", O.command "show" . O.info showCmd $ O.progDesc "Show details of all issues", - O.command "status" . O.info statusCmd $ - O.progDesc "Describe the current anissue action.", O.command "tags" . O.info tagsCmd $ O.progDesc "Show all tags" ] @@ -532,10 +531,6 @@ patternArg = (O.maybeReader R.compileRegex) (O.metavar "PATTERN") -statusCmd :: O.Parser Command -statusCmd = - pure Status - tagsCmd :: O.Parser Command tagsCmd = pure Tags @@ -592,21 +587,24 @@ main :: IO () main = do settings <- readSettings O.execParser (O.info (options <**> O.helper) O.idm) >>= \case - Options {colorize, noPager, width, command = Status} -> do - status <- S.readStatus ".anissue/status" - putDoc colorize noPager width status - Options {colorize, noPager, width, command = Review {baseBranch, featureBranch, perCommit}} -> do + Options {command = Review {baseBranch, featureBranch, perCommit}} -> do sh_ "test -z $(git status --porcelain --untracked-files=no)" `catch` \(_ :: E.ProcessException) -> error "working directory not clean, aborting.." - S.withReviewing - (putDoc colorize noPager width) - perCommit - baseBranch - featureBranch - ".anissue/status" - S.continueReview --- REVIEW Why is withReviewing in the Status module and not the Review module? + plan <- R.formulatePlan perCommit baseBranch featureBranch + patch <- + A.Patch . concat + <$> mapM + ( \step -> do + R.separateReview step.commit step.changes + =<< R.reviewPatch step.changes + ) + (NE.toList plan.steps) + T.writeFile "review.patch" (renderAsText patch) + -- REVIEW Why is withReviewing in the Status module and not the Review + -- module? + -- + -- RESOLVED `Status` has been dropped in this commit Options {colorize, noPager, width, command = List {sort, filters, files, group = Just group, closed}} -> do ungroupedIssues <- I.applySorts sort diff --git a/app/Review.hs b/app/Review.hs index 91f4baf..e134a62 100644 --- a/app/Review.hs +++ b/app/Review.hs @@ -7,15 +7,11 @@ module Review ) where -import Control.Exception (SomeException, catch) import Control.Monad (ap, forM, forM_) import Data.Binary qualified as B import Data.ByteString.Lazy qualified as LB import Data.Function ((&)) import Data.List.NonEmpty qualified as NE -import Data.List.NonEmpty.Zipper qualified as Z -import Data.List.NonEmpty.Zipper.Extra () -import Data.Maybe (fromMaybe) import Data.Text qualified as T import Data.Text.Encoding qualified as T import Data.Text.IO qualified as T @@ -34,15 +30,14 @@ import Text.Diff.Parse.Types qualified as D data Plan = Plan { baseBranch :: BranchName, perCommit :: Bool, - steps :: Z.Zipper PlanStep + steps :: NE.NonEmpty PlanStep } deriving (Show, Generic, B.Binary) type BranchName = T.Text data PlanStep = PlanStep - { id :: [Int], - commit :: Git.CommitHash, + { commit :: Git.CommitHash, changes :: D.FileDeltas } deriving (Show, Generic, B.Binary) @@ -69,8 +64,7 @@ formulatePlan perCommit baseBranch featureBranch = do pure Plan { steps = - Z.fromNonEmpty . fromMaybe (error "TODO") . NE.nonEmpty $ - map (uncurry (PlanStep {- TODO -} [])) fileDeltas, + NE.fromList (map (uncurry PlanStep) fileDeltas), .. } @@ -78,20 +72,17 @@ reviewPatch :: D.FileDeltas -> IO D.FileDeltas reviewPatch fileDeltas = withSystemTempDirectory "anissue" $ \tmp -> do let patchFile = tmp "a.patch" - loop = - ( do - sh_ (proc "${EDITOR-vi} %" patchFile) - T.writeFile patchFile - . (renderAsText . A.Patch) - . addComments - . ((.fileDeltas) . A.parse) - =<< T.readFile patchFile - ((.fileDeltas) . A.parse . T.decodeUtf8 . LB.toStrict) - <$> sh (proc "recountdiff %" patchFile) - ) - `catch` (\(_ :: SomeException) -> loop) + patchFile' = tmp "b.patch" T.writeFile patchFile (renderAsText (A.Patch fileDeltas)) - loop + T.writeFile patchFile' (renderAsText (A.Patch fileDeltas)) + sh_ (proc "${EDITOR-vi} %" patchFile') + T.writeFile patchFile' + . (renderAsText . A.Patch) + . addComments + . ((.fileDeltas) . A.parse) + =<< T.readFile patchFile' + ((.fileDeltas) . A.parse . T.decodeUtf8 . LB.toStrict) + <$> sh (proc "rediff % %" patchFile patchFile') addComments :: D.FileDeltas -> D.FileDeltas addComments = diff --git a/app/Status.hs b/app/Status.hs deleted file mode 100644 index 13effa4..0000000 --- a/app/Status.hs +++ /dev/null @@ -1,122 +0,0 @@ -{-# LANGUAGE DerivingStrategies #-} - -module Status - ( Status, - writeStatus, - readStatus, - deleteStatus, - withReviewing, - continueReview, - ) -where - -import Control.Exception (SomeException, catch) -import Control.Monad.State (MonadState, StateT, get, put, runStateT) -import Control.Monad.Trans (MonadIO, liftIO) -import Control.Monad.Writer (MonadWriter, WriterT, runWriterT, tell) -import Data.Binary qualified as B -import Data.List.NonEmpty.Zipper qualified as Z -import Data.List.NonEmpty.Zipper.Extra () -import Data.Text qualified as T -import Data.Text.IO qualified as T -import GHC.Generics (Generic) -import Patch qualified as A -import Render (Render, Summarized (Summarized), render, renderAsText, (<<<), (===)) -import Review qualified as R -import System.Directory (removeFile) -import Text.Diff.Extra () -import Text.Diff.Parse.Types qualified as D - -data Status = Reviewing {plan :: R.Plan, changes :: D.FileDeltas} - deriving (Show, Generic, B.Binary) - -writeStatus :: FilePath -> Status -> IO () -writeStatus = B.encodeFile - -readStatus :: FilePath -> IO Status -readStatus = B.decodeFile - -deleteStatus :: FilePath -> IO () -deleteStatus fp = removeFile fp - -instance Render Status where - render (Reviewing {..}) = - render ("review in progress\n" :: T.Text) - <<< (render (" " :: T.Text) <<< render (Z.lefts plan.steps) <<< render ("\n" :: T.Text)) - <<< (render ("*" :: T.Text) <<< render (Z.current plan.steps) <<< render ("\n" :: T.Text)) - <<< (render (" " :: T.Text) <<< render (Z.rights plan.steps) <<< render ("\n" :: T.Text)) - <<< (render ("run `anissue review` to continue" :: T.Text)) - -instance Render R.PlanStep where - render (R.PlanStep {..}) = - render id <<< render (Summarized commit) - -instance Render [R.PlanStep] where - render [] = render ("" :: T.Text) - render (x : xs) = render x === render xs - -instance Render [Int] where - render [] = render ("[]" :: T.Text) - render (x : xs) = render (show x) <<< render xs - -newtype ReviewingT m a = ReviewingT - { runReviewingT :: StateT (Maybe R.Plan) (WriterT D.FileDeltas m) a - } - deriving newtype - ( Functor, - Applicative, - Monad, - MonadIO, - MonadFail, - MonadState (Maybe R.Plan), - MonadWriter D.FileDeltas - ) - -type BranchName = T.Text - -withReviewing :: - (forall a. Render a => a -> IO ()) -> - Bool -> - BranchName -> - BranchName -> - FilePath -> - ReviewingT IO a -> - IO a -withReviewing putDoc perCommit baseBranch featureBranch fp action = do - (plan, changes) <- - (Just <$> readStatus fp) - `catch` (\(_ :: SomeException) -> pure Nothing) - >>= \case - Nothing -> do - plan <- R.formulatePlan perCommit baseBranch featureBranch - let changes = [] - writeStatus fp $ Reviewing plan changes - pure (plan, changes) - Just (Reviewing plan changes) -> pure (plan, changes) - ((result, maybePlan), ((++) changes) -> changes') <- - runWriterT (runStateT (runReviewingT action) (Just plan)) - case maybePlan of - Just plan' -> do - let status' = Reviewing plan' changes' - writeStatus fp status' - putDoc status' - Nothing -> do - T.writeFile "review.patch" (renderAsText (A.Patch changes')) - putDoc $ - render ("your review has been put into `review.patch`\n" :: T.Text) - <<< render ("please apply it manually (`patch -p0 put $ Just $ plan {R.steps = steps'} - Nothing -> put Nothing -- cgit v1.2.3 From 75444b933f1f23223576fe0ced682b558393ed21 Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Wed, 13 Mar 2024 05:27:44 +0100 Subject: chore: patch shows commit messages --- app/Main.hs | 9 +-------- app/Review.hs | 42 ++++++++++++++++++++++++++++++++++-------- 2 files changed, 35 insertions(+), 16 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 0154840..a2fef0b 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -592,14 +592,7 @@ main = do `catch` \(_ :: E.ProcessException) -> error "working directory not clean, aborting.." plan <- R.formulatePlan perCommit baseBranch featureBranch - patch <- - A.Patch . concat - <$> mapM - ( \step -> do - R.separateReview step.commit step.changes - =<< R.reviewPatch step.changes - ) - (NE.toList plan.steps) + patch <- A.Patch . concat <$> mapM R.reviewStep (NE.toList plan.steps) T.writeFile "review.patch" (renderAsText patch) -- REVIEW Why is withReviewing in the Status module and not the Review -- module? diff --git a/app/Review.hs b/app/Review.hs index e134a62..ef901ce 100644 --- a/app/Review.hs +++ b/app/Review.hs @@ -2,8 +2,7 @@ module Review ( Plan (..), PlanStep (..), formulatePlan, - reviewPatch, - separateReview, + reviewStep, ) where @@ -38,6 +37,7 @@ type BranchName = T.Text data PlanStep = PlanStep { commit :: Git.CommitHash, + earlierCommit :: Git.CommitHash, changes :: D.FileDeltas } deriving (Show, Generic, B.Binary) @@ -58,31 +58,57 @@ formulatePlan perCommit baseBranch featureBranch = do fileDeltas <- fmap concat . forM commits $ \(commit, earlierCommit) -> - map (earlierCommit,) . (: []) . (.fileDeltas) + map ((commit, earlierCommit),) . (: []) . (.fileDeltas) <$> Git.diffOf earlierCommit commit pure Plan { steps = - NE.fromList (map (uncurry PlanStep) fileDeltas), + NE.fromList + ( map + ( \((commit, earlierCommit), changes) -> + PlanStep {..} + ) + fileDeltas + ), .. } -reviewPatch :: D.FileDeltas -> IO D.FileDeltas -reviewPatch fileDeltas = +reviewStep :: PlanStep -> IO D.FileDeltas +reviewStep step = do + commitMessages <- + T.decodeUtf8 . LB.toStrict + <$> sh + ( proc + "git log %..%" + (Git.toTextUnsafe step.earlierCommit) + (Git.toTextUnsafe step.commit) + ) + separateReview step.earlierCommit step.changes + =<< reviewPatch commitMessages step.changes + +reviewPatch :: T.Text -> D.FileDeltas -> IO D.FileDeltas +reviewPatch commitMessages fileDeltas = withSystemTempDirectory "anissue" $ \tmp -> do let patchFile = tmp "a.patch" patchFile' = tmp "b.patch" - T.writeFile patchFile (renderAsText (A.Patch fileDeltas)) - T.writeFile patchFile' (renderAsText (A.Patch fileDeltas)) + patchContents = renderAsText (A.Patch fileDeltas) + T.writeFile patchFile patchContents + T.writeFile patchFile' (addCommitMessages <> patchContents) sh_ (proc "${EDITOR-vi} %" patchFile') T.writeFile patchFile' . (renderAsText . A.Patch) . addComments . ((.fileDeltas) . A.parse) + . stripCommitMessages =<< T.readFile patchFile' ((.fileDeltas) . A.parse . T.decodeUtf8 . LB.toStrict) <$> sh (proc "rediff % %" patchFile patchFile') + where + addCommitMessages = + T.unlines . map ("# " <>) . T.lines $ commitMessages + stripCommitMessages = + T.unlines . dropWhile ("# " `T.isPrefixOf`) . T.lines addComments :: D.FileDeltas -> D.FileDeltas addComments = -- cgit v1.2.3 From f73d14f3f7ff7b7f188d9038856baee0cada0d51 Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Wed, 13 Mar 2024 05:32:02 +0100 Subject: chore: add `REVIEW` marker --- app/Review.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/app/Review.hs b/app/Review.hs index ef901ce..37690d9 100644 --- a/app/Review.hs +++ b/app/Review.hs @@ -115,7 +115,7 @@ addComments = map . mapContent . mapHunks . mapLines $ \line@(D.Line {..}) -> if lineAnnotation == D.Comment then -- TODO Haskell comment - D.Line D.Added ("--" <> lineContent) + D.Line D.Added ("-- REVIEW" <> lineContent) else line where mapContent f x = x {D.fileDeltaContent = f x.fileDeltaContent} -- cgit v1.2.3 From f63a777c07094af31c8841a3f50af8beca0aa369 Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Wed, 13 Mar 2024 05:35:58 +0100 Subject: chore: add review commit template --- app/Main.hs | 6 +++--- app/Review.hs | 36 +++++++++++++++++++++++++++++++++++- 2 files changed, 38 insertions(+), 4 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index a2fef0b..5a21787 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -343,7 +343,7 @@ import Options.Applicative ((<**>)) import Options.Applicative qualified as O import Patch qualified as A import Process (proc, sh_, textInput) -import Render (renderAsText, (<<<)) +import Render ((<<<)) import Render qualified as P import Review qualified as R import Settings (Settings (..), readSettings) @@ -592,8 +592,8 @@ main = do `catch` \(_ :: E.ProcessException) -> error "working directory not clean, aborting.." plan <- R.formulatePlan perCommit baseBranch featureBranch - patch <- A.Patch . concat <$> mapM R.reviewStep (NE.toList plan.steps) - T.writeFile "review.patch" (renderAsText patch) + R.commitReview plan . A.Patch . concat + =<< mapM R.reviewStep (NE.toList plan.steps) -- REVIEW Why is withReviewing in the Status module and not the Review -- module? -- diff --git a/app/Review.hs b/app/Review.hs index 37690d9..3b7afbe 100644 --- a/app/Review.hs +++ b/app/Review.hs @@ -3,10 +3,11 @@ module Review PlanStep (..), formulatePlan, reviewStep, + commitReview, ) where -import Control.Monad (ap, forM, forM_) +import Control.Monad (ap, forM, forM_, when) import Data.Binary qualified as B import Data.ByteString.Lazy qualified as LB import Data.Function ((&)) @@ -28,6 +29,8 @@ import Text.Diff.Parse.Types qualified as D data Plan = Plan { baseBranch :: BranchName, + featureBranch :: BranchName, + commit :: Git.CommitHash, perCommit :: Bool, steps :: NE.NonEmpty PlanStep } @@ -71,6 +74,7 @@ formulatePlan perCommit baseBranch featureBranch = do ) fileDeltas ), + commit = featureCommit, .. } @@ -177,3 +181,33 @@ withTempSourceFiles (Git.Commit hash) fileDeltas action = do if' :: Bool -> a -> a -> a if' True a _ = a if' False _ b = b + +commitReview :: Plan -> A.Patch -> IO () +commitReview plan patch = do + withSystemTempDirectory "anissue" $ \tmp -> do + when (not (null patch.fileDeltas)) do + T.writeFile (tmp "review.patch") (renderAsText patch) + sh_ (proc "patch -p0 <%/review.patch" tmp) + T.writeFile (tmp "commit_editmsg") (commit_editmsg plan) + sh_ (proc "git add %" (map (.fileDeltaDestFile) patch.fileDeltas)) + sh_ (proc "git commit --allow-empty --template %/commit_editmsg" tmp) + +commit_editmsg :: Plan -> T.Text +commit_editmsg plan = do + T.unlines + [ "", + "# Please enter the commit message for your review. Lines starting", + "# with '#' will be ignored, and an empty message aborts the commit.", + "#", + "# To approve the changes, format your commit message like this:", + "#", + "# review: approve " <> plan.featureBranch, + "#", + "# Reviewed branch " <> plan.featureBranch <> " at commit " <> Git.toTextUnsafe plan.commit <> ".", + "#", + "# To requst changes, format your commit message like this:", + "#", + "# review: request-changes " <> plan.featureBranch, + "#", + "# Reviewed branch " <> plan.featureBranch <> " at commit " <> Git.toTextUnsafe plan.commit <> "." + ] -- cgit v1.2.3 From e06061a2d5717bee9b0b4fcaf72d3c79923e4016 Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Wed, 13 Mar 2024 06:01:18 +0100 Subject: chore: drop unused app/Extract.hs --- app/Extract.hs | 17 ----------------- 1 file changed, 17 deletions(-) delete mode 100644 app/Extract.hs diff --git a/app/Extract.hs b/app/Extract.hs deleted file mode 100644 index e351898..0000000 --- a/app/Extract.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Extract where - -data Comment = Comment - { -- result fields - file :: String, - file_type :: FileType, - -- match fields - kind :: String, - name :: String, - text :: T.Text, - start :: Position, - end :: Position - } - -extractComments :: T.Text -> IO [Comment] -extractComments = do - parer <- ts_parser_new -- cgit v1.2.3 From 7f0066cafd2a91959ef618ef8342524ca30a328f Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Wed, 13 Mar 2024 06:16:50 +0100 Subject: review: request-changes feature/review --- app/Git.hs | 6 +++++- app/Git/CommitHash.hs | 6 +++++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/app/Git.hs b/app/Git.hs index fd4fa53..eae3a85 100644 --- a/app/Git.hs +++ b/app/Git.hs @@ -95,8 +95,12 @@ readTextFileOfText :: CommitHash -> FilePath -> IO LT.Text readTextFileOfText = readTextFileOf LT.readFile LT.decodeUtf8 readTextFileOfBS :: CommitHash -> FilePath -> IO LB.ByteString -readTextFileOfBS = readTextFileOf LB.readFile (\x -> x) +readTextFileOfBS = readTextFileOf LB.readFile id -- REVIEW Suggestion: we could use `id` instead of `\x -> x` +-- +-- REVIEW OK! +-- +-- RESOLVED readTextFileOf :: (FilePath -> IO a) -> (LB.ByteString -> a) -> CommitHash -> FilePath -> IO a readTextFileOf readFile _ WorkingTree filePath = diff --git a/app/Git/CommitHash.hs b/app/Git/CommitHash.hs index c53e2d8..28aa738 100644 --- a/app/Git/CommitHash.hs +++ b/app/Git/CommitHash.hs @@ -27,8 +27,12 @@ toText (Commit hash) = Just hash toTextUnsafe :: CommitHash -> T.Text toTextUnsafe (Commit hash) = hash toTextUnsafe _ = error "toTextUnsafe: WorkingDir" +-- ^ REVIEW Why is this unsafe? +-- +-- REVIEW Because it is a partial function. +-- +-- RESOLVED --- REVIEW Why is this unsafe? instance P.Render CommitHash where render = P.render . P.Detailed -- cgit v1.2.3 From dbcc58147027db21beaafab4d3fdbc349a5a22a0 Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Wed, 13 Mar 2024 06:18:58 +0100 Subject: chore: fix applying review --- app/Review.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/app/Review.hs b/app/Review.hs index 3b7afbe..b1cd21b 100644 --- a/app/Review.hs +++ b/app/Review.hs @@ -187,7 +187,7 @@ commitReview plan patch = do withSystemTempDirectory "anissue" $ \tmp -> do when (not (null patch.fileDeltas)) do T.writeFile (tmp "review.patch") (renderAsText patch) - sh_ (proc "patch -p0 <%/review.patch" tmp) + sh_ (proc "patch -p1 <%/review.patch" tmp) T.writeFile (tmp "commit_editmsg") (commit_editmsg plan) sh_ (proc "git add %" (map (.fileDeltaDestFile) patch.fileDeltas)) sh_ (proc "git commit --allow-empty --template %/commit_editmsg" tmp) -- cgit v1.2.3 From 428e61e202fefe7941a78bd57f5e14d056a74702 Mon Sep 17 00:00:00 2001 From: Fabian Kirchner Date: Wed, 13 Mar 2024 14:22:05 +0100 Subject: fix: parse base branch argument --- app/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/app/Main.hs b/app/Main.hs index 5a21787..bed31c0 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -501,7 +501,7 @@ reviewCmd = baseBranchArg :: O.Parser T.Text baseBranchArg = - O.option O.auto $ + O.strOption $ O.long "base" <> O.short 'b' <> O.metavar "BRANCH" -- cgit v1.2.3 From e39c2a2d09fde36ba7c2b5d09a9a8987221d0f5a Mon Sep 17 00:00:00 2001 From: Fabian Kirchner Date: Wed, 13 Mar 2024 14:37:46 +0100 Subject: fix: strip b/ from destinations when committing review --- app/Review.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/app/Review.hs b/app/Review.hs index b1cd21b..37d9ee4 100644 --- a/app/Review.hs +++ b/app/Review.hs @@ -189,7 +189,7 @@ commitReview plan patch = do T.writeFile (tmp "review.patch") (renderAsText patch) sh_ (proc "patch -p1 <%/review.patch" tmp) T.writeFile (tmp "commit_editmsg") (commit_editmsg plan) - sh_ (proc "git add %" (map (.fileDeltaDestFile) patch.fileDeltas)) + sh_ (proc "git add %" (map (T.drop (T.length "b/") . (.fileDeltaDestFile)) patch.fileDeltas)) sh_ (proc "git commit --allow-empty --template %/commit_editmsg" tmp) commit_editmsg :: Plan -> T.Text -- cgit v1.2.3 From f2e36372b4e07993a4992ab29585d4876b28e094 Mon Sep 17 00:00:00 2001 From: Fabian Kirchner Date: Wed, 13 Mar 2024 14:38:13 +0100 Subject: review: approve feature/review Reviewed branch feature/review at commit 07aacbbe55f4793daa0c9893efe4a64951575081. --- app/Main.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/app/Main.hs b/app/Main.hs index bed31c0..2729511 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -516,6 +516,7 @@ perCommitArg :: O.Parser Bool perCommitArg = O.switch ( O.long "per-commit" +-- REVIEW Maybe a short variant would be nice, e.g. '-c'. <> O.help "Review commits individually. (Default: review combined patches)" ) -- cgit v1.2.3 From 2c107e71572888327496d327a36737c02f64d894 Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Thu, 14 Mar 2024 06:54:00 +0100 Subject: chore: refactor `Comment.Language.fromPath` --- app/Comment.hs | 11 ++--------- app/Comment/Language.hs | 8 ++++++-- 2 files changed, 8 insertions(+), 11 deletions(-) diff --git a/app/Comment.hs b/app/Comment.hs index 123acec..febd47e 100644 --- a/app/Comment.hs +++ b/app/Comment.hs @@ -50,15 +50,8 @@ data Point = Point getComments :: Git.CommitHash -> FilePath -> IO [Comment] getComments commitHash filePath = fmap mergeLineComments - . ( extractComments - filePath - ( -- TODO Support amiguous file languages - -- - -- @backlog - N.head language - ) - . LB.toStrict - ) + . extractComments filePath language + . LB.toStrict =<< catch (Git.readTextFileOfBS commitHash filePath) (\(_ :: E.CannotReadFile) -> pure "") diff --git a/app/Comment/Language.hs b/app/Comment/Language.hs index 7a9963f..3f8c7a4 100644 --- a/app/Comment/Language.hs +++ b/app/Comment/Language.hs @@ -25,9 +25,13 @@ newtype Language = Language {languageKey :: L.LanguageKey} deriving (Eq, Show, Generic) deriving newtype (Binary) -fromPath :: FilePath -> N.NonEmpty Language +-- TODO Support amiguous file languages +-- +-- @backlog +fromPath :: FilePath -> Language fromPath fp = - fromMaybe (throw $ E.UnknownFile fp) + N.head + . fromMaybe (throw $ E.UnknownFile fp) . N.nonEmpty . map (Language . L.languageName) $ L.languagesForPath fp -- cgit v1.2.3 From 1821aca5ef5451d0b1943c8640c5eb1f6fa7bbee Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Thu, 14 Mar 2024 06:52:32 +0100 Subject: chore: resolve TODOs --- app/Exception.hs | 8 ++++++++ app/Git.hs | 18 +++++++++++++++--- app/Review.hs | 30 ++++++++++++++++++------------ 3 files changed, 41 insertions(+), 15 deletions(-) diff --git a/app/Exception.hs b/app/Exception.hs index db7612b..6ac243b 100644 --- a/app/Exception.hs +++ b/app/Exception.hs @@ -8,6 +8,7 @@ module Exception InvalidIssue (..), CannotReadFile (..), UnsupportedLanguage (..), + NoAncestor (..), ) where @@ -16,6 +17,7 @@ import Control.Exception import Data.ByteString.Lazy.Char8 as LB import Data.Text qualified as T import Data.Void (Void) +import Git.CommitHash qualified as Git import System.Exit (ExitCode) import Text.Megaparsec qualified as P @@ -27,6 +29,7 @@ data AnyException | InvalidDiff' InvalidDiff | InvalidIssue' InvalidIssue | UnsupportedLanguage' UnsupportedLanguage + | NoAncestor' NoAncestor deriving (Show) instance Exception AnyException @@ -74,3 +77,8 @@ data UnsupportedLanguage = UnsupportedLanguage T.Text deriving (Show) instance Exception UnsupportedLanguage + +data NoAncestor = NoAncestor Git.CommitHash Git.CommitHash + deriving (Show) + +instance Exception NoAncestor diff --git a/app/Git.hs b/app/Git.hs index eae3a85..2e8fa82 100644 --- a/app/Git.hs +++ b/app/Git.hs @@ -31,7 +31,7 @@ import Exception qualified as E import GHC.Generics (Generic) import Git.CommitHash import Patch qualified as A -import Process (proc, sh) +import Process (proc, sh, sh_) import Text.Printf (printf) getCommitHashes :: IO (NonEmpty T.Text) @@ -96,6 +96,7 @@ readTextFileOfText = readTextFileOf LT.readFile LT.decodeUtf8 readTextFileOfBS :: CommitHash -> FilePath -> IO LB.ByteString readTextFileOfBS = readTextFileOf LB.readFile id + -- REVIEW Suggestion: we could use `id` instead of `\x -> x` -- -- REVIEW OK! @@ -118,9 +119,20 @@ resolveRef = . sh . proc "git rev-parse %" --- TODO Throw if `prevHash` is not an ancestor of `hash`. +-- | `getCommitsBetween prevCommit commit` returns the commits from `prevCommit` to `commit`. The result excludes `prevCommit`, but includes `commit`. +-- +-- If `prevCommit` is not an ancestor of `commit`, this functions throws `NoAncestor commit prevCommit`. getCommitsBetween :: CommitHash -> CommitHash -> IO [CommitHash] -getCommitsBetween (Commit prevHash) (Commit hash) = do +getCommitsBetween WorkingTree commit@(Commit _) = + throwIO (E.NoAncestor WorkingTree commit) +getCommitsBetween WorkingTree WorkingTree = pure [WorkingTree] +getCommitsBetween prevCommit WorkingTree = + fmap (++ [WorkingTree]) . getCommitsBetween prevCommit + =<< resolveRef "HEAD" +getCommitsBetween prevCommit@(Commit prevHash) commit@(Commit hash) = do + catch + (sh_ (proc "git merge-base --is-ancestor % %" prevHash hash)) + (\(_ :: E.ProcessException) -> throwIO (E.NoAncestor commit prevCommit)) map (Commit . T.strip) . T.lines . T.decodeUtf8 . LB.toStrict <$> sh (proc "git log --format=%%H %..%" prevHash hash) diff --git a/app/Review.hs b/app/Review.hs index 37d9ee4..721d8e3 100644 --- a/app/Review.hs +++ b/app/Review.hs @@ -7,6 +7,7 @@ module Review ) where +import Comment.Language qualified as L import Control.Monad (ap, forM, forM_, when) import Data.Binary qualified as B import Data.ByteString.Lazy qualified as LB @@ -116,11 +117,18 @@ reviewPatch commitMessages fileDeltas = addComments :: D.FileDeltas -> D.FileDeltas addComments = - map . mapContent . mapHunks . mapLines $ \line@(D.Line {..}) -> - if lineAnnotation == D.Comment - then -- TODO Haskell comment - D.Line D.Added ("-- REVIEW" <> lineContent) - else line + map + ( \fileDelta@(D.FileDelta {D.fileDeltaSourceFile}) -> + ( mapContent . mapHunks . mapLines $ + \line@(D.Line {..}) -> + if lineAnnotation == D.Comment + then + let language = L.fromPath (T.unpack fileDeltaSourceFile) + in D.Line D.Added (L.lineStart language <> " REVIEW" <> lineContent) + else line + ) + fileDelta + ) where mapContent f x = x {D.fileDeltaContent = f x.fileDeltaContent} mapHunks _ D.Binary = D.Binary @@ -155,12 +163,8 @@ separateReview commit fileDeltas fileDeltas' = patchFile = "a.patch" patchFile' = "b.patch" -withTempSourceFiles :: - Git.CommitHash -> - D.FileDeltas -> - (FilePath -> IO a) -> - IO a -withTempSourceFiles (Git.Commit hash) fileDeltas action = do +withTempSourceFiles :: Git.CommitHash -> D.FileDeltas -> (FilePath -> IO a) -> IO a +withTempSourceFiles commit fileDeltas action = do withSystemTempDirectory "anissue" $ \tmp -> do createDirectoryIfMissing False (tmp "a") createDirectoryIfMissing False (tmp "b") @@ -168,7 +172,9 @@ withTempSourceFiles (Git.Commit hash) fileDeltas action = do let sourceDir = takeDirectory sourceFile fileContents <- if sourceFile /= "/dev/null" - then sh (proc "git show %:%" hash sourceFile) + then case commit of + Git.Commit hash -> sh (proc "git show %:%" hash sourceFile) + Git.WorkingTree -> sh (proc "cat" sourceFile) else pure "" createDirectoryIfMissing True (tmp "a" sourceDir) LB.writeFile (tmp "a" sourceFile) fileContents -- cgit v1.2.3 From e0ffe3e85faf4a52fbacf56edc6067c44773a8b1 Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Thu, 14 Mar 2024 07:04:09 +0100 Subject: chore: add future review todos --- app/Main.hs | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/app/Main.hs b/app/Main.hs index 2729511..d49f627 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,3 +1,39 @@ +-- TODO Add `anissue review-comments` +-- +-- The command `review-comments` should list all review comments within the current review. +-- +-- @assigned aforemny +-- @priority medium +-- @topic review + +-- TODO `anissue review --base` should take own commits into account +-- +-- To facilitate reviewing, the `--base` parameter of `anissue review` should implement some heuristic to review a set of changes multiple times. +-- +-- The first time a review is performed, `--base` should default to the base branch. Any subsequent time, it should default to the last review commit added by myself. +-- +-- @assigned aforemny +-- @priority high +-- @topic review + +-- TODO Add `anissue merge` +-- +-- The command `anissue merge` should merge the currenlty checked out feature request, if there are no unresolved review comments. +-- +-- If there are unresolved review comments, it should fail with a warning. +-- +-- @assigned aforemny +-- @priority high +-- @topic review + +-- TODO Add `anissue request-review` +-- +-- The command `request-review` should create an empty commit, stating that a review is requested. It should mention the eventual "base branch" for inclusion of the feature. +-- +-- @assigned aforemny +-- @priority high +-- @topic review + -- TODO Compute history from the top -- -- Currently we are computing the history from the bottom (ie. earliest commit -- cgit v1.2.3 From 1ed90c7eb2e01dac6604608795d2c0756f1e9f4d Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Thu, 14 Mar 2024 07:04:16 +0100 Subject: chore: format Main.hs --- app/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/app/Main.hs b/app/Main.hs index d49f627..3bd8d82 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -552,7 +552,7 @@ perCommitArg :: O.Parser Bool perCommitArg = O.switch ( O.long "per-commit" --- REVIEW Maybe a short variant would be nice, e.g. '-c'. + -- REVIEW Maybe a short variant would be nice, e.g. '-c'. <> O.help "Review commits individually. (Default: review combined patches)" ) -- cgit v1.2.3 From 8dcace960b25813b00e5f77be25aa7db57851f79 Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Thu, 14 Mar 2024 07:06:48 +0100 Subject: review: request-changes feature/review --- app/Main.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/app/Main.hs b/app/Main.hs index 3bd8d82..c35d827 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -553,6 +553,10 @@ perCommitArg = O.switch ( O.long "per-commit" -- REVIEW Maybe a short variant would be nice, e.g. '-c'. + -- + -- REVIEW Sure!, but I don't want to block on this, and I don't think this warrants a tracking issue. + -- + -- RESOLVED <> O.help "Review commits individually. (Default: review combined patches)" ) -- cgit v1.2.3 From 09e26c37de7e7227d856ffe15c9554af36b50c58 Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Thu, 14 Mar 2024 07:07:28 +0100 Subject: review: request-changes feature/review --- app/Git.hs | 6 ------ app/Git/CommitHash.hs | 5 ----- app/Main.hs | 9 --------- 3 files changed, 20 deletions(-) diff --git a/app/Git.hs b/app/Git.hs index 2e8fa82..e195d1b 100644 --- a/app/Git.hs +++ b/app/Git.hs @@ -97,12 +97,6 @@ readTextFileOfText = readTextFileOf LT.readFile LT.decodeUtf8 readTextFileOfBS :: CommitHash -> FilePath -> IO LB.ByteString readTextFileOfBS = readTextFileOf LB.readFile id --- REVIEW Suggestion: we could use `id` instead of `\x -> x` --- --- REVIEW OK! --- --- RESOLVED - readTextFileOf :: (FilePath -> IO a) -> (LB.ByteString -> a) -> CommitHash -> FilePath -> IO a readTextFileOf readFile _ WorkingTree filePath = catch diff --git a/app/Git/CommitHash.hs b/app/Git/CommitHash.hs index 28aa738..0caecf4 100644 --- a/app/Git/CommitHash.hs +++ b/app/Git/CommitHash.hs @@ -27,11 +27,6 @@ toText (Commit hash) = Just hash toTextUnsafe :: CommitHash -> T.Text toTextUnsafe (Commit hash) = hash toTextUnsafe _ = error "toTextUnsafe: WorkingDir" --- ^ REVIEW Why is this unsafe? --- --- REVIEW Because it is a partial function. --- --- RESOLVED instance P.Render CommitHash where render = P.render . P.Detailed diff --git a/app/Main.hs b/app/Main.hs index c35d827..f9fedea 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -552,11 +552,6 @@ perCommitArg :: O.Parser Bool perCommitArg = O.switch ( O.long "per-commit" - -- REVIEW Maybe a short variant would be nice, e.g. '-c'. - -- - -- REVIEW Sure!, but I don't want to block on this, and I don't think this warrants a tracking issue. - -- - -- RESOLVED <> O.help "Review commits individually. (Default: review combined patches)" ) @@ -635,10 +630,6 @@ main = do plan <- R.formulatePlan perCommit baseBranch featureBranch R.commitReview plan . A.Patch . concat =<< mapM R.reviewStep (NE.toList plan.steps) - -- REVIEW Why is withReviewing in the Status module and not the Review - -- module? - -- - -- RESOLVED `Status` has been dropped in this commit Options {colorize, noPager, width, command = List {sort, filters, files, group = Just group, closed}} -> do ungroupedIssues <- I.applySorts sort -- cgit v1.2.3