Do something clever with ToSchema for polymorphic types

[fizruk]

Turns out someone just got "bitten" by ToSchema (Either a b) instance we have. Since Generic mechanism can't display names of the type parameters, we name all instances just "Either". Apart from bad naming this results in silent overwriting schemas in Definitions.

This turned out not good for one of IOHK's APIs (see here). They are using a lot of Either WalletError something as their response types. Although that's not idiomatic API design (WalletError should be returned with 400 or some other error HTTP code) this is how things are and there's no reason to reject Swagger for this API.

To facilitate this specific use I've come up with a simple fix:

{-# LANGUAGE ScopedTypeVariables #-}

import Control.Lens
import Data.Typeable
import qualified Data.Text as Text

instance {-# OVERLAPPING #-} (Typeable a, ToSchema a) => ToSchema (Either WalletError a) where
  declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
      & mapped.name ?~ Text.pack ("Either WalletError " ++ show (typeOf (undefined :: a)))

We can use a similar fix for all polymorphic types with named schemas:

instance (Typeable a, Typeable b, ToSchema a, ToSchema b)
  => ToSchema (Either a b) where
  declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
      & mapped.name ?~ Text.pack ("Either " ++ aName ++ " " ++ bName)
    where
      aName = show (typeOf (undefined :: a))
      bName = show (typeOf (undefined :: b))

We can even make some helpers to avoid code duplication for custom polymorphic types:

genericDeclareNamedSchema1 :: forall t a. (...) =>
  SchemaOptions -> proxy (t a) -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchema1 opts proxy = genericDeclareNamedSchema opts proxy
  & mapped.name ?~ Text.pack (tName ++ " " ++ aName)
  where
    tName = show (typeOf (undefined :: t))
    aName = show (typeOf (undefined :: a))

genericDeclareNamedSchema2 :: forall t a. (...) =>
  SchemaOptions -> proxy (t a b) -> Declare (Definitions Schema) NamedSchema

genericDeclareNamedSchema3 :: forall t a. (...) =>
  SchemaOptions -> proxy (t a b c) -> Declare (Definitions Schema) NamedSchema

[phadej]

can't we extract the names for child schemas from schemas for a and b?

[fizruk]

@phadej not always, name is optional (which makes sense, e.g. for (Int, String)).

[fizruk]

We can use names for child schemas and fallback to show . typeOf though.

[phadej]

Well, I guess Typeable isn't that bad, as everything is Typeable, unelegant it is though :/ I'd rather make name less-optional...

[fizruk]

@phadej What names would you use for lists and tuples and maps? We can make names mandatory, but it does not make much sense to introduce Haskell lists, tuples and maps into Swagger spec.

Perhaps we can add an "inline me" instruction per schema so that schemas always have names (to be used in schema names for polymorphic types) but some schemas are always inlined (e.g. lists, tuples, maps).

[fizruk]

And we can easily filter "inlined" schemas from definitions.

[phadej]

That sounds great; I'd like to avoid Typeable, it's a code smell; if we have to use it (otherwise we could just used Data directly ;))

[qrilka]

Any updates on this one? I'm currently struggling to get swagger spec for a code like

data Pair a b = Pair {x :: a, y :: b} deriving Generic

data ConcretePair = Pair Int (Pair Char Bool) deriving Generic

And inlineSchemas loops while inlineNonRecursiveSchemas doesn't do inlining of course.

[fizruk]

@qrilka I did not have the time yet to implement this, are you willing to work on a PR (with my help of course)?

Regarding your example, I don't see why it wouldn't work. Can you show what schemas are produced and what schemas you're trying to achieve?

In any case, you can always fix naming in the ToSchema instances for your Pair like this:

{-# LANGUAGE ScopedTypeVariables #-}

import Control.Lens
import Data.Typeable
import qualified Data.Text as Text

instance {-# OVERLAPPING #-} (Typeable a, Typeable b, ToSchema a, ToSchema b)
  => ToSchema (Pair a b) where
  declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
      & mapped.name ?~ Text.pack
          ("Pair "
          ++ show (typeOf (undefined :: a))
          ++ " "
          ++ show (typeOf (undefined :: b)))

[phadej]

@fizruk could we add Typeable as a constraint to ToSchema and detect loops automatically (polymorphic recursion will still fail, but you cannot get everything)?

EDIT seems I loop to my previous conclusion.

[fizruk]

@phadej yeah, we kind of already discussed the plan, I just didn't have time to implement it :)

[qrilka]

for Pair Int (Pair Int Int) I'm getting

"P": {
    "required": ["x", "y"],
    "properties": {
        "x": {
            "maximum": 9223372036854775807,
            "minimum": -9223372036854775808,
            "type": "integer"
        },
        "y": {
            "$ref": "#/definitions/Pair"
        }
    },
    "type": "object"
}

And I was trying to get something like

"Pair": {
    "required": ["x", "y"],
    "properties": {
        "x": {
            "maximum": 9223372036854775807,
            "minimum": -9223372036854775808,
            "type": "integer"
        },
        "y": {
            "required": ["x", "y"],
            "properties": {
                "x": {
                    "maximum": 9223372036854775807,
                    "minimum": -9223372036854775808,
                    "type": "integer"
                },
                "y": {
                    "maximum": 9223372036854775807,
                    "minimum": -9223372036854775808,
                    "type": "integer"
                },
            },
            "type": "object"
        }
    },
    "type": "object"
}

I.e. having 2nd level Pair inlined to prevent recursion. I'll use the recipe you'v given above @fizruk and I'm not sure I have enough time to work on PR for this. BTW wasn't the previous idea about filtering out "inlined" schema and not to go with Typeable?

[fizruk]

I.e. having 2nd level Pair inlined to prevent recursion.

Ah, I misunderstood that ConcretePair was meant as a type synonym, not data as you wrote it. Now your problem makes sense!

I'll use the recipe you'v given above @fizruk and I'm not sure I have enough time to work on PR for this.

It should work fine for you and since there's a growing need in handling polymorphic types, I think we'll implement this in the library relatively soon!

BTW wasn't the previous idea about filtering out "inlined" schema and not to go with Typeable?

Yes, but that requires some changes to the ToSchema class definition (to add information about which schemas should be inlined and to make name mandatory) so it's not exactly available as a quickfix.

[michalrus]

How about if we did something like that?

@phadej will probably say that Typeble is code smell, but… It really works wonderfully and is very short to use for new polymorphic types. #deadlines

wellNamedSchema ::
     forall proxy a.
     ( Typeable a -- for the real full name
     , Generic a
     , S.GToSchema (Rep a)
     , S.GenericHasSimpleShape a "genericDeclareNamedSchemaUnrestricted" (S.GenericShape (Rep a))
     )
  => proxy a
  -> S.Declare (S.Definitions S.Schema) S.NamedSchema
wellNamedSchema proxy =
  (S.name ?~ (T.replace " " "_" . tshow . Typeable.typeRep) proxy) <$>
  S.genericDeclareNamedSchema S.defaultSchemaOptions proxy

And then:

data SearchResults a = SearchResults
  { total :: Int
  , results :: [a]
  } deriving (Eq, Show, Generic)

instance (Typeable a, ToSchema a) => ToSchema (SearchResults a) where
  declareNamedSchema = wellNamedSchema

[michalrus]

This even works nicely for data families parametrized with types from +XDataKinds:

[fizruk]

@michalrus Sorry I haven't answered you in a while!

I have encountered this problem myself recently and I had to think about it once more. I think your approach is great and we should actually make it default. However, there's one part of your implementation that bugs me: T.replace " " "_". Why do you want that? Is it for Swagger UI? What about other special symbols (e.g. something like Result (Maybe [Ok]))? Maybe a proper URL encoding is needed?

[phadej]

@michalrus not at all, see https://github.com/GetShopTV/swagger2/issues/94#issuecomment-301786414

[michalrus]

@fizruk, @phadej, awesome! :sparkles:

As for T.replace " " "_", I don’t remember, hmm… It’s very possible that I just thought it looked nicer. :blush: I think full URL encoding seems unnecessary, because ', [ etc. work fine.

[michalrus]

Oh, one reason could be swagger-codegen, this would need testing with spaces in symbol names.

[phadej]

@michalrus If swagger-codegen breaks, it's its problem. You could postprocess SwaggerDoc for it, but let's not do it for everyone.

[michalrus]

Yes, absolutely, I was speaking from a mundane I-need-to-get-this-done perspective. Sorry. :smiley_cat:

[fizruk]

@phadej should we make this wellNamedSchema default? I would like to :)

[phadej]

@fizruk I think so, let's have current as as a fallback for ones who need it.

I have few

-- type constructors with phantoms, or otherwise schema irrelevant args
instance ToSchema (TypeWithPhantomArg phantom)

which will break, but those are easy to fix. When the fix-for-this-issue is merged, I can try master on our codebase.

[phadej]

Note (which may be included in docs, in way or another), that fully resolved Typeable is only on monomorphic types, but I don't think there are APIs which have polymorphic types in them, It would be kind of weird to have:

type API a = ... :> Get '[JSON] (Proxy a)

(and getting a swaggerDoc for that!)

So I expect the breakage only for generically derived ToSchema -instances, as I mentioned above.

[fizruk]

It would be kind of weird to have:

type API a = ... :> Get '[JSON] (Proxy a)

Actually that can be useful :) For instance, I use it here: https://github.com/fizruk/arangodb/blob/7dca8557cc6a06b59e8efdf63991a6f7b7b7dc82/src/ArangoDB/Internal/AQL.hs#L41-L44

But yes, for swagger documentation I have to instantiate that variable (e.g. with Aeson.Object).

[phadej]

@fizruk in your example, CursorResponse has [a] (even CursorRequest has phantom a).