module Hasura.RQL.Types.Webhook.Transform.Url
  ( Url (..),
    UrlTransformFn (..),
    TransformCtx (..),
    TransformFn (..),
  )
where

import Autodocodec (HasCodec, codec, dimapCodec)
import Data.Aeson (FromJSON, ToJSON)
import Hasura.Prelude
import Hasura.RQL.Types.Webhook.Transform.Class (TransformCtx, TransformFn, UnescapedTemplate (..))
import Hasura.RQL.Types.Webhook.Transform.Request (RequestTransformCtx (..))

-- | The actual URL string we are transforming.
--
-- This newtype is necessary because otherwise we end up with an
-- orphan instance.
newtype Url = Url {Url -> Text
unUrl :: Text}
  deriving stock (Url -> Url -> Bool
(Url -> Url -> Bool) -> (Url -> Url -> Bool) -> Eq Url
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Url -> Url -> Bool
== :: Url -> Url -> Bool
$c/= :: Url -> Url -> Bool
/= :: Url -> Url -> Bool
Eq, Int -> Url -> ShowS
[Url] -> ShowS
Url -> String
(Int -> Url -> ShowS)
-> (Url -> String) -> ([Url] -> ShowS) -> Show Url
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Url -> ShowS
showsPrec :: Int -> Url -> ShowS
$cshow :: Url -> String
show :: Url -> String
$cshowList :: [Url] -> ShowS
showList :: [Url] -> ShowS
Show)

-- | The defunctionalized transformation function on 'Url'
newtype UrlTransformFn
  = Modify UnescapedTemplate
  deriving stock (UrlTransformFn -> UrlTransformFn -> Bool
(UrlTransformFn -> UrlTransformFn -> Bool)
-> (UrlTransformFn -> UrlTransformFn -> Bool) -> Eq UrlTransformFn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UrlTransformFn -> UrlTransformFn -> Bool
== :: UrlTransformFn -> UrlTransformFn -> Bool
$c/= :: UrlTransformFn -> UrlTransformFn -> Bool
/= :: UrlTransformFn -> UrlTransformFn -> Bool
Eq, (forall x. UrlTransformFn -> Rep UrlTransformFn x)
-> (forall x. Rep UrlTransformFn x -> UrlTransformFn)
-> Generic UrlTransformFn
forall x. Rep UrlTransformFn x -> UrlTransformFn
forall x. UrlTransformFn -> Rep UrlTransformFn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UrlTransformFn -> Rep UrlTransformFn x
from :: forall x. UrlTransformFn -> Rep UrlTransformFn x
$cto :: forall x. Rep UrlTransformFn x -> UrlTransformFn
to :: forall x. Rep UrlTransformFn x -> UrlTransformFn
Generic, Int -> UrlTransformFn -> ShowS
[UrlTransformFn] -> ShowS
UrlTransformFn -> String
(Int -> UrlTransformFn -> ShowS)
-> (UrlTransformFn -> String)
-> ([UrlTransformFn] -> ShowS)
-> Show UrlTransformFn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UrlTransformFn -> ShowS
showsPrec :: Int -> UrlTransformFn -> ShowS
$cshow :: UrlTransformFn -> String
show :: UrlTransformFn -> String
$cshowList :: [UrlTransformFn] -> ShowS
showList :: [UrlTransformFn] -> ShowS
Show)
  deriving newtype (UrlTransformFn -> ()
(UrlTransformFn -> ()) -> NFData UrlTransformFn
forall a. (a -> ()) -> NFData a
$crnf :: UrlTransformFn -> ()
rnf :: UrlTransformFn -> ()
NFData, Value -> Parser [UrlTransformFn]
Value -> Parser UrlTransformFn
(Value -> Parser UrlTransformFn)
-> (Value -> Parser [UrlTransformFn]) -> FromJSON UrlTransformFn
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser UrlTransformFn
parseJSON :: Value -> Parser UrlTransformFn
$cparseJSONList :: Value -> Parser [UrlTransformFn]
parseJSONList :: Value -> Parser [UrlTransformFn]
FromJSON, [UrlTransformFn] -> Value
[UrlTransformFn] -> Encoding
UrlTransformFn -> Value
UrlTransformFn -> Encoding
(UrlTransformFn -> Value)
-> (UrlTransformFn -> Encoding)
-> ([UrlTransformFn] -> Value)
-> ([UrlTransformFn] -> Encoding)
-> ToJSON UrlTransformFn
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: UrlTransformFn -> Value
toJSON :: UrlTransformFn -> Value
$ctoEncoding :: UrlTransformFn -> Encoding
toEncoding :: UrlTransformFn -> Encoding
$ctoJSONList :: [UrlTransformFn] -> Value
toJSONList :: [UrlTransformFn] -> Value
$ctoEncodingList :: [UrlTransformFn] -> Encoding
toEncodingList :: [UrlTransformFn] -> Encoding
ToJSON)

