module Proteome.PersistBuffers where

import Conc (Lock, lockOrSkip_)
import qualified Data.Text as Text (null)
import Exon (exon)
import qualified Log
import Path (Abs, Dir, File, Path, Rel, parseRelDir, relfile, toFilePath, (</>))
import Ribosome (Rpc, RpcError)
import Ribosome.Api (bufferGetName, vimCommand, vimGetCurrentBuffer)
import Ribosome.Api.Buffer (bufferForFile, buflisted, edit)
import qualified Ribosome.Data.FileBuffer as FileBuffer
import Ribosome.Effect.Persist (Persist)
import qualified Ribosome.Persist as Persist

import Proteome.Data.Env (Env)
import qualified Proteome.Data.Env as Env (buffers, mainProject)
import Proteome.Data.PersistBuffers (PersistBuffers (PersistBuffers))
import Proteome.Data.Project (Project (Project))
import Proteome.Data.ProjectMetadata (ProjectMetadata (DirProject))
import Proteome.Data.ProjectName (ProjectName (ProjectName))
import Proteome.Data.ProjectRoot (ProjectRoot (ProjectRoot))
import Proteome.Data.ProjectType (ProjectType (ProjectType))
import Proteome.Path (existingFile)

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

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

file :: Path Rel File
file :: Path Rel File
file =
  [relfile|buffers.json|]

projectPaths ::
  Member (AtomicState Env) r =>
  Sem r (Maybe (Path Abs Dir, Path Rel Dir))
projectPaths :: forall (r :: EffectRow).
Member (AtomicState Env) r =>
Sem r (Maybe (Path Abs Dir, Path Rel Dir))
projectPaths =
  Project -> Maybe (Path Abs Dir, Path Rel Dir)
examine (Project -> Maybe (Path Abs Dir, Path Rel Dir))
-> Sem r Project -> Sem r (Maybe (Path Abs Dir, Path Rel Dir))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Env -> Project) -> Sem r Project
forall s s' (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s') -> Sem r s'
atomicGets Env -> Project
Env.mainProject
  where
    examine :: Project -> Maybe (Path Abs Dir, Path Rel Dir)
examine (Project (DirProject (ProjectName Text
name) (ProjectRoot Path Abs Dir
root) (Just (ProjectType Text
tpe))) [ProjectType]
_ Maybe ProjectLang
_ [ProjectLang]
_) =
      (Path Abs Dir
root,) (Path Rel Dir -> (Path Abs Dir, Path Rel Dir))
-> Maybe (Path Rel Dir) -> Maybe (Path Abs Dir, Path Rel Dir)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
(</>) (Path Rel Dir -> Path Rel Dir -> Path Rel Dir)
-> Maybe (Path Rel Dir) -> Maybe (Path Rel Dir -> Path Rel Dir)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
tpe) Maybe (Path Rel Dir -> Path Rel Dir)
-> Maybe (Path Rel Dir) -> Maybe (Path Rel Dir)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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))
    examine Project
_ =
      Maybe (Path Abs Dir, Path Rel Dir)
forall a. Maybe a
Nothing

storeBuffers ::
  Member (Persist PersistBuffers) r =>
  Members [Lock @@ StoreBuffersLock, AtomicState Env, Rpc, Rpc !! RpcError, Resource, Embed IO] r =>
  Sem r ()
storeBuffers :: forall (r :: EffectRow).
(Member (Persist PersistBuffers) r,
 Members
   '[Lock @@ StoreBuffersLock, AtomicState Env, Rpc, Rpc !! RpcError,
     Resource, Embed IO]
   r) =>
Sem r ()
storeBuffers =
  Sem (Lock : r) () -> Sem r ()
forall {k1} (k2 :: k1) (e :: (* -> *) -> * -> *) (r :: EffectRow)
       a.
Member (Tagged k2 e) r =>
Sem (e : r) a -> Sem r a
tag (Sem (Lock : r) () -> Sem r ()) -> Sem (Lock : r) () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Sem (Lock : r) () -> Sem (Lock : r) ()
forall (r :: EffectRow) a. Member Lock r => Sem r a -> Sem r ()
lockOrSkip_ (Sem (Lock : r) () -> Sem (Lock : r) ())
-> Sem (Lock : r) () -> Sem (Lock : r) ()
forall a b. (a -> b) -> a -> b
$ Sem (Lock : r) (Maybe (Path Abs Dir, Path Rel Dir))
forall (r :: EffectRow).
Member (AtomicState Env) r =>
Sem r (Maybe (Path Abs Dir, Path Rel Dir))
projectPaths Sem (Lock : r) (Maybe (Path Abs Dir, Path Rel Dir))
-> (Maybe (Path Abs Dir, Path Rel Dir) -> Sem (Lock : r) ())
-> Sem (Lock : r) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Path Abs Dir, Path Rel Dir) -> Sem (Lock : r) ())
-> Maybe (Path Abs Dir, Path Rel Dir) -> Sem (Lock : r) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ \ (Path Abs Dir
cwd, Path Rel Dir
path) -> do
    [Text]
