module Hix.Env where

import qualified Data.Text.IO as Text
import Path (Abs, Dir, Path)

import Hix.Component (targetComponent)
import qualified Hix.Data.ComponentConfig
import Hix.Data.ComponentConfig (
  EnvRunner (EnvRunner),
  PackageName,
  PackagesConfig,
  TargetOrDefault (DefaultTarget, ExplicitTarget),
  )
import Hix.Data.Error (pathText)
import qualified Hix.Data.GhciConfig
import Hix.Json (jsonConfig)
import Hix.Monad (M)
import qualified Hix.Options as Options
import Hix.Options (EnvRunnerOptions, TargetSpec)

-- TODO when there is a solution for default command env fallback configuration, the DefaultTarget case must return
-- Nothing when the config requests it
componentRunner ::
  Maybe (Path Abs Dir) ->
  Maybe PackageName ->
  PackagesConfig ->
  TargetSpec ->
  M (Maybe EnvRunner)
componentRunner :: Maybe (Path Abs Dir)
-> Maybe PackageName
-> PackagesConfig
-> TargetSpec
-> M (Maybe EnvRunner)
componentRunner Maybe (Path Abs Dir)
cliRoot Maybe PackageName
defaultPkg PackagesConfig
config TargetSpec
spec =
  Maybe (Path Abs Dir)
-> Maybe PackageName
-> PackagesConfig
-> TargetSpec
-> M TargetOrDefault
targetComponent Maybe (Path Abs Dir)
cliRoot Maybe PackageName
defaultPkg PackagesConfig
config TargetSpec
spec M TargetOrDefault
-> (TargetOrDefault -> Maybe EnvRunner) -> M (Maybe EnvRunner)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    ExplicitTarget Target
t -> Target
t.component.runner
    DefaultTarget Target
t -> Target
t.component.runner
    TargetOrDefault
_ -> Maybe EnvRunner
forall a. Maybe a
Nothing

envRunner :: EnvRunnerOptions -> M EnvRunner
envRunner :: EnvRunnerOptions -> M EnvRunner
envRunner EnvRunnerOptions
opts = do
  EnvConfig
config <- (EnvConfig -> ReaderT Env (ExceptT Error IO) EnvConfig)
-> (JsonConfig -> ReaderT Env (ExceptT Error IO) EnvConfig)
-> Either EnvConfig JsonConfig
-> ReaderT Env (ExceptT Error IO) EnvConfig
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either EnvConfig -> ReaderT Env (ExceptT Error IO) EnvConfig
forall a. a -> ReaderT Env (ExceptT Error IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JsonConfig -> ReaderT Env (ExceptT Error IO) EnvConfig
forall a. FromJSON a => JsonConfig -> M a
jsonConfig EnvRunnerOptions
opts.config
  let runner :: TargetSpec -> M (Maybe EnvRunner)
runner = Maybe (Path Abs Dir)
-> Maybe PackageName
-> PackagesConfig
-> TargetSpec
-> M (Maybe EnvRunner)
componentRunner EnvRunnerOptions
opts.root EnvConfig
config.mainPackage EnvConfig
config.packages
  EnvRunner -> Maybe EnvRunner -> EnvRunner
forall a. a -> Maybe a -> a
fromMaybe EnvConfig
config.defaultEnv (Maybe EnvRunner -> EnvRunner)
-> (Maybe (Maybe EnvRunner) -> Maybe EnvRunner)
-> Maybe (Maybe EnvRunner)
-> EnvRunner
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Maybe EnvRunner) -> Maybe EnvRunner
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe EnvRunner) -> EnvRunner)
-> ReaderT Env (ExceptT Error IO) (Maybe (Maybe EnvRunner))
-> M EnvRunner
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TargetSpec -> M (Maybe EnvRunner))
-> Maybe TargetSpec
-> ReaderT Env (ExceptT Error IO) (Maybe (Maybe EnvRunner))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse TargetSpec -> M (Maybe EnvRunner)
runner EnvRunnerOptions
opts.component

printEnvRunner :: EnvRunnerOptions -> M ()
printEnvRunner :: EnvRunnerOptions -> M ()
printEnvRunner EnvRunnerOptions
opts = do
  EnvRunner Path Abs File
runner <- EnvRunnerOptions -> M EnvRunner
envRunner EnvRunnerOptions
opts
  IO () -> M ()
forall a. IO a -> ReaderT Env (ExceptT Error IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Text -> IO ()
Text.putStrLn (Path Abs File -> Text
forall b t. Path b t -> Text
pathText Path Abs File
runner))