{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
--
-- Module      : Network.AWS.ARN.Lambda
-- Copyright   : (C) 2020-2021 Bellroy Pty Ltd
-- License     : BSD-3-Clause
-- Maintainer  : Bellroy Tech Team <haskell@bellroy.com>
-- Stability   : experimental
module Network.AWS.ARN.Lambda
  ( -- * Functions
    Function (..),
    toFunction,
    fromFunction,

    -- ** Function Optics
    _Function,
    fName,
    fQualifier,
  )
where

import Control.Lens
import Data.Hashable (Hashable)
import Data.Maybe (maybeToList)
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics (Generic)

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Control.Lens

-- | An AWS Lambda function name, and optional alias/version qualifier.
--
-- >>> "function:helloworld" ^? _Function
-- Just (Function {_fName = "helloworld", _fQualifier = Nothing})
--
-- >>> "function:helloworld:$LATEST" ^? _Function
-- Just (Function {_fName = "helloworld", _fQualifier = Just "$LATEST"})
--
-- >>> "function:helloworld:42" ^? _Function
-- Just (Function {_fName = "helloworld", _fQualifier = Just "42"})
data Function = Function
  { Function -> Text
_fName :: Text,
    Function -> Maybe Text
_fQualifier :: Maybe Text
  }
  deriving (Function -> Function -> Bool
(Function -> Function -> Bool)
-> (Function -> Function -> Bool) -> Eq Function
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Function -> Function -> Bool
$c/= :: Function -> Function -> Bool
== :: Function -> Function -> Bool
$c== :: Function -> Function -> Bool
Eq, Eq Function
Eq Function
-> (Function -> Function -> Ordering)
-> (Function -> Function -> Bool)
-> (Function -> Function -> Bool)
-> (Function -> Function -> Bool)
-> (Function -> Function -> Bool)
-> (Function -> Function -> Function)
-> (Function -> Function -> Function)
-> Ord Function
Function -> Function -> Bool
Function -> Function -> Ordering
Function -> Function -> Function
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
min :: Function -> Function -> Function
$cmin :: Function -> Function -> Function
max :: Function -> Function -> Function
$cmax :: Function -> Function -> Function
>= :: Function -> Function -> Bool
$c>= :: Function -> Function -> Bool
> :: Function -> Function -> Bool
$c> :: Function -> Function -> Bool
<= :: Function -> Function -> Bool
$c<= :: Function -> Function -> Bool
< :: Function -> Function -> Bool
$c< :: Function -> Function -> Bool
compare :: Function -> Function -> Ordering
$ccompare :: Function -> Function -> Ordering
$cp1Ord :: Eq Function
Ord, Int -> Function -> Int
Function -> Int
(Int -> Function -> Int) -> (Function -> Int) -> Hashable Function
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Function -> Int
$chash :: Function -> Int
hashWithSalt :: Int -> Function -> Int
$chashWithSalt :: Int -> Function -> Int
Hashable, Int -> Function -> ShowS
[Function] -> ShowS
Function -> String
(Int -> Function -> ShowS)
-> (Function -> String) -> ([Function] -> ShowS) -> Show Function
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Function] -> ShowS
$cshowList :: [Function] -> ShowS
show :: Function -> String
$cshow :: Function -> String
showsPrec :: Int -> Function -> ShowS
$cshowsPrec :: Int -> Function -> ShowS
Show, (forall x. Function -> Rep Function x)
-> (forall x. Rep Function x -> Function) -> Generic Function
forall x. Rep Function x -> Function
forall x. Function -> Rep Function x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Function x -> Function
$cfrom :: forall x. Function -> Rep Function x
Generic)

$(makeLenses ''Function)

toFunction :: Text -> Maybe Function
toFunction :: Text -> Maybe Function
toFunction Text
t = case Text -> Text -> [Text]
T.splitOn Text
":" Text
t of
  (Text
"function" : Text
name : [Text]
qual) ->
    (Maybe Text -> Function) -> Maybe (Maybe Text -> Function)
forall a. a -> Maybe a
Just (Text -> Maybe Text -> Function
Function Text
name) Maybe (Maybe Text -> Function)
-> Maybe (Maybe Text) -> Maybe Function
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 Function
forall a. Maybe a
Nothing

fromFunction :: Function -> Text
fromFunction :: Function -> Text
fromFunction Function
f =
  Text -> [Text] -> Text
T.intercalate Text
":" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    [Text
"function", Function -> Text
_fName Function
f] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Function -> Maybe Text
_fQualifier Function
f)

_Function :: Prism' Text Function
_Function :: p Function (f Function) -> p Text (f Text)
_Function = (Function -> Text)
-> (Text -> Maybe Function) -> Prism Text Text Function Function
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Function -> Text
fromFunction Text -> Maybe Function
toFunction