module Stackctl.Spec.List
  ( ListOptions (..)
  , parseListOptions
  , runList
  ) where

import Stackctl.Prelude

import Blammo.Logging.Logger (pushLoggerLn)
import qualified Data.Text as T
import Options.Applicative
import Stackctl.AWS
import Stackctl.AWS.Scope
import Stackctl.Colors
import Stackctl.Config (HasConfig)
import Stackctl.DirectoryOption (HasDirectoryOption (..))
import Stackctl.FilterOption (HasFilterOption)
import Stackctl.Spec.Discover
import Stackctl.StackSpec

newtype ListOptions = ListOptions
  { ListOptions -> Bool
loLegend :: Bool
  }

parseListOptions :: Parser ListOptions
parseListOptions :: Parser ListOptions
parseListOptions =
  Bool -> ListOptions
ListOptions
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Bool -> Bool
not
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch
              ( forall a. Monoid a => [a] -> a
mconcat
                  [ forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-legend"
                  , forall (f :: * -> *) a. String -> Mod f a
help String
"Don't print indicators legend at the end"
                  ]
              )
        )

runList
  :: ( MonadUnliftIO m
     , MonadMask m
     , MonadResource m
     , MonadLogger m
     , MonadReader env m
     , HasAwsScope env
     , HasAwsEnv env
     , HasLogger env
     , HasConfig env
     , HasDirectoryOption env
     , HasFilterOption env
     )
  => ListOptions
  -> m ()
runList :: forall (m :: * -> *) env.
(MonadUnliftIO m, MonadMask m, MonadResource m, MonadLogger m,
 MonadReader env m, HasAwsScope env, HasAwsEnv env, HasLogger env,
 HasConfig env, HasDirectoryOption env, HasFilterOption env) =>
ListOptions -> m ()
runList ListOptions {Bool
loLegend :: Bool
loLegend :: ListOptions -> Bool
..} = do
  colors :: Colors
colors@Colors {Text -> Text
gray :: Colors -> Text -> Text
black :: Colors -> Text -> Text
cyan :: Colors -> Text -> Text
magenta :: Colors -> Text -> Text
blue :: Colors -> Text -> Text
yellow :: Colors -> Text -> Text
green :: Colors -> Text -> Text
red :: Colors -> Text -> Text
bold :: Colors -> Text -> Text
dim :: Colors -> Text -> Text
dim :: Text -> Text
bold :: Text -> Text
red :: Text -> Text
green :: Text -> Text
yellow :: Text -> Text
blue :: Text -> Text
magenta :: Text -> Text
cyan :: Text -> Text
black :: Text -> Text
gray :: Text -> Text
..} <- forall env (m :: * -> *).
(MonadReader env m, HasLogger env) =>
m Colors
getColorsLogger

  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
    let
      path :: String
path = StackSpec -> String
stackSpecFilePath StackSpec
spec
      name :: StackName
name = StackSpec -> StackName
stackSpecStackName StackSpec
spec

    Maybe StackStatus
mStackStatus <-
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s a. s -> Getting a s a -> a
^. Lens' Stack StackStatus
stack_stackStatus)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) env.
(MonadUnliftIO m, MonadResource m, MonadReader env m,
 HasAwsEnv env) =>
StackName -> m (Maybe Stack)
awsCloudFormationDescribeStackMaybe StackName
name

    let
      indicator :: Indicator
indicator = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Indicator
NotDeployed StackStatus -> Indicator
statusIndicator Maybe StackStatus
mStackStatus

      formatted :: Text
      formatted :: Text
formatted =
        Text
"  "
          forall a. Semigroup a => a -> a -> a
<> Colors -> Indicator -> Text
indicatorIcon Colors
colors Indicator
indicator
          forall a. Semigroup a => a -> a -> a
<> Text
" "
          forall a. Semigroup a => a -> a -> a
<> Text -> Text
cyan (StackName -> Text
unStackName StackName
name)
          forall a. Semigroup a => a -> a -> a
<> Text
" => "
          forall a. Semigroup a => a -> a -> a
<> Text -> Text
magenta (String -> Text
pack String
path)

    forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogger env) =>
Text -> m ()
pushLoggerLn Text
formatted

  let legendItem :: Indicator -> Text
legendItem Indicator
i = Colors -> Indicator -> Text
indicatorIcon Colors
colors Indicator
i forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Indicator -> Text
indicatorDescription Indicator
i

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
loLegend
    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogger env) =>
Text -> m ()
pushLoggerLn
    forall a b. (a -> b) -> a -> b
