module Proteome.Filename where

import qualified Chronos
import qualified Data.Text as Text
import Exon (exon)
import Path (
  Abs,
  Dir,
  File,
  Path,
  Rel,
  addExtension,
  dirname,
  filename,
  parent,
  parseRelDir,
  reldir,
  relfile,
  splitExtension,
  (</>),
  )
import Path.IO (copyFile, doesDirExist, doesFileExist, ensureDir, removeFile)
import Ribosome (
  Bang (Bang),
  Handler,
  LogReport,
  Rpc,
  RpcError,
  logReport,
  mapReport,
  pathText,
  resumeReport,
  rpcError,
  )
import Ribosome.Api (bufferSetName, vimCallFunction, vimCommand, vimGetCurrentBuffer, wipeBuffer)
import Ribosome.Api.Buffer (currentBufferName, edit)
import Ribosome.Api.Path (nvimCwd)
import Ribosome.Data.PersistPathError (PersistPathError)
import Ribosome.Host.Modify (silent)
import Ribosome.Persist (PersistPath, persistPath)

import qualified Proteome.Data.FilenameError as FilenameError
import Proteome.Data.FilenameError (FilenameError)
import Proteome.Path (
  absoluteParse,
  absoluteParseDir,
  parseAbsDirMaybe,
  parseAbsFileMaybe,
  parseRelDirMaybe,
  parseRelFileMaybe,
  )

data BufPath =
  BufPath (Path Abs File) [Text]
  deriving stock (BufPath -> BufPath -> Bool
(BufPath -> BufPath -> Bool)
-> (BufPath -> BufPath -> Bool) -> Eq BufPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BufPath -> BufPath -> Bool
$c/= :: BufPath -> BufPath -> Bool
== :: BufPath -> BufPath -> Bool
$c== :: BufPath -> BufPath -> Bool
Eq, Int -> BufPath -> ShowS
[BufPath] -> ShowS
BufPath -> String
(Int -> BufPath -> ShowS)
-> (BufPath -> String) -> ([BufPath] -> ShowS) -> Show BufPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BufPath] -> ShowS
$cshowList :: [BufPath] -> ShowS
show :: BufPath -> String
$cshow :: BufPath -> String
showsPrec :: Int -> BufPath -> ShowS
$cshowsPrec :: Int -> BufPath -> ShowS
Show)

bufDir :: BufPath -> Path Abs Dir
bufDir :: BufPath -> Path Abs Dir
bufDir (BufPath Path Abs File
f [Text]
_) =
  Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
f

data NameSpec =
  Star (Path Rel File)
  |
  Literal (Path Rel File)
  deriving stock (NameSpec -> NameSpec -> Bool
(NameSpec -> NameSpec -> Bool)
-> (NameSpec -> NameSpec -> Bool) -> Eq NameSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameSpec -> NameSpec -> Bool
$c/= :: NameSpec -> NameSpec -> Bool
== :: NameSpec -> NameSpec -> Bool
$c== :: NameSpec -> NameSpec -> Bool
Eq, Int -> NameSpec -> ShowS
[NameSpec] -> ShowS
NameSpec -> String
(Int -> NameSpec -> ShowS)
-> (NameSpec -> String) -> ([NameSpec] -> ShowS) -> Show NameSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameSpec] -> ShowS
$cshowList :: [NameSpec] -> ShowS
show :: NameSpec -> String
$cshow :: NameSpec -> String
showsPrec :: Int -> NameSpec -> ShowS
$cshowsPrec :: Int -> NameSpec -> ShowS
Show)

rawNameSpec ::
  NameSpec ->
  Path Rel File
rawNameSpec :: NameSpec -> Path Rel File
rawNameSpec = \case
  Star Path Rel File
f -> Path Rel File
f
  Literal Path Rel File
f -> Path Rel File
f

data Modification =
  Filename (Path Rel File) (Path Rel Dir) NameSpec [Text]
  |
  Dir (Path Abs Dir)
  |
  File (Path Abs File)
  |
  Container Int (Path Rel Dir)
  deriving stock (Modification -> Modification -> Bool
(Modification -> Modification -> Bool)
-> (Modification -> Modification -> Bool) -> Eq Modification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Modification -> Modification -> Bool
$c/= :: Modification -> Modification -> Bool
== :: Modification -> Modification -> Bool
$c== :: Modification -> Modification -> Bool
Eq, Int -> Modification -> ShowS
[Modification] -> ShowS
Modification -> String
(Int -> Modification -> ShowS)
-> (Modification -> String)
-> ([Modification] -> ShowS)
-> Show Modification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Modification] -> ShowS
$cshowList :: [Modification] -> ShowS
show :: Modification -> String
$cshow :: Modification -> String
showsPrec :: Int -> Modification -> ShowS
$cshowsPrec :: Int -> Modification -> ShowS
Show)

nameSpec :: Path Rel File -> NameSpec
nameSpec :: Path Rel File -> NameSpec
nameSpec Path Rel File
p =
  if Path Rel File
p Path Rel File -> Path Rel File -> Bool
forall a. Eq a => a -> a -> Bool
== [relfile|*|] then Path Rel File -> NameSpec
Star Path Rel File
p else Path Rel File -> NameSpec
Literal Path Rel File
p

dotsInPath :: Text -> Int
dotsInPath :: Text -> Int
dotsInPath Text
path =
  Text -> Int
Text.length ((Char -> Bool) -> Text -> Text
Text.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (Int -> Text -> Text
Text.drop Int
1 Text
path))

absoluteDir :: Text -> Maybe Modification
absoluteDir :: Text -> Maybe Modification
absoluteDir =
  (Path Abs Dir -> Modification)
