module Stackctl.Spec.Cat
  ( CatOptions (..)
  , parseCatOptions
  , runCat
  ) where

import Stackctl.Prelude

import Blammo.Logging.Logger (flushLogger)
import Data.Aeson
import qualified Data.Aeson.Key as Key
import Data.Aeson.Lens
import qualified Data.HashMap.Strict as HashMap
import Data.List (sort, sortOn)
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Yaml as Yaml
import Options.Applicative
import Stackctl.AWS
import Stackctl.AWS.Scope
import Stackctl.Colors
import Stackctl.Config (HasConfig)
import Stackctl.DirectoryOption (HasDirectoryOption (..), unDirectoryOption)
import Stackctl.FilterOption (HasFilterOption)
import Stackctl.Spec.Discover
import Stackctl.StackSpec
import Stackctl.StackSpecPath
import Stackctl.StackSpecYaml

data CatOptions = CatOptions
  { CatOptions -> Bool
sctoNoStacks :: Bool
  , CatOptions -> Bool
sctoNoTemplates :: Bool
  , CatOptions -> Bool
sctoBrief :: Bool
  }

-- brittany-disable-next-binding

parseCatOptions :: Parser CatOptions
parseCatOptions :: Parser CatOptions
parseCatOptions =
  Bool -> Bool -> Bool -> CatOptions
CatOptions
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch
      ( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-stacks"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Only show templates/"
      )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
      ( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-templates"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Only show stacks/"
      )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
      ( forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'b'
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"brief"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Don't show file contents, only paths"
      )

runCat
  :: ( MonadMask m
     , MonadResource m
     , MonadLogger m
     , MonadReader env m
     , HasLogger env
     , HasAwsScope env
     , HasConfig env
     , HasDirectoryOption env
     , HasFilterOption env
     )
  => CatOptions
  -> m ()
runCat :: forall (m :: * -> *) env.
(MonadMask m, MonadResource m, MonadLogger m, MonadReader env m,
 HasLogger env, HasAwsScope env, HasConfig env,
 HasDirectoryOption env, HasFilterOption env) =>
CatOptions -> m ()
runCat CatOptions {Bool
sctoBrief :: Bool
sctoNoTemplates :: Bool
sctoNoStacks :: Bool
sctoBrief :: CatOptions -> Bool
sctoNoTemplates :: CatOptions -> Bool
sctoNoStacks :: CatOptions -> Bool
..} = do
  String
dir <- DirectoryOption -> String
unDirectoryOption forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasDirectoryOption env => Lens' env DirectoryOption
directoryOptionL
  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 (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogger env) =>
m Colors
getColorsStdout
  [((AccountId, Text), [(Region, [StackSpec])])]
tree <- [StackSpec] -> [((AccountId, Text), [(Region, [StackSpec])])]
specTree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) env.
(MonadMask m, MonadResource m, MonadLogger m, MonadReader env m,
 HasAwsScope env, HasConfig env, HasDirectoryOption env,
 HasFilterOption env) =>
m [StackSpec]
discoverSpecs

  let
    putStack :: Int -> Text -> m ()
putStack Int
n Text
x = if Bool
sctoNoStacks then forall (f :: * -> *) a. Applicative f => a -> f a
pure () else forall (m :: * -> *). MonadIO m => Int -> Text -> m ()
put Int
n Text
x
    putStackBody :: Int -> [Text] -> m ()
putStackBody Int
n [Text]
x =
      if Bool
sctoNoStacks Bool -> Bool -> Bool
|| Bool
sctoBrief then forall (f :: * -> *) a. Applicative f => a -> f a
pure () else forall (m :: * -> *). MonadIO m => Int -> [Text] -> m ()
putBoxed Int
n [Text]
x
    putTemplate :: Int -> Text -> m ()
putTemplate Int
n Text
x = if Bool
sctoNoTemplates then forall (f :: * -> *) a. Applicative f => a -> f a
pure () else forall (m :: * -> *). MonadIO m => Int -> Text -> m ()
put Int
n Text
x
    putTemplateBody :: Int -> [Text] -> m ()
putTemplateBody Int
n [Text]
x =
      if Bool
sctoNoTemplates Bool -> Bool -> Bool
|| Bool
sctoBrief then forall (f :: * -> *) a. Applicative f => a -> f a
pure () else forall (m :: * -> *). MonadIO m => Int -> [Text] -> m ()
putBoxed Int
n [Text]
x

  forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogger env) =>
m ()
flushLogger

  forall (m :: * -> *). MonadIO m => Int -> Text -> m ()
