module Shrun.Configuration
  ( mergeConfig,
  )
where

import Shrun.Command.Types (CommandP (MkCommandP), fromPositive)
import Shrun.Configuration.Args (Args)
import Shrun.Configuration.Data.Core (mergeCoreConfig)
import Shrun.Configuration.Data.Graph (EdgeArgs (EdgeArgsList))
import Shrun.Configuration.Data.Graph qualified as Graph
import Shrun.Configuration.Data.MergedConfig
  ( MergedConfig
      ( MkMergedConfig,
        commandGraph,
        commands,
        coreConfig,
        dryRun,
        tomlPaths
      ),
  )
import Shrun.Configuration.Data.WithDisabled
  ( WithDisabled (Disabled, With),
  )
import Shrun.Configuration.Data.WithDisabled qualified as WD
import Shrun.Configuration.Default qualified as D
import Shrun.Configuration.Legend qualified as Legend
import Shrun.Configuration.Toml (Toml)
import Shrun.Prelude
import Shrun.Utils qualified as Utils

-- | 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,
    MonadCatch m,
    MonadIORef m,
    MonadTerminal m
  ) =>
  Args notifyEnv ->
  Toml notifyEnv ->
  Seq OsPath ->
  m (MergedConfig notifyEnv)
mergeConfig :: forall (m :: Type -> Type) notifyEnv.
(HasCallStack, MonadCatch m, MonadIORef m, MonadTerminal m) =>
Args notifyEnv
-> Toml notifyEnv -> Seq OsPath -> m (MergedConfig notifyEnv)
mergeConfig Args notifyEnv
args Toml notifyEnv
toml Seq OsPath
tomlPaths = do
  (NESeq (CommandP 'CommandPhase1)
commands, EdgeArgs
ea) <- case Toml notifyEnv
toml Toml notifyEnv
-> Optic' A_Lens NoIx (Toml notifyEnv) (Maybe (Seq KeyVal))
-> Maybe (Seq KeyVal)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (Toml notifyEnv) (Maybe (Seq KeyVal))
#legend of
    Maybe (Seq KeyVal)
Nothing -> (NESeq (CommandP 'CommandPhase1), EdgeArgs)
-> m (NESeq (CommandP 'CommandPhase1), EdgeArgs)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((Positive Int, Text) -> CommandP 'CommandPhase1
forall {p :: CommandPhase}. (Positive Int, Text) -> CommandP p
mkCmd ((Positive Int, Text) -> CommandP 'CommandPhase1)
-> NESeq (Positive Int, Text) -> NESeq (CommandP 'CommandPhase1)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> NESeq (Positive Int, Text)
cmdsTextIndexed, EdgeArgs
cliEdgeArgs)
    Just Seq KeyVal
aliases -> do
      -- 3. We have a legend. Need to combine CLI and legend
      --    edges config. See NOTE: [CLI and Legend Edges]
      LegendMap
legendMap <- Seq KeyVal -> m LegendMap
forall (m :: Type -> Type).
(HasCallStack, MonadThrow m) =>
Seq KeyVal -> m LegendMap
Legend.linesToMap Seq KeyVal
aliases
      (NESeq (CommandP 'CommandPhase1), Edges)
cmdEdges <- case Maybe (WithDisabled EdgeArgs)
wEdgeArgs of
        -- 3.1. We also have CLI edges; pass it in.
        Just (With EdgeArgs
ea) -> LegendMap
-> NESeq Text
-> Maybe EdgeArgs
-> m (NESeq (CommandP 'CommandPhase1), Edges)
forall (m :: Type -> Type).
(HasCallStack, MonadThrow m) =>
LegendMap
-> NESeq Text
-> Maybe EdgeArgs
-> m (NESeq (CommandP 'CommandPhase1), Edges)
Legend.translateCommands LegendMap
legendMap NESeq Text
cmdsText (EdgeArgs -> Maybe EdgeArgs
forall a. a -> Maybe a
Just EdgeArgs
ea)
        -- 3.2 No CLI legend; compute toml edges as normal.
        Maybe (WithDisabled EdgeArgs)
Nothing -> LegendMap
-> NESeq Text
-> Maybe EdgeArgs
-> m (NESeq (CommandP 'CommandPhase1), Edges)
forall (m :: Type -> Type).
(HasCallStack, MonadThrow m) =>
LegendMap
-> NESeq Text
-> Maybe EdgeArgs
-> m (NESeq (CommandP 'CommandPhase1), Edges)
Legend.translateCommands LegendMap
legendMap NESeq Text
cmdsText Maybe EdgeArgs
forall a. Maybe a
Nothing
        -- 3.3 Edges disabled; not only do we have no edges to pass
        -- in, we must also disable the toml edges. We do this
        -- but overwriting whatever was computed with 'def',
        -- below.
        Just WithDisabled EdgeArgs
Disabled -> do
          (NESeq (CommandP 'CommandPhase1)
cmds, Edges
_) <- LegendMap
-> NESeq Text
-> Maybe EdgeArgs
-> m (NESeq (CommandP 'CommandPhase1), Edges)
forall (m :: Type -> Type).
(HasCallStack, MonadThrow m) =>
LegendMap
-> NESeq Text
-> Maybe EdgeArgs
-> m (NESeq (CommandP 'CommandPhase1), Edges)
Legend.translateCommands LegendMap
legendMap NESeq Text
cmdsText Maybe EdgeArgs
forall a. Maybe a
Nothing
          (NESeq (CommandP 'CommandPhase1), Edges)
-> m (NESeq (CommandP 'CommandPhase1), Edges)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (NESeq (CommandP 'CommandPhase1)
cmds, Edges
forall a. Monoid a => a
mempty)
      pure $ (Edges -> EdgeArgs)
-> (NESeq (CommandP 'CommandPhase1), Edges)
-> (NESeq (CommandP 'CommandPhase1), EdgeArgs)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: Type -> Type -> Type) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Edges -> EdgeArgs
EdgeArgsList (NESeq (CommandP 'CommandPhase1), Edges)
cmdEdges

  CoreConfigMerged notifyEnv
coreConfig <-
    NESeq (CommandP 'CommandPhase1)
-> CoreConfigArgs notifyEnv
-> CoreConfigToml notifyEnv
-> m (CoreConfigMerged notifyEnv)
forall (m :: Type -> Type) r.
(HasCallStack, MonadCatch m, MonadIORef m, MonadTerminal m) =>
NESeq (CommandP 'CommandPhase1)
-> CoreConfigArgs r -> CoreConfigToml r -> m (CoreConfigMerged r)
mergeCoreConfig
      NESeq (CommandP 'CommandPhase1)
commands
      (Args notifyEnv
args Args notifyEnv
-> Optic' A_Lens NoIx (Args notifyEnv) (CoreConfigArgs notifyEnv)
-> CoreConfigArgs notifyEnv
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (Args notifyEnv) (CoreConfigArgs notifyEnv)
#coreConfig)
      (Toml notifyEnv
toml Toml notifyEnv
-> Optic' A_Lens NoIx (Toml notifyEnv) (CoreConfigToml notifyEnv)
-> CoreConfigToml notifyEnv
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (Toml notifyEnv) (CoreConfigToml notifyEnv)
#coreConfig)

  CommandGraph
commandGraph <- EdgeArgs -> NESeq (CommandP 'CommandPhase1) -> m CommandGraph
forall (m :: Type -> Type).
(HasCallStack, MonadThrow m) =>
EdgeArgs -> NESeq (CommandP 'CommandPhase1) -> m CommandGraph
Graph.mkGraph EdgeArgs
ea NESeq (CommandP 'CommandPhase1)
commands

  pure
    $ MkMergedConfig
      { CoreConfigMerged notifyEnv
coreConfig :: CoreConfigMerged notifyEnv
coreConfig :: CoreConfigMerged notifyEnv
coreConfig,
        CommandGraph
commandGraph :: CommandGraph
commandGraph :: CommandGraph
commandGraph,
        NESeq (CommandP 'CommandPhase1)
commands :: NESeq (CommandP 'CommandPhase1)
commands :: NESeq (CommandP 'CommandPhase1)
commands,
        dryRun :: Bool
dryRun = Args notifyEnv
args Args notifyEnv -> Optic' A_Lens NoIx (Args notifyEnv) Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (Args notifyEnv) Bool
#dryRun,
        Seq OsPath
tomlPaths :: Seq OsPath
tomlPaths :: Seq OsPath
tomlPaths
      }
  where
    cmdsText :: NESeq Text
cmdsText = Args notifyEnv
args Args notifyEnv
-> Optic' A_Lens NoIx (Args notifyEnv) (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 notifyEnv) (NESeq Text)
#commands

    cmdsTextIndexed :: NESeq (Positive Int, Text)
cmdsTextIndexed = NESeq Text -> NESeq (Positive Int, Text)
forall a. NESeq a -> NESeq (Positive Int, a)
Utils.indexPos (Args notifyEnv
args Args notifyEnv
-> Optic' A_Lens NoIx (Args notifyEnv) (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 notifyEnv) (NESeq Text)
#commands)

    mkCmd :: (Positive Int, Text) -> CommandP p
mkCmd (Positive Int
i, Text
t) = CommandIndex -> Maybe Text -> Text -> CommandP p
forall (p :: CommandPhase).
CommandIndex -> Maybe Text -> Text -> CommandP p
MkCommandP (Positive Int -> CommandIndex
fromPositive Positive Int
i) Maybe Text
forall a. Maybe a
Nothing Text
t

    wEdgeArgs :: Maybe (WithDisabled EdgeArgs)
wEdgeArgs = Args notifyEnv
args Args notifyEnv
-> Optic'
     A_Lens NoIx (Args notifyEnv) (Maybe (WithDisabled EdgeArgs))
-> Maybe (WithDisabled EdgeArgs)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (Args notifyEnv) (Maybe (WithDisabled EdgeArgs))
#edges
    cliEdgeArgs :: EdgeArgs
cliEdgeArgs = Maybe EdgeArgs -> EdgeArgs
forall a. Default a => Maybe a -> a
D.fromMaybe (Maybe (WithDisabled EdgeArgs)
wEdgeArgs Maybe (WithDisabled EdgeArgs)
-> (WithDisabled EdgeArgs -> Maybe EdgeArgs) -> Maybe EdgeArgs
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= WithDisabled EdgeArgs -> Maybe EdgeArgs
forall a. WithDisabled a -> Maybe a
WD.toMaybe)
{-# INLINEABLE mergeConfig #-}