-> Maybe (Path Abs Dir) -> Maybe Modification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Path Abs Dir -> Modification
Dir (Maybe (Path Abs Dir) -> Maybe Modification)
-> (Text -> Maybe (Path Abs Dir)) -> Text -> Maybe Modification
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Path Abs Dir)
parseAbsDirMaybe

absoluteFile :: Text -> Maybe Modification
absoluteFile :: Text -> Maybe Modification
absoluteFile =
  (Path Abs File -> Modification)
-> Maybe (Path Abs File) -> Maybe Modification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Path Abs File -> Modification
File (Maybe (Path Abs File) -> Maybe Modification)
-> (Text -> Maybe (Path Abs File)) -> Text -> Maybe Modification
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Path Abs File)
parseAbsFileMaybe

relativeDir :: Path Abs Dir -> Text -> Maybe Modification
relativeDir :: Path Abs Dir -> Text -> Maybe Modification
relativeDir Path Abs Dir
cwd Text
spec = do
  Path Rel Dir
rel <- Text -> Maybe (Path Rel Dir)
parseRelDirMaybe Text
spec
  pure (Path Abs Dir -> Modification
Dir (Path Abs Dir
cwd Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
rel))

relativeFile :: Path Abs Dir -> Text -> Maybe Modification
relativeFile :: Path Abs Dir -> Text -> Maybe Modification
relativeFile Path Abs Dir
cwd Text
spec = do
  Path Rel File
rel <- Text -> Maybe (Path Rel File)
parseRelFileMaybe Text
spec
  pure (Path Abs File -> Modification
File (Path Abs Dir
cwd Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
rel))

splitExtensions :: Path b File -> (Path b File, [Text])
splitExtensions :: forall b. Path b File -> (Path b File, [Text])
splitExtensions =
  [Text] -> Path b File -> (Path b File, [Text])
forall {b}. [Text] -> Path b File -> (Path b File, [Text])
spin []
  where
    spin :: [Text] -> Path b File -> (Path b File, [Text])
spin [Text]
exts Path b File
f =
      case Path b File -> Maybe (Path b File, String)
forall (m :: * -> *) b.
MonadThrow m =>
Path b File -> m (Path b File, String)
splitExtension Path b File
f of
        Just (Path b File
f', String
e) -> [Text] -> Path b File -> (Path b File, [Text])
spin (String -> Text
forall a. ToText a => a -> Text
toText String
e Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
exts) Path b File
f'
        Maybe (Path b File, String)
Nothing -> (Path b File
f, [Text]
exts)

addExtensions ::
  Path b File ->
  [Text] ->
  Maybe (Path b File)
addExtensions :: forall b. Path b File -> [Text] -> Maybe (Path b File)
addExtensions Path b File
name [Text]
exts =
  (Path b File -> String -> Maybe (Path b File))
-> Path b File -> [String] -> Maybe (Path b File)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM ((String -> Path b File -> Maybe (Path b File))
-> Path b File -> String -> Maybe (Path b File)
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Path b File -> Maybe (Path b File)
forall (m :: * -> *) b.
MonadThrow m =>
String -> Path b File -> m (Path b File)
addExtension) Path b File
name (Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
exts)

nameOnly :: Text -> Maybe Modification
nameOnly :: Text -> Maybe Modification
nameOnly Text
spec = do
  Path Rel File
rel <- Text -> Maybe (Path Rel File)
parseRelFileMaybe Text
spec
  let (Path Rel File
name, [Text]
exts) = Path Rel File -> (Path Rel File, [Text])
forall b. Path b File -> (Path b File, [Text])
splitExtensions (Path Rel File -> Path Rel File
forall b. Path b File -> Path Rel File
filename Path Rel File
rel)
  Modification -> Maybe Modification
forall a. a -> Maybe a
Just (Path Rel File -> Path Rel Dir -> NameSpec -> [Text] -> Modification
Filename Path Rel File
rel (Path Rel File -> Path Rel Dir
forall b t. Path b t -> Path b Dir
parent Path Rel File
rel) (Path Rel File -> NameSpec
nameSpec Path Rel File
name) [Text]
exts)

maybeDir ::
  Member (Embed IO) r =>
  Path Abs Dir ->
  Text ->
  Sem r Bool
maybeDir :: forall (r :: EffectRow).
Member (Embed IO) r =>
Path Abs Dir -> Text -> Sem r Bool
maybeDir Path Abs Dir
cwd Text
spec =
  Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Sem r (Maybe Bool) -> Sem r Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Path Abs Dir -> Sem r Bool)
-> Maybe (Path Abs Dir) -> Sem r (Maybe Bool)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Path Abs Dir -> Sem r Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist (Path Abs Dir -> Text -> Maybe (Path Abs Dir)
absoluteParseDir Path Abs Dir
cwd Text
spec)

regularModification ::
  Members [Stop FilenameError, Embed IO] r =>
  Path Abs Dir ->
  Text ->
  Sem r Modification
regularModification :: forall (r :: EffectRow).
Members '[Stop FilenameError, Embed IO] r =>
Path Abs Dir -> Text -> Sem r Modification
regularModification Path Abs Dir
cwd Text
spec = do
  Bool
existingDir <- Path Abs Dir -> Text -> Sem r Bool
forall (r :: EffectRow).
Member (Embed IO) r =>
Path Abs Dir -> Text -> Sem r Bool
maybeDir Path Abs Dir
cwd Text
spec
  FilenameError -> Maybe Modification -> Sem r Modification
