-- | Definition of our @stacks/<account>/<region>/<stack-name>.yaml@ format
--
-- @
-- Template: <path>
--
-- Depends:
-- - <string>
--
-- Parameters:
-- - ParameterKey: <string>
--   ParameterValue: <string>
--
-- Capabilities:
-- - <capability>
--
-- Tags:
-- - Key: <string>
--   Value: <string>
-- @
module Stackctl.StackSpecYaml
  ( StackSpecYaml (..)
  , ParametersYaml
  , parametersYaml
  , unParametersYaml
  , ParameterYaml
  , parameterYaml
  , unParameterYaml
  , TagsYaml
  , tagsYaml
  , unTagsYaml
  , TagYaml (..)
  ) where

import Stackctl.Prelude

import Data.Aeson
import Data.Aeson.Casing
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KeyMap
import Data.Aeson.Types (typeMismatch)
import qualified Data.HashMap.Strict as HashMap
import Data.Monoid (Last (..))
import qualified Data.Text as T
import Stackctl.AWS
import Stackctl.Action

data StackSpecYaml = StackSpecYaml
  { StackSpecYaml -> Maybe StackDescription
ssyDescription :: Maybe StackDescription
  , StackSpecYaml -> FilePath
ssyTemplate :: FilePath
  , StackSpecYaml -> Maybe [StackName]
ssyDepends :: Maybe [StackName]
  , StackSpecYaml -> Maybe [Action]
ssyActions :: Maybe [Action]
  , StackSpecYaml -> Maybe ParametersYaml
ssyParameters :: Maybe ParametersYaml
  , StackSpecYaml -> Maybe [Capability]
ssyCapabilities :: Maybe [Capability]
  , StackSpecYaml -> Maybe TagsYaml
ssyTags :: Maybe TagsYaml
  }
  deriving stock (StackSpecYaml -> StackSpecYaml -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackSpecYaml -> StackSpecYaml -> Bool
$c/= :: StackSpecYaml -> StackSpecYaml -> Bool
== :: StackSpecYaml -> StackSpecYaml -> Bool
$c== :: StackSpecYaml -> StackSpecYaml -> Bool
Eq, Int -> StackSpecYaml -> ShowS
[StackSpecYaml] -> ShowS
StackSpecYaml -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [StackSpecYaml] -> ShowS
$cshowList :: [StackSpecYaml] -> ShowS
show :: StackSpecYaml -> FilePath
$cshow :: StackSpecYaml -> FilePath
showsPrec :: Int -> StackSpecYaml -> ShowS
$cshowsPrec :: Int -> StackSpecYaml -> ShowS
Show, forall x. Rep StackSpecYaml x -> StackSpecYaml
forall x. StackSpecYaml -> Rep StackSpecYaml x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StackSpecYaml x -> StackSpecYaml
$cfrom :: forall x. StackSpecYaml -> Rep StackSpecYaml x
Generic)

instance FromJSON StackSpecYaml where
  parseJSON :: Value -> Parser StackSpecYaml
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON forall a b. (a -> b) -> a -> b
$ ShowS -> Options
aesonPrefix forall a. a -> a
id

instance ToJSON StackSpecYaml where
  toJSON :: StackSpecYaml -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON forall a b. (a -> b) -> a -> b
$ ShowS -> Options
aesonPrefix forall a. a -> a
id
  toEncoding :: StackSpecYaml -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding forall a b. (a -> b) -> a -> b
$ ShowS -> Options
aesonPrefix forall a. a -> a
id

newtype ParametersYaml = ParametersYaml
  { ParametersYaml -> [ParameterYaml]
unParametersYaml :: [ParameterYaml]
  }
  deriving stock (ParametersYaml -> ParametersYaml -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParametersYaml -> ParametersYaml -> Bool
$c/= :: ParametersYaml -> ParametersYaml -> Bool
== :: ParametersYaml -> ParametersYaml -> Bool
$c== :: ParametersYaml -> ParametersYaml -> Bool
Eq, Int -> ParametersYaml -> ShowS
[ParametersYaml] -> ShowS
ParametersYaml -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ParametersYaml] -> ShowS
$cshowList :: [ParametersYaml] -> ShowS
show :: ParametersYaml -> FilePath
$cshow :: ParametersYaml -> FilePath
showsPrec :: Int -> ParametersYaml -> ShowS
$cshowsPrec :: Int -> ParametersYaml -> ShowS
Show)

instance Semigroup ParametersYaml where
  ParametersYaml [ParameterYaml]
as <> :: ParametersYaml -> ParametersYaml -> ParametersYaml
<> ParametersYaml [ParameterYaml]
bs =
    [ParameterYaml] -> ParametersYaml
