module Proteome.Grep.Replace where

import qualified Data.List.NonEmpty as NonEmpty (toList)
import qualified Data.Text as Text
import Path (parseAbsFile)
import Prelude hiding (group)
import Ribosome (
  Buffer,
  Handler,
  Rpc,
  RpcError,
  Scratch,
  ScratchId (ScratchId),
  ScratchState (ScratchState),
  mapReport,
  pathText,
  resumeReport,
  toMsgpack,
  )
import Ribosome.Api (bufferGetLines, bufferSetLines, bufferSetOption, nvimCommand, vimCallFunction)
import Ribosome.Api.Autocmd (bufferAutocmd)
import Ribosome.Api.Buffer (addBuffer, bufferContent, bufferForFile, wipeBuffer)
import Ribosome.Api.Option (withOption)
import Ribosome.Data.FileBuffer (FileBuffer (FileBuffer))
import qualified Ribosome.Data.FloatOptions as FloatBorder
import Ribosome.Data.FloatOptions (FloatOptions (FloatOptions))
import Ribosome.Host.Data.RpcType (group)
import qualified Ribosome.Scratch as Scratch

import qualified Proteome.Data.Env as Env (replace)
import Proteome.Data.Env (Env)
import qualified Proteome.Data.GrepOutputLine as GrepOutputLine
import Proteome.Data.GrepOutputLine (GrepOutputLine (GrepOutputLine))
import Proteome.Data.Replace (Replace (Replace))
import qualified Proteome.Data.ReplaceError as ReplaceError (ReplaceError (BadReplacement, CouldntLoadBuffer))
import Proteome.Data.ReplaceError (ReplaceError)

scratchName :: Text
scratchName :: Text
scratchName =
  Text
"proteome-replace"

replaceBuffer ::
  Members [Scratch, Rpc, AtomicState Env] r =>
  NonEmpty GrepOutputLine ->
  Sem r ()
replaceBuffer :: forall (r :: EffectRow).
Members '[Scratch, Rpc, AtomicState Env] r =>
NonEmpty GrepOutputLine -> Sem r ()
replaceBuffer NonEmpty GrepOutputLine
lines' = do
  ScratchState
scratch <- NonEmpty Text -> ScratchOptions -> Sem r ScratchState
forall (r :: EffectRow) (t :: * -> *).
(Member Scratch r, Foldable t) =>
t Text -> ScratchOptions -> Sem r ScratchState
Scratch.show NonEmpty Text
content ScratchOptions
options
  let buffer :: Buffer
buffer = ScratchState -> Buffer
Scratch.buffer ScratchState
scratch
  Buffer -> Text -> Text -> Sem r ()
forall p_2 (m :: * -> *).
(MonadRpc m, MsgpackEncode p_2) =>
Buffer -> Text -> p_2 -> m ()
bufferSetOption Buffer
buffer Text
"buftype" (Text
"acwrite" :: Text)
  Buffer
-> AutocmdEvents -> AutocmdOptions -> Text -> Sem r AutocmdId
forall (r :: EffectRow).
Member Rpc r =>
Buffer
-> AutocmdEvents -> AutocmdOptions -> Text -> Sem r AutocmdId
bufferAutocmd Buffer
buffer AutocmdEvents
"BufWriteCmd" AutocmdOptions
forall a. Default a => a
def { $sel:group:AutocmdOptions :: Maybe AutocmdGroup
group = AutocmdGroup -> Maybe AutocmdGroup
forall a. a -> Maybe a
Just AutocmdGroup
"ProteomeReplace" } Text
"silent! ProReplaceSave"
  Buffer
-> AutocmdEvents -> AutocmdOptions -> Text -> Sem r AutocmdId
forall (r :: EffectRow).
Member Rpc r =>
Buffer
-> AutocmdEvents -> AutocmdOptions -> Text -> Sem r AutocmdId
bufferAutocmd Buffer
buffer AutocmdEvents
"BufUnload" AutocmdOptions
forall a. Default a => a
def { $sel:group:AutocmdOptions :: Maybe AutocmdGroup
group = AutocmdGroup -> Maybe AutocmdGroup
forall a. a -> Maybe a
Just AutocmdGroup
"ProteomeReplace" } Text
"silent! ProReplaceQuit"
  (Env -> Env) -> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' (IsLabel "replace" (ASetter Env Env (Maybe Replace) (Maybe Replace))
