module Proteome.Project.Activate where

import Exon (exon)
import Path.IO (doesDirExist)
import Ribosome (Handler, Rpc, RpcError, SettingError, Settings, pathText, resumeReport)
import Ribosome.Api (echo, nvimCommand)
import Ribosome.Data.PluginName (PluginName)
import qualified Ribosome.Settings as Settings

import Proteome.Data.ActiveProject (ActiveProject (ActiveProject))
import Proteome.Data.Env (Env)
import Proteome.Data.Project (Project (Project))
import Proteome.Data.ProjectMetadata (ProjectMetadata (DirProject, VirtualProject))
import Proteome.Data.ProjectName (ProjectName (ProjectName))
import Proteome.Data.ProjectRoot (ProjectRoot (ProjectRoot))
import Proteome.Data.ProjectType (ProjectType (ProjectType))
import Proteome.Project (allProjects, currentProject)
import qualified Proteome.Settings as Settings

activeProject :: Project -> ActiveProject
activeProject :: Project -> ActiveProject
activeProject (Project (DirProject ProjectName
name ProjectRoot
_ Maybe ProjectType
tpe) [ProjectType]
_ Maybe ProjectLang
lang [ProjectLang]
_) = ProjectName -> ProjectType -> Maybe ProjectLang -> ActiveProject
ActiveProject ProjectName
name (ProjectType -> Maybe ProjectType -> ProjectType
forall a. a -> Maybe a -> a
fromMaybe (Text -> ProjectType
ProjectType Text
"none") Maybe ProjectType
tpe) Maybe ProjectLang
lang
activeProject (Project (VirtualProject ProjectName
name) [ProjectType]
_ Maybe ProjectLang
lang [ProjectLang]
_) = ProjectName -> ProjectType -> Maybe ProjectLang -> ActiveProject
ActiveProject ProjectName
name (Text -> ProjectType
ProjectType Text
"virtual") Maybe ProjectLang
lang

activateDirProject ::
  Members [Rpc, Embed IO] r =>
  ProjectMetadata ->
  Sem r ()
activateDirProject :: forall (r :: EffectRow).
Members '[Rpc, Embed IO] r =>
ProjectMetadata -> Sem r ()
activateDirProject (DirProject ProjectName
_ (ProjectRoot Path Abs Dir
root) Maybe ProjectType
_) = do
  Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Path Abs Dir -> Sem r Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist Path Abs Dir
root) do
    Text -> Sem r ()
forall (m :: * -> *). MonadRpc m => Text -> m ()
nvimCommand [exon|chdir #{pathText root}|]
activateDirProject ProjectMetadata
_ =
  Sem r ()
forall (f :: * -> *). Applicative f => f ()
unit

activateProject ::
  Members [Settings, Rpc, Embed IO] r =>
  Project ->
  Sem r ()
activateProject :: forall (r :: EffectRow).
Members '[Settings, Rpc, Embed IO] r =>
Project -> Sem r ()
activateProject project :: Project
project@(Project ProjectMetadata
meta [ProjectType]
_ Maybe ProjectLang
_ [ProjectLang]
_) = do
  Setting ActiveProject -> ActiveProject -> Sem r ()
forall a (r :: EffectRow).
(MsgpackEncode a, Member Settings r) =>
Setting a -> a -> Sem r ()
Settings.update Setting ActiveProject
Settings.active (Project -> ActiveProject
activeProject Project
project)
  ProjectMetadata -> Sem r ()
forall (r :: EffectRow).
Members '[Rpc, Embed IO] r =>
ProjectMetadata -> Sem r ()
activateDirProject ProjectMetadata
meta

describeProject :: ProjectMetadata -> Text
describeProject :: ProjectMetadata -> Text
describeProject (DirProject (ProjectName Text
name) ProjectRoot
_ (Just (ProjectType Text
tpe))) = Text
tpe Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
describeProject (DirProject (ProjectName Text
name) ProjectRoot
_ Maybe ProjectType
Nothing) = Text
name
describeProject (VirtualProject (ProjectName Text
name)) = Text
name

echoProjectActivation ::
  Members [Reader PluginName, Rpc] r =>
  Project ->
  Sem r ()
echoProjectActivation :: forall (r :: EffectRow).
Members '[Reader PluginName, Rpc] r =>
Project -> Sem r ()
echoProjectActivation (Project ProjectMetadata
meta [ProjectType]
_ Maybe ProjectLang
_ [ProjectLang]
_) =
  Text -> Sem r ()
forall (r :: EffectRow).
Members '[Rpc, Reader PluginName] r =>
Text -> Sem r ()
echo [exon|activated project #{describeProject meta}|]

activateCurrentProject ::
  Members [Settings, AtomicState Env, Reader PluginName, Rpc, Embed IO] r =>
  Sem r ()
activateCurrentProject :: forall (r :: EffectRow).
Members
  '[Settings, AtomicState Env, Reader PluginName, Rpc, Embed IO] r =>
Sem r ()
activateCurrentProject = do
  Maybe Project
pro <- Sem r (Maybe Project)
forall (r :: EffectRow).
Member (AtomicState Env) r =>
Sem r (Maybe Project)
currentProject
  (Project -> Sem r ()) -> Maybe Project -> Sem r ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Project -> Sem r ()
forall (r :: EffectRow).
Members '[Settings, Rpc, Embed IO] r =>
Project -> Sem r ()
activateProject Maybe Project
pro
  (Project -> Sem r ()) -> Maybe Project -> Sem r ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Project -> Sem r ()
forall (r :: EffectRow).
Members '[Reader PluginName, Rpc] r =>
Project -> Sem r ()
echoProjectActivation Maybe Project
pro

setProjectIndex ::
  Member (AtomicState Env) r =>
  Int ->
  Sem r ()
setProjectIndex :: forall (r :: EffectRow).
Member (AtomicState Env) r =>
Int -> Sem r ()
setProjectIndex Int
index = do
  [Project]
pros <- Sem r [Project]
forall (r :: EffectRow).
Member (AtomicState Env) r =>
Sem r [Project]
allProjects
  Maybe Int -> (Int -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Int
index Int -> Int -> Maybe Int
forall a. Integral a => a -> a -> Maybe a
`mod` [Project] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Project]
pros) \ Int
i ->
    (Env -> Env) -> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' (IsLabel "currentProjectIndex" (ASetter Env Env Int Int)
ASetter Env Env Int Int
#currentProjectIndex ASetter Env Env Int Int -> Int -> Env -> Env
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
i)

