nri-test-encoding 0.1.0.0 → 0.1.1.0
raw patch · 5 files changed
+149/−42 lines, 5 filesdep +nri-redisnew-uploaderPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: nri-redis
API changes (from Hackage documentation)
- Test.Encoding.Routes: instance (Data.Typeable.Internal.Typeable body, Examples.HasExamples body, Test.Encoding.Routes.IsApi a) => Test.Encoding.Routes.IsApi (Servant.API.ReqBody.ReqBody encodings body Servant.API.Sub.:> a)
+ Examples: instance Examples.HasExamples Text.Text
+ Redis.Test: encoding :: forall m key a. (Typeable a, HasExamples a) => m key a -> Test
+ Test.Encoding.Routes: instance (Data.Typeable.Internal.Typeable body, Examples.HasExamples body, Test.Encoding.Routes.IsApi a) => Test.Encoding.Routes.IsApi (Servant.API.ReqBody.ReqBody' x encodings body Servant.API.Sub.:> a)
+ Test.Encoding.Routes: instance (GHC.TypeLits.KnownSymbol key, Data.Typeable.Internal.Typeable val, Examples.HasExamples val, Test.Encoding.Routes.IsApi a) => Test.Encoding.Routes.IsApi (Servant.API.Header.Header key val Servant.API.Sub.:> a)
+ Test.Encoding.Routes: instance Test.Encoding.Routes.IsApi a => Test.Encoding.Routes.IsApi (Servant.API.Description.Summary x Servant.API.Sub.:> a)
Files
- CHANGELOG.md +4/−0
- nri-test-encoding.cabal +20/−5
- src/Examples.hs +3/−0
- src/Redis/Test.hs +29/−0
- src/Test/Encoding/Routes.hs +93/−37
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Unreleased next version +# 0.1.1.0++- Add tests to prevent accidental API changes in Redis (thanks @stoeffel / #82)+ # 0.1.0.0 - Initial release.
nri-test-encoding.cabal view
@@ -1,15 +1,15 @@ cabal-version: 1.18 --- This file has been generated from package.yaml by hpack version 0.34.2.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack name: nri-test-encoding-version: 0.1.0.0+version: 0.1.1.0 synopsis: A library to simplify writing golden tests for encoding types.-description: Please see the README at <https://github.com/NoRedInk/haskell-libraries/tree/trunk/nri-test-encoding>.+description: Please see the README at <https://github.com/NoRedInk/haskell-libraries/tree/trunk/nri-test-encoding#readme>. category: Testing-homepage: https://github.com/NoRedInk/haskell-libraries#readme+homepage: https://github.com/NoRedInk/haskell-libraries/tree/trunk/nri-test-encoding#readme bug-reports: https://github.com/NoRedInk/haskell-libraries/issues author: NoRedInk maintainer: haskell-open-source@noredink.com@@ -32,11 +32,25 @@ Examples Test.Encoding Test.Encoding.Routes+ Redis.Test other-modules: Paths_nri_test_encoding hs-source-dirs: src- default-extensions: DataKinds DeriveGeneric FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures ScopedTypeVariables Strict TypeOperators+ default-extensions:+ DataKinds+ DeriveGeneric+ FlexibleContexts+ FlexibleInstances+ GeneralizedNewtypeDeriving+ MultiParamTypeClasses+ NamedFieldPuns+ NoImplicitPrelude+ OverloadedStrings+ PartialTypeSignatures+ ScopedTypeVariables+ Strict+ TypeOperators ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wpartial-fields -Wredundant-constraints -Wincomplete-uni-patterns build-depends: aeson >=1.4.6.0 && <1.6@@ -45,6 +59,7 @@ , bytestring >=0.10.8.2 && <0.12 , filepath >=1.4.2.1 && <1.5 , nri-prelude >=0.1.0.0 && <0.7+ , nri-redis >=0.1.0.0 && <0.2 , servant >=0.16.2 && <0.19 , servant-auth-server >=0.4.5.1 && <0.5 , servant-server >=0.16.2 && <0.19
src/Examples.hs view
@@ -96,3 +96,6 @@ instance HasExamples () where examples _ = example "unit" ()++instance HasExamples Text where+ examples _ = example "text" ("" :: Text)
+ src/Redis/Test.hs view
@@ -0,0 +1,29 @@+-- | Useful to test encoding of data stored in redis.+module Redis.Test (encoding) where++import Data.Proxy (Proxy (Proxy))+import qualified Data.Typeable as Typeable+import qualified Examples+import NriPrelude+import Test (Test)+import qualified Test.Encoding+import qualified Text++-- | Turns a Redis.Api into a test.+-- The test does the following:+--+-- 1. get examples from the `HasExamples` constraint+-- 2. encoded the examples into JSON+-- 3. check the encoded JSON against the generated file+-- NOTE: it will generate the file if it doesn't exist yet+encoding :: forall m key a. (Typeable.Typeable a, Examples.HasExamples a) => m key a -> Test+encoding _ =+ let proxy = Proxy :: Proxy a+ tyCon =+ Typeable.typeRep proxy+ |> Typeable.typeRepTyCon+ typeName =+ Typeable.tyConModule tyCon ++ "." ++ Typeable.tyConName tyCon+ |> Text.fromList+ in Examples.examples proxy+ |> Test.Encoding.examplesToTest typeName ("redis-encoding-" ++ typeName)
src/Test/Encoding/Routes.hs view
@@ -12,7 +12,9 @@ -- have comitted to the repo. module Test.Encoding.Routes (tests, IsApi (..)) where +import qualified Data.List.NonEmpty as NonEmpty import Data.Proxy (Proxy (Proxy))+import qualified Data.Semigroup import qualified Data.Typeable as Typeable import qualified Debug import qualified Examples@@ -21,7 +23,17 @@ import qualified List import NriPrelude import qualified Servant-import Servant.API (Capture', QueryFlag, Raw, ReqBody, Verb, (:<|>), (:>))+import Servant.API+ ( Capture',+ Header,+ QueryFlag,+ Raw,+ ReqBody',+ Summary,+ Verb,+ (:<|>),+ (:>),+ ) import Servant.API.Generic (ToServantApi) import qualified Servant.Auth.Server import Test (Test, describe, test)@@ -55,6 +67,7 @@ data Route = Route { path :: [Text], method :: Text,+ headers :: [(Text, SomeType)], requestBody :: Maybe SomeType, responseBody :: SomeType }@@ -66,13 +79,21 @@ routesWithExamples routes = routes |> List.map- ( \route@Route {requestBody, responseBody} ->+ ( \route@Route {requestBody, responseBody, headers} -> ( route, case (requestBody, responseBody) of- (Nothing, SomeType t) -> Examples.examples t- (Just (SomeType s), SomeType t) -> Examples.examples s ++ Examples.examples t+ (Nothing, SomeType t) ->+ List.map headersToExamples headers+ |> (NonEmpty.:|) (Examples.examples t)+ |> Data.Semigroup.sconcat+ (Just (SomeType s), SomeType t) ->+ List.map headersToExamples headers+ |> (NonEmpty.:|) (Examples.examples s ++ Examples.examples t)+ |> Data.Semigroup.sconcat ) )+ where+ headersToExamples (_, SomeType t) = Examples.examples t routeName :: Route -> Text routeName route =@@ -87,33 +108,43 @@ routes |> List.concatMap ( \route ->- case requestBody route of- Nothing ->- [ Text.join- " "- [ routeName route,- "response",- printType (responseBody route)- ]- ]- Just body ->- [ Text.join- " "- [ routeName route,- "response",- printType (responseBody route)- ],- Text.join- " "- [ routeName route,- "request",- printType body- ]- ]+ [ case headers route of+ [] -> Nothing+ headers' ->+ Just+ <| Text.join+ " "+ ( routeName route :+ "headers" :+ List.map printHeaders headers'+ ),+ Just+ <| Text.join+ " "+ [ routeName route,+ "response",+ printType (responseBody route)+ ],+ case requestBody route of+ Nothing -> Nothing+ Just body ->+ Just+ <| Text.join+ " "+ [ routeName route,+ "request",+ printType body+ ]+ ] )+ |> List.filterMap identity |> List.sort |> Text.join "\n" +printHeaders :: (Text, SomeType) -> Text+printHeaders (key, val) =+ "(" ++ key ++ ", " ++ printType val ++ ")"+ printType :: SomeType -> Text printType (SomeType t) = Typeable.typeRep t@@ -156,16 +187,6 @@ } ) -instance (Typeable.Typeable body, Examples.HasExamples body, IsApi a) => IsApi (ReqBody encodings body :> a) where- crawl _ =- crawl (Proxy :: Proxy a)- |> List.map- ( \route ->- route- { requestBody = Just (SomeType (Proxy :: Proxy body))- }- )- instance (Typeable.Typeable method, Typeable.Typeable body, Examples.HasExamples body) => IsApi (Verb method status encodings body)@@ -173,6 +194,7 @@ crawl _ = [ Route { path = [],+ headers = [], requestBody = Nothing, method = Typeable.typeRep (Proxy :: Proxy method)@@ -188,6 +210,40 @@ crawl _ = [] instance (IsApi a) => IsApi (QueryFlag flag :> a) where+ crawl _ = crawl (Proxy :: Proxy a)++instance (Typeable.Typeable body, Examples.HasExamples body, IsApi a) => IsApi (ReqBody' x encodings body :> a) where+ crawl _ =+ crawl (Proxy :: Proxy a)+ |> List.map+ ( \route ->+ route+ { requestBody = Just (SomeType (Proxy :: Proxy body))+ }+ )++instance+ ( KnownSymbol key,+ Typeable.Typeable val,+ Examples.HasExamples val,+ IsApi a+ ) =>+ IsApi (Header key val :> a)+ where+ crawl _ =+ crawl (Proxy :: Proxy a)+ |> List.map+ ( \route ->+ route+ { headers =+ ( Text.fromList (symbolVal (Proxy :: Proxy key)),+ SomeType (Proxy :: Proxy val)+ ) :+ headers route+ }+ )++instance (IsApi a) => IsApi (Summary x :> a) where crawl _ = crawl (Proxy :: Proxy a) instance Examples.HasExamples Servant.NoContent where