-- |API function for file system paths.
module Ribosome.Api.Path where

import Exon (exon)
import Path (Abs, Dir, File, Path, SomeBase (Abs, Rel), parseSomeDir, parseSomeFile, (</>))

import Ribosome.Host.Api.Effect (nvimCommand, vimCallFunction)
import Ribosome.Host.Data.Report (Report)
import Ribosome.Host.Effect.Rpc (Rpc)
import Ribosome.Internal.Path (failInvalidPath)
import Ribosome.Host.Path (pathText)

-- |Get Neovim's current working directory.
nvimCwd ::
  Member Rpc r =>
  Sem r (Path Abs Dir)
nvimCwd :: forall (r :: EffectRow). Member Rpc r => Sem r (Path Abs Dir)
nvimCwd =
  Text -> [Object] -> Sem r (Path Abs Dir)
forall a (r :: EffectRow).
(Member Rpc r, MsgpackDecode a) =>
Text -> [Object] -> Sem r a
vimCallFunction Text
"getcwd" []

-- |Set Neovim's current working directory.
nvimSetCwd ::
  Member Rpc r =>
  Path Abs Dir ->
  Sem r ()
nvimSetCwd :: forall (r :: EffectRow). Member Rpc r => Path Abs Dir -> Sem r ()
nvimSetCwd Path Abs Dir
dir =
  Text -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Text -> Sem r ()
nvimCommand [exon|cd #{pathText dir}|]

-- |Convert an abstract path to an absolute one, using Neovim's current working directory as the base for relative
-- paths.
nvimRelativePath ::
  Member Rpc r =>
  SomeBase t ->
  Sem r (Path Abs t)
nvimRelativePath :: forall (r :: EffectRow) t.
Member Rpc r =>
SomeBase t -> Sem r (Path Abs t)
nvimRelativePath = \case
  Abs Path Abs t
p ->
    Path Abs t -> Sem r (Path Abs t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs t
p
  Rel Path Rel t
p -> do
    Path Abs Dir
cwd <- Sem r (Path Abs Dir)
forall (r :: EffectRow). Member Rpc r => Sem r (Path Abs Dir)
nvimCwd
    pure (Path Abs Dir
cwd Path Abs Dir -> Path Rel t -> Path Abs t
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel t
p)

-- |Parse a directory path and prepend Neovim's current working directory to it if it's relative.
parseNvimDir ::
  Member Rpc r =>
  Text ->
  Sem r (Maybe (Path Abs Dir))
parseNvimDir :: forall (r :: EffectRow).
Member Rpc r =>
Text -> Sem r (Maybe (Path Abs Dir))
parseNvimDir Text
"" =
  Path Abs Dir -> Maybe (Path Abs Dir)
forall a. a -> Maybe a
Just (Path Abs Dir -> Maybe (Path Abs Dir))
-> Sem r (Path Abs Dir) -> Sem r (Maybe (Path Abs Dir))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r (Path Abs Dir)
forall (r :: EffectRow). Member Rpc r => Sem r (Path Abs Dir)
nvimCwd
parseNvimDir Text
p =
  (SomeBase Dir -> Sem r (Path Abs Dir))
-> Maybe (SomeBase Dir) -> Sem r (Maybe (Path Abs Dir))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SomeBase Dir -> Sem r (Path Abs Dir)
forall (r :: EffectRow) t.
Member Rpc r =>
SomeBase t -> Sem r (Path Abs t)
nvimRelativePath (String -> Maybe (SomeBase Dir)
forall (m :: * -> *). MonadThrow m => String -> m (SomeBase Dir)
parseSomeDir (Text -> String
forall a. ToString a => a -> String
toString Text
p))

-- |Parse a file path and prepend Neovim's current working directory to it if it's relative.
parseNvimFile ::
  Member Rpc r =>
  Text ->
  Sem r (Maybe (Path Abs File))
parseNvimFile :: forall (r :: EffectRow).
Member Rpc r =>
Text -> Sem r (Maybe (Path Abs File))
parseNvimFile =
  (SomeBase File -> Sem r (Path Abs File))
-> Maybe (SomeBase File) -> Sem r (Maybe (Path Abs File))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SomeBase File -> Sem r (Path Abs File)
forall (r :: EffectRow) t.
Member Rpc r =>
SomeBase t -> Sem r (Path Abs t)
nvimRelativePath (Maybe (SomeBase File) -> Sem r (Maybe (Path Abs File)))
-> (Text -> Maybe (SomeBase File))
-> Text
-> Sem r (Maybe (Path Abs File))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe (SomeBase File)
forall (m :: * -> *). MonadThrow m => String -> m (SomeBase File)
parseSomeFile (String -> Maybe (SomeBase File))
-> (Text -> String) -> Text -> Maybe (SomeBase File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString

-- |Parse a directory path and prepend Neovim's current working directory to it if it's relative.
--
-- If parsing fails, emit an error 'Report'.
nvimDir ::
  Members [Rpc, Stop Report] r =>
  Text ->
  Sem r (Path Abs Dir)
nvimDir :: forall (r :: EffectRow).
Members '[Rpc, Stop Report] r =>
Text -> Sem r (Path Abs Dir)
nvimDir Text
spec =
  Text -> Maybe (Path Abs Dir) -> Sem r (Path Abs Dir)
forall (r :: EffectRow) a.
Member (Stop Report) r =>
Text -> Maybe a -> Sem r a
failInvalidPath Text
spec (Maybe (Path Abs Dir) -> Sem r (Path Abs Dir))
-> Sem r (Maybe (Path Abs Dir)) -> Sem r (Path Abs Dir)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Sem r (Maybe (Path Abs Dir))
forall (r :: EffectRow).
Member Rpc r =>
Text -> Sem r (Maybe (Path Abs Dir))
parseNvimDir Text
spec

-- |Parse a file path and prepend Neovim's current working directory to it if it's relative.
--
-- If parsing fails, emit an error 'Report'.
nvimFile ::
  Members [Rpc, Stop Report] r =>
  Text ->
  Sem r (Path Abs File)
nvimFile :: forall (r :: EffectRow).
Members '[Rpc, Stop Report] r =>
Text -> Sem r (Path Abs File)
nvimFile Text
spec =
  Text -> Maybe (Path Abs File) -> Sem r (Path Abs File)
forall (r :: EffectRow) a.
Member (Stop Report) r =>
Text -> Maybe a -> Sem r a
failInvalidPath Text
spec (Maybe (Path Abs File) -> Sem r (Path Abs File))
-> Sem r (Maybe (Path Abs File)) -> Sem r (Path Abs File)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Sem r (Maybe (Path Abs File))
forall (r :: EffectRow).
Member Rpc r =>
Text -> Sem r (Maybe (Path Abs File))
parseNvimFile Text
spec