ASetter Env Env (Maybe Replace) (Maybe Replace)
#replace ASetter Env Env (Maybe Replace) (Maybe Replace)
-> Replace -> Env -> Env
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ScratchState -> NonEmpty GrepOutputLine -> Replace
Replace ScratchState
scratch NonEmpty GrepOutputLine
lines')
  where
    content :: NonEmpty Text
content =
      GrepOutputLine -> Text
GrepOutputLine.content (GrepOutputLine -> Text)
-> NonEmpty GrepOutputLine -> NonEmpty Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty GrepOutputLine
lines'
    options :: ScratchOptions
options =
      ScratchOptions
forall a. Default a => a
def {
        $sel:name:ScratchOptions :: ScratchId
Scratch.name = Text -> ScratchId
ScratchId Text
scratchName,
        $sel:modify:ScratchOptions :: Bool
Scratch.modify = Bool
True,
        $sel:focus:ScratchOptions :: Bool
Scratch.focus = Bool
True,
        $sel:filetype:ScratchOptions :: Maybe Text
Scratch.filetype = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
scratchName
      }

-- If the deleted line was surrounded by blank lines or buffer edges, there will be extraneous whitespace.
-- First check whether the line number of the deleted line was line 0 and its content is now empty.
-- Then do the same for the last line.
-- Finally, check if both the preceding and current line are empty.
deleteExtraBlankLine ::
  Member Rpc r =>
  Buffer ->
  Int ->
  Sem r ()
deleteExtraBlankLine :: forall (r :: EffectRow). Member Rpc r => Buffer -> Int -> Sem r ()
deleteExtraBlankLine Buffer
buffer Int
line = do
  Int -> Int -> [Text] -> Sem r ()
check (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int
line [Item [Text]
""]
  Int -> Int -> [Text] -> Sem r ()
check Int
line (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Item [Text]
""]
  Int -> Int -> [Text] -> Sem r ()
check (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
line [Item [Text]
"", Item [Text]
""]
  where
    check :: Int -> Int -> [Text] -> Sem r ()
check Int
l Int
r [Text]
target = do
      [Text]
content <- Int -> Int -> Sem r [Text]
readLines Int
l (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Text]
content [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text]
target) Sem r ()
delete
    readLines :: Int -> Int -> Sem r [Text]
readLines Int
l Int
r =
      Buffer -> Int -> Int -> Bool -> Sem r [Text]
forall (m :: * -> *).
MonadRpc m =>
Buffer -> Int -> Int -> Bool -> m [Text]
bufferGetLines Buffer
buffer (Int -> Int
forall {p}. (Ord p, Num p) => p -> p
clamp0 Int
l) Int
r Bool
False
    delete :: Sem r ()
delete =
      Buffer -> Int -> Int -> Bool -> [Text] -> Sem r ()
forall (m :: * -> *).
MonadRpc m =>
Buffer -> Int -> Int -> Bool -> [Text] -> m ()
bufferSetLines Buffer
buffer Int
line (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Bool
False []
    clamp0 :: p -> p
clamp0 p
a | p
a p -> p -> Bool
forall a. Ord a => a -> a -> Bool
< p
0 = p
0
    clamp0 p
a = p
a

fileBuffer ::
  Member Rpc r =>
  Text ->
  Sem r (Maybe FileBuffer)
fileBuffer :: forall (r :: EffectRow).
Member Rpc r =>
Text -> Sem r (Maybe FileBuffer)
fileBuffer Text
path =
  Maybe (Maybe FileBuffer) -> Maybe FileBuffer
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe FileBuffer) -> Maybe FileBuffer)
-> Sem r (Maybe (Maybe FileBuffer)) -> Sem r (Maybe FileBuffer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Path Abs File -> Sem r (Maybe FileBuffer))
-> Maybe (Path Abs File) -> Sem r (Maybe (Maybe FileBuffer))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Path Abs File -> Sem r (Maybe FileBuffer)
forall (m :: * -> *).
MonadRpc m =>
Path Abs File -> m (Maybe FileBuffer)
bufferForFile (FilePath -> Maybe (Path Abs File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs File)
parseAbsFile (Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
path))

replaceLine ::
  Members [Rpc, Stop ReplaceError] r =>
  Text ->
  GrepOutputLine ->
  Sem r (Maybe Buffer)
replaceLine :: forall (r :: EffectRow).
Members '[Rpc, Stop ReplaceError] r =>
Text -> GrepOutputLine -> Sem r (Maybe Buffer)
replaceLine Text
updatedLine (GrepOutputLine Path Abs File
path Int
line Maybe Int
_ Text
_) = do
  Bool
