From 4c087eed161b12f2ed394f17b0ba9a4a5f6545ad Mon Sep 17 00:00:00 2001 From: Andrey Prokopenko Date: Thu, 23 Aug 2018 11:46:42 +0300 Subject: [PATCH 1/3] Update to LTS-12 --- aeson-injector.cabal | 4 ++-- stack.yaml | 8 +++++--- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/aeson-injector.cabal b/aeson-injector.cabal index 7004954..10d9fe5 100644 --- a/aeson-injector.cabal +++ b/aeson-injector.cabal @@ -31,8 +31,8 @@ library Data.Aeson.WithField build-depends: - base >= 4.7 && < 4.11 - , aeson >= 0.11 && < 1.3 + base >= 4.7 && < 4.12 + , aeson >= 0.11 && < 1.5 , bifunctors >= 5.2 && < 6 , deepseq >= 1.4 && < 2 , hashable >= 1.0 && < 2.0 diff --git a/stack.yaml b/stack.yaml index a68085d..551593d 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,9 +1,11 @@ -resolver: lts-9.6 -#resolver: nightly-2017-10-04 +resolver: lts-12.7 packages: - '.' -extra-deps: [] + +extra-deps: +- swagger2-2.3 + # system-ghc: true # nix: From a1bb526376fcb7e05ca4165329ad7db4befbd18d Mon Sep 17 00:00:00 2001 From: Andrey Prokopenko Date: Wed, 29 Aug 2018 18:37:12 +0300 Subject: [PATCH 2/3] Removing extra-deps - Since extra-deps are not required for aeson-injector in common, they should be removed particulary for PR reason --- stack.yaml | 4 ---- 1 file changed, 4 deletions(-) diff --git a/stack.yaml b/stack.yaml index 551593d..c31394a 100644 --- a/stack.yaml +++ b/stack.yaml @@ -3,10 +3,6 @@ resolver: lts-12.7 packages: - '.' -extra-deps: -- swagger2-2.3 - - # system-ghc: true # nix: # enable: true From 4c1f8b7b7729da28e82dbd09c38d9e13ac184410 Mon Sep 17 00:00:00 2001 From: Andrey Prokopenko Date: Tue, 5 Nov 2019 22:29:31 +0300 Subject: [PATCH 3/3] Bump version to lts-14 and allow Schema optional --- aeson-injector.cabal | 2 +- src/Data/Aeson/Unit.hs | 26 ++++++------- src/Data/Aeson/WithField.hs | 74 ++++++++++++++++++------------------- stack.yaml | 2 +- 4 files changed, 52 insertions(+), 52 deletions(-) diff --git a/aeson-injector.cabal b/aeson-injector.cabal index 10d9fe5..ad46254 100644 --- a/aeson-injector.cabal +++ b/aeson-injector.cabal @@ -31,7 +31,7 @@ library Data.Aeson.WithField build-depends: - base >= 4.7 && < 4.12 + base >= 4.7 && < 5 , aeson >= 0.11 && < 1.5 , bifunctors >= 5.2 && < 6 , deepseq >= 1.4 && < 2 diff --git a/src/Data/Aeson/Unit.hs b/src/Data/Aeson/Unit.hs index b4aaa1a..4dca586 100644 --- a/src/Data/Aeson/Unit.hs +++ b/src/Data/Aeson/Unit.hs @@ -8,9 +8,9 @@ Maintainer : ncrashed@gmail.com Stability : experimental Portability : Portable -Common problem in REST interfaces when you need to return nothing as result, +Common problem in REST interfaces when you need to return nothing as result, usage of `()` will produce `[]` JSON. That causes problems in some JSON parsers -in other languages. +in other languages. So, `Unit` serialises into empty JSON object: @@ -20,12 +20,12 @@ So, `Unit` serialises into empty JSON object: -} module Data.Aeson.Unit( Unit(..) - ) where + ) where -import Control.Lens -import Data.Aeson -import Data.Swagger -import GHC.Generics +import Control.Lens +import Data.Aeson +import Data.Swagger +import GHC.Generics -- | Data type that serialise into empty object in aeson -- @@ -39,14 +39,14 @@ import GHC.Generics data Unit = Unit deriving (Generic, Eq, Show, Read, Enum, Bounded) -instance ToJSON Unit where +instance ToJSON Unit where toJSON _ = object [] --- | Always a success parse -instance FromJSON Unit where +-- | Always a success parse +instance FromJSON Unit where parseJSON _ = pure Unit -instance ToSchema Unit where - declareNamedSchema _ = do +instance ToSchema Unit where + declareNamedSchema _ = do return $ NamedSchema Nothing $ mempty - & type_ .~ SwaggerObject \ No newline at end of file + & type_ ?~ SwaggerObject diff --git a/src/Data/Aeson/WithField.hs b/src/Data/Aeson/WithField.hs index 4748351..64efe76 100644 --- a/src/Data/Aeson/WithField.hs +++ b/src/Data/Aeson/WithField.hs @@ -1,12 +1,12 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedLists #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} {-| Module : Data.Aeson.WithField Description : Provides utility to inject fields into aeson values. @@ -160,24 +160,24 @@ module Data.Aeson.WithField( , OnlyId ) where -import Control.Applicative -import Control.DeepSeq -import Control.Lens hiding ((.=)) -import Control.Monad -import Data.Aeson -import Data.Aeson.Types (typeMismatch) -import Data.Hashable -import Data.Monoid -import Data.Proxy -import Data.Swagger -import GHC.Generics -import GHC.TypeLits -import Servant.Docs - -import qualified Data.Foldable as F +import Control.Applicative +import Control.DeepSeq +import Control.Lens hiding ((.=)) +import Control.Monad +import Data.Aeson +import Data.Aeson.Types (typeMismatch) +import Data.Hashable +import Data.Monoid +import Data.Proxy +import Data.Swagger +import GHC.Generics +import GHC.TypeLits +import Servant.Docs + +import qualified Data.Foldable as F import qualified Data.HashMap.Strict as H -import qualified Data.List as L -import qualified Data.Text as T +import qualified Data.List as L +import qualified Data.Text as T -- | Injects field 'a' into 'b' with tag 's'. It has -- special instances for 'ToJSON' and 'FromJSON' for @@ -262,7 +262,7 @@ instance (KnownSymbol s, FromJSON a, FromJSON b) => FromJSON (WithField s a b) w instance (KnownSymbol s, ToSchema a, ToSchema b) => ToSchema (WithField s a b) where declareNamedSchema _ = do NamedSchema n s <- declareNamedSchema (Proxy :: Proxy b) - if s ^. type_ == SwaggerObject then inline n s + if s ^. type_ == pure SwaggerObject then inline n s else wrapper n s where field = T.pack $ symbolVal (Proxy :: Proxy s) @@ -270,7 +270,7 @@ instance (KnownSymbol s, ToSchema a, ToSchema b) => ToSchema (WithField s a b) w wrapper n s = do indexSchema <- declareSchema (Proxy :: Proxy a) return $ NamedSchema (fmap (namePrefix <>) n) $ mempty - & type_ .~ SwaggerObject + & type_ ?~ SwaggerObject & properties .~ [ ("value", Inline s) , (field, Inline indexSchema) @@ -336,11 +336,11 @@ instance (ToJSON a, ToJSON b) => ToJSON (WithFields a b) where in case jsonb of Object bvs -> case jsona of Object avs -> Object $ H.union avs bvs - _ -> Object $ H.insert "injected" jsona bvs + _ -> Object $ H.insert "injected" jsona bvs _ -> case jsona of Object avs -> Object $ case H.lookup "value" avs of Nothing -> H.insert "value" jsonb avs - Just _ -> avs + Just _ -> avs _ -> object [ "injected" .= jsona , "value" .= jsonb @@ -369,7 +369,7 @@ instance (ToJSON a, FromJSON a, FromJSON b) => FromJSON (WithFields a b) where extractFields :: ToJSON a => a -> [T.Text] extractFields a = case toJSON a of Object vs -> H.keys vs - _ -> [] + _ -> [] parseJSON wat = typeMismatch "Expected JSON Object" wat -- | Note: the instance tries to generate schema of the json as object with @@ -381,18 +381,18 @@ instance (ToSchema a, ToSchema b) => ToSchema (WithFields a b) where NamedSchema na sa <- declareNamedSchema (Proxy :: Proxy a) let newName = combinedName <$> na <*> nb return . NamedSchema newName $ case (sa ^. type_ , sb ^. type_) of - (SwaggerObject, SwaggerObject) -> sb <> sa - (SwaggerObject, _) -> bwrapper sb <> sa - (_, SwaggerObject) -> sb <> awrapper sa - _ -> bwrapper sb <> awrapper sa + (Just SwaggerObject, Just SwaggerObject) -> sb <> sa + (Just SwaggerObject, Just _) -> bwrapper sb <> sa + (Just _, Just SwaggerObject) -> sb <> awrapper sa + _ -> bwrapper sb <> awrapper sa where combinedName a b = "WithFields_" <> a <> "_" <> b awrapper nas = mempty - & type_ .~ SwaggerObject + & type_ ?~ SwaggerObject & properties .~ [ ("injected", Inline nas) ] & required .~ [ "injected" ] bwrapper nbs = mempty - & type_ .~ SwaggerObject + & type_ ?~ SwaggerObject & properties .~ [ ("value", Inline nbs) ] & required .~ [ "value" ] @@ -437,7 +437,7 @@ instance (KnownSymbol s, ToSchema a) => ToSchema (OnlyField s a) where declareNamedSchema _ = do NamedSchema an as <- declareNamedSchema (Proxy :: Proxy a) return $ NamedSchema (fmap ("OnlyField" <>) an) $ mempty - & type_ .~ SwaggerObject + & type_ ?~ SwaggerObject & properties .~ [(field, Inline as)] & required .~ [field] where diff --git a/stack.yaml b/stack.yaml index c31394a..88679fe 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-12.7 +resolver: lts-14.2 packages: - '.'