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

module Hasura.RQL.Types.Webhook.Transform.Method
  ( Method (..),
    MethodTransformFn (..),
    TransformCtx (..),
    TransformFn (..),
  )
where

import Autodocodec (HasCodec (codec), dimapCodec)
import Autodocodec.Extended (caseInsensitiveTextCodec)
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson qualified as J
import Data.CaseInsensitive qualified as CI
import Data.Text qualified as T
import Hasura.Prelude
import Hasura.RQL.Types.Webhook.Transform.Class (TransformCtx, TransformFn)
import Hasura.RQL.Types.Webhook.Transform.Request (RequestTransformCtx)

-- | The actual request method we are transforming.
--
-- This newtype is necessary because otherwise we end up with an
-- orphan instance.
newtype Method = Method (CI.CI T.Text)
  deriving stock ((forall x. Method -> Rep Method x)
-> (forall x. Rep Method x -> Method) -> Generic Method
forall x. Rep Method x -> Method
forall x. Method -> Rep Method x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Method -> Rep Method x
from :: forall x. Method -> Rep Method x
$cto :: forall x. Rep Method x -> Method
to :: forall x. Rep Method x -> Method
Generic)
  deriving newtype (Int -> Method -> ShowS
[Method] -> ShowS
Method -> String
(Int -> Method -> ShowS)
-> (Method -> String) -> ([Method] -> ShowS) -> Show Method
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Method -> ShowS
showsPrec :: Int -> Method -> ShowS
$cshow :: Method -> String
show :: Method -> String
$cshowList :: [Method] -> ShowS
showList :: [Method] -> ShowS
Show, Method -> Method -> Bool
(Method -> Method -> Bool)
-> (Method -> Method -> Bool) -> Eq Method
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Method -> Method -> Bool
== :: Method -> Method -> Bool
$c/= :: Method -> Method -> Bool
/= :: Method -> Method -> Bool
Eq)
  deriving anyclass (Method -> ()
(Method -> ()) -> NFData Method
forall a. (a -> ()) -> NFData a
$crnf :: Method -> ()
rnf :: Method -> ()
NFData)

instance HasCodec Method where
  codec :: JSONCodec Method
codec = (CI Text -> Method)
-> (Method -> CI Text)
-> Codec Value (CI Text) (CI Text)
-> JSONCodec Method
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec CI Text -> Method
Method Method -> CI Text
forall a b. Coercible a b => a -> b
coerce Codec Value (CI Text) (CI Text)
forall a. (FoldCase a, HasCodec a) => JSONCodec (CI a)
caseInsensitiveTextCodec

instance J.ToJSON Method where
  toJSON :: Method -> Value
toJSON = Text -> Value
J.String (Text -> Value) -> (Method -> Text) -> Method -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI Text -> Text
forall s. CI s -> s
CI.original (CI Text -> Text) -> (Method -> CI Text) -> Method -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> CI Text
forall a b. Coercible a b => a -> b
coerce

instance J.FromJSON Method where
  parseJSON :: Value -> Parser Method
parseJSON = String -> (Text -> Parser Method) -> Value -> Parser Method
forall a. String -> (Text -> Parser a) -> Value -> Parser a
J.withText String
"Method" (Method -> Parser Method
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Method -> Parser Method)
-> (Text -> Method) -> Text -> Parser Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI Text -> Method
forall a b. Coercible a b => a -> b
coerce (CI Text -> Method) -> (Text -> CI Text) -> Text -> Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk)

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

instance HasCodec MethodTransformFn where
  codec :: JSONCodec MethodTransformFn
codec = (Method -> MethodTransformFn)
-> (MethodTransformFn -> Method)
-> JSONCodec Method
-> JSONCodec MethodTransformFn
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Method -> MethodTransformFn
Replace MethodTransformFn -> Method
forall a b. Coercible a b => a -> b
coerce JSONCodec Method
forall value. HasCodec value => JSONCodec value
codec

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

newtype instance TransformCtx Method = TransformCtx RequestTransformCtx