{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE QuasiQuotes #-}

module Hasura.SQL.Backend
  ( PostgresKind (..),
    BackendType (..),
    BackendSourceKind (..),
    backendShortName,
    supportedBackends,
    backendTextNames,
    backendTypeFromText,
    parseBackendTypeFromText,
    backendTypeFromBackendSourceKind,
  )
where

import Autodocodec (HasCodec (codec), JSONCodec, bimapCodec, dimapCodec, literalTextCodec, parseAlternatives)
import Data.Aeson
import Data.Aeson.Types (Parser)
import Data.Proxy
import Data.Text (unpack)
import Data.Text.Extended
import Data.Text.NonEmpty (NonEmptyText, mkNonEmptyText, nonEmptyTextCodec, nonEmptyTextQQ)
import Hasura.Backends.DataConnector.Adapter.Types (DataConnectorName (..))
import Hasura.Incremental
import Hasura.Prelude
import Witch qualified

-- | Argument to Postgres; we represent backends which are variations on Postgres as sub-types of
-- Postgres. This value indicates which "flavour" of Postgres a backend is.
data PostgresKind
  = Vanilla
  | Citus
  | Cockroach
  deriving stock (Int -> PostgresKind -> ShowS
[PostgresKind] -> ShowS
PostgresKind -> String
(Int -> PostgresKind -> ShowS)
-> (PostgresKind -> String)
-> ([PostgresKind] -> ShowS)
-> Show PostgresKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostgresKind] -> ShowS
$cshowList :: [PostgresKind] -> ShowS
show :: PostgresKind -> String
$cshow :: PostgresKind -> String
showsPrec :: Int -> PostgresKind -> ShowS
$cshowsPrec :: Int -> PostgresKind -> ShowS
Show, PostgresKind -> PostgresKind -> Bool
(PostgresKind -> PostgresKind -> Bool)
-> (PostgresKind -> PostgresKind -> Bool) -> Eq PostgresKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostgresKind -> PostgresKind -> Bool
$c/= :: PostgresKind -> PostgresKind -> Bool
== :: PostgresKind -> PostgresKind -> Bool
$c== :: PostgresKind -> PostgresKind -> Bool
Eq, Eq PostgresKind
Eq PostgresKind
-> (PostgresKind -> PostgresKind -> Ordering)
-> (PostgresKind -> PostgresKind -> Bool)
-> (PostgresKind -> PostgresKind -> Bool)
-> (PostgresKind -> PostgresKind -> Bool)
-> (PostgresKind -> PostgresKind -> Bool)
-> (PostgresKind -> PostgresKind -> PostgresKind)
-> (PostgresKind -> PostgresKind -> PostgresKind)
-> Ord PostgresKind
PostgresKind -> PostgresKind -> Bool
PostgresKind -> PostgresKind -> Ordering
PostgresKind -> PostgresKind -> PostgresKind
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 :: PostgresKind -> PostgresKind -> PostgresKind
$cmin :: PostgresKind -> PostgresKind -> PostgresKind
max :: PostgresKind -> PostgresKind -> PostgresKind
$cmax :: PostgresKind -> PostgresKind -> PostgresKind
>= :: PostgresKind -> PostgresKind -> Bool
$c>= :: PostgresKind -> PostgresKind -> Bool
> :: PostgresKind -> PostgresKind -> Bool
$c> :: PostgresKind -> PostgresKind -> Bool
<= :: PostgresKind -> PostgresKind -> Bool
$c<= :: PostgresKind -> PostgresKind -> Bool
< :: PostgresKind -> PostgresKind -> Bool
$c< :: PostgresKind -> PostgresKind -> Bool
compare :: PostgresKind -> PostgresKind -> Ordering
$ccompare :: PostgresKind -> PostgresKind -> Ordering
$cp1Ord :: Eq PostgresKind
Ord, (forall x. PostgresKind -> Rep PostgresKind x)
-> (forall x. Rep PostgresKind x -> PostgresKind)
-> Generic PostgresKind
forall x. Rep PostgresKind x -> PostgresKind
forall x. PostgresKind -> Rep PostgresKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PostgresKind x -> PostgresKind
$cfrom :: forall x. PostgresKind -> Rep PostgresKind x
Generic)
  deriving anyclass (Int -> PostgresKind -> Int
PostgresKind -> Int
(Int -> PostgresKind -> Int)
-> (PostgresKind -> Int) -> Hashable PostgresKind
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: PostgresKind -> Int
$chash :: PostgresKind -> Int
hashWithSalt :: Int -> PostgresKind -> Int
$chashWithSalt :: Int -> PostgresKind -> Int
Hashable, Eq PostgresKind
Eq PostgresKind
-> (Accesses -> PostgresKind -> PostgresKind -> Bool)
-> Cacheable PostgresKind
Accesses -> PostgresKind -> PostgresKind -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> PostgresKind -> PostgresKind -> Bool
$cunchanged :: Accesses -> PostgresKind -> PostgresKind -> Bool
$cp1Cacheable :: Eq PostgresKind
Cacheable)