ParametersYaml
      forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Last ParameterValue -> ParameterYaml
ParameterYaml)
      forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> [(Key, v)]
KeyMap.toList
      forall a b. (a -> b) -> a -> b
$ forall v. (v -> v -> v) -> [(Key, v)] -> KeyMap v
KeyMap.fromListWith forall a. Semigroup a => a -> a -> a
(<>)
      forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (ParameterYaml -> Key
pyKey forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ParameterYaml -> Last ParameterValue
pyValue)
      forall a b. (a -> b) -> a -> b
$ [ParameterYaml]
bs -- flipped to make sure Last-wins
      forall a. Semigroup a => a -> a -> a
<> [ParameterYaml]
as

instance FromJSON ParametersYaml where
  parseJSON :: Value -> Parser ParametersYaml
parseJSON = \case
    Object Object
o -> do
      -- NB. There are simpler ways to do this, but making sure we construct
      -- things such that we use (.:) to read the value from each key means that
      -- error messages will include "Parameters.{k}". See specs for an example.
      let parseKey :: Key -> Parser ParameterYaml
parseKey Key
k = Key -> Last ParameterValue -> ParameterYaml
ParameterYaml Key
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
k
      [ParameterYaml] -> ParametersYaml
ParametersYaml forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Key -> Parser ParameterYaml
parseKey (forall v. KeyMap v -> [Key]
KeyMap.keys Object
o)
    v :: Value
v@Array {} -> [ParameterYaml] -> ParametersYaml
ParametersYaml forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Value
v -> forall a. FilePath -> Value -> Parser a
typeMismatch forall {a}. (Semigroup a, IsString a) => a
err Value
v
   where
    err :: a
err =
      a
"Object"
        forall a. Semigroup a => a -> a -> a
<> a
", list of {ParameterKey, ParameterValue} Objects"
        forall a. Semigroup a => a -> a -> a
<> a
", or list of {Key, Value} Objects"

instance ToJSON ParametersYaml where
  toJSON :: ParametersYaml -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall kv. KeyValue kv => ParametersYaml -> [kv]
parametersYamlPairs
  toEncoding :: ParametersYaml -> Encoding
toEncoding = Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall kv. KeyValue kv => ParametersYaml -> [kv]
parametersYamlPairs

parametersYamlPairs :: KeyValue kv => ParametersYaml -> [kv]
parametersYamlPairs :: forall kv. KeyValue kv => ParametersYaml -> [kv]
parametersYamlPairs = forall a b. (a -> b) -> [a] -> [b]
map forall kv. KeyValue kv => ParameterYaml -> kv
parameterYamlPair forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParametersYaml -> [ParameterYaml]
unParametersYaml

parametersYaml :: [ParameterYaml] -> ParametersYaml
parametersYaml :: [ParameterYaml] -> ParametersYaml
parametersYaml = [ParameterYaml] -> ParametersYaml
ParametersYaml

data ParameterYaml = ParameterYaml
  { ParameterYaml -> Key
pyKey :: Key
  , ParameterYaml -> Last ParameterValue
pyValue :: Last ParameterValue
  }
  deriving stock (ParameterYaml -> ParameterYaml -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParameterYaml -> ParameterYaml -> Bool
$c/= :: ParameterYaml -> ParameterYaml -> Bool
== :: ParameterYaml -> ParameterYaml -> Bool
$c== :: ParameterYaml -> ParameterYaml -> Bool
Eq, Int -> ParameterYaml -> ShowS
[ParameterYaml] -> ShowS
ParameterYaml -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ParameterYaml] -> ShowS
$cshowList :: [ParameterYaml] -> ShowS
show :: ParameterYaml -> FilePath
$cshow :: ParameterYaml -> FilePath
showsPrec :: Int -> ParameterYaml -> ShowS
$cshowsPrec :: Int -> ParameterYaml -> ShowS
Show)

instance FromJSON ParameterYaml where
  parseJSON :: Value -> Parser ParameterYaml
parseJSON = forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject FilePath
"Parameter" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    (Text -> Maybe ParameterValue -> ParameterYaml
mkParameterYaml forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Name" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"Value")
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Maybe ParameterValue -> ParameterYaml
mkParameterYaml forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ParameterKey" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ParameterValue")

parameterYamlPair :: KeyValue kv => ParameterYaml -> kv
parameterYamlPair :: forall kv. KeyValue kv => ParameterYaml -> kv
parameterYamlPair ParameterYaml {Key
Last ParameterValue
pyValue :: Last ParameterValue
pyKey :: Key
pyValue :: ParameterYaml -> Last ParameterValue
pyKey :: ParameterYaml -> Key
..} = Key
pyKey forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Last ParameterValue
pyValue