put Int
0 forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
dir forall a. Semigroup a => a -> a -> a
<> Text
"/"
  Int -> Text -> m ()
putStack Int
2 Text
"stacks/"
  [[[String]]]
templates <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [((AccountId, Text), [(Region, [StackSpec])])]
tree forall a b. (a -> b) -> a -> b
$ \((AccountId
accountId, Text
accountName), [(Region, [StackSpec])]
regions) -> do
    Int -> Text -> m ()
putStack Int
4 forall a b. (a -> b) -> a -> b
$ Text -> Text
magenta (AccountId -> Text
unAccountId AccountId
accountId) forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text
accountName forall a. Semigroup a => a -> a -> a
<> Text
"/"

    forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Region, [StackSpec])]
regions forall a b. (a -> b) -> a -> b
$ \(Region
region, [StackSpec]
specs) -> do
      Int -> Text -> m ()
putStack Int
6 forall a b. (a -> b) -> a -> b
$ Text -> Text
magenta (forall a. ToText a => a -> Text
toText Region
region) forall a. Semigroup a => a -> a -> a
<> Text
"/"

      let sorted :: [StackSpec]
sorted = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (StackSpecPath -> String
stackSpecPathBasePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpec -> StackSpecPath
stackSpecSpecPath) [StackSpec]
specs
      forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [StackSpec]
sorted forall a b. (a -> b) -> a -> b
$ \StackSpec
spec -> do
        let
          base :: String
base = StackSpecPath -> String
stackSpecPathBasePath forall a b. (a -> b) -> a -> b
$ StackSpec -> StackSpecPath
stackSpecSpecPath StackSpec
spec
          body :: StackSpecYaml
body = StackSpec -> StackSpecYaml
stackSpecSpecBody StackSpec
spec
          name :: StackName
name = StackSpec -> StackName
stackSpecStackName StackSpec
spec
          yaml :: [Text]
yaml = Colors -> StackName -> StackSpecYaml -> [Text]
prettyPrintStackSpecYaml Colors
colors StackName
name StackSpecYaml
body

        Int -> Text -> m ()
putStack Int
8 forall a b. (a -> b) -> a -> b
$ Text -> Text
magenta (forall a. IsString a => String -> a
fromString String
base)
        Int -> [Text] -> m ()
putStackBody Int
10 [Text]
yaml
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ StackSpecYaml -> String
ssyTemplate StackSpecYaml
body

  Int -> Text -> m ()
putTemplate Int
2 Text
"templates/"
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[String]]]
templates) forall a b. (a -> b) -> a -> b
$ \String
template -> do
    Value
val <- forall (m :: * -> *) a. (MonadIO m, FromJSON a) => String -> m a
Yaml.decodeFileThrow @_ @Value forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"templates" String -> String -> String
</> String
template

    Int -> Text -> m ()
putTemplate Int
4 forall a b. (a -> b) -> a -> b
$ Text -> Text
green forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
template
    Int -> [Text] -> m ()
putTemplateBody Int
6 forall a b. (a -> b) -> a -> b
$ Colors -> Value -> [Text]
prettyPrintTemplate Colors
colors Value
val

specTree :: [StackSpec] -> [((AccountId, Text), [(Region, [StackSpec])])]
specTree :: [StackSpec] -> [((AccountId, Text), [(Region, [StackSpec])])]
specTree = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [StackSpec] -> [(Region, [StackSpec])]
groupRegion) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StackSpec] -> [((AccountId, Text), [StackSpec])]
groupAccount
 where
  groupRegion :: [StackSpec] -> [(Region, [StackSpec])]
  groupRegion :: [StackSpec] -> [(Region, [StackSpec])]
groupRegion = forall b a. Ord b => (a -> b) -> [a] -> [(b, [a])]
groupTo (StackSpecPath -> Region
stackSpecPathRegion forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpec -> StackSpecPath
stackSpecSpecPath)

  groupAccount :: [StackSpec] -> [((AccountId, Text), [StackSpec])]
  groupAccount :: [StackSpec] -> [((AccountId, Text), [StackSpec])]
groupAccount =
    forall b a. Ord b => (a -> b) -> [a] -> [(b, [a])]