$ Text
"\nLegend:\n  "
    forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " (forall a b. (a -> b) -> [a] -> [b]
map Indicator -> Text
legendItem [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound])

data Indicator
  = Deployed
  | DeployFailed
  | NotDeployed
  | Reviewing
  | Deploying
  | Unknown
  deriving stock (Indicator
forall a. a -> a -> Bounded a
maxBound :: Indicator
$cmaxBound :: Indicator
minBound :: Indicator
$cminBound :: Indicator
Bounded, Int -> Indicator
Indicator -> Int
Indicator -> [Indicator]
Indicator -> Indicator
Indicator -> Indicator -> [Indicator]
Indicator -> Indicator -> Indicator -> [Indicator]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Indicator -> Indicator -> Indicator -> [Indicator]
$cenumFromThenTo :: Indicator -> Indicator -> Indicator -> [Indicator]
enumFromTo :: Indicator -> Indicator -> [Indicator]
$cenumFromTo :: Indicator -> Indicator -> [Indicator]
enumFromThen :: Indicator -> Indicator -> [Indicator]
$cenumFromThen :: Indicator -> Indicator -> [Indicator]
enumFrom :: Indicator -> [Indicator]
$cenumFrom :: Indicator -> [Indicator]
fromEnum :: Indicator -> Int
$cfromEnum :: Indicator -> Int
toEnum :: Int -> Indicator
$ctoEnum :: Int -> Indicator
pred :: Indicator -> Indicator
$cpred :: Indicator -> Indicator
succ :: Indicator -> Indicator
$csucc :: Indicator -> Indicator
Enum)

indicatorIcon :: Colors -> Indicator -> Text
indicatorIcon :: Colors -> Indicator -> Text
indicatorIcon Colors {Text -> Text
dim :: Text -> Text
bold :: Text -> Text
red :: Text -> Text
green :: Text -> Text
yellow :: Text -> Text
blue :: Text -> Text
magenta :: Text -> Text
cyan :: Text -> Text
black :: Text -> Text
gray :: Text -> Text
gray :: Colors -> Text -> Text
black :: Colors -> Text -> Text
cyan :: Colors -> Text -> Text
magenta :: Colors -> Text -> Text
blue :: Colors -> Text -> Text
yellow :: Colors -> Text -> Text
green :: Colors -> Text -> Text
red :: Colors -> Text -> Text
bold :: Colors -> Text -> Text
dim :: Colors -> Text -> Text
..} = \case
  Indicator
Deployed -> Text -> Text
green Text
"✓"
  Indicator
DeployFailed -> Text -> Text
red Text
"✗"
  Indicator
NotDeployed -> Text -> Text
yellow Text
"_"
  Indicator
Reviewing -> Text -> Text
yellow Text
"∇"
  Indicator
Deploying -> Text -> Text
cyan Text
"⋅"
  Indicator
Unknown -> Text -> Text
magenta Text
"?"

indicatorDescription :: Indicator -> Text
indicatorDescription :: Indicator -> Text
indicatorDescription = \case
  Indicator
Deployed -> Text
"deployed"
  Indicator
DeployFailed -> Text
"failed or rolled back"
  Indicator
NotDeployed -> Text
"doesn't exist"
  Indicator
Reviewing -> Text
"reviewing"
  Indicator
Deploying -> Text
"deploying"
  Indicator
Unknown -> Text
"unknown"

statusIndicator :: StackStatus -> Indicator
statusIndicator :: StackStatus -> Indicator
statusIndicator = \case
  StackStatus
StackStatus_REVIEW_IN_PROGRESS -> Indicator
Reviewing
  StackStatus
StackStatus_ROLLBACK_COMPLETE -> Indicator
DeployFailed
  StackStatus
x | Text -> StackStatus -> Bool
statusSuffixed Text
"_IN_PROGRESS" StackStatus
x -> Indicator
Deploying
  StackStatus
x | Text -> StackStatus -> Bool
statusSuffixed Text
"_FAILED" StackStatus
x -> Indicator
DeployFailed
  StackStatus
x | Text -> StackStatus -> Bool
statusSuffixed Text
"_ROLLBACK_COMPLETE" StackStatus
x -> Indicator
DeployFailed
  StackStatus
x | Text -> StackStatus -> Bool
statusSuffixed Text
"_COMPLETE" StackStatus
x -> Indicator
Deployed
  StackStatus
_ -> Indicator
Unknown
 where
  statusSuffixed :: Text -> StackStatus -> Bool
statusSuffixed Text
x = (Text
x Text -> Text -> Bool
`T.isSuffixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackStatus -> Text
fromStackStatus