mkParameterYaml :: Text -> Maybe ParameterValue -> ParameterYaml
mkParameterYaml :: Text -> Maybe ParameterValue -> ParameterYaml
mkParameterYaml Text
k = Key -> Last ParameterValue -> ParameterYaml
ParameterYaml (Text -> Key
Key.fromText Text
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> Last a
Last

parameterYaml :: Parameter -> Maybe ParameterYaml
parameterYaml :: Parameter -> Maybe ParameterYaml
parameterYaml Parameter
p = do
  Text
k <- Parameter
p forall s a. s -> Getting a s a -> a
^. Lens' Parameter (Maybe Text)
parameter_parameterKey
  let mv :: Maybe Text
mv = Parameter
p forall s a. s -> Getting a s a -> a
^. Lens' Parameter (Maybe Text)
parameter_parameterValue
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Maybe ParameterValue -> ParameterYaml
mkParameterYaml Text
k forall a b. (a -> b) -> a -> b
$ Text -> ParameterValue
ParameterValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mv

unParameterYaml :: ParameterYaml -> Parameter
unParameterYaml :: ParameterYaml -> Parameter
unParameterYaml (ParameterYaml Key
k Last ParameterValue
v) =
  Text -> Maybe Text -> Parameter
makeParameter (Key -> Text
Key.toText Key
k) forall a b. (a -> b) -> a -> b
$ ParameterValue -> Text
unParameterValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Last a -> Maybe a
getLast Last ParameterValue
v

newtype ParameterValue = ParameterValue
  { ParameterValue -> Text
unParameterValue :: Text
  }
  deriving stock (ParameterValue -> ParameterValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParameterValue -> ParameterValue -> Bool
$c/= :: ParameterValue -> ParameterValue -> Bool
== :: ParameterValue -> ParameterValue -> Bool
$c== :: ParameterValue -> ParameterValue -> Bool
Eq, Int -> ParameterValue -> ShowS
[ParameterValue] -> ShowS
ParameterValue -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ParameterValue] -> ShowS
$cshowList :: [ParameterValue] -> ShowS
show :: ParameterValue -> FilePath
$cshow :: ParameterValue -> FilePath
showsPrec :: Int -> ParameterValue -> ShowS
$cshowsPrec :: Int -> ParameterValue -> ShowS
Show)
  deriving newtype (NonEmpty ParameterValue -> ParameterValue
ParameterValue -> ParameterValue -> ParameterValue
forall b. Integral b => b -> ParameterValue -> ParameterValue
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> ParameterValue -> ParameterValue
$cstimes :: forall b. Integral b => b -> ParameterValue -> ParameterValue
sconcat :: NonEmpty ParameterValue -> ParameterValue
$csconcat :: NonEmpty ParameterValue -> ParameterValue
<> :: ParameterValue -> ParameterValue -> ParameterValue
$c<> :: ParameterValue -> ParameterValue -> ParameterValue
Semigroup, [ParameterValue] -> Encoding
[ParameterValue] -> Value
ParameterValue -> Encoding
ParameterValue -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ParameterValue] -> Encoding
$ctoEncodingList :: [ParameterValue] -> Encoding
toJSONList :: [ParameterValue] -> Value
$ctoJSONList :: [ParameterValue] -> Value
toEncoding :: ParameterValue -> Encoding
$ctoEncoding :: ParameterValue -> Encoding
toJSON :: ParameterValue -> Value
$ctoJSON :: ParameterValue -> Value
ToJSON)

instance FromJSON ParameterValue where
  parseJSON :: Value -> Parser ParameterValue
parseJSON = \case
    String Text
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> ParameterValue
ParameterValue Text
x
    Number Scientific
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> ParameterValue
ParameterValue forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
dropSuffix Text
".0" forall a b. (a -> b) -> a -> b
$ FilePath -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show Scientific
x
    Value
x -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Expected String or Number, got: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Value
x

newtype TagsYaml = TagsYaml
  { TagsYaml -> [TagYaml]
unTagsYaml :: [TagYaml]
  }
  deriving stock (TagsYaml -> TagsYaml -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagsYaml -> TagsYaml -> Bool
$c/= :: TagsYaml -> TagsYaml -> Bool
== :: TagsYaml -> TagsYaml -> Bool
$c== :: TagsYaml -> TagsYaml -> Bool
Eq, Int -> TagsYaml -> ShowS
[TagsYaml] -> ShowS
TagsYaml -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TagsYaml] -> ShowS
$cshowList :: [TagsYaml] -> ShowS
show :: TagsYaml -> FilePath
$cshow :: TagsYaml -> FilePath
showsPrec :: Int -> TagsYaml -> ShowS
$cshowsPrec :: Int -> TagsYaml -> ShowS
Show)

