1
0
mirror of https://github.com/hasura/graphql-engine.git synced 2024-12-20 05:51:54 +03:00
graphql-engine/server/src-lib/Data/Text/NonEmpty.hs
Jesse Hallett 84fd5910b0 server: polymorphic codec for metadata sources
This PR expands the OpenAPI specification generated for metadata to include separate definitions for `SourceMetadata` for each native database type, and for DataConnector.

For the most part the changes add `HasCodec` implementations, and don't modify existing code otherwise.

The generated OpenAPI spec can be used to generate TypeScript definitions that distinguish different source metadata types based on the value of the `kind` properly. There is a problem: because the specified `kind` value for a data connector source is any string, when TypeScript gets a source with a `kind` value of, say, `"postgres"`, it cannot unambiguously determine whether the source is postgres, or a data connector. For example,

```ts
function consumeSourceMetadata(source: SourceMetadata) {
    if (source.kind === "postgres" || source.kind === "pg") {
        // At this point TypeScript infers that `source` is either an instance
        // of `PostgresSourceMetadata`, or `DataconnectorSourceMetadata`. It
        // can't narrow further.
        source
    }
    if (source.kind === "something else") {
        // TypeScript infers that this `source` must be an instance of
        // `DataconnectorSourceMetadata` because `source.kind` does not match
        // any of the other options.
        source
    }
}
```

The simplest way I can think of to fix this would be to add a boolean property to the `SourceMetadata` type along the lines of `isNative` or `isDataConnector`. This could be a field that only exists in serialized data, like the metadata version field. The combination of one of the native database names for `kind`, and a true value for `isNative` would be enough for TypeScript to unambiguously distinguish the source kinds.

But note that in the current state TypeScript is able to reference the short `"pg"` name correctly!

~~Tests are not passing yet due to some discrepancies in DTO serialization vs existing Metadata serialization. I'm working on that.~~

The placeholders that I used for table and function metadata are not compatible with the ordered JSON serialization in use. I think the best solution is to write compatible codecs for those types in another PR. For now I have disabled some DTO tests for this PR.

Here are the generated [OpenAPI spec](https://github.com/hasura/graphql-engine-mono/files/9397333/openapi.tar.gz) based on these changes, and the generated [TypeScript client code](https://github.com/hasura/graphql-engine-mono/files/9397339/client-typescript.tar.gz) based on that spec.

Ticket: [MM-66](https://hasurahq.atlassian.net/browse/MM-66)

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5582
GitOrigin-RevId: e1446191c6c832879db04f129daa397a3be03f62
2022-08-25 18:36:02 +00:00

74 lines
2.4 KiB
Haskell

{-# LANGUAGE TemplateHaskellQuotes #-}
module Data.Text.NonEmpty
( NonEmptyText,
mkNonEmptyTextUnsafe,
mkNonEmptyText,
unNonEmptyText,
nonEmptyText,
nonEmptyTextCodec,
nonEmptyTextQQ,
)
where
import Autodocodec (HasCodec (codec), JSONCodec, bimapCodec, textCodec)
import Data.Aeson
import Data.Text qualified as T
import Data.Text.Extended
import Database.PG.Query qualified as Q
import Hasura.Prelude hiding (lift)
import Language.Haskell.TH.Quote (QuasiQuoter (..))
import Language.Haskell.TH.Syntax (Lift, Q, TExp, lift)
import Test.QuickCheck qualified as QC
newtype NonEmptyText = NonEmptyText {unNonEmptyText :: Text}
deriving (Show, Eq, Ord, Hashable, ToJSON, ToJSONKey, Lift, Q.ToPrepArg, ToTxt, Generic, NFData)
instance QC.Arbitrary NonEmptyText where
arbitrary = NonEmptyText . T.pack <$> QC.listOf1 (QC.elements alphaNumerics)
mkNonEmptyText :: Text -> Maybe NonEmptyText
mkNonEmptyText "" = Nothing
mkNonEmptyText text = Just $ NonEmptyText text
mkNonEmptyTextUnsafe :: Text -> NonEmptyText
mkNonEmptyTextUnsafe = NonEmptyText
parseNonEmptyText :: MonadFail m => Text -> m NonEmptyText
parseNonEmptyText text = mkNonEmptyText text `onNothing` fail "empty string not allowed"
nonEmptyText :: Text -> Q (TExp NonEmptyText)
nonEmptyText = parseNonEmptyText >=> \text -> [||text||]
nonEmptyTextCodec :: JSONCodec NonEmptyText
nonEmptyTextCodec = bimapCodec dec enc textCodec
where
dec = maybeToEither "empty string not allowed" . parseNonEmptyText
enc = unNonEmptyText
-- | Construct 'NonEmptyText' literals at compile-time via quasiquotation.
nonEmptyTextQQ :: QuasiQuoter
nonEmptyTextQQ =
QuasiQuoter {quoteExp, quotePat, quoteType, quoteDec}
where
quotePat _ = error "nonEmptyTextQQ does not support quoting patterns"
quoteType _ = error "nonEmptyTextQQ does not support quoting types"
quoteDec _ = error "nonEmptyTextQQ does not support quoting declarations"
quoteExp s = case mkNonEmptyText (T.pack s) of
Just result -> lift result
Nothing -> fail "empty string not allowed"
instance FromJSON NonEmptyText where
parseJSON = withText "String" parseNonEmptyText
instance FromJSONKey NonEmptyText where
fromJSONKey = FromJSONKeyTextParser parseNonEmptyText
instance Q.FromCol NonEmptyText where
fromCol bs =
mkNonEmptyText <$> Q.fromCol bs
>>= maybe (Left "empty string not allowed") Right
instance HasCodec NonEmptyText where
codec = nonEmptyTextCodec