groupTo
      ((StackSpecPath -> AccountId
stackSpecPathAccountId forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& StackSpecPath -> Text
stackSpecPathAccountName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpec -> StackSpecPath
stackSpecSpecPath)

groupTo :: Ord b => (a -> b) -> [a] -> [(b, [a])]
groupTo :: forall b a. Ord b => (a -> b) -> [a] -> [(b, [a])]
groupTo a -> b
f = forall a b. (a -> b) -> [a] -> [b]
map (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NE.head forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. NonEmpty a -> [a]
NE.toList) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [NonEmpty a]
NE.groupAllWith a -> b
f

prettyPrintStackSpecYaml :: Colors -> StackName -> StackSpecYaml -> [Text]
prettyPrintStackSpecYaml :: Colors -> StackName -> StackSpecYaml -> [Text]
prettyPrintStackSpecYaml 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
..} StackName
name StackSpecYaml {String
Maybe [Capability]
Maybe [StackName]
Maybe [Action]
Maybe StackDescription
Maybe TagsYaml
Maybe ParametersYaml
ssyTags :: StackSpecYaml -> Maybe TagsYaml
ssyCapabilities :: StackSpecYaml -> Maybe [Capability]
ssyParameters :: StackSpecYaml -> Maybe ParametersYaml
ssyActions :: StackSpecYaml -> Maybe [Action]
ssyDepends :: StackSpecYaml -> Maybe [StackName]
ssyDescription :: StackSpecYaml -> Maybe StackDescription
ssyTags :: Maybe TagsYaml
ssyCapabilities :: Maybe [Capability]
ssyParameters :: Maybe ParametersYaml
ssyActions :: Maybe [Action]
ssyDepends :: Maybe [StackName]
ssyTemplate :: String
ssyDescription :: Maybe StackDescription
ssyTemplate :: StackSpecYaml -> String
..} =
  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Text -> Text
cyan Text
"Name" forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> Text -> Text
green (StackName -> Text
unStackName StackName
name)]
    , forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] StackDescription -> [Text]
ppDescription Maybe StackDescription
ssyDescription
    , [Text -> Text
cyan Text
"Template" forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> Text -> Text
green (String -> Text
pack String
ssyTemplate)]
    , forall a. Text -> (a -> [(Text, Maybe Text)]) -> Maybe a -> [Text]
ppObject Text
"Parameters" ParametersYaml -> [(Text, Maybe Text)]
parametersYamlKVs Maybe ParametersYaml
ssyParameters
    , forall a. Text -> (a -> [Text]) -> Maybe a -> [Text]
ppList Text
"Capabilities" [Capability] -> [Text]
ppCapabilities Maybe [Capability]
ssyCapabilities
    , forall a. Text -> (a -> [(Text, Maybe Text)]) -> Maybe a -> [Text]
ppObject Text
"Tags" TagsYaml -> [(Text, Maybe Text)]
tagsYamlKVs Maybe TagsYaml
ssyTags
    ]
 where
  ppObject :: Text -> (a -> [(Text, Maybe Text)]) -> Maybe a -> [Text]
  ppObject :: forall a. Text -> (a -> [(Text, Maybe Text)]) -> Maybe a -> [Text]
ppObject Text
label a -> [(Text, Maybe Text)]
f Maybe a
mA = forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ do
    [(Text, Maybe Text)]
kvs <- a -> [(Text, Maybe Text)]
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mA
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      forall a b. (a -> b) -> a -> b
$ [Text -> Text
cyan Text
label forall a. Semigroup a => a -> a -> a
<> Text
":"]
      forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map
        ( \(Text
k, Maybe Text
mV) ->
            Text
"  " forall a. Semigroup a => a -> a -> a
<> Text -> Text
cyan Text
k 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
v -> Text
" " forall a. Semigroup a => a -> a -> a
<> Text -> Text
green Text
v) Maybe Text
mV
        )
        [(Text, Maybe Text)]
kvs

  ppList :: Text -> (a -> [Text]) -> Maybe a -> [Text]
  ppList :: forall a. Text -> (a -> [Text]) -> Maybe a -> [Text]
ppList Text
label a -> [Text]
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (((Text -> Text
cyan Text
label forall a. Semigroup a => a -> a -> a
<> Text
":") forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Text]
f)

  ppDescription :: StackDescription -> [Text]
ppDescription StackDescription
d =
    [Text -> Text
cyan Text
"Description" forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> Text -> Text
green (StackDescription -> Text
unStackDescription StackDescription
d)]
  ppCapabilities :: [Capability] -> [Text]
