module Shrun.Configuration
  ( mergeConfig,
  )
where

import Shrun.Configuration.Args (Args)
import Shrun.Configuration.Data.Core (mergeCoreConfig)
import Shrun.Configuration.Data.MergedConfig
  ( MergedConfig
      ( MkMergedConfig,
        commands,
        coreConfig
      ),
  )
import Shrun.Configuration.Legend qualified as Legend
import Shrun.Configuration.Toml (Toml)
import Shrun.Data.Command (CommandP (MkCommandP))
import Shrun.Prelude

-- | Merges Args and Toml together, filling in necessary defaults and
-- doing some light processing.
--
-- We want this function to do as much to prepare the final config as
-- possible. For instance, in addition to filling in defaults, we also process
-- commands via the legend (MonadThrow) and detect the terminal width for
-- command logging's lineTrunc field (MonadTerminal).
--
-- This is very nearly pure, except for the aforementioned effects.
-- The only remaining tasks the Env needs to take care of is IO that we
-- really can't test anyway, such as opening file handles and creating
-- queues.
mergeConfig ::
  ( HasCallStack,
    MonadTerminal m,
    MonadThrow m
  ) =>
  Args ->
  Maybe Toml ->
  m MergedConfig
mergeConfig :: forall (m :: Type -> Type).
(HasCallStack, MonadTerminal m, MonadThrow m) =>
Args -> Maybe Toml -> m MergedConfig
mergeConfig Args
args Maybe Toml
mToml = do
  case Maybe Toml
mToml of
    Maybe Toml
Nothing -> do
      let commands :: NESeq (CommandP 'CommandPhase1)
commands = Maybe Text -> Text -> CommandP 'CommandPhase1
forall (p :: CommandPhase). Maybe Text -> Text -> CommandP p
MkCommandP Maybe Text
forall a. Maybe a
Nothing (Text -> CommandP 'CommandPhase1)
-> NESeq Text -> NESeq (CommandP 'CommandPhase1)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> NESeq Text
cmdsText

      CoreConfigMerged
coreConfig <-
        CoreConfigArgs -> Maybe CoreConfigToml -> m CoreConfigMerged
forall (m :: Type -> Type).
(HasCallStack, MonadTerminal m) =>
CoreConfigArgs -> Maybe CoreConfigToml -> m CoreConfigMerged
mergeCoreConfig
          (Args
args Args -> Optic' A_Lens NoIx Args CoreConfigArgs -> CoreConfigArgs
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Args CoreConfigArgs
#coreConfig)
          Maybe CoreConfigToml
forall a. Maybe a
Nothing

      pure
        $ MkMergedConfig
          { CoreConfigMerged
coreConfig :: CoreConfigMerged
coreConfig :: CoreConfigMerged
coreConfig,
            NESeq (CommandP 'CommandPhase1)
commands :: NESeq (CommandP 'CommandPhase1)
commands :: NESeq (CommandP 'CommandPhase1)
commands
          }
    (Just Toml
toml) -> do
      NESeq (CommandP 'CommandPhase1)
commands <- case Toml
toml Toml
-> Optic' A_Lens NoIx Toml (Maybe (List KeyVal))
-> Maybe (List KeyVal)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Toml (Maybe (List KeyVal))
#legend of
        Maybe (List KeyVal)
Nothing -> NESeq (CommandP 'CommandPhase1)
-> m (NESeq (CommandP 'CommandPhase1))
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (NESeq (CommandP 'CommandPhase1)
 -> m (NESeq (CommandP 'CommandPhase1)))
-> NESeq (CommandP 'CommandPhase1)
-> m (NESeq (CommandP 'CommandPhase1))
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> CommandP 'CommandPhase1
forall (p :: CommandPhase). Maybe Text -> Text -> CommandP p
MkCommandP Maybe Text
forall a. Maybe a
Nothing (Text -> CommandP 'CommandPhase1)
-> NESeq Text -> NESeq (CommandP 'CommandPhase1)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> NESeq Text
cmdsText
        Just List KeyVal
aliases -> case List KeyVal -> Either DuplicateKeyError LegendMap
Legend.linesToMap List KeyVal
aliases of
          Right LegendMap
mp -> case LegendMap
-> NESeq Text
-> Either CyclicKeyError (NESeq (CommandP 'CommandPhase1))
Legend.translateCommands LegendMap
mp NESeq Text
cmdsText of
            Right NESeq (CommandP 'CommandPhase1)
cmds -> NESeq (CommandP 'CommandPhase1)
-> m (NESeq (CommandP 'CommandPhase1))
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure NESeq (CommandP 'CommandPhase1)
cmds
            Left CyclicKeyError
err -> CyclicKeyError -> m (NESeq (CommandP 'CommandPhase1))
forall (m :: Type -> Type) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwM CyclicKeyError
err
          Left DuplicateKeyError
err -> DuplicateKeyError -> m (NESeq (CommandP 'CommandPhase1))
forall (m :: Type -> Type) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwM DuplicateKeyError
err

      CoreConfigMerged
coreConfig <-
        CoreConfigArgs -> Maybe CoreConfigToml -> m CoreConfigMerged
forall (m :: Type -> Type).
(HasCallStack, MonadTerminal m) =>
CoreConfigArgs -> Maybe CoreConfigToml -> m CoreConfigMerged
mergeCoreConfig
          (Args
args Args -> Optic' A_Lens NoIx Args CoreConfigArgs -> CoreConfigArgs
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Args CoreConfigArgs
#coreConfig)
          (CoreConfigToml -> Maybe CoreConfigToml
forall a. a -> Maybe a
Just (CoreConfigToml -> Maybe CoreConfigToml)
-> CoreConfigToml -> Maybe CoreConfigToml
forall a b. (a -> b) -> a -> b
$ Toml
toml Toml -> Optic' A_Lens NoIx Toml CoreConfigToml -> CoreConfigToml
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Toml CoreConfigToml
#coreConfig)

      pure
        $ MkMergedConfig
          { CoreConfigMerged
coreConfig :: CoreConfigMerged
coreConfig :: CoreConfigMerged
coreConfig,
            NESeq (CommandP 'CommandPhase1)
commands :: NESeq (CommandP 'CommandPhase1)
commands :: NESeq (CommandP 'CommandPhase1)
commands
          }
  where
    cmdsText :: NESeq Text
cmdsText = Args
args Args -> Optic' A_Lens NoIx Args (NESeq Text) -> NESeq Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Args (NESeq Text)
#commands