module Proteome.Init where

import Exon (exon)
import qualified Log
import Ribosome (Handler, Rpc, RpcError, SettingError, Settings, resumeReport)
import Ribosome.Api (nvimCallFunction, uautocmd)
import qualified Ribosome.Settings as Settings

import Proteome.Config (logConfig, readConfig)
import Proteome.Data.Env (Env)
import qualified Proteome.Data.Env as Env (mainProject)
import Proteome.Data.Project (Project (Project))
import Proteome.Data.ProjectMetadata (ProjectMetadata (DirProject, VirtualProject))
import Proteome.Data.ProjectRoot (ProjectRoot (ProjectRoot))
import Proteome.Data.ProjectType (ProjectType (ProjectType))
import Proteome.Data.ResolveError (ResolveError)
import Proteome.Project.Activate (activateProject)
import Proteome.Project.Resolve (fromRootSettings)
import qualified Proteome.Settings as Settings (mainName, mainProjectDir, mainType)

resolveMainProject ::
  Members [Settings, Settings !! SettingError, Rpc, Stop ResolveError, Embed IO] r =>
  Sem r Project
resolveMainProject :: forall (r :: EffectRow).
Members
  '[Settings, Settings !! SettingError, Rpc, Stop ResolveError,
    Embed IO]
  r =>
Sem r Project
resolveMainProject = do
  Maybe (Path Abs Dir)
mainDir <- Setting (Path Abs Dir) -> Sem r (Maybe (Path Abs Dir))
forall a (r :: EffectRow).
(MsgpackDecode a, Member (Settings !! SettingError) r) =>
Setting a -> Sem r (Maybe a)
Settings.maybe Setting (Path Abs Dir)
Settings.mainProjectDir
  Path Abs Dir
vimCwd <- Text -> [Object] -> Sem r (Path Abs Dir)
forall a (m :: * -> *).
(MonadRpc m, MsgpackDecode a) =>
Text -> [Object] -> m a
nvimCallFunction Text
"getcwd" []
  ProjectRoot -> Sem r Project
forall (r :: EffectRow).
Members '[Settings, Stop ResolveError, Embed IO] r =>
ProjectRoot -> Sem r Project
fromRootSettings (Path Abs Dir -> ProjectRoot
ProjectRoot (Path Abs Dir -> Maybe (Path Abs Dir) -> Path Abs Dir
forall a. a -> Maybe a -> a
fromMaybe Path Abs Dir
vimCwd Maybe (Path Abs Dir)
mainDir))

updateMainType ::
  Member Settings r =>
  Maybe ProjectType ->
  Sem r ()
updateMainType :: forall (r :: EffectRow).
Member Settings r =>
Maybe ProjectType -> Sem r ()
updateMainType Maybe ProjectType
tpe =
  Setting ProjectType -> ProjectType -> Sem r ()
forall a (r :: EffectRow).
(MsgpackEncode a, Member Settings r) =>
Setting a -> a -> Sem r ()
Settings.update Setting ProjectType
Settings.mainType (ProjectType -> Maybe ProjectType -> ProjectType
forall a. a -> Maybe a -> a
fromMaybe (Text -> ProjectType
ProjectType Text
"none") Maybe ProjectType
tpe)

setMainProjectVars ::
  Member Settings r =>
  ProjectMetadata ->
  Sem r ()
setMainProjectVars :: forall (r :: EffectRow).
Member Settings r =>
ProjectMetadata -> Sem r ()
setMainProjectVars = \case
  DirProject ProjectName
name ProjectRoot
_ Maybe ProjectType
tpe -> do
    Setting ProjectName -> ProjectName -> Sem r ()
forall a (r :: EffectRow).
(MsgpackEncode a, Member Settings r) =>
Setting a -> a -> Sem r ()
Settings.update Setting ProjectName
Settings.mainName ProjectName
name
    Maybe ProjectType -> Sem r ()
forall (r :: EffectRow).
Member Settings r =>
Maybe ProjectType -> Sem r ()
updateMainType Maybe ProjectType
tpe
  VirtualProject ProjectName
name -> do
    Setting ProjectName -> ProjectName -> Sem r ()
forall a (r :: EffectRow).
(MsgpackEncode a, Member Settings r) =>
Setting a -> a -> Sem r ()
Settings.update Setting ProjectName
Settings.mainName ProjectName
name
    Maybe ProjectType -> Sem r ()
forall (r :: EffectRow).
Member Settings r =>
Maybe ProjectType -> Sem r ()
updateMainType (ProjectType -> Maybe ProjectType
forall a. a -> Maybe a
Just (Text -> ProjectType
ProjectType Text
"virtual"))