ppCapabilities = forall a b. (a -> b) -> [a] -> [b]
map ((Text
"  - " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
green forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToText a => a -> Text
toText)

parametersYamlKVs :: ParametersYaml -> [(Text, Maybe Text)]
parametersYamlKVs :: ParametersYaml -> [(Text, Maybe Text)]
parametersYamlKVs = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ParameterYaml -> Maybe (Text, Maybe Text)
parameterYamlKV forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParametersYaml -> [ParameterYaml]
unParametersYaml

parameterYamlKV :: ParameterYaml -> Maybe (Text, Maybe Text)
parameterYamlKV :: ParameterYaml -> Maybe (Text, Maybe Text)
parameterYamlKV ParameterYaml
py =
  (,)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parameter
p forall s a. s -> Getting a s a -> a
^. Lens' Parameter (Maybe Text)
parameter_parameterKey)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Parameter
p forall s a. s -> Getting a s a -> a
^. Lens' Parameter (Maybe Text)
parameter_parameterValue)
 where
  p :: Parameter
p = ParameterYaml -> Parameter
unParameterYaml ParameterYaml
py

tagsYamlKVs :: TagsYaml -> [(Text, Maybe Text)]
tagsYamlKVs :: TagsYaml -> [(Text, Maybe Text)]
tagsYamlKVs = forall a b. (a -> b) -> [a] -> [b]
map (Tag -> (Text, Maybe Text)
tagKV forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagYaml -> Tag
unTagYaml) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagsYaml -> [TagYaml]
unTagsYaml

tagKV :: Tag -> (Text, Maybe Text)
tagKV :: Tag -> (Text, Maybe Text)
tagKV Tag
tg = (Tag
tg forall s a. s -> Getting a s a -> a
^. Lens' Tag Text
tag_key, Tag
tg forall s a. s -> Getting a s a -> a
^. Lens' Tag Text
tag_value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. (s -> a) -> SimpleGetter s a
to forall a. a -> Maybe a
Just)

prettyPrintTemplate :: Colors -> Value -> [Text]
prettyPrintTemplate :: Colors -> Value -> [Text]
prettyPrintTemplate 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
..} Value
val =
  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Text -> [Text]
displayTextProperty Text
"Description"
    , Text -> [Text]
displayObjectProperty Text
"Parameters"
    , Text -> [Text]
displayObjectProperty Text
"Resources"
    , Text -> [Text]
displayObjectProperty Text
"Outputs"
    ]
 where
  displayTextProperty :: Text -> [Text]
  displayTextProperty :: Text -> [Text]
displayTextProperty = forall a. (FromJSON a, ToJSON a) => (a -> [Text]) -> Text -> [Text]
displayPropertyWith
    forall a b. (a -> b) -> a -> b
$ \String
v -> let tp :: Text
tp = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (forall a. Eq a => a -> a -> Bool
== Char
'\n') forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
v in [Text
"  " forall a. Semigroup a => a -> a -> a
<> Text -> Text
green Text
tp]

  displayObjectProperty :: Text -> [Text]
  displayObjectProperty :: Text -> [Text]
displayObjectProperty =
    forall a. (FromJSON a, ToJSON a) => (a -> [Text]) -> Text -> [Text]
displayPropertyWith @(HashMap Text Value)
      forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((Text
"  - " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
green)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [k]
HashMap.keys

  displayPropertyWith
    :: (FromJSON a, ToJSON a) => (a -> [Text]) -> Text -> [Text]
  displayPropertyWith :: forall a. (FromJSON a, ToJSON a) => (a -> [Text]) -> Text -> [Text]
displayPropertyWith a -> [Text]
f Text
k = Text -> Text
cyan Text
k forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. a -> [a] -> [a]
: forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Text]
displayValue
   where
    displayValue :: Maybe [Text]
displayValue = Value
val forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key (Text -> Key
Key.fromText Text
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
_JSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. (s -> a) -> SimpleGetter s a
to a -> [Text]
f

putBoxed :: MonadIO m => Int -> [Text] -> m ()
putBoxed :: forall (m :: * -> *). MonadIO m => Int -> [Text] -> m ()
putBoxed Int
n [Text]
xs = do
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *). MonadIO m => Int -> Text -> m ()
put Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"│ " forall a. Semigroup a => a -> a -> a
<>)) [Text]
xs
  forall (m :: * -> *). MonadIO m => Int -> Text -> m ()
put Int
n Text
"└──────────"
  forall (m :: * -> *). MonadIO m => Int -> Text -> m ()
put Int
0 Text
""

put :: MonadIO m => Int -> Text -> m ()
put :: forall (m :: * -> *). MonadIO m => Int -> Text -> m ()
put Int
n = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
T.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
indent forall a. Semigroup a => a -> a -> a
<>)
 where
  indent :: Text
indent = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
n Text
" "