-- | An enum that represents each backend we support.
data BackendType
  = Postgres PostgresKind
  | MSSQL
  | BigQuery
  | MySQL
  | DataConnector
  deriving stock (Int -> BackendType -> ShowS
[BackendType] -> ShowS
BackendType -> String
(Int -> BackendType -> ShowS)
-> (BackendType -> String)
-> ([BackendType] -> ShowS)
-> Show BackendType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BackendType] -> ShowS
$cshowList :: [BackendType] -> ShowS
show :: BackendType -> String
$cshow :: BackendType -> String
showsPrec :: Int -> BackendType -> ShowS
$cshowsPrec :: Int -> BackendType -> ShowS
Show, BackendType -> BackendType -> Bool
(BackendType -> BackendType -> Bool)
-> (BackendType -> BackendType -> Bool) -> Eq BackendType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BackendType -> BackendType -> Bool
$c/= :: BackendType -> BackendType -> Bool
== :: BackendType -> BackendType -> Bool
$c== :: BackendType -> BackendType -> Bool
Eq, Eq BackendType
Eq BackendType
-> (BackendType -> BackendType -> Ordering)
-> (BackendType -> BackendType -> Bool)
-> (BackendType -> BackendType -> Bool)
-> (BackendType -> BackendType -> Bool)
-> (BackendType -> BackendType -> Bool)
-> (BackendType -> BackendType -> BackendType)
-> (BackendType -> BackendType -> BackendType)
-> Ord BackendType
BackendType -> BackendType -> Bool
BackendType -> BackendType -> Ordering
BackendType -> BackendType -> BackendType
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 :: BackendType -> BackendType -> BackendType
$cmin :: BackendType -> BackendType -> BackendType
max :: BackendType -> BackendType -> BackendType
$cmax :: BackendType -> BackendType -> BackendType
>= :: BackendType -> BackendType -> Bool
$c>= :: BackendType -> BackendType -> Bool
> :: BackendType -> BackendType -> Bool
$c> :: BackendType -> BackendType -> Bool
<= :: BackendType -> BackendType -> Bool
$c<= :: BackendType -> BackendType -> Bool
< :: BackendType -> BackendType -> Bool
$c< :: BackendType -> BackendType -> Bool
compare :: BackendType -> BackendType -> Ordering
$ccompare :: BackendType -> BackendType -> Ordering
$cp1Ord :: Eq BackendType
Ord, (forall x. BackendType -> Rep BackendType x)
-> (forall x. Rep BackendType x -> BackendType)
-> Generic BackendType
forall x. Rep BackendType x -> BackendType
forall x. BackendType -> Rep BackendType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BackendType x -> BackendType
$cfrom :: forall x. BackendType -> Rep BackendType x
Generic)
  deriving anyclass (Int -> BackendType -> Int
BackendType -> Int
(Int -> BackendType -> Int)
-> (BackendType -> Int) -> Hashable BackendType
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: BackendType -> Int
$chash :: BackendType -> Int
hashWithSalt :: Int -> BackendType -> Int
$chashWithSalt :: Int -> BackendType -> Int
Hashable, Eq BackendType
Eq BackendType
-> (Accesses -> BackendType -> BackendType -> Bool)
-> Cacheable BackendType
Accesses -> BackendType -> BackendType -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> BackendType -> BackendType -> Bool
$cunchanged :: Accesses -> BackendType -> BackendType -> Bool
$cp1Cacheable :: Eq BackendType
Cacheable)

