module Stackctl.Spec.Changes.Format
  ( Format (..)
  , formatOption
  , OmitFull (..)
  , omitFullOption
  , formatChangeSet
  , formatRemovedStack
  , formatTTY
  ) where

import Stackctl.Prelude

import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import Options.Applicative hiding (action)
import Stackctl.AWS
import Stackctl.Colors

data Format
  = FormatTTY
  | FormatPullRequest

data OmitFull
  = OmitFull
  | IncludeFull

formatOption :: Parser Format
formatOption :: Parser Format
formatOption =
  forall a. ReadM a -> Mod OptionFields a -> Parser a
option (forall a. (String -> Either String a) -> ReadM a
eitherReader String -> Either String Format
readFormat)
    forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
      [ forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f'
      , forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"format"
      , forall (f :: * -> *) a. String -> Mod f a
help String
"Format to output changes in"
      , forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Format
FormatTTY
      , forall a (f :: * -> *). (a -> String) -> Mod f a
showDefaultWith Format -> String
showFormat
      ]

readFormat :: String -> Either String Format
readFormat :: String -> Either String Format
readFormat = \case
  String
"tty" -> forall a b. b -> Either a b
Right Format
FormatTTY
  String
"pr" -> forall a b. b -> Either a b
Right Format
FormatPullRequest
  String
x -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Invalid format: " forall a. Semigroup a => a -> a -> a
<> String
x

showFormat :: Format -> String
showFormat :: Format -> String
showFormat = \case
  Format
FormatTTY -> String
"tty"
  Format
FormatPullRequest -> String
"pr"

-- brittany-disable-next-binding

omitFullOption :: Parser OmitFull
omitFullOption :: Parser OmitFull
omitFullOption =
  forall a. a -> a -> Mod FlagFields a -> Parser a
flag
    OmitFull
IncludeFull
    OmitFull
OmitFull
    ( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-include-full"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Don't include full ChangeSet JSON details"
    )

formatChangeSet
  :: Colors -> OmitFull -> Text -> Format -> Maybe ChangeSet -> Text
formatChangeSet :: Colors -> OmitFull -> Text -> Format -> Maybe ChangeSet -> Text
formatChangeSet Colors
colors OmitFull
omitFull Text
name = \case
  Format
FormatTTY -> Colors -> Text -> Maybe ChangeSet -> Text
formatTTY Colors
colors Text
name
  Format
FormatPullRequest -> OmitFull -> Text -> Maybe ChangeSet -> Text
formatPullRequest OmitFull
omitFull Text
name

formatRemovedStack :: Colors -> Format -> Stack -> Text
formatRemovedStack :: Colors -> Format -> Stack -> Text
formatRemovedStack 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
..} Format
format Stack
stack = case Format
format of
  Format
FormatTTY -> Text -> Text
red Text
"DELETE" forall a. Semigroup a => a -> a -> a
<> Text
" stack " forall a. Semigroup a => a -> a -> a
<> Text -> Text
cyan Text
name
  Format
FormatPullRequest -> Text
":x: This PR will **delete** the stack `" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
"`"
 where
  name :: Text
name = Stack
stack forall s a. s -> Getting a s a -> a
^. Lens' Stack Text
stack_stackName

