module Proteome.BufEnter where

import Conc (Lock, lock)
import Data.List.Extra (nub)
import qualified Data.Text as Text (intercalate)
import Path (Abs, Dir, File, Path, toFilePath, (</>))
import Ribosome (Buffer, Handler, Rpc, RpcError, Settings, resumeReport)
import Ribosome.Api (bufferSetOption, vimGetCurrentBuffer)
import Ribosome.Api.Buffer (bufferIsFile, buflisted)
import Ribosome.Data.SettingError (SettingError)
import qualified Ribosome.Settings as Settings

import Proteome.Data.Env (Env)
import qualified Proteome.Data.Env as Env (buffers)
import Proteome.Data.Project (Project (Project))
import Proteome.Data.ProjectMetadata (ProjectMetadata (DirProject))
import Proteome.Data.ProjectRoot (ProjectRoot (ProjectRoot))
import Proteome.Project (allProjects)
import Proteome.Settings (tagsFileName)

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

setBufferTags ::
  Member Rpc r =>
  [Path Abs File] ->
  Sem r ()
setBufferTags :: forall (r :: EffectRow).
Member Rpc r =>
[Path Abs File] -> Sem r ()
setBufferTags [Path Abs File]
tags = do
  Buffer
buf <- Sem r Buffer
forall (m :: * -> *). MonadRpc m => m Buffer
vimGetCurrentBuffer
  Buffer -> Text -> Text -> Sem r ()
forall p_2 (m :: * -> *).
(MonadRpc m, MsgpackEncode p_2) =>
Buffer -> Text -> p_2 -> m ()
bufferSetOption Buffer
buf Text
"tags" (Text -> [Text] -> Text
Text.intercalate Text
"," (String -> Text
forall a. ToText a => a -> Text
toText (String -> Text)
-> (Path Abs File -> String) -> Path Abs File -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> String
forall b t. Path b t -> String
toFilePath (Path Abs File -> Text) -> [Path Abs File] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Path Abs File]
tags))

projectRoot :: Project -> Maybe (Path Abs Dir)
projectRoot :: Project -> Maybe (Path Abs Dir)
projectRoot (Project (DirProject ProjectName
_ (ProjectRoot Path Abs Dir
root) Maybe ProjectType
_) [ProjectType]
_ Maybe ProjectLang
_ [ProjectLang]
_) = Path Abs Dir -> Maybe (Path Abs Dir)
forall a. a -> Maybe a
Just Path Abs Dir
root
projectRoot Project
_ = Maybe (Path Abs Dir)
forall a. Maybe a
Nothing

updateBufferMru ::
  Members [AtomicState Env, Lock @@ Mru, Rpc !! RpcError, Resource] r =>
  Buffer ->
  Sem r ()
updateBufferMru :: forall (r :: EffectRow).
Members
  '[AtomicState Env, Lock @@ Mru, Rpc !! RpcError, Resource] r =>
Buffer -> Sem r ()
updateBufferMru Buffer
buffer = do
  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 a
lock do
    [Buffer]
old <- (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
    [Buffer]
new <- (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] -> [Buffer]
forall a. Eq a => [a] -> [a]
nub (Buffer
buffer Buffer -> [Buffer] -> [Buffer]
forall a. a -> [a] -> [a]
: [Buffer]
old))
    (Env -> Env) -> Sem (Lock : 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
.~ [Buffer]
new)

updateBuffers ::
  Members [AtomicState Env, Lock @@ Mru, Rpc, Rpc !! RpcError, Resource] r =>
  Sem r ()
updateBuffers :: forall (r :: EffectRow).
Members
  '[AtomicState Env, Lock @@ Mru, Rpc, Rpc !! RpcError, Resource]
  r =>
Sem r ()
updateBuffers = do
  Buffer
current <- Sem r Buffer
forall (m :: * -> *). MonadRpc m => m Buffer
vimGetCurrentBuffer
  Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Buffer -> Sem r Bool
forall (m :: * -> *). MonadRpc m => Buffer -> m Bool
bufferIsFile Buffer
current) (Buffer -> Sem r ()
forall (r :: EffectRow).
Members
  '[AtomicState Env, Lock @@ Mru, Rpc !! RpcError, Resource] r =>
Buffer -> Sem r ()
updateBufferMru Buffer
current)

bufEnter ::
  Members [AtomicState Env, Lock @@ Mru, Rpc !! RpcError, Settings !! SettingError, Resource] r =>
  Handler r ()
bufEnter :: forall (r :: EffectRow).
Members
  '[AtomicState Env, Lock @@ Mru, Rpc !! RpcError,
    Settings !! SettingError, Resource]
  r =>
Handler r ()
bufEnter =
  forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow) a.
(Reportable e, Members '[eff !! e, Stop Report] r) =>
Sem (eff : r) a -> Sem r a
resumeReport @Rpc do
    Sem (Rpc : Stop Report : r) ()
forall (r :: EffectRow).
Members
  '[AtomicState Env, Lock @@ Mru, Rpc, Rpc !! RpcError, Resource]
  r =>
Sem r ()
updateBuffers
    [Path Abs Dir]
roots <- (Project -> Maybe (Path Abs Dir)) -> [Project] -> [Path Abs Dir]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Project -> Maybe (Path Abs Dir)
projectRoot ([Project] -> [Path Abs Dir])
-> Sem (Rpc : Stop Report : r) [Project]
-> Sem (Rpc : Stop Report : r) [Path Abs Dir]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem (Rpc : Stop Report : r) [Project]
forall (r :: EffectRow).
Member (AtomicState Env) r =>
Sem r [Project]
allProjects
    Path Rel File
name <- Sem (Settings : Rpc : Stop Report : r) (Path Rel File)
-> Sem (Rpc : Stop Report : r) (Path Rel File)
forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow) a.
(Reportable e, Members '[eff !! e, Stop Report] r) =>
Sem (eff : r) a -> Sem r a
resumeReport (Setting (Path Rel File)
-> Sem (Settings : Rpc : Stop Report : r) (Path Rel File)
forall a (r :: EffectRow).
(MsgpackDecode a, Member Settings r) =>
Setting a -> Sem r a
Settings.get Setting (Path Rel File)
tagsFileName)
    [Path Abs File] -> Sem (Rpc : Stop Report : r) ()
forall (r :: EffectRow).
Member Rpc r =>
[Path Abs File] -> Sem r ()
setBufferTags ((Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
name) (Path Abs Dir -> Path Abs File)
-> [Path Abs Dir] -> [Path Abs File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Path Abs Dir]
roots)