module Stackctl.Spec.Changes
  ( ChangesOptions (..)
  , parseChangesOptions
  , runChanges
  ) where

import Stackctl.Prelude

import Blammo.Logging.Logger (pushLoggerLn)
import qualified Data.Text.IO as T
import Options.Applicative
import Stackctl.AWS hiding (action)
import Stackctl.AWS.Scope
import Stackctl.Colors
import Stackctl.Config (HasConfig)
import Stackctl.DirectoryOption (HasDirectoryOption)
import Stackctl.FilterOption (HasFilterOption)
import Stackctl.ParameterOption
import Stackctl.RemovedStack
import Stackctl.Spec.Changes.Format
import Stackctl.Spec.Discover
import Stackctl.StackSpec
import Stackctl.StackSpecPath
import Stackctl.TagOption

data ChangesOptions = ChangesOptions
  { ChangesOptions -> Format
scoFormat :: Format
  , ChangesOptions -> OmitFull
scoOmitFull :: OmitFull
  , ChangesOptions -> [Parameter]
scoParameters :: [Parameter]
  , ChangesOptions -> [Tag]
scoTags :: [Tag]
  , ChangesOptions -> Maybe FilePath
scoOutput :: Maybe FilePath
  }

-- brittany-disable-next-binding

parseChangesOptions :: Parser ChangesOptions
parseChangesOptions :: Parser ChangesOptions
parseChangesOptions =
  Format
-> OmitFull
-> [Parameter]
-> [Tag]
-> Maybe FilePath
-> ChangesOptions
ChangesOptions
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Format
formatOption
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OmitFull
omitFullOption
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Parameter
parameterOption
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Tag
tagOption
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument
          forall s. IsString s => ReadM s
str
          ( forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PATH"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Write changes summary to PATH"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
action FilePath
"file"
          )
      )

runChanges
  :: ( MonadMask m
     , MonadUnliftIO m
     , MonadResource m
     , MonadLogger m
     , MonadReader env m
     , HasLogger env
     , HasAwsScope env
     , HasAwsEnv env
     , HasConfig env
     , HasDirectoryOption env
     , HasFilterOption env
     )
  => ChangesOptions
  -> m ()
runChanges :: forall (m :: * -> *) env.
(MonadMask m, MonadUnliftIO m, MonadResource m, MonadLogger m,
 MonadReader env m, HasLogger env, HasAwsScope env, HasAwsEnv env,
 HasConfig env, HasDirectoryOption env, HasFilterOption env) =>
ChangesOptions -> m ()
runChanges ChangesOptions {[Tag]
[Parameter]
Maybe FilePath
OmitFull
Format
scoOutput :: Maybe FilePath
scoTags :: [Tag]
scoParameters :: [Parameter]
scoOmitFull :: OmitFull
scoFormat :: Format
scoOutput :: ChangesOptions -> Maybe FilePath
scoTags :: ChangesOptions -> [Tag]
scoParameters :: ChangesOptions -> [Parameter]
scoOmitFull :: ChangesOptions -> OmitFull
scoFormat :: ChangesOptions -> Format
..} = do
  -- Clear file before starting, as we have to use append for each spec
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (FilePath -> Text -> IO ()
`T.writeFile` Text
"") Maybe FilePath
scoOutput

  Colors
colors <- case Maybe FilePath
scoOutput of
    Maybe FilePath
Nothing -> forall env (m :: * -> *).
(MonadReader env m, HasLogger env) =>
m Colors
getColorsLogger
    Just {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Colors
noColors

  let write :: Text -> m ()
write Text
formatted = case Maybe FilePath
scoOutput of
        Maybe FilePath
Nothing -> forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogger env) =>
Text -> m ()
pushLoggerLn Text
formatted
        Just FilePath
p -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
T.appendFile FilePath
p forall a b. (a -> b) -> a -> b
$ Text
formatted forall a. Semigroup a => a -> a -> a
<> Text
"\n"

  forall (m :: * -> *) env.
(MonadMask m, MonadResource m, MonadLogger m, MonadReader env m,
 HasAwsScope env, HasConfig env, HasDirectoryOption env,
 HasFilterOption env) =>
(StackSpec -> m ()) -> m ()
forEachSpec_ forall a b. (a -> b) -> a -> b
$ \StackSpec
spec -> do
    forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Pair] -> m a -> m a
withThreadContext [Key
"stackName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StackSpec -> StackName
stackSpecStackName StackSpec
spec] forall a b. (a -> b) -> a -> b
$ do
      Either Text (Maybe ChangeSet)
emChangeSet <- forall (m :: * -> *) env.
(MonadUnliftIO m, MonadResource m, MonadLogger m,
 MonadReader env m, HasAwsEnv env) =>
StackSpec
-> [Parameter] -> [Tag] -> m (Either Text (Maybe ChangeSet))
createChangeSet StackSpec
spec [Parameter]
scoParameters [Tag]
scoTags

      case Either Text (Maybe ChangeSet)
emChangeSet of
        Left Text
err -> do
          forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logError forall a b. (a -> b) -> a -> b
$ Text
"Error creating ChangeSet" Text -> [SeriesElem] -> Message
:# [Key
"error" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
err]
          forall (m :: * -> *) a. MonadIO m => m a
exitFailure
        Right Maybe ChangeSet
mChangeSet -> do
          let name :: Text
name = FilePath -> Text
pack forall a b. (a -> b) -> a -> b
$ StackSpecPath -> FilePath
stackSpecPathFilePath forall a b. (a -> b) -> a -> b
$ StackSpec -> StackSpecPath
stackSpecSpecPath StackSpec
spec
          Text -> m ()
write forall a b. (a -> b) -> a -> b
$ Colors -> OmitFull -> Text -> Format -> Maybe ChangeSet -> Text
formatChangeSet Colors
colors OmitFull
scoOmitFull Text
name Format
scoFormat Maybe ChangeSet
mChangeSet

  [Stack]
removed <- forall (m :: * -> *) env.
(MonadUnliftIO m, MonadResource m, MonadReader env m,
 HasAwsEnv env, HasAwsScope env, HasFilterOption env) =>
m [Stack]
inferRemovedStacks
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Text -> m ()
write forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colors -> Format -> Stack -> Text
formatRemovedStack Colors
colors Format
scoFormat) [Stack]
removed