From f92c593a3d2c4bdb023fdd834b6e8c874d063cc8 Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
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.
---
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 +++++++++++++++++
8 files changed, 482 insertions(+), 17 deletions(-)
create mode 100644 app/Data/List/NonEmpty/Zipper/Extra.hs
create mode 100644 app/Review.hs
create mode 100644 app/Status.hs
(limited to 'app')
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 <review.patch`)" :: T.Text)
+ deleteStatus fp
+ pure result
+
+continueReview :: ReviewingT IO ()
+continueReview = do
+ Just plan <- get
+ let step = Z.current plan.steps
+ tell
+ =<< liftIO
+ ( R.separateReview step.commit step.changes
+ =<< R.reviewPatch step.changes
+ )
+ case Z.right plan.steps of
+ Just steps' -> put $ Just $ plan {R.steps = steps'}
+ Nothing -> put Nothing
--
cgit v1.2.3
From a2f401ca9839b6041b7d94f77de4530f168b12ad Mon Sep 17 00:00:00 2001
From: Fabian Kirchner <kirchner@posteo.de>
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(+)
(limited to 'app')
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 <aforemny@posteo.de>
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(-)
(limited to 'app')
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 <aforemny@posteo.de>
Date: Wed, 13 Mar 2024 04:46:13 +0100
Subject: chore: drop `Status`
---
app/Main.hs | 40 +++++++++----------
app/Review.hs | 35 +++++++----------
app/Status.hs | 122 ----------------------------------------------------------
3 files changed, 32 insertions(+), 165 deletions(-)
delete mode 100644 app/Status.hs
(limited to 'app')
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 <review.patch`)" :: T.Text)
- deleteStatus fp
- pure result
-
-continueReview :: ReviewingT IO ()
-continueReview = do
- Just plan <- get
- let step = Z.current plan.steps
- tell
- =<< liftIO
- ( R.separateReview step.commit step.changes
- =<< R.reviewPatch step.changes
- )
- case Z.right plan.steps of
- Just steps' -> 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 <aforemny@posteo.de>
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(-)
(limited to 'app')
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 <aforemny@posteo.de>
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(-)
(limited to 'app')
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 <aforemny@posteo.de>
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(-)
(limited to 'app')
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 <aforemny@posteo.de>
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
(limited to 'app')
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 <aforemny@posteo.de>
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(-)
(limited to 'app')
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 <aforemny@posteo.de>
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(-)
(limited to 'app')
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 <kirchner@posteo.de>
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(-)
(limited to 'app')
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 <kirchner@posteo.de>
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(-)
(limited to 'app')
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 <kirchner@posteo.de>
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(+)
(limited to 'app')
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 <aforemny@posteo.de>
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(-)
(limited to 'app')
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 <aforemny@posteo.de>
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(-)
(limited to 'app')
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 <aforemny@posteo.de>
Date: Thu, 14 Mar 2024 07:04:09 +0100
Subject: chore: add future review todos
---
app/Main.hs | 36 ++++++++++++++++++++++++++++++++++++
1 file changed, 36 insertions(+)
(limited to 'app')
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 <aforemny@posteo.de>
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(-)
(limited to 'app')
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 <aforemny@posteo.de>
Date: Thu, 14 Mar 2024 07:06:48 +0100
Subject: review: request-changes feature/review
---
app/Main.hs | 4 ++++
1 file changed, 4 insertions(+)
(limited to 'app')
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 <aforemny@posteo.de>
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(-)
(limited to 'app')
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