names <- (Buffer -> Sem (Lock : r) Text)
-> [Buffer] -> Sem (Lock : r) [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Buffer -> Sem (Lock : r) Text
forall (m :: * -> *). MonadRpc m => Buffer -> m Text
bufferGetName ([Buffer] -> Sem (Lock : r) [Text])
-> Sem (Lock : r) [Buffer] -> Sem (Lock : r) [Text]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Buffer -> Sem (Lock : r) Bool)
-> [Buffer] -> Sem (Lock : r) [Buffer]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Buffer -> Sem (Lock : r) Bool
forall (r :: EffectRow).
Member (Rpc !! RpcError) r =>
Buffer -> Sem r Bool
buflisted ([Buffer] -> Sem (Lock : r) [Buffer])
-> Sem (Lock : r) [Buffer] -> Sem (Lock : r) [Buffer]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Env -> [Buffer]) -> Sem (Lock : r) [Buffer]
forall s s' (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s') -> Sem r s'
atomicGets Env -> [Buffer]
Env.buffers
    [Path Abs File]
files <- [Maybe (Path Abs File)] -> [Path Abs File]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Path Abs File)] -> [Path Abs File])
-> Sem (Lock : r) [Maybe (Path Abs File)]
-> Sem (Lock : r) [Path Abs File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Sem (Lock : r) (Maybe (Path Abs File)))
-> [Text] -> Sem (Lock : r) [Maybe (Path Abs File)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Path Abs Dir -> Text -> Sem (Lock : r) (Maybe (Path Abs File))
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> Text -> m (Maybe (Path Abs File))
existingFile Path Abs Dir
cwd) [Text]
names
    Maybe (Path Rel File) -> PersistBuffers -> Sem (Lock : r) ()
forall a (r :: EffectRow).
Member (Persist a) r =>
Maybe (Path Rel File) -> a -> Sem r ()
Persist.store (Path Rel File -> Maybe (Path Rel File)
forall a. a -> Maybe a
Just (Path Rel Dir
path Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
file)) (Maybe (Path Abs File) -> [Path Abs File] -> PersistBuffers
PersistBuffers ([Path Abs File] -> Maybe (Path Abs File)
forall a. [a] -> Maybe a
listToMaybe [Path Abs File]
files) [Path Abs File]
files)

decodePersistBuffers ::
  Member (Persist PersistBuffers) r =>
  Path Rel Dir ->
  Sem r (Maybe PersistBuffers)
decodePersistBuffers :: forall (r :: EffectRow).
Member (Persist PersistBuffers) r =>
Path Rel Dir -> Sem r (Maybe PersistBuffers)
decodePersistBuffers Path Rel Dir
path =
  Maybe (Path Rel File) -> Sem r (Maybe PersistBuffers)
forall a (r :: EffectRow).
Member (Persist a) r =>
Maybe (Path Rel File) -> Sem r (Maybe a)
Persist.load (Path Rel File -> Maybe (Path Rel File)
forall a. a -> Maybe a
Just (Path Rel Dir
path Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
file))

restoreBuffers ::
  Members [Rpc, AtomicState Env, Log] r =>
  PersistBuffers ->
  Sem r ()
