json-api (empty) → 0.1.0.0
raw patch · 22 files changed
+1059/−0 lines, 22 filesdep +aesondep +aeson-prettydep +basesetup-changed
Dependencies added: aeson, aeson-pretty, base, bytestring, containers, data-default, hspec, json-api, lens, lens-aeson, swagger2, text, unordered-containers, url
Files
- LICENSE +21/−0
- README.md +13/−0
- Setup.hs +2/−0
- circle.yml +15/−0
- example/LICENSE +30/−0
- example/README.md +94/−0
- example/Setup.hs +2/−0
- example/example.cabal +73/−0
- example/stack.yaml +39/−0
- json-api.cabal +113/−0
- src/Network/JSONApi/Document.hs +122/−0
- src/Network/JSONApi/Error.hs +52/−0
- src/Network/JSONApi/Link.hs +51/−0
- src/Network/JSONApi/Meta.hs +42/−0
- src/Network/JSONApi/ResourceObject.hs +62/−0
- stack.yaml +35/−0
- test/Network/JSONApi/DocumentSpec.hs +83/−0
- test/Network/JSONApi/ErrorSpec.hs +36/−0
- test/Network/JSONApi/MetaSpec.hs +33/−0
- test/Network/JSONApi/ResourceObjectSpec.hs +60/−0
- test/Spec.hs +2/−0
- test/TestHelpers.hs +79/−0
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2016 Todd Mohney++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,13 @@+[](https://circleci.com/gh/toddmohney/json-api)++## Haskell Implementation of the JSON-API specification+++#### The specification++Find the specification [here](http://jsonapi.org/)+++#### Example usage++There is an [example project](example) illustrating how the library can be used.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ circle.yml view
@@ -0,0 +1,15 @@+dependencies:+ cache_directories:+ - "~/.stack"+ - ".stack-work"+ pre:+ - sudo apt-key adv --keyserver keyserver.ubuntu.com --recv-keys 575159689BEFB442+ - echo 'deb http://download.fpcomplete.com/ubuntu trusty main'|sudo tee /etc/apt/sources.list.d/fpco.list+ - sudo apt-get update && sudo apt-get install stack -y+ override:+ - stack setup+ - stack build+test:+ override:+ - stack test+
+ example/LICENSE view
@@ -0,0 +1,30 @@+Copyright Todd Mohney (c) 2016++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 Todd Mohney 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.
+ example/README.md view
@@ -0,0 +1,94 @@+++## List Resource Example++```json+GET /users++{+ "data":[+ {+ "attributes":{+ "userFirstName":"Isaac",+ "userLastName":"Newton",+ "userId":1+ },+ "id":"1",+ "meta":null,+ "type":"User",+ "links":{+ "self":"/users/1"+ }+ },+ {+ "attributes":{+ "userFirstName":"Albert",+ "userLastName":"Einstein",+ "userId":2+ },+ "id":"2",+ "meta":null,+ "type":"User",+ "links":{+ "self":"/users/2"+ }+ }+ ],+ "meta":{+ "user-count":2+ },+ "links":{+ "self":"/users"+ }+}+```+++## Singleton Resource Example++```json+GET /users/1++{+ "data":{+ "attributes":{+ "userFirstName":"Isaac",+ "userLastName":"Newton",+ "userId":1+ },+ "id":"1",+ "meta":null,+ "type":"User",+ "links":{+ "self":"/users/1"+ }+ },+ "meta":null,+ "links":{+ "self":"/users/1"+ }+}+```+++## Error Example++```json+GET /users/3++{+ "error":{+ "status":"404",+ "code":null,+ "id":null,+ "meta":null,+ "title":"Resource Not Found",+ "links":null,+ "detail":"There is no User with id: 3"+ },+ "meta":null,+ "links":{+ "self":"/users/3"+ }+}+```
+ example/Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ example/example.cabal view
@@ -0,0 +1,73 @@+name: example+version: 0.1.0.0+synopsis: Initial project template from stack+description: Please see README.md+homepage: https://github.com/toddmohney/example#readme+license: BSD3+license-file: LICENSE+author: Todd Mohney+maintainer: toddmohney@gmail.com+copyright: 2016 Todd Mohney+category: Web+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10++library+ hs-source-dirs:+ src++ exposed-modules:+ Lib+ Users+ Users.Controller++ other-modules:+ Users.Actions.Index+ Users.Actions.Show++ build-depends: base >= 4.7 && < 5+ , aeson+ , containers+ , data-default+ , json-api+ , servant-server+ , text+ , url+ , wai+ , warp+ default-language: Haskell2010++ default-extensions:+ OverloadedStrings+ RecordWildCards++ ghc-options:+ -Wall+ -fwarn-unused-matches+ -fwarn-unused-binds+ -fwarn-unused-imports+ -threaded+ -rtsopts+ -with-rtsopts=-N++executable example-exe+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base+ , example+ default-language: Haskell2010++test-suite example-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , example+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/toddmohney/example
+ example/stack.yaml view
@@ -0,0 +1,39 @@+# This file was automatically generated by stack init+# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration/++# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)+resolver: lts-6.4++# Local packages, usually specified by relative directory name+packages:+ - location: .++ - location: ../+ extra-dep: true++# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)+extra-deps: []++# Override default flag values for local packages and extra-deps+flags: {}++# Extra package databases containing global packages+extra-package-dbs: []++# Control whether we use the GHC we find on the path+# system-ghc: true++# Require a specific version of stack, using version ranges+# require-stack-version: -any # Default+# require-stack-version: >= 1.0.0++# Override the architecture used by stack, especially useful on Windows+# arch: i386+# arch: x86_64++# Extra directories used by stack for building+# extra-include-dirs: [/path/to/dir]+# extra-lib-dirs: [/path/to/dir]++# Allow a newer minor version of GHC than the snapshot specifies+# compiler-check: newer-minor
+ json-api.cabal view
@@ -0,0 +1,113 @@+name: json-api+version: 0.1.0.0+homepage: https://github.com/toddmohney/json-api+license: MIT+license-file: LICENSE+author: Todd Mohney+maintainer: toddmohney@gmail.com+copyright: 2016 Todd Mohney+category: Network+build-type: Simple+cabal-version: >=1.10+maintainer: Todd Mohney <toddmohney@gmail.com>+stability: experimental+synopsis: Utilities for generating JSON-API payloads+description:+ Provides utilities for deriving JSON payloads conformant to the json-api+ specification++extra-source-files:+ README.md+ LICENSE+ circle.yml+ stack.yaml+ example/LICENSE+ example/README.md+ example/example.cabal+ example/*.hs+ example/stack.yaml++source-repository head+ type: git+ location: https://github.com/toddmohney/json-api.git++library+ build-depends: aeson >= 0.11.2.0 && < 0.11.3.0+ , base >= 4.7 && < 5.0+ , containers >= 0.5.6.2 && < 0.5.7.1+ , data-default >= 0.5.3 && < 5.6.0+ , lens-aeson >= 1.0.0.5 && < 1.0.1.0+ , swagger2 >= 2.0.2 && < 2.1.0+ , text >= 1.2.2.1 && < 1.2.3.0+ , unordered-containers >= 0.2.7.1 && < 0.2.8.0+ , url >= 2.1.3 && < 2.2.0++ default-language: Haskell2010++ default-extensions:+ DeriveGeneric+ GeneralizedNewtypeDeriving+ OverloadedStrings+ RecordWildCards++ exposed-modules:+ Network.JSONApi.Error+ Network.JSONApi.Document+ Network.JSONApi.Meta+ Network.JSONApi.Link+ Network.JSONApi.ResourceObject++ other-modules:++ ghc-options:+ -Wall+ -fwarn-unused-matches+ -fwarn-unused-binds+ -fwarn-unused-imports++ hs-source-dirs: src++test-suite json-api-test+ build-depends: aeson >= 0.11.2.0 && < 0.11.3.0+ , aeson-pretty >= 0.7.2 && < 0.8.0+ , base >= 4.7 && < 5.0+ , bytestring >= 0.10.6.0 && < 0.10.7.0+ , containers >= 0.5.6.2 && < 0.5.7.1+ , data-default >= 0.5.3 && < 5.6.0+ , hspec >= 2.2.3 && < 2.3.0+ , json-api+ , lens >= 4.13 && < 5.0+ , lens-aeson >= 1.0.0.5 && < 1.0.1.0+ , text >= 1.2.2.1 && < 1.2.3.0+ , url >= 2.1.3 && < 2.2.0++ default-language: Haskell2010++ default-extensions:+ DeriveGeneric+ GeneralizedNewtypeDeriving+ OverloadedStrings+ RecordWildCards++ ghc-options:+ -Wall+ -fwarn-unused-matches+ -fwarn-unused-binds+ -fwarn-unused-imports++ hs-source-dirs: test++ main-is: Spec.hs++ other-modules:+ Network.JSONApi.ErrorSpec+ Network.JSONApi.DocumentSpec+ Network.JSONApi.MetaSpec+ Network.JSONApi.ResourceObjectSpec+ TestHelpers++ type: exitcode-stdio-1.0++source-repository head+ type: git+ location: https://github.com/toddmohney/json-api
+ src/Network/JSONApi/Document.hs view
@@ -0,0 +1,122 @@+{- |+Entry-point module for this package.++Contains representations of the top-level JSON-API document structure.+-}+module Network.JSONApi.Document+( Document (..)+, ErrorDocument (..)+, E.Error (..)+, Resource (..)+, RO.ResourceId (..)+, RO.ResourceObject (..)+, RO.ResourceType (..)+, L.Links+, M.Meta (..)+, L.toLinks+) where++import Control.Monad (mzero)+import Data.Aeson+ ( ToJSON+ , FromJSON+ , (.=)+ , (.:)+ , (.:?)+ )+import qualified Data.Aeson as AE+import Data.Swagger (ToSchema)+import GHC.Generics+import qualified Network.JSONApi.Error as E+import Network.JSONApi.Link as L+import Network.JSONApi.Meta as M+import Network.JSONApi.ResourceObject (ResourceObject)+import qualified Network.JSONApi.ResourceObject as RO++{- |+The @Document@ type represents the top-level JSON-API requirement.++@data@ attribute - the resulting JSON may be either a singleton resource+or a list of resources. See 'Resource' for the construction.++For more information see: <http://jsonapi.org/format/#document-top-level>+-}+data Document a b c = Document+ { _data :: Resource a b+ , _links :: Maybe Links+ , _meta :: Maybe (Meta c)+ } deriving (Show, Eq, Generic)++{- |+The @Resource@ type encapsulates the underlying 'ResourceObject'++Included in the top-level 'Document', the @Resource@ may be either+a singleton resource or a list.++For more information see: <http://jsonapi.org/format/#document-top-level>+-}+data Resource a b = Singleton (ResourceObject a b)+ | List [ResourceObject a b]+ deriving (Show, Eq, Generic)++instance (ToJSON a, ToJSON b) => ToJSON (Resource a b) where+ toJSON (Singleton res) = AE.toJSON res+ toJSON (List res) = AE.toJSON res++instance (FromJSON a, FromJSON b) => FromJSON (Resource a b) where+ parseJSON (AE.Object v) = Singleton <$> (AE.parseJSON (AE.Object v))+ parseJSON (AE.Array v) = List <$> (AE.parseJSON (AE.Array v))+ parseJSON _ = mzero++instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON (Document a b c) where+ toJSON (Document (List res) links meta) =+ AE.object [ "data" .= res+ , "links" .= links+ , "meta" .= meta+ ]+ toJSON (Document (Singleton res) links meta) =+ AE.object [ "data" .= res+ , "links" .= links+ , "meta" .= meta+ ]++instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (Document a b c) where+ parseJSON = AE.withObject "document" $ \v -> do+ d <- v .: "data"+ l <- v .:? "links"+ m <- v .:? "meta"+ return (Document d l m)++instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (Document a b c)+instance (ToSchema a, ToSchema b) => ToSchema (Resource a b)++{- |+The @ErrorDocument@ type represents the alternative form of the top-level+JSON-API requirement.++@error@ attribute - a descriptive object encapsulating application-specific+error detail.++For more information see: <http://jsonapi.org/format/#errors>+-}+data ErrorDocument a b = ErrorDocument+ { _error :: E.Error a+ , _errorLinks :: Maybe Links+ , _errorMeta :: Maybe (Meta b)+ } deriving (Show, Eq, Generic)++instance (ToJSON a, ToJSON b) => ToJSON (ErrorDocument a b) where+ toJSON (ErrorDocument err links meta) =+ AE.object [ "error" .= err+ , "links" .= links+ , "meta" .= meta+ ]++instance (FromJSON a, FromJSON b) => FromJSON (ErrorDocument a b) where+ parseJSON = AE.withObject "error" $ \v ->+ ErrorDocument+ <$> v .: "error"+ <*> v .:? "links"+ <*> v .:? "meta"++instance (ToSchema a, ToSchema b) => ToSchema (ErrorDocument a b)
+ src/Network/JSONApi/Error.hs view
@@ -0,0 +1,52 @@+{- |+Module representing a JSON-API error object.++Error objects are used for providing application-specific detail+to unsuccessful API responses.++Specification: <http://jsonapi.org/format/#error-objects>+-}+module Network.JSONApi.Error+( Error (..)+) where++import Data.Aeson (ToJSON, FromJSON)+import Data.Default+import Data.Swagger (ToSchema)+import Data.Text+import GHC.Generics+import Network.JSONApi.Link (Links)+import Network.JSONApi.Meta+import Prelude hiding (id)++{- |+Type for providing application-specific detail to unsuccessful API+responses.++Specification: <http://jsonapi.org/format/#error-objects>+-}+data Error a =+ Error { id :: Maybe Text+ , links :: Maybe Links+ , status :: Maybe Text+ , code :: Maybe Text+ , title :: Maybe Text+ , detail :: Maybe Text+ , meta :: Maybe (Meta a)+ }+ deriving (Show, Eq, Generic)++instance ToJSON a => ToJSON (Error a)+instance FromJSON a => FromJSON (Error a)+instance ToSchema a => ToSchema (Error a)++instance Default (Error a) where+ def = Error+ { id = Nothing+ , links = Nothing+ , status = Nothing+ , code = Nothing+ , title = Nothing+ , detail = Nothing+ , meta = Nothing+ }
+ src/Network/JSONApi/Link.hs view
@@ -0,0 +1,51 @@+{- |+Module representing a JSON-API link object.++Specification: <http://jsonapi.org/format/#document-links>+-}+module Network.JSONApi.Link+( Links+, Rel+, Href+, toLinks+) where++import Data.Aeson (ToJSON, FromJSON)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Swagger (ToSchema)+import Data.Text (Text, pack)+import GHC.Generics+import Network.URL (URL, exportURL)++{- |+Type representing a JSON-API link object.++Links are an abstraction around an underlying Map consisting of+relevance identifiers as keys and URIs as values.++Example JSON:+@+"links": {+ "self": "http://example.com/posts/1"+}+@++Specification: <http://jsonapi.org/format/#document-links>+-}+newtype Links = Links (Map Rel Href)+ deriving (Show, Eq, Ord, ToJSON, FromJSON, Generic)++instance ToSchema Links++type Rel = Text+type Href = Text++{- |+Constructor function for building Links+-}+toLinks :: [(Rel, URL)] -> Links+toLinks = Links . Map.fromList . map buildLink++buildLink :: (Rel, URL) -> (Rel, Href)+buildLink (key, url) = (key, pack (exportURL url))
+ src/Network/JSONApi/Meta.hs view
@@ -0,0 +1,42 @@+{- |+Module representing a JSON-API meta object.++Specification: <http://jsonapi.org/format/#document-meta>+-}+module Network.JSONApi.Meta where++import Data.Aeson (ToJSON, FromJSON)+import Data.Map (Map)+import Data.Swagger (ToSchema)+import Data.Text (Text)+import GHC.Generics++{- |+Type representing a JSON-API meta object.++Meta is an abstraction around an underlying Map consisting of+resource-specific metadata.++Example JSON:+@+"meta": {+ "copyright": "Copyright 2015 Example Corp.",+ "authors": [+ "Andre Dawson",+ "Kirby Puckett",+ "Don Mattingly",+ "Ozzie Guillen"+ ]+}+@++Specification: <http://jsonapi.org/format/#document-meta>+-}+data Meta a = Meta (Map Text a)+ deriving (Show, Eq, Ord, Generic)++instance ToJSON a => ToJSON (Meta a)+instance FromJSON a => FromJSON (Meta a)++instance ToSchema a => ToSchema (Meta a)+
+ src/Network/JSONApi/ResourceObject.hs view
@@ -0,0 +1,62 @@+{- |+Module representing a JSON-API resource object.++Specification: <http://jsonapi.org/format/#document-resource-objects>+-}+module Network.JSONApi.ResourceObject+( ResourceId (..)+, ResourceObject (..)+, ResourceType (..)+) where++import Data.Aeson (ToJSON, FromJSON, (.=), (.:), (.:?))+import qualified Data.Aeson as AE+import Data.Swagger (ToSchema)+import Data.Text (Text)+import GHC.Generics+import Network.JSONApi.Link (Links)+import Network.JSONApi.Meta (Meta)++{- |+Type representing a JSON-API resource object.++A ResourceObject supplies standardized data and metadata about a+resource.++Specification: <http://jsonapi.org/format/#document-resource-objects>+-}+data ResourceObject a b = ResourceObject+ { getResourceId :: ResourceId+ , getResourceType :: ResourceType+ , getResource :: a+ , getLinks :: Maybe Links+ , getMetaData :: Maybe (Meta b)+ } deriving (Show, Eq, Ord, Generic)++newtype ResourceId = ResourceId Text+ deriving (Show, Eq, Ord, ToJSON, FromJSON, Generic)++newtype ResourceType = ResourceType Text+ deriving (Show, Eq, Ord, ToJSON, FromJSON, Generic)++instance (ToSchema a, ToSchema b) => ToSchema (ResourceObject a b)+instance ToSchema ResourceId+instance ToSchema ResourceType++instance (ToJSON a, ToJSON b) => ToJSON (ResourceObject a b) where+ toJSON (ResourceObject resId resType resObj linksObj metaObj) =+ AE.object [ "id" .= resId+ , "type" .= resType+ , "attributes" .= resObj+ , "links" .= linksObj+ , "meta" .= metaObj+ ]++instance (FromJSON a, FromJSON b) => FromJSON (ResourceObject a b) where+ parseJSON = AE.withObject "resourceObject" $ \v ->+ ResourceObject+ <$> v .: "id"+ <*> v .: "type"+ <*> v .: "attributes"+ <*> v .:? "links"+ <*> v .:? "meta"
+ stack.yaml view
@@ -0,0 +1,35 @@+# This file was automatically generated by stack init+# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration/++# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)+resolver: lts-6.4++# Local packages, usually specified by relative directory name+packages:+ - '.'+# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)+extra-deps: []++# Override default flag values for local packages and extra-deps+flags: {}++# Extra package databases containing global packages+extra-package-dbs: []++# Control whether we use the GHC we find on the path+# system-ghc: true++# Require a specific version of stack, using version ranges+# require-stack-version: -any # Default+# require-stack-version: >= 1.0.0++# Override the architecture used by stack, especially useful on Windows+# arch: i386+# arch: x86_64++# Extra directories used by stack for building+# extra-include-dirs: [/path/to/dir]+# extra-lib-dirs: [/path/to/dir]++# Allow a newer minor version of GHC than the snapshot specifies+# compiler-check: newer-minor
+ test/Network/JSONApi/DocumentSpec.hs view
@@ -0,0 +1,83 @@+module Network.JSONApi.DocumentSpec where++import Control.Lens ((^?))+import Data.Aeson (ToJSON)+import qualified Data.Aeson as AE+import qualified Data.Aeson.Lens as Lens+import Data.ByteString.Lazy.Char8 (ByteString)+{- import qualified Data.ByteString.Lazy.Char8 as BS -}+import Data.Either (isRight)+import Data.Maybe+import Network.JSONApi.Document+import TestHelpers+import Test.Hspec++main :: IO ()+main = hspec spec++spec :: Spec+spec =+ describe "JSON serialization" $ do+ it "JSON encodes/decodes a singleton resource" $ do+ let resource = toResourceObject testObject+ let jsonApiObj = Document (Singleton resource) emptyLinks emptyMeta+ let encodedJson = encodeDocumentObject jsonApiObj+ let decodedJson = decodeDocumentObject encodedJson+ {- putStrLn (BS.unpack encodedJson) -}+ {- putStrLn (show decodedJson) -}+ isRight decodedJson `shouldBe` True++ it "JSON encodes/decodes a list of resources" $ do+ let resources = [toResourceObject testObject, toResourceObject testObject2]+ let jsonApiObj = Document (List resources) emptyLinks emptyMeta+ let encodedJson = encodeDocumentObject jsonApiObj+ let decodedJson = decodeDocumentObject encodedJson+ {- putStrLn (BS.unpack encodedJson) -}+ {- putStrLn (show decodedJson) -}+ isRight decodedJson `shouldBe` True++ it "contains the allowable top-level keys" $ do+ let resource = toResourceObject testObject+ let jsonApiObj = Document (Singleton resource) emptyLinks emptyMeta+ let encodedJson = encodeDocumentObject jsonApiObj+ let dataObject = encodedJson ^? Lens.key "data"+ let linksObject = encodedJson ^? Lens.key "links"+ let metaObject = encodedJson ^? Lens.key "meta"+ isJust dataObject `shouldBe` True+ isJust linksObject `shouldBe` True+ isJust metaObject `shouldBe` True++ it "allows an optional top-level links object" $ do+ let resource = toResourceObject testObject+ let jsonApiObj = Document (Singleton resource) (Just linksObj) emptyMeta+ let encodedJson = encodeDocumentObject jsonApiObj+ let decodedJson = decodeDocumentObject encodedJson+ -- putStrLn (BS.unpack encodedJson)+ -- putStrLn $ show . fromJust $ decodedJson+ isRight decodedJson `shouldBe` True++ it "allows an optional top-level meta object" $ do+ let resource = toResourceObject testObject+ let jsonApiObj = Document (Singleton resource) emptyLinks (Just testMetaObj)+ let encodedJson = encodeDocumentObject jsonApiObj+ let decodedJson = decodeDocumentObject encodedJson+ -- putStrLn (BS.unpack encodedJson)+ -- putStrLn $ show . fromJust $ decodedJson+ isRight decodedJson `shouldBe` True++ it "allows an optional top-level meta object" $ do+ let resource = toResourceObject testObject+ let jsonApiObj = Document (Singleton resource) (Just linksObj) (Just testMetaObj)+ let encodedJson = encodeDocumentObject jsonApiObj+ let decodedJson = decodeDocumentObject encodedJson+ -- putStrLn (BS.unpack encodedJson)+ -- putStrLn $ show . fromJust $ decodedJson+ isRight decodedJson `shouldBe` True++decodeDocumentObject :: ByteString+ -> Either String (Document TestResourceObject (Maybe Bool) (Maybe TestMetaObject))+decodeDocumentObject = AE.eitherDecode++encodeDocumentObject :: (ToJSON a, ToJSON b, ToJSON c) => Document a b c -> ByteString+encodeDocumentObject = prettyEncode+
+ test/Network/JSONApi/ErrorSpec.hs view
@@ -0,0 +1,36 @@+module Network.JSONApi.ErrorSpec where++import qualified Data.Aeson as AE+import qualified Data.ByteString.Lazy.Char8 as BS+import Data.Default (def)+import Data.Maybe+import Network.JSONApi.Error+import Prelude hiding (id)+import TestHelpers (prettyEncode)+import Test.Hspec++main :: IO ()+main = hspec spec++spec :: Spec+spec =+ describe "Defaults" $ do+ it "provides defaults" $+ let expectedDefault = Error+ { id = Nothing+ , links = Nothing+ , status = Nothing+ , code = Nothing+ , title = Nothing+ , detail = Nothing+ , meta = Nothing+ }+ in (def::Error Int) `shouldBe` expectedDefault++ it "provides ToJSON/FromJSON instances" $ do+ let testError = (def::Error Int)+ let encJson = BS.unpack . prettyEncode $ testError+ let decJson = AE.decode (BS.pack encJson) :: Maybe (Error Int)+ isJust decJson `shouldBe` True+ {- putStrLn encJson -}+ {- putStrLn $ show . fromJust $ decJson -}
+ test/Network/JSONApi/MetaSpec.hs view
@@ -0,0 +1,33 @@+module Network.JSONApi.MetaSpec where++import qualified Data.Aeson as AE+import qualified Data.ByteString.Lazy.Char8 as BS+import qualified Data.Map as Map+import Data.Maybe (isJust)+import Network.JSONApi.Meta+import TestHelpers (prettyEncode)+import Test.Hspec++main :: IO ()+main = hspec spec++spec :: Spec+spec =+ describe "serialization" $+ -- is there a compelling reason to test this?+ --+ it "serializes/deserializes primitive values" $ do+ let intTestData = Meta . Map.fromList $ [ ("numData", 5 :: Int) ]+ let encIntJson = BS.unpack . prettyEncode $ intTestData+ let decIntJson = AE.decode (BS.pack encIntJson) :: Maybe (Meta Int)+ isJust decIntJson `shouldBe` True+ -- putStrLn (keys encIntJson)+ -- putStrLn $ show . fromJust $ decIntJson++ let boolTestData = Meta . Map.fromList $ [ ("boolData", True) ]+ let encBoolJson = BS.unpack . prettyEncode $ boolTestData+ let decBoolJson = AE.decode (BS.pack encBoolJson) :: Maybe (Meta Bool)+ isJust decBoolJson `shouldBe` True+ -- putStrLn (keys encBoolJson)+ -- putStrLn $ show . fromJust $ decBoolJson+
+ test/Network/JSONApi/ResourceObjectSpec.hs view
@@ -0,0 +1,60 @@+module Network.JSONApi.ResourceObjectSpec where++import qualified Data.Aeson as AE+import qualified Data.ByteString.Lazy.Char8 as BS+import qualified Data.Map as Map+import Data.Maybe (isJust, fromJust)+import Data.Text (Text, pack)+import GHC.Generics+import Network.JSONApi.Document+import Network.URL (URL, importURL)+import TestHelpers (prettyEncode)+import Test.Hspec++data TestObject =+ TestObject { myId :: Int+ , myName :: Text+ , myAge :: Int+ , myFavoriteFood :: Text+ } deriving (Show, Generic)++instance AE.ToJSON TestObject+instance AE.FromJSON TestObject++toResourceObject :: TestObject -> ResourceObject TestObject Int+toResourceObject obj =+ ResourceObject+ (ResourceId . pack . show . myId $ obj)+ (ResourceType "TestObject")+ obj+ (Just resourceObjectLinks)+ (Just resourceObjectMetaData)++resourceObjectLinks :: Links+resourceObjectLinks =+ toLinks [ ("self", toURL "/me")+ , ("related", toURL "/tacos/4")+ ]++resourceObjectMetaData :: Meta Int+resourceObjectMetaData = Meta . Map.fromList $ [ ("extraData", 20) ]++toURL :: String -> URL+toURL = fromJust . importURL++testObject :: TestObject+testObject = TestObject 1 "Fred Armisen" 49 "Pizza"++main :: IO ()+main = hspec spec++spec :: Spec+spec =+ describe "ToResourceObject" $+ it "can be encoded and decoded from JSON" $ do+ let encodedJson = BS.unpack . prettyEncode $ toResourceObject testObject+ let decodedJson = AE.decode (BS.pack encodedJson) :: Maybe (ResourceObject TestObject (Maybe Int))+ isJust decodedJson `shouldBe` True+ {- putStrLn encodedJson -}+ -- putStrLn $ show . fromJust $ decodedJson+
+ test/Spec.hs view
@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+
+ test/TestHelpers.hs view
@@ -0,0 +1,79 @@+module TestHelpers where++import qualified Data.Aeson as AE+import qualified Data.Aeson.Encode.Pretty as AE+import qualified Data.ByteString.Lazy.Char8 as BS+import Data.Maybe (fromJust)+import qualified Data.Map as Map+import Data.Monoid ((<>))+import Data.Text (Text, pack)+import GHC.Generics+import Network.JSONApi.Document+import Network.URL (URL, importURL)++prettyEncode :: AE.ToJSON a => a -> BS.ByteString+prettyEncode = AE.encodePretty' prettyConfig++prettyConfig :: AE.Config+prettyConfig = AE.Config { AE.confIndent = 2, AE.confCompare = mempty }++data TestResourceObject =+ TestResourceObject { myId :: Int+ , myName :: Text+ , myAge :: Int+ , myFavoriteFood :: Text+ } deriving (Show, Generic)++data TestMetaObject =+ TestMetaObject { totalPages :: Int+ , isSuperFun :: Bool+ } deriving (Show, Generic)++instance AE.ToJSON TestResourceObject+instance AE.FromJSON TestResourceObject++instance AE.ToJSON TestMetaObject+instance AE.FromJSON TestMetaObject++toResourceObject :: TestResourceObject -> ResourceObject TestResourceObject Bool+toResourceObject obj =+ ResourceObject+ (ResourceId . pack . show . myId $ obj)+ (ResourceType "TestResourceObject")+ obj+ (Just $ objectLinks obj)+ (Just $ objectMetaData obj)++objectLinks :: TestResourceObject -> Links+objectLinks obj =+ toLinks [ ("self", toURL ("/me/" <> (show $ myId obj)))+ , ("related", toURL ("/friends/" <> (show $ myId obj)))+ ]++objectMetaData :: TestResourceObject -> Meta Bool+objectMetaData obj =+ Meta . Map.fromList $ [ ("isOld", myAge obj > 50) ]++linksObj :: Links+linksObj = toLinks [ ("self", toURL "/things/1")+ , ("related", toURL "http://some.domain.com/other/things/1")+ ]++testObject :: TestResourceObject+testObject = TestResourceObject 1 "Fred Armisen" 51 "Pizza"++testObject2 :: TestResourceObject+testObject2 = TestResourceObject 2 "Carrie Brownstein" 35 "Lunch"++testMetaObj :: Meta TestMetaObject+testMetaObj =+ Meta . Map.fromList $ [ ("importantData", TestMetaObject 3 True) ]++emptyMeta :: Maybe (Meta TestMetaObject)+emptyMeta = Nothing++toURL :: String -> URL+toURL = fromJust . importURL++emptyLinks :: Maybe Links+emptyLinks = Nothing