formatTTY :: Colors -> Text -> Maybe ChangeSet -> Text
formatTTY :: Colors -> Text -> Maybe ChangeSet -> Text
formatTTY colors :: Colors
colors@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
..} Text
name Maybe ChangeSet
mChangeSet = case (Maybe ChangeSet
mChangeSet, Maybe (NonEmpty ResourceChange)
rChanges) of
  (Maybe ChangeSet
Nothing, Maybe (NonEmpty ResourceChange)
_) -> Text
"No changes for " forall a. Semigroup a => a -> a -> a
<> Text
name
  (Maybe ChangeSet
_, Maybe (NonEmpty ResourceChange)
Nothing) -> Text
"Metadata only changes (e.g. Tags or Outputs)"
  (Maybe ChangeSet
_, Just NonEmpty ResourceChange
rcs) ->
    (Text
"\n" forall a. Semigroup a => a -> a -> a
<>) forall a b. (a -> b) -> a -> b
$ (forall a. Semigroup a => a -> a -> a
<> Text
"\n") forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ (Text
"Changes for " forall a. Semigroup a => a -> a -> a
<> Text -> Text
cyan Text
name forall a. Semigroup a => a -> a -> a
<> Text
":")
      forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map
        ((Text
"\n  " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceChange -> Text
formatResourceChange)
        (forall a. NonEmpty a -> [a]
NE.toList NonEmpty ResourceChange
rcs)
 where
  rChanges :: Maybe (NonEmpty ResourceChange)
rChanges = do
    ChangeSet
cs <- Maybe ChangeSet
mChangeSet
    [Change]
changes <- ChangeSet -> Maybe [Change]
csChanges ChangeSet
cs
    forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Change -> Maybe ResourceChange
resourceChange [Change]
changes

  formatResourceChange :: ResourceChange -> Text
formatResourceChange ResourceChange' {Maybe [ResourceChangeDetail]
Maybe [ResourceAttribute]
Maybe Text
Maybe Replacement
Maybe ModuleInfo
Maybe ChangeAction
$sel:action:ResourceChange' :: ResourceChange -> Maybe ChangeAction
$sel:changeSetId:ResourceChange' :: ResourceChange -> Maybe Text
$sel:details:ResourceChange' :: ResourceChange -> Maybe [ResourceChangeDetail]
$sel:logicalResourceId:ResourceChange' :: ResourceChange -> Maybe Text
$sel:moduleInfo:ResourceChange' :: ResourceChange -> Maybe ModuleInfo
$sel:physicalResourceId:ResourceChange' :: ResourceChange -> Maybe Text
$sel:replacement:ResourceChange' :: ResourceChange -> Maybe Replacement
$sel:resourceType:ResourceChange' :: ResourceChange -> Maybe Text
$sel:scope:ResourceChange' :: ResourceChange -> Maybe [ResourceAttribute]
scope :: Maybe [ResourceAttribute]
resourceType :: Maybe Text
replacement :: Maybe Replacement
physicalResourceId :: Maybe Text
moduleInfo :: Maybe ModuleInfo
logicalResourceId :: Maybe Text
details :: Maybe [ResourceChangeDetail]
changeSetId :: Maybe Text
action :: Maybe ChangeAction
..} =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ChangeAction -> Text
colorAction Maybe ChangeAction
action
      forall a. Semigroup a => a -> a -> a
<> Text
" "
      forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" forall a. ToText a => a -> Text
toText Maybe Text
logicalResourceId
      forall a. Semigroup a => a -> a -> a
<> Text
" ("
      forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Text -> Text
cyan Maybe Text
resourceType
      forall a. Semigroup a => a -> a -> a
<> Text
")"
      forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
" " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
magenta) Maybe Text
physicalResourceId
      forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
"\n    Replacement: " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Replacement -> Text
colorReplacement) Maybe Replacement
replacement
      forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
"\n    Scope: " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. ToText a => a -> Text
toText) Maybe [ResourceAttribute]
scope
      forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
"\n    Details:" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ResourceChangeDetail] -> Text
formatDetails) Maybe [ResourceChangeDetail]
details

  formatDetails :: [ResourceChangeDetail] -> Text
formatDetails =
    forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Text
"\n      * " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Colors -> ResourceChangeDetail -> Maybe Text
formatDetail Colors
colors)

  colorAction :: ChangeAction -> Text
colorAction = \case
    x :: ChangeAction
x@ChangeAction
ChangeAction_Add -> Text -> Text
green (forall a. ToText a => a -> Text
toText ChangeAction
x)
    x :: ChangeAction
x@ChangeAction
ChangeAction_Modify -> Text -> Text
yellow (forall a. ToText a => a -> Text
toText ChangeAction
x)
    x :: ChangeAction
x@ChangeAction
ChangeAction_Remove -> Text -> Text
red (forall a. ToText a => a -> Text
toText ChangeAction
x)
    ChangeAction' Text
x -> Text
x

  colorReplacement :: Replacement -> Text
colorReplacement = \case
    x :: Replacement
x@Replacement
Replacement_True -> Text -> Text
red (forall a. ToText a => a -> Text
toText Replacement
x)
    x :: Replacement
x@Replacement
Replacement_False -> Text -> Text
green (forall a. ToText a => a -> Text
toText Replacement
x)
    x :: Replacement
x@Replacement
Replacement_Conditional -> Text -> Text
yellow (forall a. ToText a => a -> Text
toText Replacement
x)
    Replacement' Text
x -> Text
x

formatPullRequest :: OmitFull -> Text -> Maybe ChangeSet -> Text
formatPullRequest :: OmitFull -> Text -> Maybe ChangeSet -> Text
formatPullRequest OmitFull
omitFull Text
name Maybe ChangeSet
mChangeSet =
  Text
emoji
    forall a. Semigroup a => a -> a -> a
<> Text
" This PR generates "
    forall a. Semigroup a => a -> a -> a
<> Text
description
    forall a. Semigroup a => a -> a -> a
<> Text
" for `"
    forall a. Semigroup a => a -> a -> a
<> Text
name
    forall a. Semigroup a => a -> a -> a
<> Text
"`."
    forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a -> a
