{-# 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