wip: add `review` command

Prototype of the `review` command, cf. `anissue review -h`. Also adds
the `status` command.

1 files changed, 232 insertions, 0 deletions

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