1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
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
|