forall err (r :: EffectRow) a.
Member (Stop err) r =>
err -> Maybe a -> Sem r a
stopNote (Text -> FilenameError
FilenameError.InvalidPathSpec Text
spec) (Bool -> Text -> Maybe Modification
cons Bool
existingDir Text
spec)
  where
    cons :: Bool -> Text -> Maybe Modification
cons Bool
existingDir
      | Bool
name = Text -> Maybe Modification
nameOnly
      | Bool
absolute = if Bool
explicitDir Bool -> Bool -> Bool
|| Bool
existingDir then Text -> Maybe Modification
absoluteDir else Text -> Maybe Modification
absoluteFile
      | Bool
explicitDir = Path Abs Dir -> Text -> Maybe Modification
relativeDir Path Abs Dir
cwd
      | Bool
otherwise = Path Abs Dir -> Text -> Maybe Modification
relativeFile Path Abs Dir
cwd
    name :: Bool
name =
      Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
Text.any (Char
'/' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
spec)
    absolute :: Bool
absolute =
      Int -> Text -> Text
Text.take Int
1 Text
spec Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"/"
    explicitDir :: Bool
explicitDir =
      Int -> Text -> Text
Text.takeEnd Int
1 Text
spec Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"/"

directorySelector :: Text -> (Int, Text)
directorySelector :: Text -> (Int, Text)
directorySelector =
  (Text -> Int) -> (Text, Text) -> (Int, Text)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> Int
Text.length ((Text, Text) -> (Int, Text))
-> (Text -> (Text, Text)) -> Text -> (Int, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> (Text, Text)
Text.span (Char
'^' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==)

modification ::
  Members [Stop FilenameError, Embed IO] r =>
  Bool ->
  Path Abs Dir ->
  Text ->
  Sem r Modification
modification :: forall (r :: EffectRow).
Members '[Stop FilenameError, Embed IO] r =>
Bool -> Path Abs Dir -> Text -> Sem r Modification
modification Bool
raw Path Abs Dir
cwd (Text -> Text
Text.strip -> Text
spec) =
  case Text -> (Int, Text)
directorySelector Text
spec of
    (Int
n, Text
_) | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Bool
raw ->
      Path Abs Dir -> Text -> Sem r Modification
forall (r :: EffectRow).
Members '[Stop FilenameError, Embed IO] r =>
Path Abs Dir -> Text -> Sem r Modification
regularModification Path Abs Dir
cwd Text
spec
    (Int
n, Text
name) -> do
      Path Rel Dir
dir <- FilenameError -> Maybe (Path Rel Dir) -> Sem r (Path Rel Dir)
forall err (r :: EffectRow) a.
Member (Stop err) r =>
err -> Maybe a -> Sem r a
stopNote (Text -> FilenameError
FilenameError.InvalidPathSpec Text
name) (String -> Maybe (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir (Text -> String
forall a. ToString a => a -> String
toString Text
name))
      pure (Int -> Path Rel Dir -> Modification
Container Int
n Path Rel Dir
dir)

checkBufferPath ::
  Members [Rpc, Stop FilenameError, Embed IO] r =>
  Path Abs Dir ->
  Sem r (Path Abs File)
checkBufferPath :: forall (r :: EffectRow).
Members '[Rpc, Stop FilenameError, Embed IO] r =>
Path Abs Dir -> Sem r (Path Abs File)
checkBufferPath Path Abs Dir
cwd = do
  Text
name <- Sem r Text
forall (m :: * -> *). MonadRpc m => m Text
currentBufferName
  Path Abs File
path <- FilenameError -> Maybe (Path Abs File) -> Sem r (Path Abs File)
forall err (r :: EffectRow) a.
Member (Stop err) r =>
err -> Maybe a -> Sem r a
stopNote FilenameError
FilenameError.BufferPathInvalid (Path Abs Dir -> Text -> Maybe (Path Abs File)
absoluteParse Path Abs Dir
cwd Text
name)
  Sem r Bool
-> Sem r (Path Abs File)
-> Sem r (Path Abs File)
-> Sem r (Path Abs File)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Path Abs File -> Sem r Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
path) (Path Abs File -> Sem r (Path Abs File)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs File
path) (FilenameError -> Sem r (Path Abs File)
forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop FilenameError
FilenameError.BufferPathInvalid)

withExtension ::
  BufPath ->
  [Text] ->
  NameSpec ->
  Maybe (Path Rel File)
withExtension :: BufPath -> [Text] -> NameSpec -> Maybe (Path Rel File)
withExtension (BufPath Path Abs File
bufName [Text]
bufExts) [Text]
exts = \case
  Star Path Rel File
_ ->
    Path Rel File -> [Text] -> Maybe (Path Rel File)
forall b. Path b File -> [Text] -> Maybe (Path b File)
addExtensions (Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename Path Abs File
bufName) (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
bufExts Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
exts) [Text]
bufExts [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
exts)
  Literal Path Rel File
name ->
    Path Rel File -> [Text] -> Maybe (Path Rel File)
forall b. Path b File -> [Text] -> Maybe (Path b File)
addExtensions Path Rel File
name ([Text]
exts [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
exts) [Text]
bufExts)

renameInplace ::
  Member (Stop FilenameError) r =>
  Bool ->
  Path Rel File ->
  BufPath ->
  Path Rel Dir ->
  NameSpec ->
  [Text] ->
  Sem r (Path Abs File)
renameInplace :: forall (r :: EffectRow).
Member (Stop FilenameError) r =>
Bool
-> Path Rel File
-> BufPath
-> Path Rel Dir
-> NameSpec
-> [Text]
-> Sem r (Path Abs File)
renameInplace Bool
raw Path Rel File
spec BufPath
bufPath Path Rel Dir
destDir NameSpec
newName [Text]
exts = do
  Path Rel File
rel <-
    if Bool
raw
    then Path Rel File -> Sem r (Path Rel File)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Rel Dir
destDir Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
spec)
    else FilenameError -> Maybe (Path Rel File) -> Sem r (Path Rel File)