fromMaybe Text
"" (OmitFull -> ChangeSet -> NonEmpty ResourceChange -> Text
commentBody OmitFull
omitFull forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ChangeSet
mChangeSet forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (NonEmpty ResourceChange)
rChanges)
    forall a. Semigroup a => a -> a -> a
<> Text
"\n"
 where
  emoji :: Text
emoji = case (Maybe ChangeSet
mChangeSet, Maybe Int
nChanges) of
    (Maybe ChangeSet
Nothing, Maybe Int
_) -> Text
":heavy_check_mark:"
    (Maybe ChangeSet
_, Maybe Int
Nothing) -> Text
":book:"
    (Maybe ChangeSet
_, Just Int
_) -> Text
":warning:"

  description :: Text
description = case (Maybe ChangeSet
mChangeSet, Maybe Int
nChanges) of
    (Maybe ChangeSet
Nothing, Maybe Int
_) -> Text
"no changes"
    (Maybe ChangeSet
_, Maybe Int
Nothing) -> Text
"only metadata changes (Tags, Outputs, etc)"
    (Maybe ChangeSet
_, Just Int
1) -> Text
"**1** change"
    (Maybe ChangeSet
_, Just Int
n) -> Text
"**" forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (forall a. Show a => a -> String
show Int
n) forall a. Semigroup a => a -> a -> a
<> Text
"** changes"

  nChanges :: Maybe Int
nChanges = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty ResourceChange)
rChanges

  rChanges :: Maybe (NonEmpty ResourceChange)
rChanges = do
    ChangeSet
cs <- Maybe ChangeSet
mChangeSet
    [Change]
changes <- ChangeSet -> Maybe [Change]
csChanges ChangeSet
cs
    forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Change -> Maybe ResourceChange
resourceChange [Change]
changes

commentBody :: OmitFull -> ChangeSet -> NonEmpty ResourceChange -> Text
commentBody :: OmitFull -> ChangeSet -> NonEmpty ResourceChange -> Text
commentBody OmitFull
omitFull ChangeSet
cs NonEmpty ResourceChange
rcs =
  forall a. Monoid a => [a] -> a
mconcat
    forall a b. (a -> b) -> a -> b
$ [ Text
"\n"
      , Text
"\n| Action | Logical Id | Physical Id | Type | Replacement | Scope | Details |"
      , Text
"\n| ---    | ---        | ---         | ---  | ---         | ---   | ---     |"
      ]
    forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map ResourceChange -> Text
commentTableRow (forall a. NonEmpty a -> [a]
NE.toList NonEmpty ResourceChange
rcs)
    forall a. Semigroup a => a -> a -> a
<> case OmitFull
omitFull of
      OmitFull
OmitFull -> []
      OmitFull
IncludeFull ->
        [ Text
"\n"
        , Text
"\n<details>"
        , Text
"\n<summary>Full changes</summary>"
        , Text
"\n"
        , Text
"\n```json"
        , Text
"\n" forall a. Semigroup a => a -> a -> a
<> ChangeSet -> Text
changeSetJSON ChangeSet
cs
        , Text
"\n```"
        , Text
"\n"
        , Text
"\n</details>"
        ]

commentTableRow :: ResourceChange -> Text
commentTableRow :: ResourceChange -> Text
commentTableRow ResourceChange' {Maybe [ResourceChangeDetail]
Maybe [ResourceAttribute]
Maybe Text
Maybe Replacement
Maybe ModuleInfo
Maybe ChangeAction
scope :: Maybe [ResourceAttribute]
resourceType :: Maybe Text
replacement :: Maybe Replacement
physicalResourceId :: Maybe Text
moduleInfo :: Maybe ModuleInfo
logicalResourceId :: Maybe Text
details :: Maybe [ResourceChangeDetail]
changeSetId :: Maybe Text
action :: Maybe ChangeAction
$sel:action:ResourceChange' :: ResourceChange -> Maybe ChangeAction
$sel:changeSetId:ResourceChange' :: ResourceChange -> Maybe Text
$sel:details:ResourceChange' :: ResourceChange -> Maybe [ResourceChangeDetail]
$sel:logicalResourceId:ResourceChange' :: ResourceChange -> Maybe Text
$sel:moduleInfo:ResourceChange' :: ResourceChange -> Maybe ModuleInfo
$sel:physicalResourceId:ResourceChange' :: ResourceChange -> Maybe Text
$sel:replacement:ResourceChange' :: ResourceChange -> Maybe Replacement
$sel:resourceType:ResourceChange' :: ResourceChange -> Maybe Text
$sel:scope:ResourceChange' :: ResourceChange -> Maybe [ResourceAttribute]
..} =
  forall a. Monoid a => [a] -> a
