diff options
| -rw-r--r-- | anissue.cabal | 6 | ||||
| -rw-r--r-- | app/Comment.hs | 11 | ||||
| -rw-r--r-- | app/Comment/Language.hs | 8 | ||||
| -rw-r--r-- | app/Data/List/NonEmpty/Zipper/Extra.hs | 8 | ||||
| -rw-r--r-- | app/Exception.hs | 8 | ||||
| -rw-r--r-- | app/Extract.hs | 17 | ||||
| -rw-r--r-- | app/Git.hs | 36 | ||||
| -rw-r--r-- | app/Git/CommitHash.hs | 5 | ||||
| -rw-r--r-- | app/Main.hs | 82 | ||||
| -rw-r--r-- | app/Patch.hs | 29 | ||||
| -rw-r--r-- | app/Render.hs | 16 | ||||
| -rw-r--r-- | app/Review.hs | 219 | ||||
| -rw-r--r-- | default.nix | 8 | ||||
| -rw-r--r-- | diff-parse.patch | 39 | ||||
| -rw-r--r-- | nix/sources.json | 14 | ||||
| -rw-r--r-- | nix/sources.nix | 198 |
16 files changed, 656 insertions, 48 deletions
diff --git a/anissue.cabal b/anissue.cabal index 434f4b2..1d23cf3 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,6 +94,7 @@ executable anissue Patch Process Render + Review Settings Text.Diff.Extra TreeSitter @@ -206,7 +208,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 +222,8 @@ executable anissue generic-deriving, lingo, megaparsec, + mtl, + nonempty-zipper, optparse-applicative, parallel-io, prettyprinter, 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 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/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/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 @@ -8,6 +8,9 @@ module Git getCommitOf, readTextFileOfText, readTextFileOfBS, + resolveRef, + getCommitsBetween, + diffOf, ) where @@ -27,7 +30,8 @@ import Data.Time.Clock (UTCTime, getCurrentTime) import Exception qualified as E import GHC.Generics (Generic) import Git.CommitHash -import Process (proc, sh) +import Patch qualified as A +import Process (proc, sh, sh_) import Text.Printf (printf) getCommitHashes :: IO (NonEmpty T.Text) @@ -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 id readTextFileOf :: (FilePath -> IO a) -> (LB.ByteString -> a) -> CommitHash -> FilePath -> IO a readTextFileOf readFile _ WorkingTree filePath = @@ -102,3 +106,31 @@ 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 %" + +-- | `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 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) + +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..f9fedea 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 @@ -319,14 +355,17 @@ 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.List.NonEmpty qualified as NE import Data.Map qualified as M import Data.Maybe (fromMaybe) 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 (..)) @@ -338,9 +377,11 @@ 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 qualified as P +import Review qualified as R import Settings (Settings (..), readSettings) import System.Console.Terminal.Size qualified as Terminal import System.Exit (ExitCode (ExitFailure), exitWith) @@ -424,6 +465,11 @@ data Command | Open { id :: String } + | Review + { baseBranch :: T.Text, + featureBranch :: T.Text, + perCommit :: Bool + } | Search { pattern :: R.RE, closed :: Bool, @@ -444,6 +490,8 @@ 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 $ @@ -480,6 +528,33 @@ openCmd = Open <$> idArg +reviewCmd :: O.Parser Command +reviewCmd = + Review + <$> baseBranchArg + <*> featureBranchArg + <*> perCommitArg + +baseBranchArg :: O.Parser T.Text +baseBranchArg = + O.strOption $ + 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") + +perCommitArg :: O.Parser Bool +perCommitArg = + O.switch + ( O.long "per-commit" + <> O.help "Review commits individually. (Default: review combined patches)" + ) + showCmd :: O.Parser Command showCmd = Show @@ -548,6 +623,13 @@ main :: IO () main = do settings <- readSettings O.execParser (O.info (options <**> O.helper) O.idm) >>= \case + 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.." + plan <- R.formulatePlan perCommit baseBranch featureBranch + R.commitReview plan . A.Patch . concat + =<< mapM R.reviewStep (NE.toList plan.steps) 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..f170817 100644 --- a/app/Patch.hs +++ b/app/Patch.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DerivingStrategies #-} module Patch - ( Patch, + ( Patch (..), parse, ) where @@ -11,6 +11,7 @@ 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 () @@ -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..721d8e3 --- /dev/null +++ b/app/Review.hs @@ -0,0 +1,219 @@ +module Review + ( Plan (..), + PlanStep (..), + formulatePlan, + reviewStep, + commitReview, + ) +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 +import Data.Function ((&)) +import Data.List.NonEmpty qualified as NE +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 + +data Plan = Plan + { baseBranch :: BranchName, + featureBranch :: BranchName, + commit :: Git.CommitHash, + perCommit :: Bool, + steps :: NE.NonEmpty PlanStep + } + deriving (Show, Generic, B.Binary) + +type BranchName = T.Text + +data PlanStep = PlanStep + { commit :: Git.CommitHash, + earlierCommit :: Git.CommitHash, + changes :: D.FileDeltas + } + deriving (Show, Generic, B.Binary) + +formulatePlan :: Bool -> T.Text -> T.Text -> IO Plan +formulatePlan perCommit baseBranch featureBranch = do + baseCommit <- Git.resolveRef baseBranch + featureCommit <- Git.resolveRef featureBranch + + commits <- + if 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 ((commit, earlierCommit),) . (: []) . (.fileDeltas) + <$> Git.diffOf earlierCommit commit + + pure + Plan + { steps = + NE.fromList + ( map + ( \((commit, earlierCommit), changes) -> + PlanStep {..} + ) + fileDeltas + ), + commit = featureCommit, + .. + } + +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" + 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 = + 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 + 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 commit 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 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 + 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 + +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 -p1 <%/review.patch" tmp) + T.writeFile (tmp </> "commit_editmsg") (commit_editmsg plan) + 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 +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 <> "." + ] diff --git a/default.nix b/default.nix index 758626b..4caf76a 100644 --- a/default.nix +++ b/default.nix @@ -1,4 +1,4 @@ -{ pkgs ? import <nixpkgs> { +{ pkgs ? import (import ./nix/sources.nix).nixpkgs { overlays = [ (self: super: { tree-sitter = super.tree-sitter.overrideAttrs (oldAttrs: { @@ -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 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/<owner>/<repo>/archive/<rev>.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_<type> fetches specs of type <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 = <nixpkgs> == ./.; + in + if builtins.hasAttr "nixpkgs" sources + then sourcesNixpkgs + else if hasNixpkgsPath && ! hasThisAsNixpkgsPath then + import <nixpkgs> { } + else + abort + '' + Please specify either <nixpkgs> (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); } |