-- | The name of the backend, as we expect it to appear in our metadata and API.
instance Witch.From BackendType NonEmptyText where
  from :: BackendType -> NonEmptyText
from (Postgres PostgresKind
Vanilla) = [nonEmptyTextQQ|postgres|]
  from (Postgres PostgresKind
Citus) = [nonEmptyTextQQ|citus|]
  from (Postgres PostgresKind
Cockroach) = [nonEmptyTextQQ|cockroach|]
  from BackendType
MSSQL = [nonEmptyTextQQ|mssql|]
  from BackendType
BigQuery = [nonEmptyTextQQ|bigquery|]
  from BackendType
MySQL = [nonEmptyTextQQ|mysql|]
  from BackendType
DataConnector = [nonEmptyTextQQ|dataconnector|]

instance ToTxt BackendType where
  toTxt :: BackendType -> Text
toTxt = NonEmptyText -> Text
forall a. ToTxt a => a -> Text
toTxt (NonEmptyText -> Text)
-> (BackendType -> NonEmptyText) -> BackendType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall source. From source NonEmptyText => source -> NonEmptyText
forall target source. From source target => source -> target
Witch.into @NonEmptyText

instance FromJSON BackendType where
  parseJSON :: Value -> Parser BackendType
parseJSON = String
-> (Text -> Parser BackendType) -> Value -> Parser BackendType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"backend type" Text -> Parser BackendType
parseBackendTypeFromText

instance ToJSON BackendType where
  toJSON :: BackendType -> Value
toJSON = Text -> Value
String (Text -> Value) -> (BackendType -> Text) -> BackendType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BackendType -> Text
forall a. ToTxt a => a -> Text
toTxt

instance Cacheable (Proxy (b :: BackendType))

-- | Similar to 'BackendType', however, in the case of 'DataConnectorKind' we need to be able
-- capture the name of the data connector that should be used by the DataConnector backend.
-- This type correlates to the kind property of 'SourceMetadata', which is usually just
-- postgres, mssql, etc for static backends, but can be a configurable value for DataConnector
-- hence requiring 'DataConnectorName' for 'DataConnectorKind'
--
-- This type cannot entirely replace 'BackendType' because 'BackendType' has a fixed number of
-- possible values which can be enumerated over at compile time, but 'BackendSourceKind' does
-- not because DataConnector fundamentally is configured at runtime with 'DataConnectorName'.
data BackendSourceKind (b :: BackendType) where
  PostgresVanillaKind :: BackendSourceKind ('Postgres 'Vanilla)
  PostgresCitusKind :: BackendSourceKind ('Postgres 'Citus)
  PostgresCockroachKind :: BackendSourceKind ('Postgres 'Cockroach)
  MSSQLKind :: BackendSourceKind 'MSSQL
  BigQueryKind :: BackendSourceKind 'BigQuery
  MySQLKind :: BackendSourceKind 'MySQL
  DataConnectorKind :: DataConnectorName -> BackendSourceKind 'DataConnector

deriving instance Show (BackendSourceKind b)

deriving instance Eq (BackendSourceKind b)

deriving instance Ord (BackendSourceKind b)

instance Cacheable (BackendSourceKind b) where
  unchanged :: Accesses -> BackendSourceKind b -> BackendSourceKind b -> Bool
unchanged Accesses
_ = BackendSourceKind b -> BackendSourceKind b -> Bool
forall a. Eq a => a -> a -> Bool
(==)

instance Witch.From (BackendSourceKind b) NonEmptyText where
  -- All cases are specified explicitly here to ensure compiler warnings highlight
  -- this area for consideration and update if another BackendType is added
  from :: BackendSourceKind b -> NonEmptyText