forall err (r :: EffectRow) a.
Member (Stop err) r =>
err -> Maybe a -> Sem r a
stopNote FilenameError
FilenameError.BufferPathInvalid (BufPath -> [Text] -> NameSpec -> Maybe (Path Rel File)
withExtension BufPath
bufPath [Text]
exts NameSpec
newName)
  pure (BufPath -> Path Abs Dir
bufDir BufPath
bufPath Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
rel)

replaceDir ::
  Member (Stop FilenameError) r =>
  Int ->
  Path Rel Dir ->
  Path Abs File ->
  Sem r (Path Abs File)
replaceDir :: forall (r :: EffectRow).
Member (Stop FilenameError) r =>
Int -> Path Rel Dir -> Path Abs File -> Sem r (Path Abs File)
replaceDir Int
index Path Rel Dir
name Path Abs File
file = do
  Path Abs Dir
dir <- Path Abs Dir -> Int -> Sem r (Path Abs Dir)
spin (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
file) Int
index
  pure (Path Abs Dir
dir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename Path Abs File
file)
  where
    spin :: Path Abs Dir -> Int -> Sem r (Path Abs Dir)
spin Path Abs Dir
d Int
_ | Path Abs Dir -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs Dir
d Path Abs Dir -> Path Abs Dir -> Bool
forall a. Eq a => a -> a -> Bool
== Path Abs Dir
d =
      FilenameError -> Sem r (Path Abs Dir)
forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop (Text -> FilenameError
FilenameError.InvalidPathSpec Text
"not enough directory segments in buffer path")
    spin Path Abs Dir
d Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 =
      Path Abs Dir -> Sem r (Path Abs Dir)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs Dir -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs Dir
d Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
name)
    spin Path Abs Dir
d Int
i = do
      Path Abs Dir
sub <- Path Abs Dir -> Int -> Sem r (Path Abs Dir)
spin (Path Abs Dir -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs Dir
d) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      pure (Path Abs Dir
sub Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Abs Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
dirname Path Abs Dir
d)

assemblePath ::
  Member (Stop FilenameError) r =>
  Bool ->
  Path Abs File ->
  Modification ->
  Sem r (Path Abs File)
assemblePath :: forall (r :: EffectRow).
Member (Stop FilenameError) r =>
Bool -> Path Abs File -> Modification -> Sem r (Path Abs File)
assemblePath Bool
raw Path Abs File
bufPath = \case
  Filename Path Rel File
rawSpec Path Rel Dir
destDir NameSpec
newName [Text]
exts ->
    Bool
-> Path Rel File
-> BufPath
-> Path Rel Dir
-> NameSpec
-> [Text]
-> Sem r (Path Abs File)
forall (r :: EffectRow).
Member (Stop FilenameError) r =>
Bool
-> Path Rel File
-> BufPath
-> Path Rel Dir
-> NameSpec
-> [Text]
-> Sem r (Path Abs File)
renameInplace Bool
raw Path Rel File
rawSpec ((Path Abs File -> [Text] -> BufPath)
-> (Path Abs File, [Text]) -> BufPath
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Path Abs File -> [Text] -> BufPath
BufPath (Path Abs File -> (Path Abs File, [Text])
forall b. Path b File -> (Path b File, [Text])
splitExtensions Path Abs File
bufPath)) Path Rel Dir
destDir NameSpec
newName [Text]
exts
  Dir Path Abs Dir
dir ->
    Path Abs File -> Sem r (Path Abs File)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs Dir
dir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename Path Abs File
bufPath)
  File Path Abs File
file ->
    Path Abs File -> Sem r (Path Abs File)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs File
file
  Container Int
index Path Rel Dir
name ->
    Int -> Path Rel Dir -> Path Abs File -> Sem r (Path Abs File)
forall (r :: EffectRow).
Member (Stop FilenameError) r =>
Int -> Path Rel Dir -> Path Abs File -> Sem r (Path Abs File)
replaceDir Int
index Path Rel Dir
name Path Abs File
bufPath

ensureDestinationEmpty ::
  Members [Stop FilenameError, Embed IO] r =>
  Path Abs File ->
  Sem r ()
ensureDestinationEmpty :: forall (r :: EffectRow).
Members '[Stop FilenameError, Embed IO] r =>
Path Abs File -> Sem r ()
ensureDestinationEmpty Path Abs File
path =
  Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Path Abs File -> Sem r Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
path) (FilenameError -> Sem r ()
forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop (Text -> FilenameError
FilenameError.Exists (Path Abs File -> Text
forall b t. Path b t -> Text
pathText Path Abs File
path)))

prepareDestination ::
  Members [Stop FilenameError, Embed IO] r =>
  Path Abs File ->
  Sem r ()
prepareDestination :: forall (r :: EffectRow).
Members '[Stop FilenameError, Embed IO] r =>
Path Abs File -> Sem r ()
prepareDestination Path Abs File
path =
  Sem r Bool -> Sem r () -> Sem r () -> Sem r ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM Sem r Bool
exists (Path Abs File -> Sem r ()
forall (r :: EffectRow).
Members '[Stop FilenameError, Embed IO] r =>
Path Abs File -> Sem r ()
ensureDestinationEmpty Path Abs File
path) Sem r ()
create
  where
    exists :: Sem r Bool
exists =
      Path Abs Dir -> Sem r Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist Path Abs Dir
