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