from k :: BackendSourceKind b
k@BackendSourceKind b
PostgresVanillaKind = forall source. From source NonEmptyText => source -> NonEmptyText
forall target source. From source target => source -> target
Witch.into @NonEmptyText (BackendType -> NonEmptyText) -> BackendType -> NonEmptyText
forall a b. (a -> b) -> a -> b
$ BackendSourceKind b -> BackendType
forall (b :: BackendType). BackendSourceKind b -> BackendType
backendTypeFromBackendSourceKind BackendSourceKind b
k
  from k :: BackendSourceKind b
k@BackendSourceKind b
PostgresCitusKind = forall source. From source NonEmptyText => source -> NonEmptyText
forall target source. From source target => source -> target
Witch.into @NonEmptyText (BackendType -> NonEmptyText) -> BackendType -> NonEmptyText
forall a b. (a -> b) -> a -> b
$ BackendSourceKind b -> BackendType
forall (b :: BackendType). BackendSourceKind b -> BackendType
backendTypeFromBackendSourceKind BackendSourceKind b
k
  from k :: BackendSourceKind b
k@BackendSourceKind b
PostgresCockroachKind = forall source. From source NonEmptyText => source -> NonEmptyText
forall target source. From source target => source -> target
Witch.into @NonEmptyText (BackendType -> NonEmptyText) -> BackendType -> NonEmptyText
forall a b. (a -> b) -> a -> b
$ BackendSourceKind b -> BackendType
forall (b :: BackendType). BackendSourceKind b -> BackendType
backendTypeFromBackendSourceKind BackendSourceKind b
k
  from k :: BackendSourceKind b
k@BackendSourceKind b
MSSQLKind = forall source. From source NonEmptyText => source -> NonEmptyText
forall target source. From source target => source -> target
Witch.into @NonEmptyText (BackendType -> NonEmptyText) -> BackendType -> NonEmptyText
forall a b. (a -> b) -> a -> b
$ BackendSourceKind b -> BackendType
forall (b :: BackendType). BackendSourceKind b -> BackendType
backendTypeFromBackendSourceKind BackendSourceKind b
k
  from k :: BackendSourceKind b
k@BackendSourceKind b
BigQueryKind = forall source. From source NonEmptyText => source -> NonEmptyText
forall target source. From source target => source -> target
Witch.into @NonEmptyText (BackendType -> NonEmptyText) -> BackendType -> NonEmptyText
forall a b. (a -> b) -> a -> b
$ BackendSourceKind b -> BackendType
forall (b :: BackendType). BackendSourceKind b -> BackendType
backendTypeFromBackendSourceKind BackendSourceKind b
k
  from k :: BackendSourceKind b
k@BackendSourceKind b
MySQLKind = forall source. From source NonEmptyText => source -> NonEmptyText
forall target source. From source target => source -> target
Witch.into @NonEmptyText (BackendType -> NonEmptyText) -> BackendType -> NonEmptyText
forall a b. (a -> b) -> a -> b
$ BackendSourceKind b -> BackendType
forall (b :: BackendType). BackendSourceKind b -> BackendType
backendTypeFromBackendSourceKind BackendSourceKind b
k
  from (DataConnectorKind DataConnectorName
dataConnectorName) = DataConnectorName -> NonEmptyText
forall target source. From source target => source -> target
Witch.into @NonEmptyText DataConnectorName
dataConnectorName

instance ToTxt (BackendSourceKind b) where
  toTxt :: BackendSourceKind b -> Text
toTxt = NonEmptyText -> Text
forall a. ToTxt a => a -> Text
toTxt (NonEmptyText -> Text)
-> (BackendSourceKind b -> NonEmptyText)
-> BackendSourceKind b
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall source. From source NonEmptyText => source -> NonEmptyText
forall target source. From source target => source -> target
Witch.into @NonEmptyText

-- If you need to parse an arbitrary string into a BackendSourceKind, you can't because of the
-- b type parameter. You actually want to parse into 'AnyBackend BackendSourceKind'.
-- See 'backendSourceKindFromText' from the AnyBackend module for that.

instance ToJSON (BackendSourceKind b) where
  toJSON :: BackendSourceKind b -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (BackendSourceKind b -> Text) -> BackendSourceKind b -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BackendSourceKind b -> Text