exists <- Maybe FileBuffer -> Bool
forall a. Maybe a -> Bool
isJust (Maybe FileBuffer -> Bool)
-> Sem r (Maybe FileBuffer) -> Sem r Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Abs File -> Sem r (Maybe FileBuffer)
forall (m :: * -> *).
MonadRpc m =>
Path Abs File -> m (Maybe FileBuffer)
bufferForFile Path Abs File
path
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (Text -> Sem r ()
forall (m :: * -> *). MonadRpc m => Text -> m ()
addBuffer (Path Abs File -> Text
forall b t. Path b t -> Text
pathText Path Abs File
path))
  () <- Text -> [Object] -> Sem r ()
forall a (m :: * -> *).
(MonadRpc m, MsgpackDecode a) =>
Text -> [Object] -> m a
vimCallFunction Text
"bufload" [Path Abs File -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Path Abs File
path]
  FileBuffer Buffer
buffer Path Abs File
_ <- ReplaceError -> Maybe FileBuffer -> Sem r FileBuffer
forall err (r :: EffectRow) a.
Member (Stop err) r =>
err -> Maybe a -> Sem r a
stopNote (Path Abs File -> ReplaceError
ReplaceError.CouldntLoadBuffer Path Abs File
path) (Maybe FileBuffer -> Sem r FileBuffer)
-> Sem r (Maybe FileBuffer) -> Sem r FileBuffer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Path Abs File -> Sem r (Maybe FileBuffer)
forall (m :: * -> *).
MonadRpc m =>
Path Abs File -> m (Maybe FileBuffer)
bufferForFile Path Abs File
path
  Buffer -> Int -> Int -> Bool -> [Text] -> Sem r ()