restoreBuffers :: forall (r :: EffectRow).
Members '[Rpc, AtomicState Env, Log] r =>
PersistBuffers -> Sem r ()
restoreBuffers (PersistBuffers Maybe (Path Abs File)
active [Path Abs File]
rest) = do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug [exon|Restoring buffers. Active: #{show active}|]
  (Path Abs File -> Sem r ()) -> Maybe (Path Abs File) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Path Abs File -> Sem r ()
forall {r :: EffectRow} {b} {t}.
Member Rpc r =>
Path b t -> Sem r ()
loadActive Maybe (Path Abs File)
active
  (Path Abs File -> Sem r ()) -> [Path Abs File] -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Path Abs File -> Sem r ()
forall {m :: * -> *} {b} {t}. MonadRpc m => Path b t -> m ()
add [Path Abs File]
rest
  [Maybe FileBuffer]
buffers <- (Path Abs File -> Sem r (Maybe FileBuffer))
-> [Path Abs File] -> Sem r [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 [Path Abs File]
rest
  (Env -> Env) -> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' (IsLabel "buffers" (ASetter Env Env [Buffer] [Buffer])
ASetter Env Env [Buffer] [Buffer]
#buffers ASetter Env Env [Buffer] [Buffer] -> [Buffer] -> Env -> Env
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (FileBuffer -> Buffer
FileBuffer.buffer (FileBuffer -> Buffer) -> [FileBuffer] -> [Buffer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe FileBuffer] -> [FileBuffer]
forall a. [Maybe a] -> [a]
catMaybes [Maybe FileBuffer]
buffers))
  where
    add :: Path b t -> m ()
add Path b t
a =
      Text -> m ()
forall (m :: * -> *). MonadRpc m => Text -> m ()
vimCommand (Text
"silent! badd " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText (Path b t -> String
forall b t. Path b t -> String
toFilePath Path b t
a))
    loadActive :: Path b t -> Sem r ()
loadActive Path b t
path = do
      Text
currentBufferName <- Buffer -> Sem r Text
forall (m :: * -> *). MonadRpc m => Buffer -> m Text
bufferGetName (Buffer -> Sem r Text) -> Sem r Buffer -> Sem r Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r Buffer
forall (m :: * -> *). MonadRpc m => m Buffer
vimGetCurrentBuffer
      Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
Text.null Text
currentBufferName) (Path b t -> Sem r ()
forall {r :: EffectRow} {b} {t}.
Member Rpc r =>
Path b t -> Sem r ()
edit Path b t
path)

loadBuffers ::
  Members [Persist PersistBuffers, Lock @@ LoadBuffersLock, Rpc, AtomicState Env, Log, Resource] r =>
  Sem r ()
loadBuffers :: forall (r :: EffectRow).
Members
  '[Persist PersistBuffers, Lock @@ LoadBuffersLock, Rpc,
    AtomicState Env, Log, Resource]
  r =>
Sem r ()
loadBuffers =
  Sem (Lock : r) () -> Sem r ()
forall {k1} (k2 :: k1) (e :: (* -> *) -> * -> *) (r :: EffectRow)
       a.
Member (Tagged k2 e) r =>
Sem (e : r) a -> Sem r a
tag (Sem (Lock : r) () -> Sem r ()) -> Sem (Lock : r) () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Sem (Lock : r) () -> Sem (Lock : r) ()
forall (r :: EffectRow) a. Member Lock r => Sem r a -> Sem r ()
lockOrSkip_ (Sem (Lock : r) () -> Sem (Lock : r) ())
-> Sem (Lock : r) () -> Sem (Lock : r) ()
forall a b. (a -> b) -> a -> b
$ Sem (Lock : r) (Maybe (Path Abs Dir, Path Rel Dir))
forall (r :: EffectRow).
Member (AtomicState Env) r =>
Sem r (Maybe (Path Abs Dir, Path Rel Dir))
projectPaths Sem (Lock : r) (Maybe (Path Abs Dir, Path Rel Dir))
-> (Maybe (Path Abs Dir, Path Rel Dir) -> Sem (Lock : r) ())
-> Sem (Lock : r) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Path Abs Dir, Path Rel Dir) -> Sem (Lock : r) ())
-> Maybe (Path Abs Dir, Path Rel Dir) -> Sem (Lock : r) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ \ (Path Abs Dir
_, Path Rel Dir
path) ->
    (PersistBuffers -> Sem (Lock : r) ())
-> Maybe PersistBuffers -> Sem (Lock : r) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ PersistBuffers -> Sem (Lock : r) ()
forall (r :: EffectRow).
Members '[Rpc, AtomicState Env, Log] r =>
PersistBuffers -> Sem r ()
restoreBuffers (Maybe PersistBuffers -> Sem (Lock : r) ())
-> Sem (Lock : r) (Maybe PersistBuffers) -> Sem (Lock : r) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Path Rel Dir -> Sem (Lock : r) (Maybe PersistBuffers)
forall (r :: EffectRow).
Member (Persist PersistBuffers) r =>
Path Rel Dir -> Sem r (Maybe PersistBuffers)
decodePersistBuffers Path Rel Dir
path