Improve HasOpenApi compat shim

src/Gargantext/API/Routes/Named/Share.hs

@@ -29,7 +29,7 @@ import Servant
 -- would fail because '#/share/NodeCorpus/16' by the RFC3968 spec is considered
 -- an uriFragment, but BaseUrl cannot handle that.
 newtype ShareLink = ShareLink { getShareLink :: URI }
-  deriving (Show, Eq, Ord)
+  deriving (Show, Eq, Ord, Generic)
 
 renderShareLink :: ShareLink -> T.Text
 renderShareLink = T.pack . show . getShareLink

src/Gargantext/API/Swagger.hs

@@ -17,14 +17,11 @@ module Gargantext.API.Swagger (
   , openApiDoc
   ) where
 
----------------------------------------------------------------------
 import Control.Lens
-import Data.Swagger
 import Data.Version (showVersion)
-import Servant.OpenApi (toOpenApi)
-import Data.OpenApi (OpenApi)
+import Servant.OpenApi
+import Data.OpenApi
 import Servant
-import Servant.Swagger
 import qualified Paths_gargantext as PG -- cabal magic build module
 
 import Gargantext.API.Routes.Named qualified as Named
@@ -39,15 +36,9 @@ backendApiProxy = Proxy
 -- is stuck on version 2.x of the OpenAPI spec.
 openApiDoc :: OpenApi
 openApiDoc = toOpenApi backendApiProxy
-
--- | Swagger Specifications
-_swaggerDoc :: Swagger
-_swaggerDoc = toSwagger backendApiProxy
   & info.title       .~ "GarganText"
   & info.version     .~ (cs $ showVersion PG.version)
-  -- & info.base_url     ?~ (URL "http://gargantext.org/")
   & info.description ?~ "REST API specifications"
-  -- & tags             .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
   & applyTagsFor (subOperations backendApiProxy backendApiProxy)
                  ["Gargantext" & description ?~ "Main operations"]
   & info.license     ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )

src/Gargantext/Orphans/OpenAPI.hs

@@ -76,13 +76,13 @@ fromParamSchema :: Swagger.ParamSchema t -> Schema
 fromParamSchema ps = OpenAPI.Schema
   { OpenAPI._schemaTitle = Nothing
   , OpenAPI._schemaDescription = Nothing
-  , OpenAPI._schemaDefault = Swagger._paramSchemaDefault ps
+  , OpenAPI._schemaDefault = view Swagger.default_ ps
   , OpenAPI._schemaExample = Nothing
-  , OpenAPI._schemaType = convertType <$> Swagger._paramSchemaType ps
-  , OpenAPI._schemaFormat = Swagger._paramSchemaFormat ps
+  , OpenAPI._schemaType = convertType <$> view Swagger.type_ ps
+  , OpenAPI._schemaFormat = view Swagger.format ps
   , OpenAPI._schemaNullable = Nothing
-  , OpenAPI._schemaEnum = Swagger._paramSchemaEnum ps
-  , OpenAPI._schemaMaximum = Swagger._paramSchemaMaximum ps
+  , OpenAPI._schemaEnum = view Swagger.enum_ ps
+  , OpenAPI._schemaMaximum = view Swagger.maximum_ ps
   , OpenAPI._schemaExclusiveMaximum = Swagger._paramSchemaExclusiveMaximum ps
   , OpenAPI._schemaMinimum = Swagger._paramSchemaMinimum ps
   , OpenAPI._schemaExclusiveMinimum = Swagger._paramSchemaExclusiveMinimum ps
@@ -91,11 +91,11 @@ fromParamSchema ps = OpenAPI.Schema
   , OpenAPI._schemaPattern = Swagger._paramSchemaPattern ps
   , OpenAPI._schemaMaxItems = Swagger._paramSchemaMaxItems ps
   , OpenAPI._schemaMinItems = Swagger._paramSchemaMinItems ps
-  , OpenAPI._schemaUniqueItems = Swagger._paramSchemaUniqueItems ps
+  , OpenAPI._schemaUniqueItems = view Swagger.uniqueItems ps
   , OpenAPI._schemaMaxProperties = Nothing
   , OpenAPI._schemaMinProperties = Nothing
   , OpenAPI._schemaAdditionalProperties = Nothing
-  , OpenAPI._schemaItems = convertItems <$> Swagger._paramSchemaItems ps
+  , OpenAPI._schemaItems = convertItems <$> view Swagger.items ps
   , OpenAPI._schemaProperties = mempty
   , OpenAPI._schemaRequired = mempty
   , OpenAPI._schemaAllOf = Nothing
@@ -108,7 +108,7 @@ fromParamSchema ps = OpenAPI.Schema
   , OpenAPI._schemaXml = Nothing
   , OpenAPI._schemaExternalDocs = Nothing
   , OpenAPI._schemaDeprecated = Nothing
-  , OpenAPI._schemaMultipleOf = Swagger._paramSchemaMultipleOf ps
+  , OpenAPI._schemaMultipleOf = view Swagger.multipleOf ps
   }
 
 convertType :: Swagger.SwaggerType t -> OpenAPI.OpenApiType
@@ -169,51 +169,52 @@ convertDiscriminator t = OpenAPI.Discriminator t mempty
 
 fromSwaggerSchema :: Swagger.Schema -> OpenAPI.Schema
 fromSwaggerSchema swaggerSchema = OpenAPI.Schema
