module Proteome.Config where

import Exon (exon)
import Ribosome (Handler, Rpc, RpcError, msgpackArray, resumeReport)
import Ribosome.Api (nvimGetOption, vimCallFunction, vimCommand)

import qualified Proteome.Data.Env as Env
import Proteome.Data.Env (Env)
import qualified Proteome.Data.Project as Project
import Proteome.Data.Project (Project (Project))
import Proteome.Data.ProjectMetadata (ProjectMetadata (DirProject))
import Proteome.Data.ProjectName (ProjectName (ProjectName))
import Proteome.Data.ProjectType (ProjectType (ProjectType))

globRtp ::
  Member Rpc r =>
  Text ->
  Sem r [Text]
globRtp :: forall (r :: EffectRow). Member Rpc r => Text -> Sem r [Text]
globRtp Text
path = do
  Text
rtp :: Text <- Text -> Sem r Text
forall a (m :: * -> *).
(MonadRpc m, MsgpackDecode a) =>
Text -> m a
nvimGetOption Text
"runtimepath"
  Text -> [Object] -> Sem r [Text]
forall a (m :: * -> *).
(MonadRpc m, MsgpackDecode a) =>
Text -> [Object] -> m a
vimCallFunction Text
"globpath" (Text -> Text -> Bool -> Bool -> [Object]
forall a. MsgpackArray a => a
msgpackArray Text
rtp Text
path Bool
False Bool
True)

runtime ::
  Member Rpc r =>
  Text ->
  Sem r [Text]
runtime :: forall (r :: EffectRow). Member Rpc r => Text -> Sem r [Text]
runtime Text
path = do
  Text -> Sem r ()
