siren-json 0.1.0.0 → 0.1.0.1
raw patch · 4 files changed
+35/−3 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- ChangeLog.md +5/−0
- siren-json.cabal +3/−1
- test/Data/SirenJSON/Arbitrary.hs +22/−1
- test/External/Network/URI/Arbitrary.hs +5/−1
ChangeLog.md view
@@ -1,5 +1,10 @@ # Revision history for siren-json +## 0.1.0.1 -- 2017-11-11++* add shrink methods to Arbitrary instances+* add other-extensions to cabal file+ ## 0.1.0.0 -- 2017-11-08 * First version.
siren-json.cabal view
@@ -1,5 +1,5 @@ name: siren-json-version: 0.1.0.0+version: 0.1.0.1 synopsis: Siren Tools for Haskell description: @@ -109,3 +109,5 @@ , unordered-containers == 0.2.* other-extensions:+ OverloadedStrings+ , RecordWildCards
test/Data/SirenJSON/Arbitrary.hs view
@@ -1,5 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE RecordWildCards #-}+ {-| Module : Data.SirenJSON.Arbitrary Description : Arbitrary Instances for Data.SirenJSON@@ -11,7 +13,8 @@ module Data.SirenJSON.Arbitrary where import Control.Applicative ((<$>), (<*>))-import Test.QuickCheck (Arbitrary (arbitrary), elements, oneof, scale)+import Data.Maybe (mapMaybe)+import Test.QuickCheck (Arbitrary (arbitrary, shrink), elements, oneof, scale) import Test.QuickCheck.Instances () import Data.SirenJSON@@ -27,12 +30,24 @@ <*> arbitrary <*> arbitrary + shrink Entity{..} = mapMaybe e eEntities +++ [ Entity eClass' eProperties' eEntities' eLinks' eActions' eTitle' | (eClass', eProperties', eEntities', eLinks', eActions', eTitle') <- shrink (eClass, eProperties, eEntities, eLinks, eActions, eTitle) ]+ where e EmbeddedRepresentation{..} = Just sEntity+ e _ = Nothing+ instance Arbitrary SubEntity where arbitrary = oneof [ EmbeddedLink <$> arbitrary , EmbeddedRepresentation <$> scale (`div` 2) arbitrary <*> arbitrary ] + shrink (EmbeddedLink l) = [ EmbeddedLink l' | l' <- shrink l ]+ shrink EmbeddedRepresentation{..} = map EmbeddedLink (eLinks sEntity) +++ filter isEntity (eEntities sEntity) +++ [ EmbeddedRepresentation sEntity' sRel' | (sEntity', sRel') <- shrink (sEntity, sRel) ]+ where isEntity (EmbeddedRepresentation _ _) = True+ isEntity _ = False+ instance Arbitrary Link where arbitrary = Link <$> arbitrary <*> arbitrary@@ -40,6 +55,8 @@ <*> arbitrary <*> arbitrary + shrink Link{..} = [ Link lClass' lRel' lHref' lType' lTitle' | (lClass', lRel', lHref', lType', lTitle') <- shrink (lClass, lRel, lHref, lType, lTitle) ]+ instance Arbitrary Action where arbitrary = Action <$> arbitrary <*> arbitrary@@ -49,12 +66,16 @@ <*> arbitrary <*> arbitrary + shrink Action{..} = [ Action aName' aClass' aMethod' aHref' aTitle' aType' aFields' | (aName', aClass', aMethod', aHref', aTitle', aType', aFields') <- shrink (aName, aClass, aMethod, aHref, aTitle, aType, aFields) ]+ instance Arbitrary Field where arbitrary = Field <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++ shrink Field{..} = [ Field fName' fClass' fType' fValue' fTitle' | (fName', fClass', fType', fValue', fTitle') <- shrink (fName, fClass, fType, fValue, fTitle) ] instance Arbitrary InputType where arbitrary = elements [ Hidden
test/External/Network/URI/Arbitrary.hs view
@@ -16,7 +16,7 @@ import Control.Monad (replicateM) import Data.List (intercalate) import Network.URI (URI (..), URIAuth (..))-import Test.QuickCheck (Arbitrary (arbitrary), choose, elements, Gen, listOf, listOf1, oneof, suchThat)+import Test.QuickCheck (Arbitrary (arbitrary, shrink), choose, elements, Gen, listOf, listOf1, oneof, suchThat) instance Arbitrary URI where arbitrary =@@ -29,10 +29,14 @@ return URI {..} where emptyAuthority URIAuth{..} = all null [uriUserInfo, uriRegName, uriPort] + shrink URI{..} = [ URI uriScheme' uriAuthority' uriPath' uriQuery' uriFragment' | (uriScheme', uriAuthority', uriPath', uriQuery', uriFragment') <- shrink (uriScheme, uriAuthority, uriPath, uriQuery, uriFragment) ]+ instance Arbitrary URIAuth where arbitrary = URIAuth <$> userinfo <*> host `suchThat` (not . null) <*> port++ shrink URIAuth{..} = [ URIAuth uriUserInfo' uriRegName' uriPort' | (uriUserInfo', uriRegName', uriPort') <- shrink (uriUserInfo, uriRegName, uriPort) ] -- * RFC 3986 Generators --