{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

module Network.AWS.ARN.States
  ( StateMachine (..),
    parseStateMachine,
    renderStateMachine,
    _StateMachine,
  )
where

import Data.Hashable (Hashable)
import Data.Maybe (maybeToList)
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics (Generic)
import Lens.Micro.Pro (Prism', prism')

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Lens.Micro.Pro ((^?))

-- | An AWS State Machine, made of its name and optional qualifier.
--
-- >>> "stateMachine:orderProcessor" ^? _StateMachine
-- Just (StateMachine {name = "orderProcessor", qualifier = Nothing})
--
-- >>> "stateMachine:orderProcessor:v2" ^? _StateMachine
-- Just (StateMachine {name = "orderProcessor", qualifier = Just "v2"})
--
-- @since 0.3.3.0
data StateMachine = StateMachine
  { StateMachine -> Text
name :: Text
  , StateMachine -> Maybe Text
qualifier :: Maybe Text
  }
  deriving (StateMachine -> StateMachine -> Bool
(StateMachine -> StateMachine -> Bool)
-> (StateMachine -> StateMachine -> Bool) -> Eq StateMachine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StateMachine -> StateMachine -> Bool
== :: StateMachine -> StateMachine -> Bool
$c/= :: StateMachine -> StateMachine -> Bool
/= :: StateMachine -> StateMachine -> Bool
Eq, Eq StateMachine
Eq StateMachine =>
(StateMachine -> StateMachine -> Ordering)
-> (StateMachine -> StateMachine -> Bool)
-> (StateMachine -> StateMachine -> Bool)
-> (StateMachine -> StateMachine -> Bool)
-> (StateMachine -> StateMachine -> Bool)
-> (StateMachine -> StateMachine -> StateMachine)
-> (StateMachine -> StateMachine -> StateMachine)
-> Ord StateMachine
StateMachine -> StateMachine -> Bool
StateMachine -> StateMachine -> Ordering
StateMachine -> StateMachine -> StateMachine
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StateMachine -> StateMachine -> Ordering
compare :: StateMachine -> StateMachine -> Ordering
$c< :: StateMachine -> StateMachine -> Bool
< :: StateMachine -> StateMachine -> Bool
$c<= :: StateMachine -> StateMachine -> Bool
<= :: StateMachine -> StateMachine -> Bool
$c> :: StateMachine -> StateMachine -> Bool
> :: StateMachine -> StateMachine -> Bool
$c>= :: StateMachine -> StateMachine -> Bool
>= :: StateMachine -> StateMachine -> Bool
$cmax :: StateMachine -> StateMachine -> StateMachine
max :: StateMachine -> StateMachine -> StateMachine
$cmin :: StateMachine -> StateMachine -> StateMachine
min :: StateMachine -> StateMachine -> StateMachine
Ord, Eq StateMachine
Eq StateMachine =>
(Int -> StateMachine -> Int)
-> (StateMachine -> Int) -> Hashable StateMachine
Int -> StateMachine -> Int
StateMachine -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> StateMachine -> Int
hashWithSalt :: Int -> StateMachine -> Int
$chash :: StateMachine -> Int
hash :: StateMachine -> Int
Hashable, Int -> StateMachine -> ShowS
[StateMachine] -> ShowS
StateMachine -> String
(Int -> StateMachine -> ShowS)
-> (StateMachine -> String)
-> ([StateMachine] -> ShowS)
-> Show StateMachine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StateMachine -> ShowS
showsPrec :: Int -> StateMachine -> ShowS
$cshow :: StateMachine -> String
show :: StateMachine -> String
$cshowList :: [StateMachine] -> ShowS
showList :: [StateMachine] -> ShowS
Show, (forall x. StateMachine -> Rep StateMachine x)
-> (forall x. Rep StateMachine x -> StateMachine)
-> Generic StateMachine
forall x. Rep StateMachine x -> StateMachine
forall x. StateMachine -> Rep StateMachine x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StateMachine -> Rep StateMachine x
from :: forall x. StateMachine -> Rep StateMachine x
$cto :: forall x. Rep StateMachine x -> StateMachine
to :: forall x. Rep StateMachine x -> StateMachine
Generic)

-- | @since 0.3.3.0
parseStateMachine :: Text -> Maybe StateMachine
parseStateMachine :: Text -> Maybe StateMachine
parseStateMachine Text
t = case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
":" Text
t of
  (Text
"stateMachine" : Text
nam : [Text]
qual) ->
    (Maybe Text -> StateMachine) -> Maybe (Maybe Text -> StateMachine)
forall a. a -> Maybe a
Just (Text -> Maybe Text -> StateMachine
StateMachine Text
nam) Maybe (Maybe Text -> StateMachine)
-> Maybe (Maybe Text) -> Maybe StateMachine
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> case [Text]
qual of
      [Text
q] -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just (Maybe Text -> Maybe (Maybe Text))
-> Maybe Text -> Maybe (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
q
      [] -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just Maybe Text
forall a. Maybe a
Nothing
      [Text]
_ -> Maybe (Maybe Text)
forall a. Maybe a
Nothing
  [Text]
_ -> Maybe StateMachine
forall a. Maybe a
Nothing

-- | @since 0.3.3.0
renderStateMachine :: StateMachine -> Text
renderStateMachine :: StateMachine -> Text
renderStateMachine StateMachine
s =
  Text -> [Text] -> Text
T.intercalate Text
":" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    [Text
"stateMachine", StateMachine -> Text
name StateMachine
s] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (StateMachine -> Maybe Text
qualifier StateMachine
s)

-- | @since 0.3.3.0
_StateMachine :: Prism' Text StateMachine
_StateMachine :: Prism' Text StateMachine
_StateMachine = (StateMachine -> Text)
-> (Text -> Maybe StateMachine) -> Prism' Text StateMachine
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' StateMachine -> Text
renderStateMachine Text -> Maybe StateMachine
parseStateMachine