initWithMain ::
  Members [AtomicState Env, Settings, Rpc, Log, Embed IO] r =>
  Project ->
  Sem r ()
initWithMain :: forall (r :: EffectRow).
Members '[AtomicState Env, Settings, Rpc, Log, Embed IO] r =>
Project -> Sem r ()
initWithMain main :: Project
main@(Project ProjectMetadata
meta [ProjectType]
_ Maybe ProjectLang
_ [ProjectLang]
_) = do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug [exon|initializing with main project: #{show main}|]
  (Env -> Env) -> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' (IsLabel "mainProject" (ASetter Env Env Project Project)
ASetter Env Env Project Project
#mainProject ASetter Env Env Project Project -> Project -> Env -> Env
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Project
main)
  ProjectMetadata -> Sem r ()
forall (r :: EffectRow).
Member Settings r =>
ProjectMetadata -> Sem r ()
setMainProjectVars ProjectMetadata
meta
  Project -> Sem r ()
forall (r :: EffectRow).
Members '[Settings, Rpc, Embed IO] r =>
Project -> Sem r ()
activateProject Project
main

resolveAndInitMain ::
  Members [AtomicState Env, Settings !! SettingError, Settings, Rpc, Stop ResolveError, Log, Embed IO] r =>
  Sem r ()
resolveAndInitMain :: forall (r :: EffectRow).
Members
  '[AtomicState Env, Settings !! SettingError, Settings, Rpc,
    Stop ResolveError, Log, Embed IO]
  r =>
Sem r ()
resolveAndInitMain =
  Project -> Sem r ()
forall (r :: EffectRow).
Members '[AtomicState Env, Settings, Rpc, Log, Embed IO] r =>
Project -> Sem r ()
initWithMain (Project -> Sem r ()) -> Sem r Project -> Sem r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r Project
forall (r :: EffectRow).
Members
  '[Settings, Settings !! SettingError, Rpc, Stop ResolveError,
    Embed IO]
  r =>
Sem r Project
resolveMainProject

loadConfig ::
  Members [AtomicState Env, Rpc] r =>
  Text ->
  Sem r ()
loadConfig :: forall (r :: EffectRow).
Members '[AtomicState Env, Rpc] r =>
Text -> Sem r ()
loadConfig Text
dir =
  [Text] -> Sem r ()
forall (r :: EffectRow).
Member (AtomicState Env) r =>
[Text] -> Sem r ()
logConfig ([Text] -> Sem r ()) -> Sem r [Text] -> Sem r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Project -> Sem r [Text]
forall (r :: EffectRow).
Member Rpc r =>
Text -> Project -> Sem r [Text]
readConfig Text
dir (Project -> Sem r [Text]) -> Sem r Project -> Sem r [Text]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m 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

projectConfig ::
  Members [AtomicState Env, Rpc] r =>
  Sem r ()
projectConfig :: forall (r :: EffectRow).
Members '[AtomicState Env, Rpc] r =>
Sem r ()
projectConfig = do
  Text -> Sem r ()
forall (r :: EffectRow).
Members '[AtomicState Env, Rpc] r =>
Text -> Sem r ()
loadConfig Text
"project"
  Text -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Text -> Sem r ()
uautocmd Text
"ProteomeProject"

projectConfigAfter ::
  Members [AtomicState Env, Rpc] r =>
  Sem r ()
projectConfigAfter :: forall (r :: EffectRow).
Members '[AtomicState Env, Rpc] r =>
Sem r ()
projectConfigAfter = do
  Text -> Sem r ()
forall (r :: EffectRow).
Members '[AtomicState Env, Rpc] r =>
Text -> Sem r ()
loadConfig Text
"project_after"
  Text -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Text -> Sem r ()
uautocmd Text
"ProteomeProjectAfter"
  Text -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Text -> Sem r ()
uautocmd Text
"RibosomeUpdateVariables"

proLoad ::
  Members [AtomicState Env, Rpc !! RpcError] r =>
  Handler r ()
proLoad :: forall (r :: EffectRow).
Members '[AtomicState Env, Rpc !! RpcError] r =>
Handler r ()
proLoad =
  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) ()
forall (r :: EffectRow).
Members '[AtomicState Env, Rpc] r =>
Sem r ()
projectConfig

proLoadAfter ::
  Members [AtomicState Env, Rpc !! RpcError] r =>
  Handler r ()
proLoadAfter :: forall (r :: EffectRow).
Members '[AtomicState Env, Rpc !! RpcError] r =>
Handler r ()
proLoadAfter =
  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) ()
forall (r :: EffectRow).
Members '[AtomicState Env, Rpc] r =>
Sem r ()
projectConfigAfter