-  { OpenAPI._schemaTitle = Swagger._schemaTitle swaggerSchema
-  , OpenAPI._schemaDescription = Swagger._schemaDescription swaggerSchema
-  , OpenAPI._schemaDefault = Nothing
-  , OpenAPI._schemaExample = Swagger._schemaExample swaggerSchema
-  , OpenAPI._schemaType = Nothing
-  , OpenAPI._schemaFormat = Nothing
+  { OpenAPI._schemaTitle = view Swagger.title swaggerSchema
+  , OpenAPI._schemaDescription = view Swagger.description swaggerSchema
+  , OpenAPI._schemaDefault = view Swagger.default_ swaggerSchema
+  , OpenAPI._schemaExample = view Swagger.example swaggerSchema
+  , OpenAPI._schemaType = convertType <$> view Swagger.type_ swaggerSchema
+  , OpenAPI._schemaFormat = view Swagger.format swaggerSchema
   , OpenAPI._schemaNullable = Nothing
-  , OpenAPI._schemaEnum = Nothing
-  , OpenAPI._schemaMaximum = Nothing
+  , OpenAPI._schemaEnum = view Swagger.enum_ swaggerSchema
+  , OpenAPI._schemaMaximum = view Swagger.maximum_ swaggerSchema
   , OpenAPI._schemaExclusiveMaximum = Nothing
-  , OpenAPI._schemaMinimum = Nothing
+  , OpenAPI._schemaMinimum = view Swagger.minimum_ swaggerSchema
   , OpenAPI._schemaExclusiveMinimum = Nothing
   , OpenAPI._schemaMaxLength = Nothing
   , OpenAPI._schemaMinLength = Nothing
   , OpenAPI._schemaPattern = Nothing
   , OpenAPI._schemaMaxItems = Nothing
   , OpenAPI._schemaMinItems = Nothing
-  , OpenAPI._schemaUniqueItems = Nothing
-  , OpenAPI._schemaMaxProperties = Swagger._schemaMaxProperties swaggerSchema
-  , OpenAPI._schemaMinProperties = Swagger._schemaMinProperties swaggerSchema
-  , OpenAPI._schemaAdditionalProperties = convertAdditionalProps <$> Swagger._schemaAdditionalProperties swaggerSchema
-  , OpenAPI._schemaItems = Nothing
-  , OpenAPI._schemaProperties = HM.map convertRef $ Swagger._schemaProperties swaggerSchema
-  , OpenAPI._schemaRequired = Swagger._schemaRequired swaggerSchema
-  , OpenAPI._schemaAllOf = map convertRef <$> Swagger._schemaAllOf swaggerSchema
+  , OpenAPI._schemaUniqueItems = view Swagger.uniqueItems swaggerSchema
+  , OpenAPI._schemaMaxProperties = view Swagger.maxProperties swaggerSchema
+  , OpenAPI._schemaMinProperties = view Swagger.minProperties swaggerSchema
+  , OpenAPI._schemaAdditionalProperties = convertAdditionalProps <$> view Swagger.additionalProperties swaggerSchema
+  , OpenAPI._schemaItems = convertItems <$> view Swagger.items swaggerSchema
+  , OpenAPI._schemaProperties = HM.map convertRef $ view Swagger.properties swaggerSchema
+  , OpenAPI._schemaRequired = view Swagger.required swaggerSchema
+  , OpenAPI._schemaAllOf = map convertRef <$> view Swagger.allOf swaggerSchema
   , OpenAPI._schemaOneOf = Nothing
   , OpenAPI._schemaNot = Nothing
   , OpenAPI._schemaAnyOf = Nothing
-  , OpenAPI._schemaDiscriminator = convertDiscriminator <$> Swagger._schemaDiscriminator swaggerSchema
-  , OpenAPI._schemaReadOnly = Swagger._schemaReadOnly swaggerSchema
+  , OpenAPI._schemaDiscriminator = convertDiscriminator <$> view Swagger.discriminator swaggerSchema
+  , OpenAPI._schemaReadOnly = view Swagger.readOnly swaggerSchema
   , OpenAPI._schemaWriteOnly = Nothing
-  , OpenAPI._schemaXml = convertXml <$> Swagger._schemaXml swaggerSchema
-  , OpenAPI._schemaExternalDocs = convertDocs <$> Swagger._schemaExternalDocs swaggerSchema
+  , OpenAPI._schemaXml = convertXml <$> view Swagger.xml swaggerSchema
+  , OpenAPI._schemaExternalDocs = convertDocs <$> view Swagger.externalDocs swaggerSchema
   , OpenAPI._schemaDeprecated = Nothing
-  , OpenAPI._schemaMultipleOf = Nothing
+  , OpenAPI._schemaMultipleOf = view Swagger.multipleOf swaggerSchema
   }
 
 -- little compat-shim to avoid re-implementing 'ToSchema' and 'ToParamSchema' for each
 -- and every type, while we transition away from swagger.
 
-instance {-# OVERLAPPABLE #-} Swagger.ToParamSchema a => ToParamSchema a where
+instance {-# OVERLAPS #-} (Typeable a, Swagger.ToParamSchema a) => ToParamSchema a where
   toParamSchema p = fromParamSchema $ Swagger.toParamSchema p
 
-instance {-# OVERLAPPABLE #-} (Typeable a, Swagger.ToSchema a) => ToSchema a where
-  declareNamedSchema _ = pure $ OpenAPI.NamedSchema swaggerName openApiSchema
+instance {-# OVERLAPS #-} (Typeable a, Swagger.ToSchema a) => ToSchema a where
+  declareNamedSchema _ =
+    pure $ OpenAPI.NamedSchema swaggerName openApiSchema
     where
       Swagger.NamedSchema swaggerName swaggerSchema = Swagger.toNamedSchema (Proxy :: Proxy a)
       openApiSchema = fromSwaggerSchema swaggerSchema