packages feed

servant-aeson-specs (empty) → 0.1

raw patch · 11 files changed

+534/−0 lines, 11 filesdep +QuickCheckdep +aesondep +basesetup-changed

Dependencies added: QuickCheck, aeson, base, bytestring, doctest, hspec, hspec-core, servant, temporary

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016, Sönke Hahn++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Sönke Hahn nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ servant-aeson-specs.cabal view
@@ -0,0 +1,65 @@+-- This file has been generated from package.yaml by hpack version 0.14.0.+--+-- see: https://github.com/sol/hpack++name:           servant-aeson-specs+version:        0.1+synopsis:       generic tests for aeson serialization in servant+description:    tests for aeson serialization in servant+category:       Web+homepage:       https://github.com/plow-technologies/servant-aeson-specs#readme+bug-reports:    https://github.com/plow-technologies/servant-aeson-specs/issues+maintainer:     soenkehahn@gmail.com+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++source-repository head+  type: git+  location: https://github.com/plow-technologies/servant-aeson-specs++library+  hs-source-dirs:+      src+  ghc-options: -Wall -fno-warn-name-shadowing+  build-depends:+      base < 5+    , aeson+    , bytestring+    , hspec+    , QuickCheck+    , servant == 0.4.*+  exposed-modules:+      Servant.Aeson.RoundtripSpecs+      Servant.Aeson.RoundtripSpecs.Internal+      Test.Aeson.RoundtripSpecs+      Test.Aeson.RoundtripSpecs.Internal+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+    , src+  ghc-options: -Wall -fno-warn-name-shadowing+  build-depends:+      base < 5+    , aeson+    , bytestring+    , hspec+    , QuickCheck+    , servant == 0.4.*+    , hspec-core+    , temporary+    , doctest+  other-modules:+      DoctestSpec+      Servant.Aeson.RoundtripSpecsSpec+      Test.Aeson.RoundtripSpecsSpec+      Servant.Aeson.RoundtripSpecs+      Servant.Aeson.RoundtripSpecs.Internal+      Test.Aeson.RoundtripSpecs+      Test.Aeson.RoundtripSpecs.Internal+  default-language: Haskell2010
+ src/Servant/Aeson/RoundtripSpecs.hs view
@@ -0,0 +1,63 @@++-- | If you're using [servant](http://haskell-servant.readthedocs.org/) with+-- either [servant-client](http://hackage.haskell.org/package/servant-client)+-- or [servant-server](http://hackage.haskell.org/package/servant-server) there+-- will be types included in your APIs that servant will convert to and from+-- JSON. (At least for most common APIs.) 'roundtripSpecs' allows you to+-- generically obtain a test-suite, that makes sure for those types, that they+-- can be serialized to JSON and read back to Haskell successfully.+--+-- Here's an example:+--+-- >>> :set -XTypeOperators+-- >>> :set -XDataKinds+-- >>> :set -XDeriveGeneric+--+-- >>> import Servant.API+-- >>> import Test.Hspec (hspec)+-- >>> import GHC.Generics (Generic)+-- >>> import Data.Aeson (ToJSON, FromJSON)+-- >>> import Test.QuickCheck (Arbitrary(..), oneof)+--+-- >>> data Foo = Foo { a :: String, b :: Int } deriving (Eq, Show, Generic)+-- >>> instance FromJSON Foo+-- >>> instance ToJSON Foo+-- >>> :{+--   instance Arbitrary Foo where+--     arbitrary = Foo <$> arbitrary <*> arbitrary+-- :}+--+-- >>> data Bar = BarA | BarB { bar :: Bool } deriving (Eq, Show, Generic)+-- >>> instance FromJSON Bar+-- >>> instance ToJSON Bar+-- >>> :{+--   instance Arbitrary Bar where+--     arbitrary = oneof $+--       pure BarA :+--       (BarB <$> arbitrary) :+--       []+-- :}+--+--+-- >>> type Api = "post" :> ReqBody '[JSON] Foo :> Get '[JSON] Bar+-- >>> let api = Proxy :: Proxy Api+-- >>> hspec $ roundtripSpecs api+-- <BLANKLINE>+-- JSON encoding of Bar+--   allows to encode values with aeson and read them back+-- JSON encoding of Foo+--   allows to encode values with aeson and read them back+-- <BLANKLINE>+-- Finished in ... seconds+-- 2 examples, 0 failures+module Servant.Aeson.RoundtripSpecs (+  roundtripSpecs,+  usedTypes,++  -- * re-exports+  Proxy(..),+) where++import           Data.Proxy++import           Servant.Aeson.RoundtripSpecs.Internal
+ src/Servant/Aeson/RoundtripSpecs/Internal.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++-- | Internal module, use at your own risk.+module Servant.Aeson.RoundtripSpecs.Internal where++import           Data.Aeson+import           Data.Function+import           Data.List+import           Data.Proxy+import           Data.Typeable+import           GHC.TypeLits+import           Servant.API+import           Test.Hspec+import           Test.QuickCheck++import           Test.Aeson.RoundtripSpecs.Internal++-- | Allows to obtain roundtrip tests for JSON serialization for all types used+-- in a [servant](http://haskell-servant.readthedocs.org/) api.+--+-- See also 'Test.Aeson.RoundtripSpecs.genericAesonRoundtrip'.+roundtripSpecs :: (HasRoundtripSpecs api) => Proxy api -> Spec+roundtripSpecs = sequence_ . map snd . mkRoundtripSpecs++-- | Allows to retrieve a list of all used types in a+-- [servant](http://haskell-servant.readthedocs.org/) api as 'TypeRep's.+usedTypes :: (HasRoundtripSpecs api) => Proxy api -> [TypeRep]+usedTypes = map fst . mkRoundtripSpecs++mkRoundtripSpecs :: (HasRoundtripSpecs api) => Proxy api -> [(TypeRep, Spec)]+mkRoundtripSpecs = normalize . collectRoundtripSpecs+  where+    normalize = nubBy ((==) `on` fst) . sortBy (compare `on` (show . fst))++class HasRoundtripSpecs api where+  collectRoundtripSpecs :: Proxy api -> [(TypeRep, Spec)]++instance (HasRoundtripSpecs a, HasRoundtripSpecs b) => HasRoundtripSpecs (a :<|> b) where+  collectRoundtripSpecs Proxy =+    collectRoundtripSpecs (Proxy :: Proxy a) +++    collectRoundtripSpecs (Proxy :: Proxy b)++instance (MkSpec response) =>+  HasRoundtripSpecs (Get contentTypes response) where++  collectRoundtripSpecs Proxy = do+    mkSpec (Proxy :: Proxy response)++instance (MkSpec response) =>+  HasRoundtripSpecs (Post contentTypes response) where++  collectRoundtripSpecs Proxy = mkSpec (Proxy :: Proxy response)++instance (MkSpec body, HasRoundtripSpecs api) =>+  HasRoundtripSpecs (ReqBody contentTypes body :> api) where++  collectRoundtripSpecs Proxy =+    mkSpec (Proxy :: Proxy body) +++    collectRoundtripSpecs (Proxy :: Proxy api)++instance HasRoundtripSpecs api => HasRoundtripSpecs ((path :: Symbol) :> api) where+  collectRoundtripSpecs Proxy = collectRoundtripSpecs (Proxy :: Proxy api)++instance HasRoundtripSpecs api => HasRoundtripSpecs (MatrixParam name a :> api) where+  collectRoundtripSpecs Proxy = collectRoundtripSpecs (Proxy :: Proxy api)++-- 'mkSpec' has to be implemented as a method of a separate class, because we+-- want to be able to have a specialized implementation for lists.+class MkSpec a where+  mkSpec :: Proxy a -> [(TypeRep, Spec)]++instance (Typeable a, Eq a, Show a, Arbitrary a, ToJSON a, FromJSON a) => MkSpec a where++  mkSpec proxy = [(typeRep proxy, genericAesonRoundtrip proxy)]++-- This will only test json serialization of the element type. As we trust aeson+-- to do the right thing for lists, we don't need to test that. (This speeds up+-- test suites immensely.)+instance {-# OVERLAPPING #-}+  (Eq a, Show a, Typeable a, Arbitrary a, ToJSON a, FromJSON a) =>+  MkSpec [a] where++  mkSpec Proxy = [(typeRep proxy, genericAesonRoundtripWithNote proxy (Just note))]+    where+      proxy = Proxy :: Proxy a+      note = "(as element-type in [])"
+ src/Test/Aeson/RoundtripSpecs.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Aeson.RoundtripSpecs (+  genericAesonRoundtrip,+  shouldBeIdentity,++  -- * re-exports+  Proxy(..),+) where++import           Data.Proxy++import           Test.Aeson.RoundtripSpecs.Internal
+ src/Test/Aeson/RoundtripSpecs/Internal.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE ScopedTypeVariables #-}++-- | Internal module, use at your own risk.+module Test.Aeson.RoundtripSpecs.Internal where++import           Control.Arrow+import           Control.Exception+import qualified Data.Aeson as Aeson+import           Data.Aeson as Aeson hiding (encode)+import           Data.ByteString.Lazy (ByteString)+import           Data.Typeable+import           Test.Hspec+import           Test.QuickCheck++-- | Allows to obtain a roundtrip test to check whether values of the given type+-- can be successfully converted to JSON and back.+--+-- 'genericAesonRoundtrip' will+--+-- - create random values (using 'Arbitrary'),+-- - convert them into JSON (using 'ToJSON'),+-- - read them back into Haskell (using 'FromJSON') and+-- - make sure that the result is the same as the value it started with+--   (using 'Eq').+genericAesonRoundtrip :: forall a .+  (Typeable a, Eq a, Show a, Arbitrary a, ToJSON a, FromJSON a) =>+  Proxy a -> Spec+genericAesonRoundtrip proxy = genericAesonRoundtripWithNote proxy Nothing++genericAesonRoundtripWithNote :: forall a .+  (Typeable a, Eq a, Show a, Arbitrary a, ToJSON a, FromJSON a) =>+  Proxy a -> Maybe String -> Spec+genericAesonRoundtripWithNote proxy mNote = do+  let note = maybe "" (" " ++) mNote+  describe ("JSON encoding of " ++ addBrackets (show (typeRep proxy)) ++ note) $ do+    it "allows to encode values with aeson and read them back" $ do+      shouldBeIdentity proxy $+        Aeson.encode >>> aesonDecodeIO++addBrackets :: String -> String+addBrackets s =+  if ' ' `elem` s+    then "(" ++ s ++ ")"+    else s++-- | [hspec](http://hspec.github.io/) style combinator to easily write tests+-- that check the a given operation returns the same value it was given, e.g.+-- roundtrip tests.+shouldBeIdentity :: (Eq a, Show a, Arbitrary a) =>+  Proxy a -> (a -> IO a) -> Property+shouldBeIdentity Proxy function =+  property $ \ (a :: a) -> do+    function a `shouldReturn` a++aesonDecodeIO :: FromJSON a => ByteString -> IO a+aesonDecodeIO bs = case eitherDecode bs of+  Right a -> return a+  Left msg -> throwIO $ ErrorCall+    ("aeson couldn't parse value: " ++ msg)
+ test/DoctestSpec.hs view
@@ -0,0 +1,10 @@++module DoctestSpec where++import           Test.DocTest+import           Test.Hspec++spec :: Spec+spec = do+  it "doctest" $ do+    doctest ["src/Servant/Aeson/RoundtripSpecs.hs"]
+ test/Servant/Aeson/RoundtripSpecsSpec.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}++module Servant.Aeson.RoundtripSpecsSpec where++import           Data.Typeable+import           Servant.API+import           System.IO+import           System.IO.Temp+import           Test.Hspec+import           Test.Hspec.Core.Runner++import           Servant.Aeson.RoundtripSpecs+import           Test.Aeson.RoundtripSpecsSpec++-- ignores the Summary+hspecOutput :: Spec -> IO String+hspecOutput spec =+  withSystemTempFile "servant-aeson-specs" $ \ file handle -> do+    let config = defaultConfig{+          configOutputFile = Left handle+        }+    _ <- hspecWithResult config spec+    hClose handle+    readFile file++spec :: Spec+spec = do+  describe "roundtripSpecs" $ do+    it "detects failures in types from ReqBody" $ do+      roundtripSpecs reqBodyFailApi `shouldTestAs`+        Summary 2 1++    it "detects failures in types from Get" $ do+      roundtripSpecs getFailApi `shouldTestAs`+        Summary 1 1++    context "when it finds a list of something" $ do+      it "returns only the element type" $ do+        usedTypes getBoolList `shouldBe` [boolRep]++      it "mentions that the type was wrapped in a list" $ do+        output <- hspecOutput $ roundtripSpecs getBoolList+        output `shouldContain` "(as element-type in [])"++  describe "usedTypes" $ do+    it "extracts types from ReqBody" $ do+      usedTypes reqBodyFailApi `shouldMatchList`+        [faultyRoundtripRep, boolRep]++    it "extracts types from Get" $ do+      usedTypes getFailApi `shouldBe`+        [faultyRoundtripRep]++    it "traverses :>" $ do+      usedTypes (Proxy :: Proxy ("foo" :> Get '[JSON] FaultyRoundtrip)) `shouldBe`+        [faultyRoundtripRep]++    it "traverses :<|>" $ do+      usedTypes reqBodyFailApi `shouldMatchList` [faultyRoundtripRep, boolRep]++    it "returns types only ones (i.e. nubbed)" $ do+      usedTypes doubleTypesApi `shouldBe` [boolRep]++    it "returns types sorted by name" $ do+      usedTypes reqBodyFailApi `shouldBe` [boolRep, faultyRoundtripRep]++reqBodyFailApi :: Proxy (ReqBody '[JSON] FaultyRoundtrip :> Get '[JSON] Bool)+reqBodyFailApi = Proxy++getFailApi :: Proxy (Get '[JSON] FaultyRoundtrip)+getFailApi = Proxy++getBoolList :: Proxy (Get '[JSON] [Bool])+getBoolList = Proxy++doubleTypesApi :: Proxy (ReqBody '[JSON] Bool :> Get '[JSON] Bool)+doubleTypesApi = Proxy++faultyRoundtripRep :: TypeRep+faultyRoundtripRep = typeRep (Proxy :: Proxy FaultyRoundtrip)++boolRep :: TypeRep+boolRep = typeRep (Proxy :: Proxy Bool)
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/Test/Aeson/RoundtripSpecsSpec.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Test.Aeson.RoundtripSpecsSpec where++import           Control.Applicative+import           Data.Aeson+import           GHC.Generics+import           System.IO+import           System.IO.Temp+import           Test.Hspec+import           Test.Hspec.Core.Runner+import           Test.QuickCheck++import           Test.Aeson.RoundtripSpecs++hspecSilently :: Spec -> IO Summary+hspecSilently s = do+  withSystemTempFile "ghcjs-hspec-jsval-aeson" $ \ path handle -> do+    hClose handle+    let silentConfig :: Test.Hspec.Core.Runner.Config+        silentConfig = defaultConfig{+          configOutputFile = Right path+        }+    hspecWithResult silentConfig s++shouldTestAs :: Spec -> Summary -> IO ()+shouldTestAs spec expected = do+  summary <- hspecSilently spec+  summary `shouldBe` expected++spec :: Spec+spec = do+  describe "genericAesonRoundtrip" $ do+    it "detects incompatible json encodings" $ do+      genericAesonRoundtrip faultyRoundtripProxy `shouldTestAs` Summary 1 1++    context "when used with compatible encodings" $ do+      it "creates passing tests" $ do+        genericAesonRoundtrip correctProxy `shouldTestAs` Summary 1 0++      it "creates passing tests for sum types" $ do+        genericAesonRoundtrip correctSumProxy `shouldTestAs` Summary 1 0++-- | Type where roundtrips don't work.+data FaultyRoundtrip+  = FaultyRoundtrip {+    faultyRoundtripFoo :: String,+    faultyRoundtripBar :: Int+  }+  deriving (Show, Eq, Generic)++faultyRoundtripProxy :: Proxy FaultyRoundtrip+faultyRoundtripProxy = Proxy++instance ToJSON FaultyRoundtrip where+  toJSON x = object $+    "foo" .= faultyRoundtripFoo x :+    "bar" .= faultyRoundtripBar x :+    []++instance FromJSON FaultyRoundtrip++instance Arbitrary FaultyRoundtrip where+  arbitrary = FaultyRoundtrip <$> arbitrary <*> arbitrary++data Correct+  = Correct {+    correctFoo :: String,+    correctBar :: String+  }+  deriving (Show, Eq, Generic)++correctProxy :: Proxy Correct+correctProxy = Proxy++instance ToJSON Correct++instance FromJSON Correct++instance Arbitrary Correct where+  arbitrary = Correct <$> arbitrary <*> arbitrary++data CorrectSum+  = Foo {+    correctSumFoo :: String+  }+  | Bar {+    correctSumFoo :: String,+    correctSumBar :: String+  }+  deriving (Show, Eq, Generic)++correctSumProxy :: Proxy CorrectSum+correctSumProxy = Proxy++instance ToJSON CorrectSum where+  toJSON = \ case+    Foo foo -> object ["Foo" .= foo]+    Bar foo bar -> object+      ["Bar" .= object ["correctSumFoo" .= foo, "correctSumBar" .= bar]]++instance FromJSON CorrectSum where+  parseJSON = withObject "CorrectSum" $ \ o ->+    (Foo <$> o .: "Foo") <|>+    (o .: "Bar" >>= \ dict ->+      Bar <$> dict .: "correctSumFoo" <*> dict .: "correctSumBar")++instance Arbitrary CorrectSum where+  arbitrary = oneof $+    (Foo <$> arbitrary) :+    (Bar <$> arbitrary <*> arbitrary) :+    []