instance HasCodec UrlTransformFn where
  codec :: JSONCodec UrlTransformFn
codec = (UnescapedTemplate -> UrlTransformFn)
-> (UrlTransformFn -> UnescapedTemplate)
-> Codec Value UnescapedTemplate UnescapedTemplate
-> JSONCodec UrlTransformFn
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec UnescapedTemplate -> UrlTransformFn
Modify UrlTransformFn -> UnescapedTemplate
forall a b. Coercible a b => a -> b
coerce Codec Value UnescapedTemplate UnescapedTemplate
forall value. HasCodec value => JSONCodec value
codec

-- NOTE: GHC does not let us attach Haddock documentation to data family
-- instances, so 'UrlTransformFn' is defined separately from this
-- wrapper.
newtype instance TransformFn Url = UrlTransformFn_ UrlTransformFn
  deriving stock (TransformFn Url -> TransformFn Url -> Bool
(TransformFn Url -> TransformFn Url -> Bool)
-> (TransformFn Url -> TransformFn Url -> Bool)
-> Eq (TransformFn Url)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TransformFn Url -> TransformFn Url -> Bool
== :: TransformFn Url -> TransformFn Url -> Bool
$c/= :: TransformFn Url -> TransformFn Url -> Bool
/= :: TransformFn Url -> TransformFn Url -> Bool
Eq, (forall x. TransformFn Url -> Rep (TransformFn Url) x)
-> (forall x. Rep (TransformFn Url) x -> TransformFn Url)
-> Generic (TransformFn Url)
forall x. Rep (TransformFn Url) x -> TransformFn Url
forall x. TransformFn Url -> Rep (TransformFn Url) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TransformFn Url -> Rep (TransformFn Url) x
from :: forall x. TransformFn Url -> Rep (TransformFn Url) x
$cto :: forall x. Rep (TransformFn Url) x -> TransformFn Url
to :: forall x. Rep (TransformFn Url) x -> TransformFn Url
Generic, Int -> TransformFn Url -> ShowS
[TransformFn Url] -> ShowS
TransformFn Url -> String
(Int -> TransformFn Url -> ShowS)
-> (TransformFn Url -> String)
-> ([TransformFn Url] -> ShowS)
-> Show (TransformFn Url)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TransformFn Url -> ShowS
showsPrec :: Int -> TransformFn Url -> ShowS
$cshow :: TransformFn Url -> String
show :: TransformFn Url -> String
$cshowList :: [TransformFn Url] -> ShowS
showList :: [TransformFn Url] -> ShowS
Show)
  deriving newtype (TransformFn Url -> ()
(TransformFn Url -> ()) -> NFData (TransformFn Url)
forall a. (a -> ()) -> NFData a
$crnf :: TransformFn Url -> ()
rnf :: TransformFn Url -> ()
NFData, Value -> Parser [TransformFn Url]
Value -> Parser (TransformFn Url)
(Value -> Parser (TransformFn Url))
-> (Value -> Parser [TransformFn Url])
-> FromJSON (TransformFn Url)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser (TransformFn Url)
parseJSON :: Value -> Parser (TransformFn Url)
$cparseJSONList :: Value -> Parser [TransformFn Url]
parseJSONList :: Value -> Parser [TransformFn Url]
FromJSON, [TransformFn Url] -> Value
[TransformFn Url] -> Encoding
TransformFn Url -> Value
TransformFn Url -> Encoding
(TransformFn Url -> Value)
-> (TransformFn Url -> Encoding)
-> ([TransformFn Url] -> Value)
-> ([TransformFn Url] -> Encoding)
-> ToJSON (TransformFn Url)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: TransformFn Url -> Value
toJSON :: TransformFn Url -> Value
$ctoEncoding :: TransformFn Url -> Encoding
toEncoding :: TransformFn Url -> Encoding
$ctoJSONList :: [TransformFn Url] -> Value
toJSONList :: [TransformFn Url] -> Value
$ctoEncodingList :: [TransformFn Url] -> Encoding
toEncodingList :: [TransformFn Url] -> Encoding
ToJSON)

newtype instance TransformCtx Url = TransformCtx RequestTransformCtx