collection-json 1.0.1.0 → 1.1.0.0
raw patch · 14 files changed
+482/−258 lines, 14 filesdep +bytestringdep +hspecdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: bytestring, hspec
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- ChangeLog.md +8/−0
- collection-json.cabal +26/−19
- src/Data/CollectionJSON.hs +38/−36
- src/Internal/Network/URI.hs +0/−26
- src/Internal/Network/URI/JSON.hs +23/−0
- test/Data/CollectionJSON/Arbitrary.hs +59/−0
- test/Data/CollectionJSON/Tests.hs +0/−111
- test/Data/CollectionJSONSpec.hs +88/−0
- test/Internal/Network/URI/Arbitrary.hs +187/−0
- test/Internal/Network/URI/ArbitrarySpec.hs +25/−0
- test/Internal/Network/URI/JSONSpec.hs +27/−0
- test/Internal/Network/URI/Tests.hs +0/−48
- test/Main.hs +0/−18
- test/Spec.hs +1/−0
ChangeLog.md view
@@ -1,5 +1,13 @@ # Revision history for collection-json +## 1.1.0.0 -- 2017-11-05++* minimize produced JSON in ToJSON instances+* attempt to ensure RFC compliance with hspec+* add more robust URI testing+* add nix development environment (shell.nix, default.nix, collection-json.nix)+* change test suite to hspec+ ## 1.0.1.0 -- 2017-08-08 * increase aeson upper bound to 1.2
collection-json.cabal view
@@ -1,5 +1,5 @@ name: collection-json-version: 1.0.1.0+version: 1.1.0.0 synopsis: Collection+JSON—Hypermedia Type Tools description:@@ -24,9 +24,6 @@ , LICENSE , README.md , Setup.hs- , test/Data/CollectionJSON/Tests.hs- , test/Internal/Network/URI/Tests.hs- , test/Main.hs source-repository head type: git@@ -35,20 +32,22 @@ library default-language: Haskell2010- hs-source-dirs: src - exposed-modules:- Data.CollectionJSON- ghc-options: -Wall -fwarn-tabs -fwarn-monomorphism-restriction -fwarn-unused-do-bind + hs-source-dirs:+ src++ exposed-modules:+ Data.CollectionJSON+ other-modules:- Internal.Network.URI+ Internal.Network.URI.JSON build-depends: aeson >= 0.8 && < 1.2- , base >= 4.6 && < 4.11+ , base >= 4.6 && < 4.12 , network-uri == 2.6.* , text == 1.2.* @@ -56,26 +55,35 @@ OverloadedStrings , RecordWildCards -test-suite Properties+test-suite collection-json-tests default-language: Haskell2010- hs-source-dirs: src test- type: exitcode-stdio-1.0- main-is: Main.hs+ main-is: Spec.hs ghc-options: -Wall -fwarn-tabs -fwarn-monomorphism-restriction -fwarn-unused-do-bind + hs-source-dirs:+ src+ , test+ other-modules: Data.CollectionJSON- Data.CollectionJSON.Tests+ , Data.CollectionJSON.Arbitrary+ , Data.CollectionJSONSpec+ , Internal.Network.URI.Arbitrary+ , Internal.Network.URI.ArbitrarySpec+ , Internal.Network.URI.JSON+ , Internal.Network.URI.JSONSpec - Internal.Network.URI- Internal.Network.URI.Tests+ build-tool-depends:+ hspec-discover:hspec-discover == 2.4.* build-depends: aeson >= 0.8 && < 1.2- , base >= 4.6 && < 4.11+ , base >= 4.6 && < 4.12+ , bytestring == 0.10.*+ , hspec == 2.4.* , network-uri == 2.6.* , QuickCheck == 2.9.* , quickcheck-instances == 0.3.*@@ -85,4 +93,3 @@ other-extensions: OverloadedStrings , RecordWildCards- , TemplateHaskell
src/Data/CollectionJSON.hs view
@@ -15,10 +15,12 @@ module Data.CollectionJSON where import Data.Aeson ((.=), (.:?), (.!=), (.:), FromJSON (parseJSON), object, ToJSON (toJSON), withObject)+import Data.Functor ((<$>))+import Data.Maybe (catMaybes) import Data.Text (Text)-import Network.URI (URI)+import Network.URI (nullURI, URI) -import Internal.Network.URI ()+import Internal.Network.URI.JSON () -- * Core Data Types @@ -39,7 +41,7 @@ v <- c .: "collection" cVersion <- v .:? "version" .!= "1.0"- cHref <- v .: "href"+ cHref <- v .:? "href" .!= nullURI cLinks <- v .:? "links" .!= [] cItems <- v .:? "items" .!= [] cQueries <- v .:? "queries" .!= []@@ -50,16 +52,16 @@ instance ToJSON Collection where toJSON Collection{..} = object- [ "collection" .= object- [ "version" .= cVersion- , "href" .= cHref- , "links" .= cLinks- , "items" .= cItems- , "queries" .= cQueries- , "template" .= cTemplate- , "error" .= cError+ [ "collection" .= object (catMaybes+ [ Just $ "version" .= cVersion+ , Just $ "href" .= cHref+ , if null cLinks then Nothing else Just $ "links" .= cLinks+ , if null cItems then Nothing else Just $ "items" .= cItems+ , if null cQueries then Nothing else Just $ "queries" .= cQueries+ , (.=) "template" <$> cTemplate+ , (.=) "error" <$> cError ]- ]+ ) ] {-| A link to a related resource (not necessarily an@@ -89,12 +91,12 @@ return Link{..} instance ToJSON Link where- toJSON Link{..} = object- [ "href" .= lHref- , "rel" .= lRel- , "name" .= lName- , "render" .= lRender- , "prompt" .= lPrompt+ toJSON Link{..} = object $ catMaybes+ [ Just $ "href" .= lHref+ , Just $ "rel" .= lRel+ , (.=) "name" <$> lName+ , (.=) "render" <$> lRender+ , (.=) "prompt" <$> lPrompt ] -- | An element in the 'Collection'@@ -114,10 +116,10 @@ return Item{..} instance ToJSON Item where- toJSON Item{..} = object- [ "href" .= iHref- , "data" .= iData- , "links" .= iLinks+ toJSON Item{..} = object $ catMaybes+ [ Just $ "href" .= iHref+ , if null iData then Nothing else Just $ "data" .= iData+ , if null iLinks then Nothing else Just $ "links" .= iLinks ] {-|@@ -155,12 +157,12 @@ return Query{..} instance ToJSON Query where- toJSON Query{..} = object- [ "href" .= qHref- , "rel" .= qRel- , "name" .= qName- , "prompt" .= qPrompt- , "data" .= qData+ toJSON Query{..} = object $ catMaybes+ [ Just $ "href" .= qHref+ , Just $ "rel" .= qRel+ , (.=) "name" <$> qName+ , (.=) "prompt" <$> qPrompt+ , if null qData then Nothing else Just $ "data" .= qData ] -- | A fillable template for creation of a new object in the 'Collection'.@@ -196,10 +198,10 @@ return Error{..} instance ToJSON Error where- toJSON Error{..} = object- [ "title" .= eTitle- , "code" .= eCode- , "message" .= eMessage+ toJSON Error{..} = object $ catMaybes+ [ (.=) "title" <$> eTitle+ , (.=) "code" <$> eCode+ , (.=) "message" <$> eMessage ] -- | Contents of a 'Collection' 'Item'.@@ -218,10 +220,10 @@ return Datum{..} instance ToJSON Datum where- toJSON Datum{..} = object- [ "name" .= dName- , "value" .= dValue- , "prompt" .= dPrompt+ toJSON Datum{..} = object $ catMaybes+ [ Just $ "name" .= dName+ , (.=) "value" <$> dValue+ , (.=) "prompt" <$> dPrompt ] -- * Type Conversion
− src/Internal/Network/URI.hs
@@ -1,26 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--{-# LANGUAGE OverloadedStrings #-}--{-|-Module : Internal.Network.URI-Description : URI Helper Functions-Copyright : (c) Alex Brandt, 2017-License : MIT--URI utility functions that don't belong anywhere else.--}-module Internal.Network.URI where--import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), withText)-import Data.Text (unpack)-import Network.URI (parseURIReference, URI)--instance FromJSON URI where- parseJSON = withText "URI" $ \ v ->- case parseURIReference (unpack v) of- Nothing -> fail "invalid URI"- Just x -> return x--instance ToJSON URI where- toJSON = toJSON . show
+ src/Internal/Network/URI/JSON.hs view
@@ -0,0 +1,23 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-# LANGUAGE OverloadedStrings #-}++{-|+Module : Internal.Network.URI.JSON+Description : URI FromJSON and ToJSON Instances+Copyright : (c) Alex Brandt, 2017+License : MIT++URI Instances for FromJSON and ToJSON+-}+module Internal.Network.URI.JSON where++import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), withText)+import Data.Text (unpack)+import Network.URI (parseURIReference, URI, uriToString)++instance FromJSON URI where+ parseJSON = withText "URI" $ maybe (fail "invalid URI") return . parseURIReference . unpack++instance ToJSON URI where+ toJSON u = toJSON $ uriToString id u ""
+ test/Data/CollectionJSON/Arbitrary.hs view
@@ -0,0 +1,59 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|+Module : Data.CollectionJSON.Arbitrary+Description : Arbitrary Instances for Data.CollectionJSON+Copyright : (c) Alex Brandt, 2017+License : MIT++Arbitrary instances for "Data.CollectionJSON".+-}+module Data.CollectionJSON.Arbitrary where++import Control.Applicative ((<$>), (<*>))+import Data.Text (pack)+import Test.QuickCheck (Arbitrary (arbitrary))+import Test.QuickCheck.Instances ()++import Data.CollectionJSON+import Internal.Network.URI.Arbitrary ()++instance Arbitrary Collection where+ arbitrary = Collection (pack "1.0") <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary Link where+ arbitrary = Link <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary Item where+ arbitrary = Item <$> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary Query where+ arbitrary = Query <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary Template where+ arbitrary = Template <$> arbitrary++instance Arbitrary Error where+ arbitrary = Error <$> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary Datum where+ arbitrary = Datum <$> arbitrary+ <*> arbitrary+ <*> arbitrary
− test/Data/CollectionJSON/Tests.hs
@@ -1,111 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TemplateHaskell #-}--{-|-Module : Data.CollectionJSON.Tests-Description : Tests for Data.CollectionJSON-Copyright : (c) Alex Brandt, 2017-License : MIT--Tests for "Data.CollectionJSON".--}-module Data.CollectionJSON.Tests (runTests) where--import Data.Aeson (decode, encode)-import Data.Maybe (fromJust)-import Data.Text (pack)-import Test.Invariant ((<=>))-import Test.QuickCheck (Arbitrary (arbitrary), forAllProperties, maxSize, stdArgs, quickCheckWithResult)-import Test.QuickCheck.Instances ()--import Data.CollectionJSON-import Internal.Network.URI.Tests ()--prop_id_c :: Collection -> Bool-prop_id_c = fromJust . decode . encode <=> id--prop_id_l :: Link -> Bool-prop_id_l = fromJust . decode . encode <=> id--prop_id_i :: Item -> Bool-prop_id_i = fromJust . decode . encode <=> id--prop_id_q :: Query -> Bool-prop_id_q = fromJust . decode . encode <=> id--prop_id_t :: Template -> Bool-prop_id_t = fromJust . decode . encode <=> id--prop_id_e :: Error -> Bool-prop_id_e = fromJust . decode . encode <=> id--prop_id_d :: Datum -> Bool-prop_id_d = fromJust . decode . encode <=> id--return []-runTests :: IO Bool-runTests = $forAllProperties $ quickCheckWithResult $ stdArgs {maxSize = 50}--instance Arbitrary Collection where- arbitrary =- do let cVersion = pack "1.0"- cHref <- arbitrary- cLinks <- arbitrary- cItems <- arbitrary- cQueries <- arbitrary- cTemplate <- arbitrary- cError <- arbitrary-- return Collection{..}--instance Arbitrary Link where- arbitrary =- do lHref <- arbitrary- lRel <- arbitrary- lName <- arbitrary- lRender <- arbitrary- lPrompt <- arbitrary-- return Link{..}--instance Arbitrary Item where- arbitrary =- do iHref <- arbitrary- iData <- arbitrary- iLinks <- arbitrary-- return Item{..}--instance Arbitrary Query where- arbitrary =- do qHref <- arbitrary- qRel <- arbitrary- qName <- arbitrary- qPrompt <- arbitrary- qData <- arbitrary-- return Query{..}--instance Arbitrary Template where- arbitrary =- do tData <- arbitrary- - return Template{..}--instance Arbitrary Error where- arbitrary =- do eTitle <- arbitrary- eCode <- arbitrary- eMessage <- arbitrary-- return Error{..}--instance Arbitrary Datum where- arbitrary =- do dName <- arbitrary- dValue <- arbitrary- dPrompt <- arbitrary-- return Datum{..}
+ test/Data/CollectionJSONSpec.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Module : Data.CollectionJSONSpec+Description : Tests for Data.CollectionJSON+Copyright : (c) Alex Brandt, 2017+License : MIT++Tests for "Data.CollectionJSON".+-}+module Data.CollectionJSONSpec (main, spec) where++import Data.Aeson (decode, encode)+import Data.Maybe (fromJust, isJust, isNothing)+import Network.URI (parseURIReference)+import Test.Hspec (context, describe, hspec, it, shouldBe, Spec)+import Test.Hspec.QuickCheck (modifyMaxSize, prop)+import Test.Invariant ((<=>))++import qualified Data.ByteString.Lazy as BL (ByteString)++import Data.CollectionJSON+import Data.CollectionJSON.Arbitrary ()++main :: IO ()+main = hspec spec++spec :: Spec+spec =+ describe "application/vnd.collection+json" $ modifyMaxSize (const 25) $+ do describe "RFC compliance (http://amundsen.com/media-types/collection/format/)" $+ do prop "'Template' decode JSON string: \"{}\"" $ isJust (decode "{}" :: Maybe Template)+ prop "'Collection' decode JSON string: \"{\"collection\":{}}\"" $ isJust (decode "{\"collection\":{}}" :: Maybe Collection) ++ describe "common parse errors" $+ prop "'Collection' errors on \"{}\"" $ isNothing (decode "{}" :: Maybe Collection)++ describe "properties" $+ context "fromJust . decode . encode == id" $+ do prop "Datum" (fromJust . decode . encode <=> id :: Datum -> Bool)+ prop "Error" (fromJust . decode . encode <=> id :: Error -> Bool)+ prop "Template" (fromJust . decode . encode <=> id :: Template -> Bool)+ prop "Query" (fromJust . decode . encode <=> id :: Query -> Bool)+ prop "Item" (fromJust . decode . encode <=> id :: Item -> Bool)+ prop "Link" (fromJust . decode . encode <=> id :: Link -> Bool)+ prop "Collection" (fromJust . decode . encode <=> id :: Collection -> Bool)++ describe "JSON Missing Keys" $+ do context "decode minimal JSON strings" $+ do prop "Datum" $ isJust (decode mDatum :: Maybe Datum)+ prop "Error" $ isJust (decode mError :: Maybe Error)+ prop "Template" $ isJust (decode mTemplate :: Maybe Template)+ prop "Query" $ isJust (decode mQuery :: Maybe Query)+ prop "Item" $ isJust (decode mItem :: Maybe Item)+ prop "Link" $ isJust (decode mLink :: Maybe Link)+ prop "Collection" $ isJust (decode mCollection :: Maybe Collection)++ context "encode minimal data to JSON" $+ do it "Datum" $+ encode (Datum "name" Nothing Nothing) `shouldBe` mDatum++ it "Error" $+ encode (Error Nothing Nothing Nothing) `shouldBe` mError++ it "Template" $+ encode (Template []) `shouldBe` mTemplate++ it "Query" $+ encode (Query eURI "item" Nothing Nothing []) `shouldBe` mQuery++ it "Item" $+ encode (Item eURI [] []) `shouldBe` mItem++ it "Link" $+ encode (Link eURI "item" Nothing Nothing Nothing) `shouldBe` mLink++ it "Collection" $+ encode (Collection "1.0" eURI [] [] [] Nothing Nothing) `shouldBe` mCollection++ where mCollection = "{\"collection\":{\"href\":\"http://example.com\",\"version\":\"1.0\"}}" :: BL.ByteString+ mLink = "{\"href\":\"http://example.com\",\"rel\":\"item\"}" :: BL.ByteString+ mItem = "{\"href\":\"http://example.com\"}" :: BL.ByteString+ mQuery = "{\"href\":\"http://example.com\",\"rel\":\"item\"}" :: BL.ByteString+ mTemplate = "{\"data\":[]}" :: BL.ByteString+ mError = "{}" :: BL.ByteString+ mDatum = "{\"name\":\"name\"}" :: BL.ByteString++ eURI = fromJust $ parseURIReference "http://example.com"
+ test/Internal/Network/URI/Arbitrary.hs view
@@ -0,0 +1,187 @@+{-# LANGUAGE RecordWildCards #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|+Module : Internal.Network.URI.Arbitrary+Description : Arbitrary Instances for Network.URI+Copyright : (c) Alex Brandt, 2017+License : MIT++Arbitrary instances for "Network.URI".+-}+module Internal.Network.URI.Arbitrary () where++import Control.Applicative ((<$>), (<*>))+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)++instance Arbitrary URI where+ arbitrary =+ do uriScheme <- scheme+ uriAuthority <- arbitrary :: Gen (Maybe URIAuth)+ uriPath <- path (null uriScheme) $ maybe True emptyAuthority uriAuthority+ uriQuery <- oneof [query, return ""]+ uriFragment <- oneof [fragment, return ""]++ return URI {..}+ where emptyAuthority URIAuth{..} = all null [uriUserInfo, uriRegName, uriPort]++instance Arbitrary URIAuth where+ arbitrary = URIAuth <$> userinfo+ <*> host `suchThat` (not . null)+ <*> port++-- * RFC 3986 Generators+--+-- Some generators are handled by the 'Arbitrary' instances above, and others+-- are folded into symbols that are preceeded or followed by identifying+-- tokens.++scheme :: Gen String+scheme =+ do a <- alpha+ r <- listOf $ oneof [alpha, digit, elements ['+', '-', '.']]+ return $ a : (r ++ ":")++userinfo :: Gen String+userinfo =+ do u <- concat <$> userinfo'+ if null u+ then return ""+ else return $ u ++ "@"+ where userinfo' = listOf $ oneof [ replicateM 1 $ oneof [unreserved, subDelims, return ':']+ , percentEncoded+ ]++host :: Gen String+host = oneof [ ipLiteral+ , ipv4Address+ , regName+ ]++port :: Gen String+port =+ do p <- listOf digit+ if null p+ then return ""+ else return $ ':':p++ipLiteral :: Gen String+ipLiteral =+ do x <- oneof [ ipv6Address+ --, ipvFuture+ ]+ return $ "[" ++ x ++ "]"++{- TODO Check that "Network.URI" implements this correctly.+ipvFuture :: Gen String+ipvFuture =+ do h <- hexdig+ o <- oneof [ unreserved, subDelims, return ':' ]+ return ['v', h, '.', o]+-}++ipv6Address :: Gen String+ipv6Address = concat <$> oneof [ sequence [b 6, ls32]+ , sequence [return "::", b 5, ls32]+ , sequence [h16, return "::", b 4, ls32]+ , sequence [b 1, h16, return "::", b 3, ls32]+ , sequence [b 2, h16, return "::", b 2, ls32]+ , sequence [b 3, h16, return "::", b 1, ls32]+ , sequence [b 4, h16, return "::", ls32]+ , sequence [b 5, h16, return "::", h16]+ , sequence [b 6, h16, return "::"]+ ]+ where b n = fmap concat $ replicateM n $ fmap (++ ":") h16 :: Gen String++h16 :: Gen String+h16 = replicateM 4 hexdig++ls32 :: Gen String+ls32 = oneof [ intercalate ":" <$> replicateM 2 h16+ , ipv4Address+ ]++ipv4Address :: Gen String+ipv4Address = intercalate "." <$> replicateM 4 decOctet++decOctet :: Gen String+decOctet = (show :: Int -> String) <$> choose (0, 255)++regName :: Gen String+regName = fmap concat $ listOf $ oneof [ replicateM 1 unreserved+ , percentEncoded+ , replicateM 1 subDelims+ ]++path :: Bool -> Bool -> Gen String+path emptyScheme emptyURIAuth = if emptyURIAuth+ then oneof [ pathAbsolute+ , if emptyScheme then pathNoScheme else pathRootless+ , return ""+ ]+ else pathAbEmpty++pathAbEmpty :: Gen String+pathAbEmpty = concat <$> listOf ((('/':) . concat) <$> listOf pchar)++pathAbsolute :: Gen String+pathAbsolute = ('/':) <$> oneof [return "", pathRootless]++pathNoScheme :: Gen String+pathNoScheme = concat <$> sequence [segment1nc, pathAbEmpty]++pathRootless :: Gen String+pathRootless = concat <$> sequence [ concat <$> listOf1 pchar+ , pathAbEmpty+ ]++segment1nc :: Gen String+segment1nc = oneof [ replicateM 1 unreserved+ , percentEncoded+ , replicateM 1 subDelims+ , replicateM 1 $ return '@'+ ] ++pchar :: Gen String+pchar = oneof [ replicateM 1 unreserved+ , percentEncoded+ , replicateM 1 subDelims+ , replicateM 1 $ return ':'+ , replicateM 1 $ return '@'+ ]++query :: Gen String+query = fmap (('?':) . concat) $ listOf $ oneof [ pchar+ , return "/"+ , return "?"+ ]++fragment :: Gen String+fragment = fmap (('#':) . concat) $ listOf $ oneof [ pchar+ , return "/"+ , return "?"+ ]++percentEncoded :: Gen String+percentEncoded = ('%':) <$> replicateM 2 hexdig++unreserved :: Gen Char+unreserved = oneof [ alpha, digit, elements ['-', '.', '_', '~']]++subDelims :: Gen Char+subDelims = elements ['!', '$', '&', '\'', '(', ')', '*', '+', ',', ';', '=']++-- * RFC 2234 Generators++alpha :: Gen Char+alpha = elements $ ['a'..'z'] ++ ['A'..'Z']++digit :: Gen Char+digit = elements ['0'..'9']++hexdig :: Gen Char+hexdig = oneof [digit, elements ['A'..'F']]
+ test/Internal/Network/URI/ArbitrarySpec.hs view
@@ -0,0 +1,25 @@+{-|+Module : Internal.Network.URI.ArbitrarySpec+Description : Tests for Internal.Network.URI.Arbitrary+Copyright : (c) Alex Brandt, 2017+License : MIT++Tests for "Internal.Network.URI.Arbitrary".+-}+module Internal.Network.URI.ArbitrarySpec (main, spec) where++import Network.URI (isURIReference, parseURIReference, uriToString)+import Test.Hspec (describe, hspec, Spec)+import Test.Hspec.QuickCheck (prop)++import Internal.Network.URI.Arbitrary ()++main :: IO ()+main = hspec spec++spec :: Spec+spec =+ describe "properties" $+ do prop "isURIReference (uriToString id u \"\")" $ \ u -> isURIReference (uriToString id u "")++ prop "Just u == parseURIReference (uriToString id u \"\")" $ \ u -> Just u == parseURIReference (uriToString id u "")
+ test/Internal/Network/URI/JSONSpec.hs view
@@ -0,0 +1,27 @@+{-|+Module : Internal.Network.URI.JSONSpec+Description : Tests for Internal.Network.URI.JSON+Copyright : (c) Alex Brandt, 2017+License : MIT++Tests for "Internal.Network.URI.JSON".+-}+module Internal.Network.URI.JSONSpec (main, spec) where++import Data.Aeson (decode, encode)+import Data.Maybe (fromJust)+import Network.URI (URI)+import Test.Hspec (describe, hspec, Spec)+import Test.Hspec.QuickCheck (prop)+import Test.Invariant ((<=>))++import Internal.Network.URI.Arbitrary ()+import Internal.Network.URI.JSON ()++main :: IO ()+main = hspec spec++spec :: Spec+spec =+ describe "properties" $+ prop "fromJust . decode . encode == id" (fromJust . decode . encode <=> id :: URI -> Bool)
− test/Internal/Network/URI/Tests.hs
@@ -1,48 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--{-|-Module : Internal.Network.URI.Tests-Description : URI Arbitrary Instances-Copyright : (c) Alex Brandt, 2017-License : MIT--A collection of 'Arbitrary' instances for 'URI'.--}-module Internal.Network.URI.Tests where--import Control.Applicative ((<$>))-import Data.Maybe (fromJust)-import Network.URI (parseURIReference, URI)-import Test.QuickCheck (Arbitrary (arbitrary), elements)---- | Not a general implementation.------ This implementation just returns a random URI from the--- @application/vnd.collection+json@ examples.-instance Arbitrary URI where- arbitrary = fromJust . parseURIReference <$> elements uris- where uris = [ "http://example.org/friends/"- , "http://example.org/friends/"- , "http://example.org/friends/rss"- , "http://example.org/friends/jdoe"- , "http://examples.org/blogs/jdoe"- , "http://examples.org/images/jdoe"- , "http://example.org/friends/msmith"- , "http://examples.org/blogs/msmith"- , "http://examples.org/images/msmith"- , "http://example.org/friends/rwilliams"- , "http://examples.org/blogs/rwilliams"- , "http://examples.org/images/rwilliams"- , "http://example.org/friends/search"- , "http://example.org/friends/"- , "http://example.org/friends/rss"- , "http://example.org/friends/?queries"- , "http://example.org/friends/?template"- , "http://example.org/friends/jdoe"- , "http://examples.org/blogs/jdoe"- , "http://examples.org/images/jdoe"- , "http://example.org/friends/"- , "http://example.org/friends/search"- , "http://example.org/friends/"- , "http://example.org/friends/"- ]
− test/Main.hs
@@ -1,18 +0,0 @@-{-|-Module : Main-Copyright : (c) Alex Brandt, 2017-License : MIT--"Main" Module for collection-json property tests.--}-module Main where--import Control.Applicative ((<$>))-import System.Exit (exitFailure, exitSuccess)--import qualified Data.CollectionJSON.Tests--main :: IO ()-main =- do success <- and <$> sequence [ Data.CollectionJSON.Tests.runTests ]- if success then exitSuccess else exitFailure
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}