dir
    create :: Sem r ()
create =
      (Text -> FilenameError) -> IO () -> Sem r ()
forall e (r :: EffectRow) a.
Members '[Stop e, Embed IO] r =>
(Text -> e) -> IO a -> Sem r a
stopTryAny (FilenameError -> Text -> FilenameError
forall a b. a -> b -> a
const (Text -> FilenameError
FilenameError.CreateDir (Path Abs Dir -> Text
forall b t. Path b t -> Text
pathText Path Abs Dir
dir))) (Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir Path Abs Dir
dir)
    dir :: Path Abs Dir
dir =
      Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
path

getCwd ::
  Members [Stop FilenameError, Rpc !! RpcError] r =>
  Sem r (Path Abs Dir)
getCwd :: forall (r :: EffectRow).
Members '[Stop FilenameError, Rpc !! RpcError] r =>
Sem r (Path Abs Dir)
getCwd =
  FilenameError -> InterpreterFor Rpc r
forall err (eff :: (* -> *) -> * -> *) err' (r :: EffectRow).
Members '[Resumable err eff, Stop err'] r =>
err' -> InterpreterFor eff r
resumeHoistAs FilenameError
FilenameError.BadCwd Sem (Rpc : r) (Path Abs Dir)
forall (m :: * -> *). MonadRpc m => m (Path Abs Dir)
nvimCwd

smartModification ::
  Members [Stop FilenameError, Rpc !! RpcError, Embed IO] r =>
  Bool ->
  Text ->
  Sem r Modification
smartModification :: forall (r :: EffectRow).
Members '[Stop FilenameError, Rpc !! RpcError, Embed IO] r =>
Bool -> Text -> Sem r Modification
smartModification Bool
raw Text
spec = do
  Path Abs Dir
cwd <- Sem r (Path Abs Dir)
forall (r :: EffectRow).
Members '[Stop FilenameError, Rpc !! RpcError] r =>
Sem r (Path Abs Dir)
getCwd
  Bool -> Path Abs Dir -> Text -> Sem r Modification
forall (r :: EffectRow).
Members '[Stop FilenameError, Embed IO] r =>
Bool -> Path Abs Dir -> Text -> Sem r Modification
modification Bool
raw Path Abs Dir
cwd Text
spec

trashModification ::
  Members [Stop FilenameError, Rpc, Rpc !! RpcError, PersistPath, Embed IO] r =>
  Sem r Modification
trashModification :: forall (r :: EffectRow).
Members
  '[Stop FilenameError, Rpc, Rpc !! RpcError, PersistPath, Embed IO]
  r =>
Sem r Modification
trashModification = do
  Path Abs Dir
cwd <- Sem r (Path Abs Dir)
forall (r :: EffectRow).
Members '[Stop FilenameError, Rpc !! RpcError] r =>
Sem r (Path Abs Dir)
getCwd
  Path Abs File
bufPath <- Path Abs Dir -> Sem r (Path Abs File)
forall (r :: EffectRow).
Members '[Rpc, Stop FilenameError, Embed IO] r =>
Path Abs Dir -> Sem r (Path Abs File)
checkBufferPath Path Abs Dir
cwd
  let original :: Text
original = Path Rel File -> Text
forall b t. Path b t -> Text
pathText (Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename Path Abs File
bufPath)
  Chronos.Time Int64
stamp <- IO Time -> Sem r Time
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Time
Chronos.now
  Path Rel File