forall a. ToTxt a => a -> Text
toTxt

instance FromJSON (BackendSourceKind ('Postgres 'Vanilla)) where
  parseJSON :: Value -> Parser (BackendSourceKind ('Postgres 'Vanilla))
parseJSON = BackendSourceKind ('Postgres 'Vanilla)
-> Value -> Parser (BackendSourceKind ('Postgres 'Vanilla))
forall (b :: BackendType).
BackendSourceKind b -> Value -> Parser (BackendSourceKind b)
mkParseStaticBackendSourceKind BackendSourceKind ('Postgres 'Vanilla)
PostgresVanillaKind

instance FromJSON (BackendSourceKind ('Postgres 'Citus)) where
  parseJSON :: Value -> Parser (BackendSourceKind ('Postgres 'Citus))
parseJSON = BackendSourceKind ('Postgres 'Citus)
-> Value -> Parser (BackendSourceKind ('Postgres 'Citus))
forall (b :: BackendType).
BackendSourceKind b -> Value -> Parser (BackendSourceKind b)
mkParseStaticBackendSourceKind BackendSourceKind ('Postgres 'Citus)
PostgresCitusKind

instance FromJSON (BackendSourceKind ('Postgres 'Cockroach)) where
  parseJSON :: Value -> Parser (BackendSourceKind ('Postgres 'Cockroach))
parseJSON = BackendSourceKind ('Postgres 'Cockroach)
-> Value -> Parser (BackendSourceKind ('Postgres 'Cockroach))
forall (b :: BackendType).
BackendSourceKind b -> Value -> Parser (BackendSourceKind b)
mkParseStaticBackendSourceKind BackendSourceKind ('Postgres 'Cockroach)
PostgresCockroachKind

