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. --- app/Review.hs | 232 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 232 insertions(+) create mode 100644 app/Review.hs (limited to 'app/Review.hs') 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 -- 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/Review.hs | 82 +++++------------------------------------------------------ 1 file changed, 6 insertions(+), 76 deletions(-) (limited to 'app/Review.hs') 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 -- 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` --- app/Review.hs | 35 +++++++++++++---------------------- 1 file changed, 13 insertions(+), 22 deletions(-) (limited to 'app/Review.hs') 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 = -- 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/Review.hs | 42 ++++++++++++++++++++++++++++++++++-------- 1 file changed, 34 insertions(+), 8 deletions(-) (limited to 'app/Review.hs') 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(-) (limited to 'app/Review.hs') 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/Review.hs | 36 +++++++++++++++++++++++++++++++++++- 1 file changed, 35 insertions(+), 1 deletion(-) (limited to 'app/Review.hs') 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 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(-) (limited to 'app/Review.hs') 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 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(-) (limited to 'app/Review.hs') 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 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/Review.hs | 30 ++++++++++++++++++------------ 1 file changed, 18 insertions(+), 12 deletions(-) (limited to 'app/Review.hs') 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