instance Semigroup TagsYaml where
  TagsYaml [TagYaml]
as <> :: TagsYaml -> TagsYaml -> TagsYaml
<> TagsYaml [TagYaml]
bs =
    [TagYaml] -> TagsYaml
TagsYaml
      forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Tag -> TagYaml
TagYaml forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Tag
newTag)
      forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
HashMap.toList
      forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
      forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Tag -> (Text, Text)
toPair forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagYaml -> Tag
unTagYaml)
      forall a b. (a -> b) -> a -> b
$ [TagYaml]
as
      forall a. Semigroup a => a -> a -> a
<> [TagYaml]
bs
   where
    toPair :: Tag -> (Text, Text)
    toPair :: Tag -> (Text, Text)
toPair = (forall s a. s -> Getting a s a -> a
^. Lens' Tag Text
tag_key) forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (forall s a. s -> Getting a s a -> a
^. Lens' Tag Text
tag_value)

instance FromJSON TagsYaml where
  parseJSON :: Value -> Parser TagsYaml
parseJSON = \case
    Object Object
o -> do
      let parseKey :: Key -> Parser TagYaml
parseKey Key
k = do
            Tag
t <- Text -> Text -> Tag
newTag (Key -> Text
Key.toText Key
k) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
k
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Tag -> TagYaml
TagYaml Tag
t
      [TagYaml] -> TagsYaml
TagsYaml forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Key -> Parser TagYaml
parseKey (forall v. KeyMap v -> [Key]
KeyMap.keys Object
o)
    v :: Value
v@Array {} -> [TagYaml] -> TagsYaml
TagsYaml forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Value
v -> forall a. FilePath -> Value -> Parser a
typeMismatch forall {a}. IsString a => a
err Value
v
   where
    err :: a
err = a
"Object or list of {Key, Value} Objects"

instance ToJSON TagsYaml where
  toJSON :: TagsYaml -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall kv. KeyValue kv => TagsYaml -> [kv]
tagsYamlPairs
  toEncoding :: TagsYaml -> Encoding
toEncoding = Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall kv. KeyValue kv => TagsYaml -> [kv]
tagsYamlPairs

tagsYamlPairs :: KeyValue kv => TagsYaml -> [kv]
tagsYamlPairs :: forall kv. KeyValue kv => TagsYaml -> [kv]
tagsYamlPairs = forall a b. (a -> b) -> [a] -> [b]
map forall kv. KeyValue kv => TagYaml -> kv
tagYamlPair forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagsYaml -> [TagYaml]
unTagsYaml

tagsYaml :: [TagYaml] -> TagsYaml
tagsYaml :: [TagYaml] -> TagsYaml
tagsYaml = [TagYaml] -> TagsYaml
TagsYaml

newtype TagYaml = TagYaml
  { TagYaml -> Tag
unTagYaml :: Tag
  }
  deriving newtype (TagYaml -> TagYaml -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagYaml -> TagYaml -> Bool
$c/= :: TagYaml -> TagYaml -> Bool
== :: TagYaml -> TagYaml -> Bool
$c== :: TagYaml -> TagYaml -> Bool
Eq, Int -> TagYaml -> ShowS
[TagYaml] -> ShowS
TagYaml -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TagYaml] -> ShowS
$cshowList :: [TagYaml] -> ShowS
show :: TagYaml -> FilePath
$cshow :: TagYaml -> FilePath
showsPrec :: Int -> TagYaml -> ShowS
$cshowsPrec :: Int -> TagYaml -> ShowS
Show)

instance FromJSON TagYaml where
  parseJSON :: Value -> Parser TagYaml
parseJSON = forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject FilePath
"Tag" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Tag
t <- Text -> Text -> Tag
newTag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Key" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Value"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Tag -> TagYaml
TagYaml Tag
t

tagYamlPair :: KeyValue kv => TagYaml -> kv
tagYamlPair :: forall kv. KeyValue kv => TagYaml -> kv
tagYamlPair (TagYaml Tag
t) = Text -> Key
Key.fromText (Tag
t forall s a. s -> Getting a s a -> a
^. Lens' Tag Text
tag_key) forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Tag
t forall s a. s -> Getting a s a -> a
^. Lens' Tag Text
tag_value)

dropSuffix :: Text -> Text -> Text
dropSuffix :: Text -> Text -> Text
dropSuffix Text
suffix Text
t = forall a. a -> Maybe a -> a
fromMaybe Text
t forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripSuffix Text
suffix Text
t