mconcat
    [ Text
"\n"
    , Text
"| " forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" forall a. ToText a => a -> Text
toText Maybe ChangeAction
action forall a. Semigroup a => a -> a -> a
<> Text
" "
    , Text
"| " forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" forall a. ToText a => a -> Text
toText Maybe Text
logicalResourceId forall a. Semigroup a => a -> a -> a
<> Text
" "
    , Text
"| " forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" forall a. ToText a => a -> Text
toText Maybe Text
physicalResourceId forall a. Semigroup a => a -> a -> a
<> Text
" "
    , Text
"| " forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" forall a. ToText a => a -> Text
toText Maybe Text
resourceType forall a. Semigroup a => a -> a -> a
<> Text
" "
    , Text
"| " forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" forall a. ToText a => a -> Text
toText Maybe Replacement
replacement forall a. Semigroup a => a -> a -> a
<> Text
" "
    , Text
"| " forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> [Text] -> Text
T.intercalate Text
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. ToText a => a -> Text
toText) Maybe [ResourceAttribute]
scope forall a. Semigroup a => a -> a -> a
<> Text
" "
    , Text
"| " forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ([Text] -> Text
mdList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Colors -> ResourceChangeDetail -> Maybe Text
formatDetail Colors
noColors)) Maybe [ResourceChangeDetail]
details forall a. Semigroup a => a -> a -> a
<> Text
" "
    , Text
"|"
    ]

mdList :: [Text] -> Text
mdList :: [Text] -> Text
mdList [Text]
xs =
  Text
"<ul>" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (\Text
x -> Text
"<li>" forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<> Text
"</li>") [Text]
xs) forall a. Semigroup a => a -> a -> a
<> Text
"</ul>"

formatDetail :: Colors -> ResourceChangeDetail -> Maybe Text
formatDetail :: Colors -> ResourceChangeDetail -> Maybe Text
formatDetail 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
..} ResourceChangeDetail' {Maybe Text
Maybe ResourceTargetDefinition
Maybe EvaluationType
Maybe ChangeSource
$sel:causingEntity:ResourceChangeDetail' :: ResourceChangeDetail -> Maybe Text
$sel:changeSource:ResourceChangeDetail' :: ResourceChangeDetail -> Maybe ChangeSource
$sel:evaluation:ResourceChangeDetail' :: ResourceChangeDetail -> Maybe EvaluationType
$sel:target:ResourceChangeDetail' :: ResourceChangeDetail -> Maybe ResourceTargetDefinition
target :: Maybe ResourceTargetDefinition
evaluation :: Maybe EvaluationType
changeSource :: Maybe ChangeSource
causingEntity :: Maybe Text
..} = do
  ChangeSource
c <- Maybe ChangeSource
changeSource
  ResourceTargetDefinition
t <- Maybe ResourceTargetDefinition
target

  let
    attr :: Maybe ResourceAttribute
attr = ResourceTargetDefinition -> Maybe ResourceAttribute
attribute ResourceTargetDefinition
t
    n :: Maybe Text
n = ResourceTargetDefinition -> Maybe Text
name ResourceTargetDefinition
t
    rr :: Maybe RequiresRecreation
rr = ResourceTargetDefinition -> Maybe RequiresRecreation
requiresRecreation ResourceTargetDefinition
t

  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    forall a b. (a -> b) -> a -> b
$ forall a. ToText a => a -> Text
toText ChangeSource
c
    forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
" in " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToText a => a -> Text
toText) Maybe ResourceAttribute
attr
    forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Text
x -> Text
" (" forall a. Semigroup a => a -> a -> a
<> Text -> Text
magenta (forall a. ToText a => a -> Text
toText Text
x) forall a. Semigroup a => a -> a -> a
<> Text
")") Maybe Text
n
    forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
", recreation " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequiresRecreation -> Text
formatRR) Maybe RequiresRecreation
rr
    forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
", caused by " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToText a => a -> Text
toText) Maybe Text
causingEntity
 where
  formatRR :: RequiresRecreation -> Text
formatRR = \case
    x :: RequiresRecreation
x@RequiresRecreation
RequiresRecreation_Always -> Text -> Text
red (forall a. ToText a => a -> Text
toText RequiresRecreation
x)
    x :: RequiresRecreation
x@RequiresRecreation
RequiresRecreation_Never -> Text -> Text
green (forall a. ToText a => a -> Text
toText RequiresRecreation
x)
    x :: RequiresRecreation
x@RequiresRecreation
RequiresRecreation_Conditionally -> Text -> Text
yellow (forall a. ToText a => a -> Text
toText RequiresRecreation
x)
    RequiresRecreation' Text
x -> Text
x