Haskell/Aeson/Lens/OpenApi versus underscore

Question

Given a data/newtype such as:

newtype Disclosed = Disclosed { _getDisclosed :: [Word64] }
  deriving (Eq, Generic, Show, Semigroup)

I create lens via:

makeLenses ''Disclosed

and drop the underscore when encoding to JSON:

deriveJSON defaultOptions{fieldLabelModifier = drop 1} ''Disclosed

It works:

λ: encode (Disclosed [34,43])
"{\"getDisclosed\":[34,43]}"

I expose this type to a HTTP API using Data.OpenApi

instance ToSchema Disclosed

but that results in

 { "_getDisclosed": 9223372036854776000 }

in the generated OpenApi description (note the underscore is back).

I know I can manually write the description manually to do the "right" thing:

instance ToSchema  VCP.JV2.Disclosed where
  declareNamedSchema _ = do
    intSchema <- declareSchemaRef (Proxy :: Proxy Int)
    return $ NamedSchema (Just "Disclosed") $ mempty
      & type_      ?~ OpenApiObject
      & properties .~ fromList [ ("getDisclosed", intSchema) ]
      & required   .~ [ "getDisclosed" ]

but that is tedious boilerplate.

Is there some "magic" way to get OpenApi to drop the underscores?

Answer 1

Something like

instance ToSchema VCP.JV2.Disclosed where
  declareNamedSchema _ =
    genericDeclareNamedSchema (defaultSchemaOptions {fieldLabelModifier = tail})

should do the trick.

You also should be able to package this logic into an instance associated with a Newtype and use newtype-deriving for all of your data types along the lines of

newtype DropUnderscores a = DropUnderscores a

instance (Generic a, GToSchema (Rep a)) => ToSchema (DropUnderscores a) where
  declareNamedSchema _ =
    genericDeclareNamedSchema (defaultSchemaOptions {fieldLabelModifier = dropWhile (== '_')})

newtype Disclosed = Disclosed { _getDisclosed :: [Word64] }
  deriving (Eq, Generic, Show, Semigroup)
  deriving newtype ToSchema via DropUnderscores Disclosed

None of that code was tested, so take it with a grain of salt.