cycleProjectIndex ::
  Member (AtomicState Env) r =>
  (Int -> Int) ->
  Sem r ()
cycleProjectIndex :: forall (r :: EffectRow).
Member (AtomicState Env) r =>
(Int -> Int) -> Sem r ()
cycleProjectIndex Int -> Int
f = do
  [Project]
pros <- Sem r [Project]
forall (r :: EffectRow).
Member (AtomicState Env) r =>
Sem r [Project]
allProjects
  (Env -> Env) -> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' ((Env -> Env) -> Sem r ()) -> (Env -> Env) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ IsLabel "currentProjectIndex" (ASetter Env Env Int Int)
ASetter Env Env Int Int
#currentProjectIndex ASetter Env Env Int Int -> (Int -> Int) -> Env -> Env
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \ Int
i -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
i (Int -> Int
f Int
i Int -> Int -> Maybe Int
forall a. Integral a => a -> a -> Maybe a
`rem` [Project] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Project]
pros)

selectProject ::
  Members [Settings, AtomicState Env, Reader PluginName, Rpc, Embed IO] r =>
  Int ->
  Sem r ()
selectProject :: forall (r :: EffectRow).
Members
  '[Settings, AtomicState Env, Reader PluginName, Rpc, Embed IO] r =>
Int -> Sem r ()
selectProject Int
index = do
  Int -> Sem r ()
forall (r :: EffectRow).
Member (AtomicState Env) r =>
Int -> Sem r ()
setProjectIndex Int
index
  Sem r ()
forall (r :: EffectRow).
Members
  '[Settings, AtomicState Env, Reader PluginName, Rpc, Embed IO] r =>
Sem r ()
activateCurrentProject

proPrev ::
  Members [Settings !! SettingError, AtomicState Env, Reader PluginName, Rpc !! RpcError, Embed IO] r =>
  Handler r ()
proPrev :: forall (r :: EffectRow).
Members
  '[Settings !! SettingError, AtomicState Env, Reader PluginName,
    Rpc !! RpcError, Embed IO]
  r =>
Handler r ()
proPrev =
  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 Report : r) () -> Sem (Stop Report : r) ())
-> Sem (Rpc : 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 @Settings do
    (Int -> Int) -> Sem (Settings : Rpc : Stop Report : r) ()
forall (r :: EffectRow).
Member (AtomicState Env) r =>
(Int -> Int) -> Sem r ()
cycleProjectIndex (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1)
    Sem (Settings : Rpc : Stop Report : r) ()
forall (r :: EffectRow).
Members
  '[Settings, AtomicState Env, Reader PluginName, Rpc, Embed IO] r =>
Sem r ()
activateCurrentProject

proNext ::
  Members [Settings !! SettingError, AtomicState Env, Reader PluginName, Rpc !! RpcError, Embed IO] r =>
  Handler r ()
proNext :: forall (r :: EffectRow).
Members
  '[Settings !! SettingError, AtomicState Env, Reader PluginName,
    Rpc !! RpcError, Embed IO]
  r =>
Handler r ()
proNext =
  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 Report : r) () -> Sem (Stop Report : r) ())
-> Sem (Rpc : 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 @Settings do
    (Int -> Int) -> Sem (Settings : Rpc : Stop Report : r) ()
forall (r :: EffectRow).
Member (AtomicState Env) r =>
(Int -> Int) -> Sem r ()
cycleProjectIndex (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    Sem (Settings : Rpc : Stop Report : r) ()
forall (r :: EffectRow).
Members
  '[Settings, AtomicState Env, Reader PluginName, Rpc, Embed IO] r =>
Sem r ()
activateCurrentProject