From feaeb64e299d38aba5b8f8b1f9a9e2cb2e2c63ae Mon Sep 17 00:00:00 2001 From: anneloreegger Date: Sun, 16 Jun 2019 13:59:03 +0200 Subject: [PATCH 1/7] add Json-instances for TimeOfDay --- src/Data/Swagger/Internal/ParamSchema.hs | 3 +++ src/Data/Swagger/Internal/Schema.hs | 4 ++++ 2 files changed, 7 insertions(+) diff --git a/src/Data/Swagger/Internal/ParamSchema.hs b/src/Data/Swagger/Internal/ParamSchema.hs index ff56f42..06e18a3 100644 --- a/src/Data/Swagger/Internal/ParamSchema.hs +++ b/src/Data/Swagger/Internal/ParamSchema.hs @@ -193,6 +193,9 @@ timeParamSchema fmt = mempty instance ToParamSchema Day where toParamSchema _ = timeParamSchema "date" +instance ToParamSchema TimeOfDay where + toParamSchema _ = timeParamSchema "hh:MM:ss" + -- | -- >>> toParamSchema (Proxy :: Proxy LocalTime) ^. format -- Just "yyyy-mm-ddThh:MM:ss" diff --git a/src/Data/Swagger/Internal/Schema.hs b/src/Data/Swagger/Internal/Schema.hs index 74a4060..ade084c 100644 --- a/src/Data/Swagger/Internal/Schema.hs +++ b/src/Data/Swagger/Internal/Schema.hs @@ -147,6 +147,10 @@ class ToSchema a where Proxy a -> Declare (Definitions Schema) NamedSchema declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions +instance ToSchema TimeOfDay where + declareNamedSchema _ = pure $ named "TimeOfDay" $ timeSchema "hh:MM:ss" + & example ?~ toJSON (TimeOfDay 12 33 15) + -- | Convert a type into a schema and declare all used schema definitions. declareSchema :: ToSchema a => Proxy a -> Declare (Definitions Schema) Schema declareSchema = fmap _namedSchemaSchema . declareNamedSchema From fbf77235e9d69e9946847eff3dffe07626f8bfe2 Mon Sep 17 00:00:00 2001 From: anneloreegger Date: Sun, 16 Jun 2019 20:09:26 +0200 Subject: [PATCH 2/7] add Test for ParamSchema --- stack.yaml | 3 ++- test/Data/Swagger/ParamSchemaSpec.hs | 7 ++++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/stack.yaml b/stack.yaml index 87d4b77..efd159d 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-12.10 +resolver: lts-13.23 packages: - '.' extra-deps: @@ -6,3 +6,4 @@ extra-deps: - base-compat-batteries-0.10.4 - contravariant-1.5 - insert-ordered-containers-0.2.2 +#- base-compat-0.10.4 diff --git a/test/Data/Swagger/ParamSchemaSpec.hs b/test/Data/Swagger/ParamSchemaSpec.hs index 95a4c5c..1b5d074 100644 --- a/test/Data/Swagger/ParamSchemaSpec.hs +++ b/test/Data/Swagger/ParamSchemaSpec.hs @@ -3,9 +3,10 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE OverloadedStrings #-} module Data.Swagger.ParamSchemaSpec where -import Data.Aeson (Value) +import Data.Aeson import Data.Aeson.QQ.Simple import Data.Char import Data.Proxy @@ -17,6 +18,9 @@ import Data.Swagger.Internal (SwaggerKind(..)) import Data.Swagger.CommonTestTypes import SpecCommon import Test.Hspec +import Data.Time.LocalTime + +import qualified Data.HashMap.Strict as HM checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema ('SwaggerKindNormal Param)) <=> js @@ -30,6 +34,7 @@ spec = do context "Unary records" $ do context "Email (unary record)" $ checkToParamSchema (Proxy :: Proxy Email) emailSchemaJSON context "UserId (non-record newtype)" $ checkToParamSchema (Proxy :: Proxy UserId) userIdSchemaJSON + context "TimeOfDay" $ checkToParamSchema (Proxy :: Proxy TimeOfDay) (Object (HM.fromList [("format",String "hh:MM:ss"),("type",String "string")])) main :: IO () main = hspec spec From 40d45ac17aa6c13e472c75cf7e6e27c4456614ba Mon Sep 17 00:00:00 2001 From: anneloreegger Date: Sat, 22 Jun 2019 16:10:18 +0200 Subject: [PATCH 3/7] add Test for Schema --- test/Data/Swagger/SchemaSpec.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/test/Data/Swagger/SchemaSpec.hs b/test/Data/Swagger/SchemaSpec.hs index 54f8d85..6a84a9f 100644 --- a/test/Data/Swagger/SchemaSpec.hs +++ b/test/Data/Swagger/SchemaSpec.hs @@ -1,14 +1,16 @@ {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE OverloadedStrings #-} module Data.Swagger.SchemaSpec where import Prelude () import Prelude.Compat import Control.Lens ((^.)) -import Data.Aeson (Value, ToJSON(..), ToJSONKey(..)) +import Data.Aeson (Value, ToJSON(..), ToJSONKey(..), Value(Object), Value(String)) import Data.Aeson.Types (toJSONKeyText) import Data.Aeson.QQ.Simple import Data.Char @@ -26,6 +28,9 @@ import Data.Swagger.CommonTestTypes import SpecCommon import Test.Hspec +import qualified Data.HashMap.Strict as HM +import Data.Time + checkToSchema :: ToSchema a => Proxy a -> Value -> Spec checkToSchema proxy js = toSchema proxy <=> js @@ -110,6 +115,7 @@ spec = do context "MyRoseTree' (inlineNonRecursiveSchemas)" $ checkInlinedRecSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON' describe "Bounded Enum key mapping" $ do context "ButtonImages" $ checkToSchema (Proxy :: Proxy ButtonImages) buttonImagesSchemaJSON + context "TimeOfDay" $ checkToSchema (Proxy :: Proxy TimeOfDay ) (Object (HM.fromList [("example",String "12:33:15"),("format",String "hh:MM:ss"),("type",String "string")])) main :: IO () main = hspec spec From 1c3de746b6ad8057c952f9e24d6f894c02378abb Mon Sep 17 00:00:00 2001 From: anneloreegger Date: Sat, 22 Jun 2019 16:39:02 +0200 Subject: [PATCH 4/7] revert stack.yaml to initial version --- stack.yaml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/stack.yaml b/stack.yaml index efd159d..87d4b77 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-13.23 +resolver: lts-12.10 packages: - '.' extra-deps: @@ -6,4 +6,3 @@ extra-deps: - base-compat-batteries-0.10.4 - contravariant-1.5 - insert-ordered-containers-0.2.2 -#- base-compat-0.10.4 From bd00ca59051d1a1a0833b17397201c649c02d9d9 Mon Sep 17 00:00:00 2001 From: anneloreegger Date: Sat, 20 Jul 2019 14:14:08 +0200 Subject: [PATCH 5/7] extract schema and paramSchema's JSON Value into CommonTestTypes --- test/Data/Swagger/CommonTestTypes.hs | 29 ++++++++++++++++++++++++++++ test/Data/Swagger/ParamSchemaSpec.hs | 2 +- test/Data/Swagger/SchemaSpec.hs | 4 ++-- 3 files changed, 32 insertions(+), 3 deletions(-) diff --git a/test/Data/Swagger/CommonTestTypes.hs b/test/Data/Swagger/CommonTestTypes.hs index b4d5492..f55f360 100644 --- a/test/Data/Swagger/CommonTestTypes.hs +++ b/test/Data/Swagger/CommonTestTypes.hs @@ -650,3 +650,32 @@ singleMaybeFieldSchemaJSON = [aesonQQ| } } |] + + +-- ======================================================================== +-- TimeOfDay +-- ======================================================================== +data TimeOfDay + = Int + | Pico + deriving (Generic) +instance ToSchema TimeOfDay +instance ToParamSchema TimeOfDay + + +timeOfDaySchemaJSON :: Value +timeOfDaySchemaJSON = [aesonQQ| +{ + "example": "12:33:15", + "type": "string", + "format": "hh:MM:ss" +} +|] + +timeOfDayParamSchemaJSON :: Value +timeOfDayParamSchemaJSON = [aesonQQ| +{ + "type": "string", + "format": "hh:MM:ss" +} +|] \ No newline at end of file diff --git a/test/Data/Swagger/ParamSchemaSpec.hs b/test/Data/Swagger/ParamSchemaSpec.hs index 1b5d074..0723864 100644 --- a/test/Data/Swagger/ParamSchemaSpec.hs +++ b/test/Data/Swagger/ParamSchemaSpec.hs @@ -34,7 +34,7 @@ spec = do context "Unary records" $ do context "Email (unary record)" $ checkToParamSchema (Proxy :: Proxy Email) emailSchemaJSON context "UserId (non-record newtype)" $ checkToParamSchema (Proxy :: Proxy UserId) userIdSchemaJSON - context "TimeOfDay" $ checkToParamSchema (Proxy :: Proxy TimeOfDay) (Object (HM.fromList [("format",String "hh:MM:ss"),("type",String "string")])) + context "TimeOfDay" $ checkToParamSchema (Proxy :: Proxy Data.Time.LocalTime.TimeOfDay) timeOfDayParamSchemaJSON main :: IO () main = hspec spec diff --git a/test/Data/Swagger/SchemaSpec.hs b/test/Data/Swagger/SchemaSpec.hs index 6a84a9f..d3d6fa3 100644 --- a/test/Data/Swagger/SchemaSpec.hs +++ b/test/Data/Swagger/SchemaSpec.hs @@ -29,7 +29,7 @@ import SpecCommon import Test.Hspec import qualified Data.HashMap.Strict as HM -import Data.Time +import Data.Time.LocalTime checkToSchema :: ToSchema a => Proxy a -> Value -> Spec checkToSchema proxy js = toSchema proxy <=> js @@ -115,7 +115,7 @@ spec = do context "MyRoseTree' (inlineNonRecursiveSchemas)" $ checkInlinedRecSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON' describe "Bounded Enum key mapping" $ do context "ButtonImages" $ checkToSchema (Proxy :: Proxy ButtonImages) buttonImagesSchemaJSON - context "TimeOfDay" $ checkToSchema (Proxy :: Proxy TimeOfDay ) (Object (HM.fromList [("example",String "12:33:15"),("format",String "hh:MM:ss"),("type",String "string")])) + context "TimeOfDay" $ checkToSchema (Proxy :: Proxy Data.Time.LocalTime.TimeOfDay ) timeOfDaySchemaJSON main :: IO () main = hspec spec From 48a545d3cadf7f31d676721403ec43a9a2f05bba Mon Sep 17 00:00:00 2001 From: anneloreegger Date: Sat, 20 Jul 2019 15:37:53 +0200 Subject: [PATCH 6/7] add Doctest for TimeOfDay in ParamSchema --- src/Data/Swagger/Internal/ParamSchema.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Data/Swagger/Internal/ParamSchema.hs b/src/Data/Swagger/Internal/ParamSchema.hs index 06e18a3..c3b1e7a 100644 --- a/src/Data/Swagger/Internal/ParamSchema.hs +++ b/src/Data/Swagger/Internal/ParamSchema.hs @@ -193,6 +193,9 @@ timeParamSchema fmt = mempty instance ToParamSchema Day where toParamSchema _ = timeParamSchema "date" +-- | +-- >>> toParamSchema (Proxy :: Proxy TimeOfDay) ^. format +-- Just "hh:MM:ss" instance ToParamSchema TimeOfDay where toParamSchema _ = timeParamSchema "hh:MM:ss" From 3089c78629f76829d66bd7f0874ff63875799989 Mon Sep 17 00:00:00 2001 From: anneloreegger Date: Fri, 25 Oct 2019 13:40:42 +0200 Subject: [PATCH 7/7] remove unnecessary space --- test/Data/Swagger/SchemaSpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Data/Swagger/SchemaSpec.hs b/test/Data/Swagger/SchemaSpec.hs index d15908a..61ab218 100644 --- a/test/Data/Swagger/SchemaSpec.hs +++ b/test/Data/Swagger/SchemaSpec.hs @@ -108,7 +108,7 @@ spec = do context "MyRoseTree' (inlineNonRecursiveSchemas)" $ checkInlinedRecSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON' describe "Bounded Enum key mapping" $ do context "ButtonImages" $ checkToSchema (Proxy :: Proxy ButtonImages) buttonImagesSchemaJSON - context "TimeOfDay" $ checkToSchema (Proxy :: Proxy Data.Time.LocalTime.TimeOfDay ) timeOfDaySchemaJSON + context "TimeOfDay" $ checkToSchema (Proxy :: Proxy Data.Time.LocalTime.TimeOfDay) timeOfDaySchemaJSON main :: IO () main = hspec spec