json-api-lib (empty) → 0.1.0.0
raw patch · 17 files changed
+1146/−0 lines, 17 filesdep +aesondep +aeson-prettydep +basesetup-changed
Dependencies added: aeson, aeson-pretty, base, bytestring, containers, data-default, hspec, json-api-lib, lens, lens-aeson, text, unordered-containers, uri-encode
Files
- LICENSE +21/−0
- Setup.hs +2/−0
- json-api-lib.cabal +109/−0
- src/Network/JSONApi.hs +41/−0
- src/Network/JSONApi/Document.hs +211/−0
- src/Network/JSONApi/Error.hs +50/−0
- src/Network/JSONApi/Identifier.hs +60/−0
- src/Network/JSONApi/Link.hs +48/−0
- src/Network/JSONApi/Meta.hs +90/−0
- src/Network/JSONApi/Resource.hs +166/−0
- test/Network/JSONApi/DocumentSpec.hs +78/−0
- test/Network/JSONApi/ErrorSpec.hs +37/−0
- test/Network/JSONApi/IdentifierSpec.hs +20/−0
- test/Network/JSONApi/MetaSpec.hs +47/−0
- test/Network/JSONApi/ResourceSpec.hs +65/−0
- test/Spec.hs +2/−0
- test/TestHelpers.hs +99/−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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ json-api-lib.cabal view
@@ -0,0 +1,109 @@+cabal-version: 2.0++name: json-api-lib+version: 0.1.0.0+homepage: https://github.com/shirren/json-api-lib+bug-reports: https://github.com/shirren/json-api-lib/issues+license: MIT+license-file: LICENSE+author: Todd Mohney, Shirren Premaratne+copyright: 2016 Todd Mohney+category: Network+build-type: Simple+maintainer: Shirren Premaratne+tested-with: GHC == 8.4.3+synopsis: Utilities for generating JSON-API payloads+description:+ Provides utilities for deriving JSON payloads conformant to the json-api+ specification++source-repository head+ type: git+ location: https://github.com/shirren/json-api-lib.git++library+ build-depends: aeson > 1.4 && < 1.5+ , base >= 4.11 && < 5+ , containers >= 0.6.1 && < 0.7+ , data-default >= 0.7.1 && < 0.8+ , lens >= 4.17.1 && < 4.18+ , lens-aeson >= 1.0.2 && < 1.1+ , text >= 1.2.3.1 && < 1.3+ , unordered-containers >= 0.2.10 && < 0.3+ , uri-encode >= 1.5.0 && < 1.6++ default-language: Haskell2010++ default-extensions:+ DeriveGeneric+ GeneralizedNewtypeDeriving+ OverloadedStrings+ RecordWildCards+ TemplateHaskell++ exposed-modules:+ Network.JSONApi+ Network.JSONApi.Error+ Network.JSONApi.Document+ Network.JSONApi.Identifier+ Network.JSONApi.Meta+ Network.JSONApi.Link+ Network.JSONApi.Resource++ other-modules:++ ghc-options:+ -Wall+ -fwarn-unused-matches+ -fwarn-unused-binds+ -fwarn-unused-imports++ hs-source-dirs: src++test-suite json-api-lib-test+ build-depends: aeson > 1.4 && < 1.5+ , aeson-pretty > 0.8 && < 0.9+ , base >= 4.11 && < 5+ , bytestring >= 0.10.8 && < 0.11+ , containers >= 0.6.1 && < 0.7+ , data-default >= 0.7.1 && < 0.8+ , hspec >= 2.7.1 && < 2.8+ , json-api-lib+ , lens >= 4.17.1 && < 4.18+ , lens-aeson >= 1.0.2 && < 1.1+ , text >= 1.2.3.1 && < 1.3+ , unordered-containers >= 0.2.10 && < 0.3+ , uri-encode >= 1.5.0 && < 1.6++ build-tool-depends: hspec-discover:hspec-discover == 2.*++ default-language: Haskell2010++ default-extensions:+ DeriveGeneric+ GeneralizedNewtypeDeriving+ OverloadedStrings+ RecordWildCards++ ghc-options:+ -Wall+ -fwarn-unused-matches+ -fwarn-unused-binds++ hs-source-dirs: test++ main-is: Spec.hs++ other-modules:+ Network.JSONApi.ErrorSpec+ Network.JSONApi.DocumentSpec+ Network.JSONApi.IdentifierSpec+ Network.JSONApi.MetaSpec+ Network.JSONApi.ResourceSpec+ TestHelpers++ type: exitcode-stdio-1.0++source-repository head+ type: git+ location: https://github.com/shirren/json-api-lib
+ src/Network/JSONApi.hs view
@@ -0,0 +1,41 @@+{- |+Entry-point module for this package.+-}+module Network.JSONApi+( D.Document+, D.ResourceData (..)+, D.ErrorDocument (..)+, D.Included+, E.Error (..)+, R.Relationship+, R.Resource (..)+, R.Relationships+, R.ResourcefulEntity (..)+, I.HasIdentifier (..)+, I.Identifier (..)+, L.Links+, M.Meta+, M.MetaObject (..)+, M.Pagination (..)+, L.mkLinks+, R.indexLinks+, R.mkRelationship+, R.mkRelationships+, R.showLink+, D.mkDocument+, D.mkDocument'+, D.singleton+, D.list+, D.mkCompoundDocument+, D.mkCompoundDocument'+, D.mkIncludedResource+, M.mkMeta+) where++import qualified Network.JSONApi.Error as E+import qualified Network.JSONApi.Document as D+import qualified Network.JSONApi.Identifier as I+import qualified Network.JSONApi.Link as L+import qualified Network.JSONApi.Meta as M+import qualified Network.JSONApi.Resource as R+
+ src/Network/JSONApi/Document.hs view
@@ -0,0 +1,211 @@+{- |+Contains representations of the top-level JSON-API document structure.+-}+module Network.JSONApi.Document+ ( Document+ , ResourceData (..)+ , ErrorDocument (..)+ , Included+ , mkDocument+ , mkDocument'+ , singleton+ , list+ , mkCompoundDocument+ , mkCompoundDocument'+ , mkIncludedResource+ ) where++import Control.Monad (mzero)+import Data.Aeson+ ( ToJSON+ , FromJSON+ , Value+ , (.=)+ , (.:)+ , (.:?)+ )+import qualified Data.Aeson as AE++import qualified GHC.Generics as G++import qualified Network.JSONApi.Error as E+import Network.JSONApi.Link as L+import Network.JSONApi.Meta as M+import Network.JSONApi.Resource (Resource, ResourcefulEntity)+import qualified Network.JSONApi.Resource as R++{- |+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 = Document+ { _data :: ResourceData a+ , _links :: Maybe Links+ , _meta :: Maybe Meta+ , _included :: [Value]+ } deriving (Show, Eq, G.Generic)++instance (ToJSON a)+ => ToJSON (Document a) where+ toJSON (Document (List res) links meta included) =+ AE.object [ "data" .= res+ , "links" .= links+ , "meta" .= meta+ , "included" .= included+ ]+ toJSON (Document (Singleton res) links meta included) =+ AE.object [ "data" .= res+ , "links" .= links+ , "meta" .= meta+ , "included" .= included+ ]++instance (FromJSON a) => FromJSON (Document a) where+ parseJSON = AE.withObject "document" $ \v -> do+ d <- v .: "data"+ l <- v .:? "links"+ m <- v .:? "meta"+ i <- v .: "included"+ return (Document d l m i)++{- |+The 'Included' type is an abstraction used to constrain the @included@+section of the Document to JSON serializable Resource objects while+enabling a heterogeneous list of Resource types.++No data constructors for this type are exported as we need to+constrain the 'Value' to a heterogeneous list of Resource types.+See 'mkIncludedResource' for creating 'Included' types.+-}+newtype Included = Included [Value]+ deriving (Show)++-- instance Monoid Included where+-- mempty = Included []+-- mappend (Included as) (Included bs) = Included (as <> bs)++{- |+Constructor function for the Document data type.++See 'mkCompoundDocument' for constructing compound Document+including 'side-loaded' resources+-}+mkDocument :: ResourcefulEntity a =>+ [a]+ -> Maybe Links+ -> Maybe Meta+ -> Document a+mkDocument res = mkDocument' (toResourceData res)++mkDocument' :: ResourceData a+ -> Maybe Links+ -> Maybe Meta+ -> Document a+mkDocument' res links meta =+ Document+ { _data = res+ , _links = links+ , _meta = meta+ , _included = []+ }++{- |+Constructor function for the Document data type.+See 'mkIncludedResource' for constructing the 'Included' type.++Supports building compound documents+<http://jsonapi.org/format/#document-compound-documents>+-}+mkCompoundDocument :: ResourcefulEntity a =>+ [a]+ -> Maybe Links+ -> Maybe Meta+ -> Included+ -> Document a+mkCompoundDocument res = mkCompoundDocument' (toResourceData res)++mkCompoundDocument' :: ResourceData a+ -> Maybe Links+ -> Maybe Meta+ -> Included+ -> Document a+mkCompoundDocument' res links meta (Included included) =+ Document+ { _data = res+ , _links = links+ , _meta = meta+ , _included = included+ }++{- |+Constructor function for the Document data type.++Supports building compound documents+<http://jsonapi.org/format/#document-compound-documents>+-}+mkIncludedResource :: ResourcefulEntity a => a -> Included+mkIncludedResource res = Included [AE.toJSON . R.toResource $ res]++toResourceData :: ResourcefulEntity a => [a] -> ResourceData a+toResourceData [r] = Singleton (R.toResource r)+toResourceData rs = List (map R.toResource rs)++{- |+The 'Resource' type encapsulates the underlying 'Resource'++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 ResourceData a = Singleton (Resource a)+ | List [ Resource a ]+ deriving (Show, Eq, G.Generic)++singleton :: ResourcefulEntity a => a -> ResourceData a+singleton = Singleton . R.toResource++list :: ResourcefulEntity a => [a] -> ResourceData a+list = List . map R.toResource++instance (ToJSON a) => ToJSON (ResourceData a) where+ toJSON (Singleton res) = AE.toJSON res+ toJSON (List res) = AE.toJSON res++instance (FromJSON a) => FromJSON (ResourceData a) where+ parseJSON (AE.Object v) = Singleton <$> AE.parseJSON (AE.Object v)+ parseJSON (AE.Array v) = List <$> AE.parseJSON (AE.Array v)+ parseJSON _ = mzero++{- |+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 = ErrorDocument+ { _error :: E.Error a+ , _errorLinks :: Maybe Links+ , _errorMeta :: Maybe Meta+ } deriving (Show, Eq, G.Generic)++instance (ToJSON a) => ToJSON (ErrorDocument a) where+ toJSON (ErrorDocument err links meta) =+ AE.object [ "error" .= err+ , "links" .= links+ , "meta" .= meta+ ]++instance (FromJSON a) => FromJSON (ErrorDocument a) where+ parseJSON = AE.withObject "error" $ \v ->+ ErrorDocument+ <$> v .: "error"+ <*> v .:? "links"+ <*> v .:? "meta"
+ src/Network/JSONApi/Error.hs view
@@ -0,0 +1,50 @@+{- |+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.Text+import qualified GHC.Generics as G+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+ }+ deriving (Show, Eq, G.Generic)++instance ToJSON a => ToJSON (Error a)+instance FromJSON a => FromJSON (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/Identifier.hs view
@@ -0,0 +1,60 @@+{- |+Module representing a JSON-API resource object.++Specification: <http://jsonapi.org/format/#document-resource-objects>+-}+module Network.JSONApi.Identifier+( HasIdentifier (..)+, Identifier (..)+, datatype+, ident+, metadata+) where++import Control.Lens.TH++import Data.Aeson (ToJSON, FromJSON, (.=), (.:), (.:?))+import qualified Data.Aeson as AE+import Data.Text (Text)++import Network.JSONApi.Meta (Meta)++import Prelude hiding (id)++{- |+Identifiers are used to encapsulate the minimum amount of information+to uniquely identify a resource.++This object will be found at multiple levels of the JSON-API structure++Specification: <http://jsonapi.org/format/#document-resource-identifier-objects>+-}+data Identifier = Identifier+ { _ident :: Text+ , _datatype :: Text+ , _metadata :: Maybe Meta+ } deriving (Show, Eq)++instance ToJSON Identifier where+ toJSON (Identifier resId resType resMetaData) =+ AE.object [ "id" .= resId+ , "type" .= resType+ , "meta" .= resMetaData+ ]++instance FromJSON Identifier where+ parseJSON = AE.withObject "resourceIdentifier" $ \v -> do+ id <- v .: "id"+ typ <- v .: "type"+ meta <- v .:? "meta"+ return $ Identifier id typ meta+++{- |+Typeclass indicating how to access an 'Identifier' for+a given datatype+-}+class HasIdentifier a where+ identifier :: a -> Identifier++makeLenses ''Identifier
+ src/Network/JSONApi/Link.hs view
@@ -0,0 +1,48 @@+{- |+Module representing a JSON-API link object.++Specification: <http://jsonapi.org/format/#document-links>+-}+module Network.JSONApi.Link+( Links+, Rel+, Href+, mkLinks+) where++import Data.Aeson (ToJSON, FromJSON)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Text (Text)++import qualified GHC.Generics as G++{- |+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, G.Generic)++type Rel = Text+type Href = Text++{- |+Constructor function for building Links+-}+mkLinks :: [(Rel, Text)] -> Links+mkLinks = Links . Map.fromList . map buildLink++buildLink :: (Rel, Text) -> (Rel, Href)+buildLink (key, url) = (key, url)
+ src/Network/JSONApi/Meta.hs view
@@ -0,0 +1,90 @@+{- |+Module representing a JSON-API meta object.++Specification: <http://jsonapi.org/format/#document-meta>+-}+module Network.JSONApi.Meta+( Meta+, MetaObject (..)+, Pagination (..)+, mkMeta+)where++import Data.Aeson (ToJSON, FromJSON, Object, toJSON)+import Data.Aeson.TH+import Data.HashMap.Strict as HM+import Data.Text (Text)++import qualified GHC.Generics as G++{- |+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>+-}+newtype Meta = Meta Object+ deriving (Show, Eq, G.Generic)++instance ToJSON Meta+instance FromJSON Meta++{- |+Convienience class for constructing a Meta type++Example usage:+@+ data Pagination = Pagination+ { currentPage :: Int+ , totalPages :: Int+ } deriving (Show, Generic)++ instance ToJSON Pagination+ instance MetaObject Pagination where+ typeName _ = "pagination"+@+-}+class (ToJSON a) => MetaObject a where+ typeName :: a -> Text++{- |+Convienience constructor function for the Meta type++Useful on its own or in combination with Meta's monoid instance++Example usage:+See MetaSpec.hs for an example+-}+mkMeta :: (MetaObject a) => a -> Meta+mkMeta obj = Meta $ HM.singleton (typeName obj) (toJSON obj)++{- |+Pagination is arguably a meta object not covered by the Spec. The spec instead opts for+links which are supported by this library. However if you would like to throw a generic+Pagination meta object into your response payload this type may be used.+-}+data Pagination = Pagination {+ pageSize :: Maybe Int+ , currentPage :: Maybe Int+ , totalDocuments :: Maybe Int+} deriving (Eq, Show)++$(deriveJSON defaultOptions ''Pagination)++instance MetaObject Pagination where+ typeName _ = "pagination"
+ src/Network/JSONApi/Resource.hs view
@@ -0,0 +1,166 @@+{- |+Module representing a JSON-API resource object.++Specification: <http://jsonapi.org/format/#document-resource-objects>+-}+module Network.JSONApi.Resource+( Resource (..)+, Relationships+, ResourcefulEntity (..)+, Relationship+, indexLinks+, mkRelationship+, mkRelationships+, showLink+) where++import Control.Lens.TH++import Data.Aeson (ToJSON, FromJSON, (.=), (.:), (.:?))+import qualified Data.Aeson as AE+import Data.Aeson.Types (fieldLabelModifier)+import Data.Map (Map)+import Data.Maybe (fromMaybe)+import qualified Data.Map as Map+import Data.Text (Text, pack)++import GHC.Generics hiding (Meta)++import Network.JSONApi.Identifier (HasIdentifier (..), Identifier (..))+import Network.JSONApi.Link (Links, mkLinks)+import Network.JSONApi.Meta (Meta)+import Network.URI.Encode (encodeText)++import Prelude hiding (id)++{- |+Type representing a JSON-API resource object.++A Resource supplies standardized data and metadata about a resource.++Specification: <http://jsonapi.org/format/#document-resource-objects>+-}+data Resource a = Resource+ { getIdentifier :: Identifier+ , getResource :: a+ , getLinks :: Maybe Links+ , getRelationships :: Maybe Relationships+ } deriving (Show, Eq, Generic)++instance (ToJSON a) => ToJSON (Resource a) where+ toJSON (Resource (Identifier resId resType metaObj) resObj linksObj rels) =+ AE.object [ "id" .= resId+ , "type" .= resType+ , "attributes" .= resObj+ , "links" .= linksObj+ , "meta" .= metaObj+ , "relationships" .= rels+ ]++instance (FromJSON a) => FromJSON (Resource a) where+ parseJSON = AE.withObject "resourceObject" $ \v -> do+ id <- v .: "id"+ typ <- v .: "type"+ attrs <- v .: "attributes"+ links <- v .:? "links"+ meta <- v .:? "meta"+ rels <- v .:? "relationships"+ return $ Resource (Identifier id typ meta) attrs links rels++instance HasIdentifier (Resource a) where+ identifier = getIdentifier++{- |+A typeclass for decorating an entity with JSON API properties+-}+class (ToJSON a, FromJSON a) => ResourcefulEntity a where+ resourceIdentifier :: a -> Text+ resourceType :: a -> Text+ resourceLinks :: a -> Maybe Links+ resourceMetaData :: a -> Maybe Meta+ resourceRelationships :: a -> Maybe Relationships++ fromResource :: Resource a -> a+ fromResource = getResource++ toResource :: a -> Resource a+ toResource a =+ Resource+ (Identifier (resourceIdentifier a) (resourceType a) (resourceMetaData a))+ a+ (resourceLinks a)+ (resourceRelationships a)++{- |+A type representing the Relationship between 2 entities++A Relationship provides basic information for fetching further information+about a related resource.++Specification: <http://jsonapi.org/format/#document-resource-object-relationships>+-}+data Relationship = Relationship+ { _data :: Maybe Identifier+ , _links :: Maybe Links+ } deriving (Show, Eq, Generic)++instance ToJSON Relationship where+ toJSON = AE.genericToJSON+ AE.defaultOptions { fieldLabelModifier = drop 1 }++instance FromJSON Relationship where+ parseJSON = AE.genericParseJSON+ AE.defaultOptions { fieldLabelModifier = drop 1 }++newtype Relationships = Relationships (Map Text Relationship)+ deriving (Show, Eq, Generic)++instance ToJSON Relationships+instance FromJSON Relationships++mkRelationships :: Relationship -> Relationships+mkRelationships rel =+ Relationships $ Map.singleton (relationshipType rel) rel++relationshipType :: Relationship -> Text+relationshipType relationship = case _data relationship of+ Nothing -> "unidentified"+ (Just (Identifier _ typ _)) -> typ++{- |+Constructor function for creating a Relationship record++A relationship must contain either an Identifier or a Links record+-}+mkRelationship :: Maybe Identifier -> Maybe Links -> Maybe Relationship+mkRelationship Nothing Nothing = Nothing+mkRelationship resId links = Just $ Relationship resId links++makeLenses ''Resource++{- |+Helper function to build relative links for a single resource of type ResourceEntity+-}+showLink :: ResourcefulEntity e => e -> Links+showLink resource = mkLinks [ ("self", selfLink) ]+ where+ selfLink = "/" <> resourceType resource <> "/" <> resourceIdentifier resource++{- |+Helper function to beuild relative links for a collection of resources of type ResourceEntity.++This helper function assumes that the first page is always page 0.+-}+indexLinks :: ResourcefulEntity e => e -> Maybe Int -> Maybe Int -> Maybe Int -> Links+indexLinks resource mPageSize mPageNo documentCount = mkLinks [+ ("self", genLink pageNo)+ ,("first", genLink (0 :: Int))+ ,("prev", genLink (if pageNo - 1 < 0 then 0 else pageNo - 1))+ ,("next", genLink (pageNo + 1))+ ,("last", genLink ((fromMaybe 0 documentCount `quot` pageSize) - 1 ))]+ where+ pageSize = fromMaybe 10 mPageSize+ pageNo = fromMaybe 0 mPageNo+ genLink no = "/" <> resourceType resource <> "?" <>+ encodeText "page[number]" <> "=" <> (pack . show) no <>+ "&" <> encodeText "page[size]" <> "=" <> (pack . show) pageSize
+ test/Network/JSONApi/DocumentSpec.hs view
@@ -0,0 +1,78 @@+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 Data.Either (isRight)+import Data.Maybe++import Network.JSONApi++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+ -- TODO: test the main resource actually is a singleton+ let jsonApiObj = mkDocument [testObject] Nothing Nothing+ encodedJson = encodeDocumentObject jsonApiObj+ decodedJson = decodeDocumentObject encodedJson++ isRight decodedJson `shouldBe` True++ it "JSON encodes/decodes a list of resources" $ do+ -- TODO: test the main resource actually is a list+ let jsonApiObj = mkDocument [testObject, testObject2] Nothing Nothing+ encodedJson = encodeDocumentObject jsonApiObj+ decodedJson = decodeDocumentObject encodedJson++ isRight decodedJson `shouldBe` True++ it "contains the allowable top-level keys" $ do+ let jsonApiObj = mkDocument [testObject] Nothing Nothing+ encodedJson = encodeDocumentObject jsonApiObj+ dataObject = encodedJson ^? Lens.key "data"+ linksObject = encodedJson ^? Lens.key "links"+ metaObject = encodedJson ^? Lens.key "meta"+ includedObject = encodedJson ^? Lens.key "included"++ isJust dataObject `shouldBe` True+ isJust linksObject `shouldBe` True+ isJust metaObject `shouldBe` True+ isJust includedObject `shouldBe` True++ it "allows an optional top-level links object" $ do+ let jsonApiObj = mkDocument [testObject] (Just linksObj) Nothing+ encodedJson = encodeDocumentObject jsonApiObj+ decodedJson = decodeDocumentObject encodedJson++ isRight decodedJson `shouldBe` True++ it "allows an optional top-level meta object" $ do+ let jsonApiObj = mkDocument [testObject] Nothing (Just testMetaObj)+ encodedJson = encodeDocumentObject jsonApiObj+ decodedJson = decodeDocumentObject encodedJson++ isRight decodedJson `shouldBe` True++ it "allows a heterogeneous list of related resources" $ do+ let includedResources = mkIncludedResource testObject+ jsonApiObj = mkCompoundDocument [testObject] Nothing Nothing includedResources+ encodedJson = encodeDocumentObject jsonApiObj+ decodedJson = decodeDocumentObject encodedJson++ isRight decodedJson `shouldBe` True++decodeDocumentObject :: ByteString -> Either String (Document TestResource)+decodeDocumentObject = AE.eitherDecode++encodeDocumentObject :: (ToJSON a) => Document a -> ByteString+encodeDocumentObject = prettyEncode
+ test/Network/JSONApi/ErrorSpec.hs view
@@ -0,0 +1,37 @@+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+import Prelude hiding (id)+import TestHelpers (prettyEncode)+import Test.Hspec++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ 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++ describe "JSON serialization" $+ 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/IdentifierSpec.hs view
@@ -0,0 +1,20 @@+module Network.JSONApi.IdentifierSpec where++import Control.Lens ((^.))+import Network.JSONApi.Identifier+import Test.Hspec+import TestHelpers (testMetaObj)++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "Lenses" $ do+ it "provides property access via lens" $ do+ testIdentifier ^. ident `shouldBe` "3"+ testIdentifier ^. datatype `shouldBe` "SomeIdentifier"+ testIdentifier ^. metadata `shouldBe` Just testMetaObj++testIdentifier :: Identifier+testIdentifier = Identifier "3" "SomeIdentifier" (Just testMetaObj)
+ test/Network/JSONApi/MetaSpec.hs view
@@ -0,0 +1,47 @@+module Network.JSONApi.MetaSpec where++import Data.Aeson (ToJSON)+import qualified Data.Aeson as AE+import qualified Data.ByteString.Lazy.Char8 as BS+import Data.Maybe (isJust)+import Data.Text (Text)+import GHC.Generics (Generic)+import Network.JSONApi+import TestHelpers (prettyEncode)+import Test.Hspec++main :: IO ()+main = hspec spec++spec :: Spec+spec =+ describe "JSON serialization" $+ it "serializes/deserializes heterogeneous maps of ToJSON types" $ do+ let boolTestData = mkMeta testObject+ let encBoolJson = BS.unpack . prettyEncode $ boolTestData+ let decBoolJson = AE.decode (BS.pack encBoolJson) :: Maybe Meta+ isJust decBoolJson `shouldBe` True++testObject :: TestObject+testObject = TestObject 99 102 "Zapp Brannigan"++data TestObject = TestObject+ { myID :: Int+ , myAge :: Int+ , myName :: Text+ } deriving (Show, Generic)++instance ToJSON TestObject+instance MetaObject TestObject where+ typeName _ = "testObject"++data OtherTestObject = OtherTestObject+ { myFavoriteRestaurant :: Text+ , myDogsName :: Text+ , myDogsAge :: Int+ , myDogsFavoriteRestarant :: Text+ } deriving (Show, Generic)++instance ToJSON OtherTestObject+instance MetaObject OtherTestObject where+ typeName _ = "otherTestObject"
+ test/Network/JSONApi/ResourceSpec.hs view
@@ -0,0 +1,65 @@+module Network.JSONApi.ResourceSpec where++import qualified Data.Aeson as AE+import qualified Data.ByteString.Lazy.Char8 as BS+import Data.Maybe (isJust, fromJust)+import Data.Text (Text, pack)++import GHC.Generics (Generic)++import Network.JSONApi++import TestHelpers (prettyEncode)+import Test.Hspec++main :: IO ()+main = hspec spec++spec :: Spec+spec =+ describe "JSON serialization" $+ it "can be encoded and decoded from JSON" $ do+ let encodedJson = BS.unpack . prettyEncode $ toResource testObject+ let decodedJson = AE.decode (BS.pack encodedJson) :: Maybe (Resource TestObject)+ isJust decodedJson `shouldBe` True++data TestObject = TestObject+ { myId :: Int+ , myName :: Text+ , myAge :: Int+ , myFavoriteFood :: Text+ } deriving (Show, Generic)++instance AE.ToJSON TestObject+instance AE.FromJSON TestObject++instance ResourcefulEntity TestObject where+ resourceIdentifier = pack . show . myId+ resourceType _ = "TestObject"+ resourceLinks _ = Just myResourceLinks+ resourceMetaData _ = Just myResourceMetaData+ resourceRelationships _ = Nothing++relationship :: Relationship+relationship =+ fromJust $ mkRelationship+ (Just $ Identifier "42" "FriendOfTestObject" Nothing)+ (Just myResourceLinks)++otherRelationship :: Relationship+otherRelationship =+ fromJust $ mkRelationship+ (Just $ Identifier "49" "CousinOfTestObject" Nothing)+ (Just myResourceLinks)++myResourceLinks :: Links+myResourceLinks =+ mkLinks [ ("self", "/me")+ , ("related", "/tacos/4")+ ]++myResourceMetaData :: Meta+myResourceMetaData = mkMeta (Pagination (Just 1) (Just 1) (Just 14))++testObject :: TestObject+testObject = TestObject 1 "Fred Armisen" 49 "Pizza"
+ test/Spec.hs view
@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+
+ test/TestHelpers.hs view
@@ -0,0 +1,99 @@+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.Text (Text, pack)++import GHC.Generics (Generic)++import Network.JSONApi++prettyEncode :: AE.ToJSON a => a -> BS.ByteString+prettyEncode = AE.encodePretty++class HasIdentifiers a where+ uniqueId :: a -> Int+ typeDescriptor :: a -> Text++data TestResource = TestResource+ { myId :: Int+ , myName :: Text+ , myAge :: Int+ , myFavoriteFood :: Text+ } deriving (Show, Generic)++instance AE.ToJSON TestResource+instance AE.FromJSON TestResource+instance ResourcefulEntity TestResource where+ resourceIdentifier = pack . show . myId+ resourceType _ = "testResource"+ resourceLinks _ = Nothing+ resourceMetaData _ = Nothing+ resourceRelationships _ = Nothing+instance HasIdentifiers TestResource where+ uniqueId = myId+ typeDescriptor _ = "TestResource"++data OtherTestResource = OtherTestResource+ { myFavoriteNumber :: Int+ , myJob :: Text+ , myPay :: Int+ , myEmployer :: Text+ } deriving (Show, Generic)++instance AE.ToJSON OtherTestResource+instance AE.FromJSON OtherTestResource+instance ResourcefulEntity OtherTestResource where+ resourceIdentifier = pack . show . myFavoriteNumber+ resourceType _ = "otherTestResource"+ resourceLinks _ = Nothing+ resourceMetaData _ = Nothing+ resourceRelationships _ = Nothing+instance HasIdentifiers OtherTestResource where+ uniqueId = myFavoriteNumber+ typeDescriptor _ = "OtherTestResource"++data TestMetaObject = TestMetaObject+ { totalPages :: Int+ , isSuperFun :: Bool+ } deriving (Show, Generic)++instance AE.ToJSON TestMetaObject+instance AE.FromJSON TestMetaObject+instance MetaObject TestMetaObject where+ typeName _ = "importantData"++toResource' :: (HasIdentifiers a) => a+ -> Maybe Links+ -> Maybe Meta+ -> Resource a+toResource' obj links meta =+ Resource+ (Identifier (pack . show . uniqueId $ obj) (typeDescriptor obj) meta)+ obj+ links+ Nothing++linksObj :: Links+linksObj = mkLinks [ ("self", "/things/1")+ , ("related", "http://some.domain.com/other/things/1")+ ]++testObject :: TestResource+testObject = TestResource 1 "Fred Armisen" 51 "Pizza"++testObject2 :: TestResource+testObject2 = TestResource 2 "Carrie Brownstein" 35 "Lunch"++otherTestObject :: OtherTestResource+otherTestObject = OtherTestResource 999 "Atom Smasher" 100 "Atom Smashers, Inc"++testMetaObj :: Meta+testMetaObj = mkMeta (TestMetaObject 3 True)++emptyMeta :: Maybe Meta+emptyMeta = Nothing++emptyLinks :: Maybe Links+emptyLinks = Nothing