some initial schemas

This commit is contained in:
Tom Sydney Kerckhove 2021-11-02 00:09:16 +01:00
parent cb1bd16e0b
commit 3703c2cd31
33 changed files with 318 additions and 13 deletions

View File

@ -33,6 +33,7 @@ library
, autodocodec
, autodocodec-aeson
, autodocodec-aeson-schema
, autodocodec-swagger2
, autodocodec-yaml
, base >=4.7 && <5
, bytestring
@ -41,6 +42,7 @@ library
, genvalidity-scientific
, genvalidity-text
, scientific
, swagger2
, text
default-language: Haskell2010
@ -65,6 +67,7 @@ test-suite autodocodec-api-usage-test
, autodocodec-aeson
, autodocodec-aeson-schema
, autodocodec-api-usage
, autodocodec-swagger2
, autodocodec-yaml
, base >=4.7 && <5
, bytestring
@ -78,6 +81,7 @@ test-suite autodocodec-api-usage-test
, genvalidity-text
, safe-coloured-text
, scientific
, swagger2
, sydtest
, sydtest-aeson
, text

View File

@ -19,6 +19,7 @@ library:
- autodocodec
- autodocodec-aeson
- autodocodec-aeson-schema
- autodocodec-swagger2
- autodocodec-yaml
- bytestring
- genvalidity
@ -26,6 +27,7 @@ library:
- genvalidity-scientific
- genvalidity-text
- scientific
- swagger2
- text
@ -46,6 +48,7 @@ tests:
- autodocodec-aeson
- autodocodec-aeson-schema
- autodocodec-api-usage
- autodocodec-swagger2
- autodocodec-yaml
- bytestring
- containers
@ -58,6 +61,7 @@ tests:
- genvalidity-text
- safe-coloured-text
- scientific
- swagger2
- sydtest
- sydtest-aeson
- text

View File

@ -1,5 +1,5 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
@ -8,8 +8,6 @@
module Autodocodec.SwaggerSpec (spec) where
import Autodocodec
import Autodocodec.Aeson
import Autodocodec.Aeson.Schema
import Autodocodec.Swagger
import Autodocodec.Usage
import qualified Data.Aeson as JSON
@ -20,15 +18,17 @@ import Data.GenValidity.Containers ()
import Data.GenValidity.Scientific ()
import Data.GenValidity.Text ()
import Data.Int
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe
import Data.Scientific
import Data.Swagger (Swagger (..))
import qualified Data.Swagger as Swagger
import qualified Data.Swagger.Declare as Swagger
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Data.Word
import Test.QuickCheck
import Test.Syd
import Test.Syd.Aeson
import Test.Syd.Validity
import Test.Syd.Validity.Utils
spec :: Spec
@ -40,6 +40,7 @@ spec = do
swaggerSchemaSpec @LT.Text "lazy-text"
swaggerSchemaSpec @String "string"
swaggerSchemaSpec @Scientific "scientific"
swaggerSchemaSpec @JSON.Object "object"
swaggerSchemaSpec @JSON.Value "value"
swaggerSchemaSpec @Int "int"
swaggerSchemaSpec @Int8 "int8"
@ -63,6 +64,11 @@ swaggerSchemaSpec :: forall a. (Show a, Eq a, Typeable a, GenValid a, HasCodec a
swaggerSchemaSpec filePath =
describe ("swaggerSchemaSpec @" <> nameOf @a) $ do
it "outputs the same schema as before" $
pureGoldenJSONFile
let definitions = flip Swagger.execDeclare mempty $ do
Swagger.NamedSchema mName schema <- declareNamedSchemaViaCodec (Proxy :: Proxy a)
Swagger.declare [(fromMaybe (T.pack $ nameOf @a) mName, schema)]
pure ()
swagger = mempty {_swaggerDefinitions = definitions}
in pureGoldenJSONFile
("test_resources/swagger/" <> filePath <> ".json")
(JSON.toJSON (jsonSchemaViaCodec @a))
(JSON.toJSON swagger)

View File

@ -0,0 +1,12 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Bool": {
"type": "boolean"
}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Char": {}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"(Either Bool Text)": {}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"(Either (Either Bool Scientific) Text)": {}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Example": {}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Int": {}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Int16": {}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Int32": {}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Int64": {}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Int8": {}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Text": {}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"[Text]": {}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"(Maybe Text)": {}
}
}

View File

@ -0,0 +1,14 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Object": {
"additionalProperties": true,
"type": "object",
"description": "Arbitrary JSON object."
}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Ordering": {}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Recursive": {}
}
}

View File

@ -0,0 +1,12 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Scientific": {
"type": "number"
}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"[Char]": {}
}
}

View File

@ -0,0 +1,12 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Text": {
"type": "string"
}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Value": {}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Via": {}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Word": {}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Word16": {}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Word32": {}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Word64": {}
}
}

View File

@ -0,0 +1,10 @@
{
"swagger": "2.0",
"info": {
"version": "",
"title": ""
},
"definitions": {
"Word8": {}
}
}

View File

@ -28,7 +28,10 @@ library
hs-source-dirs:
src
build-depends:
autodocodec
aeson
, autodocodec
, base >=4.7 && <5
, scientific
, swagger2
, text
default-language: Haskell2010

View File

@ -14,5 +14,8 @@ dependencies:
library:
source-dirs: src
dependencies:
- aeson
- autodocodec
- scientific
- swagger2
- text

View File

@ -1,14 +1,26 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
module Autodocodec.Swagger where
import Autodocodec
import qualified Data.Aeson as JSON
import Data.Proxy
import Data.Scientific
import Data.Swagger
import Data.Swagger.Declare
import Data.Text (Text)
declareNamedSchemaViaCodec :: HasCodec value => Proxy value -> Declare (Definitions Schema) NamedSchema
declareNamedSchemaViaCodec proxy = declareNamedSchemaVia codec proxy
declareNamedSchemaVia :: ValueCodec input output -> Proxy value -> Declare (Definitions Schema) NamedSchema
declareNamedSchemaVia codec Proxy = go codec
declareNamedSchemaVia :: JSONCodec value -> Proxy value -> Declare (Definitions Schema) NamedSchema
declareNamedSchemaVia c Proxy = go c
where
go :: Codec context input output -> Declare (Definitions Schema) NamedSchema
go = undefined
go = \case
BoolCodec mname -> NamedSchema mname <$> declareSchema (Proxy :: Proxy Bool)
StringCodec mname -> NamedSchema mname <$> declareSchema (Proxy :: Proxy Text)
NumberCodec mname -> NamedSchema mname <$> declareSchema (Proxy :: Proxy Scientific)
ObjectCodec -> declareNamedSchema (Proxy :: Proxy JSON.Object)
_ -> pure $ NamedSchema Nothing mempty -- TODO

View File

@ -82,6 +82,9 @@ instance HasCodec Word32 where
instance HasCodec Word64 where
codec = boundedIntegerCodec <?> "Word64"
instance HasCodec JSON.Object where
codec = ObjectCodec
instance HasCodec JSON.Value where
codec = ValueCodec