trashFile <- FilenameError -> Maybe (Path Rel File) -> Sem r (Path Rel File)
forall err (r :: EffectRow) a.
Member (Stop err) r =>
err -> Maybe a -> Sem r a
stopNote FilenameError
FilenameError.BufferPathInvalid (Text -> Maybe (Path Rel File)
parseRelFileMaybe [exon|#{show stamp}_#{original}|])
  Path Abs Dir
trashDir <- Maybe (Path Rel Dir) -> Sem r (Path Abs Dir)
forall (r :: EffectRow).
Member PersistPath r =>
Maybe (Path Rel Dir) -> Sem r (Path Abs Dir)
persistPath (Path Rel Dir -> Maybe (Path Rel Dir)
forall a. a -> Maybe a
Just [reldir|trash|])
  let trashPath :: Path Abs File
trashPath = Path Abs Dir
trashDir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
trashFile
  (Text -> FilenameError) -> IO () -> Sem r ()
forall e (r :: EffectRow) a.
Members '[Stop e, Embed IO] r =>
(Text -> e) -> IO a -> Sem r a
stopTryAny (FilenameError -> Text -> FilenameError
forall a b. a -> b -> a
const (Text -> FilenameError
FilenameError.CreateDir (Path Abs Dir -> Text
forall b t. Path b t -> Text
pathText Path Abs Dir
trashDir))) (Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir Path Abs Dir
trashDir)
  pure (Path Abs File -> Modification
File Path Abs File
trashPath)

pathsForMod ::
  Members [Stop FilenameError, Rpc, Rpc !! RpcError, Embed IO] r =>
  Bool ->
  Modification ->
  Sem r (Path Abs File, Path Abs File)
pathsForMod :: forall (r :: EffectRow).
Members '[Stop FilenameError, Rpc, Rpc !! RpcError, Embed IO] r =>
Bool -> Modification -> Sem r (Path Abs File, Path Abs File)
pathsForMod Bool
raw Modification
modi = do
  Path Abs Dir
cwd <- Sem r (Path Abs Dir)
forall (r :: EffectRow).
Members '[Stop FilenameError, Rpc !! RpcError] r =>
Sem r (Path Abs Dir)
getCwd
  Path Abs File
bufPath <- Path Abs Dir -> Sem r (Path Abs File)
forall (r :: EffectRow).
Members '[Rpc, Stop FilenameError, Embed IO] r =>
Path Abs Dir -> Sem r (Path Abs File)
checkBufferPath Path Abs Dir
cwd
  Path Abs File
path <- Bool -> Path Abs File -> Modification -> Sem r (Path Abs File)
forall (r :: EffectRow).
Member (Stop FilenameError) r =>
Bool -> Path Abs File -> Modification -> Sem r (Path Abs File)
assemblePath Bool
raw Path Abs File
bufPath Modification
modi
  Path Abs File -> Sem r ()
forall (r :: EffectRow).
Members '[Stop FilenameError, Embed IO] r =>
Path Abs File -> Sem r ()
prepareDestination Path Abs File
path
  pure (Path Abs File
bufPath, Path Abs File
path)

writeBuffer ::
  Members [Stop FilenameError, Rpc !! RpcError] r =>
  Text ->
  Sem r ()
writeBuffer :: forall (r :: EffectRow).
Members '[Stop FilenameError, Rpc !! RpcError] r =>
Text -> Sem r ()
writeBuffer Text
action =
  Text -> Sem (Rpc : r) () -> Sem r ()
err Text
"Couldn't write buffer" (Sem (Rpc : r) () -> Sem r ()) -> Sem (Rpc : r) () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Sem (Rpc : r) () -> Sem (Rpc : r) ()
forall (r :: EffectRow) a. Member Rpc r => Sem r a -> Sem r a
silent do
    Text -> Sem (Rpc : r) ()
forall (m :: * -> *). MonadRpc m => Text -> m ()
vimCommand Text
"write!"
  where
    err :: Text -> Sem (Rpc : r) () -> Sem r ()
err Text
msg =
      (RpcError -> FilenameError) -> Sem (Rpc : r) () -> Sem r ()
forall err (eff :: (* -> *) -> * -> *) err' (r :: EffectRow) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist \ RpcError
e -> Text -> Text -> FilenameError
FilenameError.ActionFailed Text
action [exon|#{msg}: #{rpcError e}|]

updateBuffer ::
  Member Rpc r =>
  Path Abs File ->
  Sem r ()
updateBuffer :: forall (r :: EffectRow). Member Rpc r => Path Abs File -> Sem r ()
updateBuffer Path Abs File
path = do
  Buffer
buf <- Sem r Buffer
forall (m :: * -> *). MonadRpc m => m Buffer
vimGetCurrentBuffer
  Buffer -> Text -> Sem r ()
forall (m :: * -> *). MonadRpc m => Buffer -> Text -> m ()
bufferSetName Buffer
buf (Path Abs File -> Text
forall b t. Path b t -> Text
pathText Path Abs File
path)
  Sem r () -> Sem r ()
forall (r :: EffectRow) a. Member Rpc r => Sem r a -> Sem r a
silent do
    Text -> Sem r ()
forall (m :: * -> *). MonadRpc m => Text -> m ()
vimCommand Text
"write!"

relocate ::
  Members [Stop FilenameError, Rpc, Rpc !! RpcError, Embed IO] r =>
  Bool ->
  Modification ->
  (Path Abs File -> Path Abs File -> Sem r ()) ->
  Sem r ()
relocate :: forall (r :: EffectRow).
Members '[Stop FilenameError, Rpc, Rpc !! RpcError, Embed IO] r =>
Bool
-> Modification
-> (Path Abs File -> Path Abs File -> Sem r ())
-> Sem r ()
relocate Bool
raw Modification
modi Path Abs File -> Path Abs File -> Sem r ()
run = do
  (Path Abs File
bufPath, Path Abs File
destPath) <- Bool -> Modification -> Sem r (Path Abs File, Path Abs File)
forall (r :: EffectRow).
Members '[Stop FilenameError, Rpc, Rpc !! RpcError, Embed IO] r =>
Bool -> Modification -> Sem r (Path Abs File, Path Abs File)
pathsForMod Bool
raw Modification
modi
  Path Abs File -> Path Abs File -> Sem r ()
run Path Abs File
bufPath Path Abs File
destPath

copyOrFail ::
  Members [Stop FilenameError, Embed IO] r =>
  Path Abs File ->
  Path Abs File ->
  Sem r ()
copyOrFail :: forall (r :: EffectRow).
Members '[Stop FilenameError, Embed IO] r =>
Path Abs File -> Path Abs File -> Sem r ()
copyOrFail Path Abs File
src Path Abs File
dest =
  (Text -> FilenameError) -> Either Text () -> Sem r ()
forall err' (r :: EffectRow) err a.
Member (Stop err') r =>
(err -> err') -> Either err a -> Sem r a
stopEitherWith Text -> FilenameError
copyFailed (Either Text () -> Sem r ()) -> Sem r (Either Text ()) -> Sem r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO () -> Sem r (Either Text ())
forall (r :: EffectRow) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryAny (Path Abs File -> Path Abs File -> IO ()
forall (m :: * -> *) b0 b1.
MonadIO m =>
Path b0 File -> Path b1 File -> m ()
copyFile Path Abs File
src Path Abs File
dest)
  where
    copyFailed :: Text -> FilenameError
copyFailed Text
e =
      Text -> Text -> FilenameError
FilenameError.ActionFailed Text
"move" [exon|Couldn't copy file: #{e}|]

moveFile ::
  Members [Stop FilenameError, DataLog LogReport, Embed IO] r =>
  Path Abs File ->
  Path Abs File ->
  Sem r ()
moveFile :: forall (r :: EffectRow).
Members '[Stop FilenameError, DataLog LogReport, Embed IO] r =>
Path Abs File -> Path Abs File -> Sem r ()
moveFile Path Abs File
src Path Abs File
dest = do
  Path Abs File -> Path Abs File -> Sem r ()
forall (r :: EffectRow).
Members '[Stop FilenameError, Embed IO] r =>
Path Abs File -> Path Abs File -> Sem r ()
copyOrFail Path Abs File
src Path Abs File
dest
  (Text -> Sem r ()) -> Either Text () -> Sem r ()
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
leftA (FilenameError -> Sem r ()
forall e (r :: EffectRow).
(Reportable e, Member (DataLog LogReport) r) =>
e -> Sem r ()
logReport (FilenameError -> Sem r ())
-> (Text -> FilenameError) -> Text -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilenameError
FilenameError.Remove) (Either Text () -> Sem r ()) -> Sem r (Either Text ()) -> Sem r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO () -> Sem r (Either Text ())
forall (r :: EffectRow) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryAny (Path Abs File -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b File -> m ()
removeFile Path Abs File
src)

move ::
  Members [Stop FilenameError, DataLog LogReport, Rpc, Rpc !! RpcError, Embed IO] r =>
  Bool ->
  Modification ->
  Sem r ()
move :: forall (r :: EffectRow).
Members
  '[Stop FilenameError, DataLog LogReport, Rpc, Rpc !! RpcError,
    Embed IO]
  r =>
Bool -> Modification -> Sem r ()
move Bool
raw Modification
modi = do
  Bool
-> Modification
-> (Path Abs File -> Path Abs File -> Sem r ())
-> Sem r ()
forall (r :: EffectRow).
Members '[Stop FilenameError, Rpc, Rpc !! RpcError, Embed IO] r =>
Bool
-> Modification
-> (Path Abs File -> Path Abs File -> Sem r ())
-> Sem r ()
relocate Bool
raw Modification
modi \ Path Abs File
buf Path Abs File
dest -> do
    Text -> Sem r ()
forall (r :: EffectRow).
Members '[Stop FilenameError, Rpc !! RpcError] r =>
Text -> Sem r ()
writeBuffer Text
"move"
    Path Abs File -> Path Abs File -> Sem r ()
forall (r :: EffectRow).
Members '[Stop FilenameError, DataLog LogReport, Embed IO] r =>
Path Abs File -> Path Abs File -> Sem r ()
moveFile Path Abs File
buf Path Abs File
dest
    Path Abs File -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Path Abs File -> Sem r ()
updateBuffer Path Abs File
dest

copy ::
  Members [Stop FilenameError, Rpc, Rpc !! RpcError, Embed IO] r =>
  Bool ->
  Modification ->
  Sem r ()
copy :: forall (r :: EffectRow).
Members '[Stop FilenameError, Rpc, Rpc !! RpcError, Embed IO] r =>
Bool -> Modification -> Sem r ()
copy Bool
raw Modification
modi =
  Bool
-> Modification
-> (Path Abs File -> Path Abs File -> Sem r ())
-> Sem r ()
forall (r :: EffectRow).
Members '[Stop FilenameError, Rpc, Rpc !! RpcError, Embed IO] r =>
Bool
-> Modification
-> (Path Abs File -> Path Abs File -> Sem r ())
-> Sem r ()
relocate Bool
raw Modification
modi \ Path Abs File
src Path Abs File
dest -> do
    Path Abs File -> Path Abs File -> Sem r ()
forall (r :: EffectRow).
Members '[Stop FilenameError, Embed IO] r =>
Path Abs File -> Path Abs File -> Sem r ()
copyOrFail Path Abs File
src Path Abs File
dest
    Object
view <- Text -> [Object] -> Sem r Object
forall a (m :: * -> *).
(MonadRpc m, MsgpackDecode a) =>
Text -> [Object] -> m a
vimCallFunction Text
"winsaveview" []
    Path Abs File -> Sem r ()
forall (r :: EffectRow) b t. Member Rpc r => Path b t -> Sem r ()
edit Path Abs File
dest
    Text -> [Object] -> Sem r ()
forall a (m :: * -> *).
(MonadRpc m, MsgpackDecode a) =>
Text -> [Object] -> m a
vimCallFunction Text
"winrestview" [Item [Object]
Object
view]

proMove ::
  Members [DataLog LogReport, Rpc !! RpcError, Embed IO] r =>
  Bang ->
  Text ->
  Handler r ()
proMove :: forall (r :: EffectRow).
Members '[DataLog LogReport, Rpc !! RpcError, Embed IO] r =>
Bang -> Text -> Handler r ()
proMove Bang
bang Text
spec =
  forall e (r :: EffectRow) a.
(Reportable e, Member (Stop Report) r) =>
Sem (Stop e : r) a -> Sem r a
mapReport @FilenameError (Sem (Stop FilenameError : Stop Report : r) ()
 -> Sem (Stop Report : r) ())
-> Sem (Stop FilenameError : Stop Report : r) ()
-> Sem (Stop Report : r) ()
forall a b. (a -> b) -> a -> b
$ forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow) a.
(Reportable e, Members '[eff !! e, Stop Report] r) =>
Sem (eff : r) a -> Sem r a
resumeReport @Rpc do
    Bool
-> Modification
-> Sem (Rpc : Stop FilenameError : Stop Report : r) ()
forall (r :: EffectRow).
Members
  '[Stop FilenameError, DataLog LogReport, Rpc, Rpc !! RpcError,
    Embed IO]
  r =>
Bool -> Modification -> Sem r ()
move Bool
raw (Modification
 -> Sem (Rpc : Stop FilenameError : Stop Report : r) ())
-> Sem (Rpc : Stop FilenameError : Stop Report : r) Modification
-> Sem (Rpc : Stop FilenameError : Stop Report : r) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool
-> Text
-> Sem (Rpc : Stop FilenameError : Stop Report : r) Modification
forall (r :: EffectRow).
Members '[Stop FilenameError, Rpc !! RpcError, Embed IO] r =>
Bool -> Text -> Sem r Modification
smartModification Bool
raw Text
spec
  where
    raw :: Bool
raw =
      Bang
bang Bang -> Bang -> Bool
forall a. Eq a => a -> a -> Bool
== Bang
Bang

proCopy ::
  Members [Rpc !! RpcError, Embed IO] r =>
  Bang ->
  Text ->
  Handler r ()
proCopy :: forall (r :: EffectRow).
Members '[Rpc !! RpcError, Embed IO] r =>
Bang -> Text -> Handler r ()
proCopy Bang
bang Text
spec =
  forall e (r :: EffectRow) a.
(Reportable e, Member (Stop Report) r) =>
Sem (Stop e : r) a -> Sem r a
mapReport @FilenameError (Sem (Stop FilenameError : Stop Report : r) ()
 -> Sem (Stop Report : r) ())
-> Sem (Stop FilenameError : Stop Report : r) ()
-> Sem (Stop Report : r) ()
forall a b. (a -> b) -> a -> b
$ forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow) a.
(Reportable e, Members '[eff !! e, Stop Report] r) =>
Sem (eff : r) a -> Sem r a
resumeReport @Rpc do
    Bool
-> Modification
-> Sem (Rpc : Stop FilenameError : Stop Report : r) ()
forall (r :: EffectRow).
Members '[Stop FilenameError, Rpc, Rpc !! RpcError, Embed IO] r =>
Bool -> Modification -> Sem r ()
copy Bool
raw (Modification
 -> Sem (Rpc : Stop FilenameError : Stop Report : r) ())
-> Sem (Rpc : Stop FilenameError : Stop Report : r) Modification
-> Sem (Rpc : Stop FilenameError : Stop Report : r) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool
-> Text
-> Sem (Rpc : Stop FilenameError : Stop Report : r) Modification
forall (r :: EffectRow).
Members '[Stop FilenameError, Rpc !! RpcError, Embed IO] r =>
Bool -> Text -> Sem r Modification
smartModification Bool
raw Text
spec
  where
    raw :: Bool
raw =
      Bang
bang Bang -> Bang -> Bool
forall a. Eq a => a -> a -> Bool
== Bang
Bang

proRemove ::
  Members [Rpc !! RpcError, PersistPath !! PersistPathError, DataLog LogReport, Embed IO] r =>
  Handler r ()
proRemove :: forall (r :: EffectRow).
Members
  '[Rpc !! RpcError, PersistPath !! PersistPathError,
    DataLog LogReport, Embed IO]
  r =>
Handler r ()
proRemove =
  forall e (r :: EffectRow) a.
(Reportable e, Member (Stop Report) r) =>
Sem (Stop e : r) a -> Sem r a
mapReport @FilenameError (Sem (Stop FilenameError : Stop Report : r) ()
 -> Sem (Stop Report : r) ())
-> Sem (Stop FilenameError : Stop Report : r) ()
-> Sem (Stop Report : r) ()
forall a b. (a -> b) -> a -> b
$ forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow) a.
(Reportable e, Members '[eff !! e, Stop Report] r) =>
Sem (eff : r) a -> Sem r a
resumeReport @Rpc (Sem (Rpc : Stop FilenameError : Stop Report : r) ()
 -> Sem (Stop FilenameError : Stop Report : r) ())
-> Sem (Rpc : Stop FilenameError : Stop Report : r) ()
-> Sem (Stop FilenameError : Stop Report : r) ()
forall a b. (a -> b) -> a -> b
$ forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow) a.
(Reportable e, Members '[eff !! e, Stop Report] r) =>
Sem (eff : r) a -> Sem r a
resumeReport @PersistPath do
    Bool
-> Modification
-> Sem
     (PersistPath : Rpc : Stop FilenameError : Stop Report : r) ()
forall (r :: EffectRow).
Members
  '[Stop FilenameError, DataLog LogReport, Rpc, Rpc !! RpcError,
    Embed IO]
  r =>
Bool -> Modification -> Sem r ()
move Bool
False (Modification
 -> Sem
      (PersistPath : Rpc : Stop FilenameError : Stop Report : r) ())
-> Sem
     (PersistPath : Rpc : Stop FilenameError : Stop Report : r)
     Modification
-> Sem
     (PersistPath : Rpc : Stop FilenameError : Stop Report : r) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem
  (PersistPath : Rpc : Stop FilenameError : Stop Report : r)
  Modification
forall (r :: EffectRow).
Members
  '[Stop FilenameError, Rpc, Rpc !! RpcError, PersistPath, Embed IO]
  r =>
Sem r Modification
trashModification
    Buffer
buf <- Sem
  (PersistPath : Rpc : Stop FilenameError : Stop Report : r) Buffer
forall (m :: * -> *). MonadRpc m => m Buffer
vimGetCurrentBuffer
    forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
Member (Resumable err eff) r =>
Sem (eff : r) () -> Sem r ()
resume_ @RpcError do
      Buffer
-> Sem
     (Rpc : PersistPath : Rpc : Stop FilenameError : Stop Report : r) ()
forall (m :: * -> *). MonadRpc m => Buffer -> m ()
wipeBuffer Buffer
buf