forall (m :: * -> *). MonadRpc m => Text -> m ()
vimCommand [exon|runtime! #{fpath}|]
  Text -> Sem r [Text]
forall (r :: EffectRow). Member Rpc r => Text -> Sem r [Text]
globRtp Text
fpath
  where
    fpath :: Text
fpath = Text
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".vim"

runtimeConf ::
  Member Rpc r =>
  Text ->
  Text ->
  Sem r [Text]
runtimeConf :: forall (r :: EffectRow).
Member Rpc r =>
Text -> Text -> Sem r [Text]
runtimeConf Text
confDir Text
path =
  Text -> Sem r [Text]
forall (r :: EffectRow). Member Rpc r => Text -> Sem r [Text]
runtime [exon|#{confDir}/#{path}|]

typeProjectConf ::
  Member Rpc r =>
  Text ->
  ProjectName ->
  ProjectType ->
  Sem r [Text]
typeProjectConf :: forall (r :: EffectRow).
Member Rpc r =>
Text -> ProjectName -> ProjectType -> Sem r [Text]
typeProjectConf Text
confDir (ProjectName Text
name') (ProjectType Text
tpe') = do
  [Text]
tpePaths <- Text -> Text -> Sem r [Text]
forall (r :: EffectRow).
Member Rpc r =>
Text -> Text -> Sem r [Text]
runtimeConf Text
confDir Text
tpe'
  [Text]
namePaths <- Text -> Text -> Sem r [Text]
forall (r :: EffectRow).
Member Rpc r =>
Text -> Text -> Sem r [Text]
runtimeConf Text
confDir (Text -> Sem r [Text]) -> Text -> Sem r [Text]
forall a b. (a -> b) -> a -> b
$ 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'
  pure $ [Text]
tpePaths [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
namePaths

readConfigMeta ::
  Member Rpc r =>
  Text ->
  Project ->
  Sem r [Text]
readConfigMeta :: forall (r :: EffectRow).
Member Rpc r =>
Text -> Project -> Sem r [Text]
readConfigMeta Text
confDir (Project (DirProject ProjectName
name' ProjectRoot
_ Maybe ProjectType
tpe') [ProjectType]
_ Maybe ProjectLang
_ [ProjectLang]
_) = do
  Maybe [Text]
paths <- (ProjectType -> Sem r [Text])
-> Maybe ProjectType -> Sem r (Maybe [Text])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Text -> ProjectName -> ProjectType -> Sem r [Text]
forall (r :: EffectRow).
Member Rpc r =>
Text -> ProjectName -> ProjectType -> Sem r [Text]
typeProjectConf Text
confDir ProjectName
name') Maybe ProjectType
tpe'
  pure $ [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Text]
paths
readConfigMeta Text
_ Project
_ = [Text] -> Sem r [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

readConfigProject ::
  Member Rpc r =>
  Text ->
  Project ->
  Sem r [Text]
readConfigProject :: forall (r :: EffectRow).
Member Rpc r =>
Text -> Project -> Sem r [Text]
readConfigProject Text
confDir Project
project = do
  [[Text]]
paths <- (ProjectType -> Sem r [Text]) -> [ProjectType] -> Sem r [[Text]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Text -> Text -> Sem r [Text]
forall (r :: EffectRow).
Member Rpc r =>
Text -> Text -> Sem r [Text]
runtimeConf Text
confDir (Text -> Sem r [Text])
-> (ProjectType -> Text) -> ProjectType -> Sem r [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectType -> Text
coerce) (Project -> [ProjectType]
Project.types Project
project)
  [Text]
metaPaths <- Text -> Project -> Sem r [Text]
forall (r :: EffectRow).
Member Rpc r =>
Text -> Project -> Sem r [Text]
readConfigMeta Text
confDir Project
project
  pure $ [[Text]] -> [Text]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [[Text]]
paths [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
metaPaths

readConfig ::
  Member Rpc r =>
  Text ->
  Project ->
  Sem r [Text]
readConfig :: forall (r :: EffectRow).
Member Rpc r =>
Text -> Project -> Sem r [Text]
readConfig Text
confDir Project
project = do
  [Text]
allPaths <- Text -> Text -> Sem r [Text]
forall (r :: EffectRow).
Member Rpc r =>
Text -> Text -> Sem r [Text]
runtimeConf Text
confDir Text
"all/*"
  [Text]
projectPaths <- Text -> Project -> Sem r [Text]
forall (r :: EffectRow).
Member Rpc r =>
Text -> Project -> Sem r [Text]
readConfigProject Text
confDir Project
project
  pure $ [Text]
allPaths [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
projectPaths

logConfig ::
  Member (AtomicState Env) r =>
  [Text] ->
  Sem r ()
logConfig :: forall (r :: EffectRow).
Member (AtomicState Env) r =>
[Text] -> Sem r ()
logConfig [Text]
paths =
  (Env -> Env) -> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' (IsLabel "configLog" (ASetter Env Env [Text] [Text])
ASetter Env Env [Text] [Text]
#configLog ASetter Env Env [Text] [Text] -> ([Text] -> [Text]) -> Env -> Env
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Text]
paths [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>))

proReadConfig ::
  Members [Rpc !! RpcError, AtomicState Env] r =>
  Handler r ()
proReadConfig :: forall (r :: EffectRow).
Members '[Rpc !! RpcError, AtomicState Env] r =>
Handler r ()
proReadConfig = do
  forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow) a.
(Reportable e, Members '[eff !! e, Stop Report] r) =>
Sem (eff : r) a -> Sem r a
resumeReport @Rpc do
    Project
main <- (Env -> Project) -> Sem (Rpc : Stop Report : r) Project
forall s s' (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s') -> Sem r s'
atomicGets Env -> Project
Env.mainProject
    [Text]
configs <- Text -> Project -> Sem (Rpc : Stop Report : r) [Text]
forall (r :: EffectRow).
Member Rpc r =>
Text -> Project -> Sem r [Text]
readConfig Text
"project" Project
main
    [Text] -> Sem (Rpc : Stop Report : r) ()
forall (r :: EffectRow).
Member (AtomicState Env) r =>
[Text] -> Sem r ()
logConfig [Text]
configs
    [Text]
afterConfigs <- Text -> Project -> Sem (Rpc : Stop Report : r) [Text]
forall (r :: EffectRow).
Member Rpc r =>
Text -> Project -> Sem r [Text]
readConfig Text
"project_after" Project
main
    [Text] -> Sem (Rpc : Stop Report : r) ()
forall (r :: EffectRow).
Member (AtomicState Env) r =>
[Text] -> Sem r ()
logConfig [Text]
afterConfigs

defaultTypeMarkers :: Map ProjectType [Text]
defaultTypeMarkers :: Map ProjectType [Text]
defaultTypeMarkers =
  [
    (Text -> ProjectType
ProjectType Text
"haskell", [Item [Text]
"stack.yaml", Item [Text]
"*.cabal", Item [Text]
"cabal.project"]),
    (Text -> ProjectType
ProjectType Text
"scala", [Item [Text]
"*.sbt"])
  ]