wip: add `review` command

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

1 files changed, 122 insertions, 0 deletions

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