forall (m :: * -> *).
MonadRpc m =>
Buffer -> Int -> Int -> Bool -> [Text] -> m ()
bufferSetLines Buffer
buffer Int
line (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Bool
False [Text]
replacement
  Buffer -> Int -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Buffer -> Int -> Sem r ()
deleteExtraBlankLine Buffer
buffer Int
line
  pure (Maybe Buffer -> Maybe Buffer -> Bool -> Maybe Buffer
forall a. a -> a -> Bool -> a
bool (Buffer -> Maybe Buffer
forall a. a -> Maybe a
Just Buffer
buffer) Maybe Buffer
forall a. Maybe a
Nothing Bool
exists)
  where
    replacement :: [Text]
replacement =
      [Text
updatedLine | Bool -> Bool
not (Text -> Bool
Text.null Text
updatedLine)]

lineNumberDesc :: (Text, GrepOutputLine) -> Int
lineNumberDesc :: (Text, GrepOutputLine) -> Int
lineNumberDesc (Text
_, GrepOutputLine Path Abs File
_ Int
number Maybe Int
_ Text
_) =
  -Int
number

replaceFloatOptions :: FloatOptions
replaceFloatOptions :: FloatOptions
replaceFloatOptions =
  FloatRelative
-> Int
-> Int
-> Int
-> Int
-> Bool
-> FloatAnchor
-> Maybe (Int, Int)
-> FloatBorder
-> Bool
-> Bool
-> Maybe FloatStyle
-> Maybe FloatZindex
-> FloatOptions
FloatOptions FloatRelative
forall a. Default a => a
def Int
1 Int
1 Int
0 Int
0 Bool
False FloatAnchor
forall a. Default a => a
def Maybe (Int, Int)
forall a. Maybe a
Nothing FloatBorder
FloatBorder.None Bool
True Bool
False (FloatStyle -> Maybe FloatStyle
forall a. a -> Maybe a
Just FloatStyle
forall a. Default a => a
def) (FloatZindex -> Maybe FloatZindex
forall a. a -> Maybe a
Just FloatZindex
1)

withReplaceEnv ::
  Members [Rpc !! RpcError, Rpc, Resource] r =>
  Sem r [Maybe Buffer] ->
  Sem r ()
withReplaceEnv :: forall (r :: EffectRow).
Members '[Rpc !! RpcError, Rpc, Resource] r =>
Sem r [Maybe Buffer] -> Sem r ()
withReplaceEnv Sem r [Maybe Buffer]
run = do
  Text -> Bool -> Sem r () -> Sem r ()
forall a (r :: EffectRow) b.
(Members '[Rpc, Resource] r, MsgpackEncode a) =>
Text -> a -> Sem r b -> Sem r b
withOption Text
"hidden" Bool
True do
    [Maybe Buffer]
transient <- Sem r [Maybe Buffer]
run
    Sem (Rpc : r) () -> Sem r ()
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
Member (Resumable err eff) r =>
Sem (eff : r) () -> Sem r ()
resume_ (Text -> Sem (Rpc : r) ()
forall (m :: * -> *). MonadRpc m => Text -> m ()
nvimCommand Text
"noautocmd wall")
    (Buffer -> Sem r ()) -> [Buffer] -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Buffer -> Sem r ()
forall (m :: * -> *). MonadRpc m => Buffer -> m ()
wipeBuffer ([Maybe Buffer] -> [Buffer]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Buffer]
transient)

replaceLines ::
  Members [Rpc !! RpcError, Rpc, Resource, Stop ReplaceError] r =>
  Buffer ->
  [(Text, GrepOutputLine)] ->
  Sem r ()
replaceLines :: forall (r :: EffectRow).
Members '[Rpc !! RpcError, Rpc, Resource, Stop ReplaceError] r =>
Buffer -> [(Text, GrepOutputLine)] -> Sem r ()
replaceLines Buffer
scratchBuffer [(Text, GrepOutputLine)]
lines' = do
  Buffer -> Text -> Text -> Sem r ()
forall p_2 (m :: * -> *).
(MonadRpc m, MsgpackEncode p_2) =>
Buffer -> Text -> p_2 -> m ()
bufferSetOption Buffer
scratchBuffer Text
"buftype" (Text
"nofile" :: Text)
  Sem r [Maybe Buffer] -> Sem r ()
forall (r :: EffectRow).
Members '[Rpc !! RpcError, Rpc, Resource] r =>
Sem r [Maybe Buffer] -> Sem r ()
withReplaceEnv do
    ((Text, GrepOutputLine) -> Sem r (Maybe Buffer))
-> [(Text, GrepOutputLine)] -> Sem r [Maybe Buffer]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Text -> GrepOutputLine -> Sem r (Maybe Buffer))
-> (Text, GrepOutputLine) -> Sem r (Maybe Buffer)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> GrepOutputLine -> Sem r (Maybe Buffer)
forall (r :: EffectRow).
Members '[Rpc, Stop ReplaceError] r =>
Text -> GrepOutputLine -> Sem r (Maybe Buffer)
replaceLine) (((Text, GrepOutputLine) -> Int)
-> [(Text, GrepOutputLine)] -> [(Text, GrepOutputLine)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text, GrepOutputLine) -> Int
lineNumberDesc [(Text, GrepOutputLine)]
lines')
  Buffer -> Text -> Text -> Sem r ()
forall p_2 (m :: * -> *).
(MonadRpc m, MsgpackEncode p_2) =>
Buffer -> Text -> p_2 -> m ()
bufferSetOption Buffer
scratchBuffer Text
"buftype" (Text
"acwrite" :: Text)
  Buffer -> Text -> Bool -> Sem r ()
forall p_2 (m :: * -> *).
(MonadRpc m, MsgpackEncode p_2) =>
Buffer -> Text -> p_2 -> m ()
bufferSetOption Buffer
scratchBuffer Text
"modified" Bool
False

deleteLines ::
  Members [Rpc !! RpcError, Rpc, Resource, Stop ReplaceError] r =>
  [GrepOutputLine] ->
  Sem r ()
deleteLines :: forall (r :: EffectRow).
Members '[Rpc !! RpcError, Rpc, Resource, Stop ReplaceError] r =>
[GrepOutputLine] -> Sem r ()
deleteLines [GrepOutputLine]
lines' =
  Sem r [Maybe Buffer] -> Sem r ()
forall (r :: EffectRow).
Members '[Rpc !! RpcError, Rpc, Resource] r =>
Sem r [Maybe Buffer] -> Sem r ()
withReplaceEnv do
    ((Text, GrepOutputLine) -> Sem r (Maybe Buffer))
-> [(Text, GrepOutputLine)] -> Sem r [Maybe Buffer]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Text -> GrepOutputLine -> Sem r (Maybe Buffer))
-> (Text, GrepOutputLine) -> Sem r (Maybe Buffer)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> GrepOutputLine -> Sem r (Maybe Buffer)
forall (r :: EffectRow).
Members '[Rpc, Stop ReplaceError] r =>
Text -> GrepOutputLine -> Sem r (Maybe Buffer)
replaceLine) (((Text, GrepOutputLine) -> Int)
-> [(Text, GrepOutputLine)] -> [(Text, GrepOutputLine)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text, GrepOutputLine) -> Int
lineNumberDesc ([Text] -> [GrepOutputLine] -> [(Text, GrepOutputLine)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Text -> [Text]
forall a. a -> [a]
repeat Text
"") [GrepOutputLine]
lines'))

replaceSave ::
  Members [Rpc !! RpcError, Rpc, Resource, Stop ReplaceError] r =>
  Replace ->
  Sem r ()
replaceSave :: forall (r :: EffectRow).
Members '[Rpc !! RpcError, Rpc, Resource, Stop ReplaceError] r =>
Replace -> Sem r ()
replaceSave (Replace (ScratchState ScratchId
_ ScratchOptions
_ Buffer
buffer Window
_ Window
_ Maybe Tabpage
_ AutocmdId
_) NonEmpty GrepOutputLine
lines') = do
  [Text]
updatedLines <- Buffer -> Sem r [Text]
forall (m :: * -> *). MonadRpc m => Buffer -> m [Text]
bufferContent Buffer
buffer
  if [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
updatedLines Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= NonEmpty GrepOutputLine -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty GrepOutputLine
lines'
  then Sem r ()
forall {a}. Sem r a
badReplacement
  else Buffer -> [(Text, GrepOutputLine)] -> Sem r ()
forall (r :: EffectRow).
Members '[Rpc !! RpcError, Rpc, Resource, Stop ReplaceError] r =>
Buffer -> [(Text, GrepOutputLine)] -> Sem r ()
replaceLines Buffer
buffer ([Text] -> [GrepOutputLine] -> [(Text, GrepOutputLine)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
updatedLines (NonEmpty GrepOutputLine -> [GrepOutputLine]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty GrepOutputLine
lines'))
  where
    badReplacement :: Sem r a
badReplacement =
      ReplaceError -> Sem r a
forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop ReplaceError
ReplaceError.BadReplacement

-- TODO quit after saving, controlled by setting
proReplaceSave ::
  Members [AtomicState Env, Rpc !! RpcError, Resource] r =>
  Handler r ()
proReplaceSave :: forall (r :: EffectRow).
Members '[AtomicState Env, Rpc !! RpcError, Resource] r =>
Handler r ()
proReplaceSave =
  Sem (Rpc : Stop Report : r) () -> Sem (Stop Report : r) ()
forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow) a.
(Reportable e, Members '[eff !! e, Stop Report] r) =>
Sem (eff : r) a -> Sem r a
resumeReport (Sem (Rpc : Stop Report : r) () -> Sem (Stop Report : r) ())
-> Sem (Rpc : Stop Report : r) () -> Sem (Stop Report : r) ()
forall a b. (a -> b) -> a -> b
$ Sem (Stop ReplaceError : Rpc : Stop Report : r) ()
-> Sem (Rpc : Stop Report : r) ()
forall e (r :: EffectRow) a.
(Reportable e, Member (Stop Report) r) =>
Sem (Stop e : r) a -> Sem r a
mapReport do
    (Replace -> Sem (Stop ReplaceError : Rpc : Stop Report : r) ())
-> Maybe Replace
-> Sem (Stop ReplaceError : Rpc : Stop Report : r) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Replace -> Sem (Stop ReplaceError : Rpc : Stop Report : r) ()
forall (r :: EffectRow).
Members '[Rpc !! RpcError, Rpc, Resource, Stop ReplaceError] r =>
Replace -> Sem r ()
replaceSave (Maybe Replace
 -> Sem (Stop ReplaceError : Rpc : Stop Report : r) ())
-> Sem (Stop ReplaceError : Rpc : Stop Report : r) (Maybe Replace)
-> Sem (Stop ReplaceError : Rpc : Stop Report : r) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Env -> Maybe Replace)
-> Sem (Stop ReplaceError : Rpc : Stop Report : r) (Maybe Replace)
forall s s' (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s') -> Sem r s'
atomicGets Env -> Maybe Replace
Env.replace

proReplaceQuit ::
  Member (AtomicState Env) r =>
  Handler r ()
proReplaceQuit :: forall (r :: EffectRow). Member (AtomicState Env) r => Handler r ()
proReplaceQuit =
  (Env -> Env) -> Sem (Stop Report : r) ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' (IsLabel "replace" (ASetter Env Env (Maybe Replace) (Maybe Replace))
ASetter Env Env (Maybe Replace) (Maybe Replace)
#replace ASetter Env Env (Maybe Replace) (Maybe Replace)
-> Maybe Replace -> Env -> Env
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Replace
forall a. Maybe a
Nothing)