instance FromJSON (BackendSourceKind ('MSSQL)) where
  parseJSON :: Value -> Parser (BackendSourceKind 'MSSQL)
parseJSON = BackendSourceKind 'MSSQL
-> Value -> Parser (BackendSourceKind 'MSSQL)
forall (b :: BackendType).
BackendSourceKind b -> Value -> Parser (BackendSourceKind b)
mkParseStaticBackendSourceKind BackendSourceKind 'MSSQL
MSSQLKind

instance FromJSON (BackendSourceKind ('BigQuery)) where
  parseJSON :: Value -> Parser (BackendSourceKind 'BigQuery)
parseJSON = BackendSourceKind 'BigQuery
-> Value -> Parser (BackendSourceKind 'BigQuery)
forall (b :: BackendType).
BackendSourceKind b -> Value -> Parser (BackendSourceKind b)
mkParseStaticBackendSourceKind BackendSourceKind 'BigQuery
BigQueryKind

instance FromJSON (BackendSourceKind ('MySQL)) where
  parseJSON :: Value -> Parser (BackendSourceKind 'MySQL)
parseJSON = BackendSourceKind 'MySQL
-> Value -> Parser (BackendSourceKind 'MySQL)
forall (b :: BackendType).
BackendSourceKind b -> Value -> Parser (BackendSourceKind b)
mkParseStaticBackendSourceKind BackendSourceKind 'MySQL
MySQLKind

instance FromJSON (BackendSourceKind ('DataConnector)) where
  parseJSON :: Value -> Parser (BackendSourceKind 'DataConnector)
parseJSON = String
-> (Text -> Parser (BackendSourceKind 'DataConnector))
-> Value
-> Parser (BackendSourceKind 'DataConnector)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"BackendSourceKind" ((Text -> Parser (BackendSourceKind 'DataConnector))
 -> Value -> Parser (BackendSourceKind 'DataConnector))
-> (Text -> Parser (BackendSourceKind 'DataConnector))
-> Value
-> Parser (BackendSourceKind 'DataConnector)
forall a b. (a -> b) -> a -> b
$ \Text
text ->
    DataConnectorName -> BackendSourceKind 'DataConnector
DataConnectorKind (DataConnectorName -> BackendSourceKind 'DataConnector)
-> (NonEmptyText -> DataConnectorName)
-> NonEmptyText
-> BackendSourceKind 'DataConnector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyText -> DataConnectorName
DataConnectorName (NonEmptyText -> BackendSourceKind 'DataConnector)
-> Parser NonEmptyText -> Parser (BackendSourceKind 'DataConnector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe NonEmptyText
mkNonEmptyText Text
text
      Maybe NonEmptyText -> Parser NonEmptyText -> Parser NonEmptyText
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` String -> Parser NonEmptyText
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot be empty string"

mkParseStaticBackendSourceKind :: BackendSourceKind b -> (Value -> Parser (BackendSourceKind b))
mkParseStaticBackendSourceKind :: BackendSourceKind b -> Value -> Parser (BackendSourceKind b)
mkParseStaticBackendSourceKind BackendSourceKind b
backendSourceKind =
  String
-> (Text -> Parser (BackendSourceKind b))
-> Value
-> Parser (BackendSourceKind b)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"BackendSourceKind" ((Text -> Parser (BackendSourceKind b))
 -> Value -> Parser (BackendSourceKind b))
-> (Text -> Parser (BackendSourceKind b))
-> Value
-> Parser (BackendSourceKind b)
forall a b. (a -> b) -> a -> b
$ \Text
text ->
    if Text
text Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
validValues
      then BackendSourceKind b -> Parser (BackendSourceKind b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure BackendSourceKind b
backendSourceKind
      else String -> Parser (BackendSourceKind b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"got: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
text String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", expected one of: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack ([Text] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated [Text]
validValues))
  where
    validValues :: [Text]
validValues = BackendType -> [Text]
backendTextNames (BackendType -> [Text]) -> BackendType -> [Text]
forall a b. (a -> b) -> a -> b
$ BackendSourceKind b -> BackendType
forall (b :: BackendType). BackendSourceKind b -> BackendType
backendTypeFromBackendSourceKind BackendSourceKind b
backendSourceKind

instance HasCodec (BackendSourceKind ('Postgres 'Vanilla)) where
  codec :: JSONCodec (BackendSourceKind ('Postgres 'Vanilla))
codec = BackendSourceKind ('Postgres 'Vanilla)
-> JSONCodec (BackendSourceKind ('Postgres 'Vanilla))
forall (b :: BackendType).
BackendSourceKind b -> JSONCodec (BackendSourceKind b)
mkCodecStaticBackendSourceKind BackendSourceKind ('Postgres 'Vanilla)
PostgresVanillaKind

instance HasCodec (BackendSourceKind ('Postgres 'Citus)) where
  codec :: JSONCodec (BackendSourceKind ('Postgres 'Citus))
codec = BackendSourceKind ('Postgres 'Citus)
-> JSONCodec (BackendSourceKind ('Postgres 'Citus))
forall (b :: BackendType).
BackendSourceKind b -> JSONCodec (BackendSourceKind b)
mkCodecStaticBackendSourceKind BackendSourceKind ('Postgres 'Citus)
PostgresCitusKind

instance HasCodec (BackendSourceKind ('Postgres 'Cockroach)) where
  codec :: JSONCodec (BackendSourceKind ('Postgres 'Cockroach))
codec = BackendSourceKind ('Postgres 'Cockroach)
-> JSONCodec (BackendSourceKind ('Postgres 'Cockroach))
forall (b :: BackendType).
BackendSourceKind b -> JSONCodec (BackendSourceKind b)
mkCodecStaticBackendSourceKind BackendSourceKind ('Postgres 'Cockroach)
PostgresCockroachKind

instance HasCodec (BackendSourceKind ('MSSQL)) where
  codec :: JSONCodec (BackendSourceKind 'MSSQL)
codec = BackendSourceKind 'MSSQL -> JSONCodec (BackendSourceKind 'MSSQL)
forall (b :: BackendType).
BackendSourceKind b -> JSONCodec (BackendSourceKind b)
mkCodecStaticBackendSourceKind BackendSourceKind 'MSSQL
MSSQLKind

instance HasCodec (BackendSourceKind ('BigQuery)) where
  codec :: JSONCodec (BackendSourceKind 'BigQuery)
codec = BackendSourceKind 'BigQuery
-> JSONCodec (BackendSourceKind 'BigQuery)
forall (b :: BackendType).
BackendSourceKind b -> JSONCodec (BackendSourceKind b)
mkCodecStaticBackendSourceKind BackendSourceKind 'BigQuery
BigQueryKind

instance HasCodec (BackendSourceKind ('MySQL)) where
  codec :: JSONCodec (BackendSourceKind 'MySQL)
codec = BackendSourceKind 'MySQL -> JSONCodec (BackendSourceKind 'MySQL)
forall (b :: BackendType).
BackendSourceKind b -> JSONCodec (BackendSourceKind b)
mkCodecStaticBackendSourceKind BackendSourceKind 'MySQL
MySQLKind

instance HasCodec (BackendSourceKind ('DataConnector)) where
  codec :: JSONCodec (BackendSourceKind 'DataConnector)
codec = (NonEmptyText -> BackendSourceKind 'DataConnector)
-> (BackendSourceKind 'DataConnector -> NonEmptyText)
-> Codec Value NonEmptyText NonEmptyText
-> JSONCodec (BackendSourceKind 'DataConnector)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec NonEmptyText -> BackendSourceKind 'DataConnector
dec BackendSourceKind 'DataConnector -> NonEmptyText
enc Codec Value NonEmptyText NonEmptyText
nonEmptyTextCodec
    where
      dec :: NonEmptyText -> BackendSourceKind 'DataConnector
dec = DataConnectorName -> BackendSourceKind 'DataConnector
DataConnectorKind (DataConnectorName -> BackendSourceKind 'DataConnector)
-> (NonEmptyText -> DataConnectorName)
-> NonEmptyText
-> BackendSourceKind 'DataConnector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyText -> DataConnectorName
DataConnectorName
      enc :: BackendSourceKind 'DataConnector -> NonEmptyText
enc = BackendSourceKind 'DataConnector -> NonEmptyText
forall target source. From source target => source -> target
Witch.into

mkCodecStaticBackendSourceKind :: BackendSourceKind b -> JSONCodec (BackendSourceKind b)
mkCodecStaticBackendSourceKind :: BackendSourceKind b -> JSONCodec (BackendSourceKind b)
mkCodecStaticBackendSourceKind BackendSourceKind b
backendSourceKind =
  (Text -> Either String (BackendSourceKind b))
-> (BackendSourceKind b -> Text)
-> Codec Value Text Text
-> JSONCodec (BackendSourceKind b)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec Text -> Either String (BackendSourceKind b)
dec BackendSourceKind b -> Text
enc (Codec Value Text Text -> JSONCodec (BackendSourceKind b))
-> Codec Value Text Text -> JSONCodec (BackendSourceKind b)
forall a b. (a -> b) -> a -> b
$
    Codec Value Text Text
-> [Codec Value Text Text] -> Codec Value Text Text
forall context input output.
Codec context input output
-> [Codec context input output] -> Codec context input output
parseAlternatives (Text -> Codec Value Text Text
literalTextCodec Text
longName) (Text -> Codec Value Text Text
literalTextCodec (Text -> Codec Value Text Text)
-> [Text] -> [Codec Value Text Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
aliases)
  where
    dec :: Text -> Either String (BackendSourceKind b)
dec Text
text =
      if Text
text Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
validValues
        then BackendSourceKind b -> Either String (BackendSourceKind b)
forall a b. b -> Either a b
Right BackendSourceKind b
backendSourceKind
        else String -> Either String (BackendSourceKind b)
forall a b. a -> Either a b
Left (String
"got: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
text String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", expected one of: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack ([Text] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated [Text]
validValues))

    enc :: BackendSourceKind b -> Text
enc = BackendSourceKind b -> Text
forall a. ToTxt a => a -> Text
toTxt

    validValues :: [Text]
validValues = BackendType -> [Text]
backendTextNames (BackendType -> [Text]) -> BackendType -> [Text]
forall a b. (a -> b) -> a -> b
$ BackendSourceKind b -> BackendType
forall (b :: BackendType). BackendSourceKind b -> BackendType
backendTypeFromBackendSourceKind BackendSourceKind b
backendSourceKind
    longName :: Text
longName = [Text] -> Text
forall a. [a] -> a
head [Text]
validValues
    aliases :: [Text]
aliases = [Text] -> [Text]
forall a. [a] -> [a]
tail [Text]
validValues

-- | Some generated APIs use a shortened version of the backend's name rather than its full
-- name. This function returns the "short form" of a backend, if any.
backendShortName :: BackendType -> Maybe Text
backendShortName :: BackendType -> Maybe Text
backendShortName = \case
  Postgres PostgresKind
Vanilla -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"pg"
  BackendType
_ -> Maybe Text
forall a. Maybe a
Nothing

supportedBackends :: [BackendType]
supportedBackends :: [BackendType]
supportedBackends =
  [ PostgresKind -> BackendType
Postgres PostgresKind
Vanilla,
    PostgresKind -> BackendType
Postgres PostgresKind
Citus,
    PostgresKind -> BackendType
Postgres PostgresKind
Cockroach,
    BackendType
MSSQL,
    BackendType
BigQuery,
    BackendType
MySQL,
    BackendType
DataConnector
  ]

backendTextNames :: BackendType -> [Text]
backendTextNames :: BackendType -> [Text]
backendTextNames BackendType
b =
  [Maybe Text] -> [Text]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes
    [ Text -> Maybe Text
forall a. a -> Maybe a
Just (BackendType -> Text
forall a. ToTxt a => a -> Text
toTxt BackendType
b), -- long form
      BackendType -> Maybe Text
backendShortName BackendType
b -- short form
    ]

backendTextNameLookup :: [(Text, BackendType)]
backendTextNameLookup :: [(Text, BackendType)]
backendTextNameLookup =
  [BackendType]
supportedBackends [BackendType]
-> (BackendType -> [(Text, BackendType)]) -> [(Text, BackendType)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\BackendType
b -> (,BackendType
b) (Text -> (Text, BackendType)) -> [Text] -> [(Text, BackendType)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BackendType -> [Text]
backendTextNames BackendType
b)

-- | This uses this lookup mechanism to avoid having to duplicate and hardcode the
-- backend string. We accept both the short form and the long form of the backend's name.
backendTypeFromText :: Text -> Maybe BackendType
backendTypeFromText :: Text -> Maybe BackendType
backendTypeFromText Text
txt =
  Text -> [(Text, BackendType)] -> Maybe BackendType
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
txt [(Text, BackendType)]
backendTextNameLookup

parseBackendTypeFromText :: Text -> Parser BackendType
parseBackendTypeFromText :: Text -> Parser BackendType
parseBackendTypeFromText Text
txt =
  let uniqueBackends :: Text
uniqueBackends = [Text] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text, BackendType) -> Text
forall a b. (a, b) -> a
fst ((Text, BackendType) -> Text) -> [(Text, BackendType)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, BackendType)]
backendTextNameLookup
   in Text -> Maybe BackendType
backendTypeFromText Text
txt
        Maybe BackendType -> Parser BackendType -> Parser BackendType
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` String -> Parser BackendType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"got: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
txt String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", expected one of: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
uniqueBackends)

backendTypeFromBackendSourceKind :: BackendSourceKind b -> BackendType
backendTypeFromBackendSourceKind :: BackendSourceKind b -> BackendType
backendTypeFromBackendSourceKind = \case
  BackendSourceKind b
PostgresVanillaKind -> PostgresKind -> BackendType
Postgres PostgresKind
Vanilla
  BackendSourceKind b
PostgresCitusKind -> PostgresKind -> BackendType
Postgres PostgresKind
Citus
  BackendSourceKind b
PostgresCockroachKind -> PostgresKind -> BackendType
Postgres PostgresKind
Cockroach
  BackendSourceKind b
MSSQLKind -> BackendType
MSSQL
  BackendSourceKind b
BigQueryKind -> BackendType
BigQuery
  BackendSourceKind b
MySQLKind -> BackendType
MySQL
  DataConnectorKind DataConnectorName
_ -> BackendType
DataConnector