aboutsummaryrefslogtreecommitdiffstats
path: root/app/Status.hs
diff options
context:
space:
mode:
authorLibravatar Alexander Foremny <aforemny@posteo.de>2024-03-13 04:46:13 +0100
committerLibravatar Alexander Foremny <aforemny@posteo.de>2024-03-14 07:07:45 +0100
commitb9f4ee069228e80dda60bc10436693df0aee77ea (patch)
tree2e39d07d72b1349ab6c2d0ecf975d9329c6493c8 /app/Status.hs
parente7450765081e31341496a3f8ac91bda119b55f5a (diff)
chore: drop `Status`
Diffstat (limited to 'app/Status.hs')
-rw-r--r--app/Status.hs122
1 files changed, 0 insertions, 122 deletions
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