diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -51,16 +51,16 @@ mkDocument :: User -> Links -> Document User Text Int mkDocument usr links = Document - (Singleton $ toResourceObject usr) + (Singleton $ toResource usr) (Just links) Nothing -- Helper function to convert a User into a resource object -- This could be our canonical serialization function for a User in any -- response payload -toResourceObject :: User -> ResourceObject User Text -toResourceObject user = - ResourceObject resourceId resourceType user resourceLinks resourceMetaData +toResource :: User -> Resource User Text +toResource user = + Resource resourceId resourceType user resourceLinks resourceMetaData where resourceId = ResourceId . pack . show . userId $ user resourceType = ResourceType "User" diff --git a/example/README.md b/example/README.md --- a/example/README.md +++ b/example/README.md @@ -31,40 +31,62 @@ 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 + "data" : [ + { + "type" : "User", + "relationships" : { + "email" : { + "links" : { + "self" : "/emails/42" + }, + "data" : { + "type" : "Email", + "id" : "42" + } + } + }, + "links" : { + "self" : "/users/1" + }, + "meta" : null, + "id" : "1", + "attributes" : { + "userFirstName" : "Isaac", + "userLastName" : "Newton", + "userId" : 1 + } }, - "id":"2", - "meta":null, - "type":"User", - "links":{ - "self":"/users/2" + { + "relationships" : { + "email" : { + "links" : { + "self" : "/emails/88" + }, + "data" : { + "id" : "88", + "type" : "Email" + } + } + }, + "type" : "User", + "attributes" : { + "userFirstName" : "Albert", + "userLastName" : "Einstein", + "userId" : 2 + }, + "meta" : null, + "links" : { + "self" : "/users/2" + }, + "id" : "2" } - } - ], - "meta":{ - "user-count":2 - }, - "links":{ - "self":"/users" - } + ], + "meta" : { + "user-count" : 2 + }, + "links" : { + "self" : "/users" + } } ``` @@ -75,23 +97,34 @@ 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" - } + "meta" : null, + "data" : { + "id" : "1", + "attributes" : { + "userFirstName" : "Isaac", + "userId" : 1, + "userLastName" : "Newton" + }, + "meta" : null, + "links" : { + "self" : "/users/1" + }, + "type" : "User", + "relationships" : { + "email" : { + "links" : { + "self" : "/emails/42" + }, + "data" : { + "id" : "42", + "type" : "Email" + } + } + } + }, + "links" : { + "self" : "/users/1" + } } ``` diff --git a/example/example.cabal b/example/example.cabal --- a/example/example.cabal +++ b/example/example.cabal @@ -1,5 +1,5 @@ name: example -version: 0.1.0.0 +version: 0.1.0.3 synopsis: Initial project template from stack description: Please see README.md homepage: https://github.com/toddmohney/example#readme @@ -19,6 +19,7 @@ exposed-modules: Lib + Emails Users Users.Controller @@ -28,7 +29,7 @@ build-depends: base >= 4.7 && < 5 , aeson >= 0.11.2.0 && < 0.11.3.0 - , containers >= 0.5.6.2 && < 0.5.7.1 + , containers >= 0.5.7.1 && < 0.5.8.0 , data-default >= 0.5.3 && < 5.6.0 , json-api , servant-server >= 0.7.1 && < 0.8.0 diff --git a/example/stack.yaml b/example/stack.yaml --- a/example/stack.yaml +++ b/example/stack.yaml @@ -2,7 +2,7 @@ # 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 +resolver: nightly-2016-07-03 # Local packages, usually specified by relative directory name packages: diff --git a/json-api.cabal b/json-api.cabal --- a/json-api.cabal +++ b/json-api.cabal @@ -1,5 +1,5 @@ name: json-api -version: 0.1.0.3 +version: 0.1.0.4 homepage: https://github.com/toddmohney/json-api bug-reports: https://github.com/toddmohney/json-api/issues license: MIT @@ -56,7 +56,7 @@ Network.JSONApi.Document Network.JSONApi.Meta Network.JSONApi.Link - Network.JSONApi.ResourceObject + Network.JSONApi.Resource other-modules: @@ -104,7 +104,7 @@ Network.JSONApi.ErrorSpec Network.JSONApi.DocumentSpec Network.JSONApi.MetaSpec - Network.JSONApi.ResourceObjectSpec + Network.JSONApi.ResourceSpec TestHelpers type: exitcode-stdio-1.0 diff --git a/src/Network/JSONApi/Document.hs b/src/Network/JSONApi/Document.hs --- a/src/Network/JSONApi/Document.hs +++ b/src/Network/JSONApi/Document.hs @@ -7,13 +7,14 @@ ( Document (..) , ErrorDocument (..) , E.Error (..) -, Resource (..) -, RO.ResourceId (..) -, RO.ResourceObject (..) -, RO.ResourceType (..) +, ResourceData (..) +, R.Relationship +, R.Resource (..) +, R.Identifier (..) , L.Links , M.Meta (..) , L.toLinks +, R.mkRelationship ) where import Control.Monad (mzero) @@ -29,8 +30,8 @@ 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 +import Network.JSONApi.Resource (Resource) +import qualified Network.JSONApi.Resource as R {- | The @Document@ type represents the top-level JSON-API requirement. @@ -41,28 +42,28 @@ For more information see: -} data Document a b c = Document - { _data :: Resource a b + { _data :: ResourceData a b , _links :: Maybe Links , _meta :: Maybe (Meta c) } deriving (Show, Eq, G.Generic) {- | -The @Resource@ type encapsulates the underlying 'ResourceObject' +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: -} -data Resource a b = Singleton (ResourceObject a b) - | List [ResourceObject a b] - deriving (Show, Eq, G.Generic) +data ResourceData a b = Singleton (Resource a b) + | List [Resource a b] + deriving (Show, Eq, G.Generic) -instance (ToJSON a, ToJSON b) => ToJSON (Resource a b) where +instance (ToJSON a, ToJSON b) => ToJSON (ResourceData 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 +instance (FromJSON a, FromJSON b) => FromJSON (ResourceData 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 diff --git a/src/Network/JSONApi/Resource.hs b/src/Network/JSONApi/Resource.hs new file mode 100644 --- /dev/null +++ b/src/Network/JSONApi/Resource.hs @@ -0,0 +1,113 @@ +{- | +Module representing a JSON-API resource object. + +Specification: +-} +module Network.JSONApi.Resource +( Identifier (..) +, Resource (..) +, Relationship +, mkRelationship +) where + +import Data.Aeson (ToJSON, FromJSON, (.=), (.:), (.:?)) +import qualified Data.Aeson as AE +import qualified Data.Aeson.Types as AE +import Data.Map (Map) +import Data.Text (Text) +import qualified GHC.Generics as G +import Network.JSONApi.Link (Links) +import Network.JSONApi.Meta (Meta) +import Prelude hiding (id) + +{- | +Type representing a JSON-API resource object. + +A Resource supplies standardized data and metadata about a +resource. + +Specification: +-} +data Resource a b = Resource + { getIdentifier :: Identifier + , getResource :: a + , getLinks :: Maybe Links + , getMetaData :: Maybe (Meta b) + , getRelationships :: Maybe (Map Text Relationship) + } deriving (Show, Eq, G.Generic) + +instance (ToJSON a, ToJSON b) => ToJSON (Resource a b) where + toJSON (Resource (Identifier resId resType) resObj linksObj metaObj rels) = + AE.object [ "id" .= resId + , "type" .= resType + , "attributes" .= resObj + , "links" .= linksObj + , "meta" .= metaObj + , "relationships" .= rels + ] + +instance (FromJSON a, FromJSON b) => FromJSON (Resource a b) 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) attrs links meta rels + + + + +{- | +A type representing the Relationship between 2 entities + +A Relationship provides basic information for fetching further information +about a related resource. + +Specification: +-} +data Relationship = Relationship + { _data :: Maybe Identifier + , _links :: Maybe Links + } deriving (Show, Eq, G.Generic) + +instance ToJSON Relationship where + toJSON = AE.genericToJSON + AE.defaultOptions { AE.fieldLabelModifier = drop 1 } + +instance FromJSON Relationship where + parseJSON = AE.genericParseJSON + AE.defaultOptions { AE.fieldLabelModifier = drop 1 } + +{- | +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 + + + +{- | +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: +-} +data Identifier = Identifier + { _id :: Text + , _type :: Text + } deriving (Show, Eq, G.Generic) + +instance ToJSON Identifier where + toJSON = AE.genericToJSON + AE.defaultOptions { AE.fieldLabelModifier = drop 1 } + +instance FromJSON Identifier where + parseJSON = AE.genericParseJSON + AE.defaultOptions { AE.fieldLabelModifier = drop 1 } diff --git a/src/Network/JSONApi/ResourceObject.hs b/src/Network/JSONApi/ResourceObject.hs deleted file mode 100644 --- a/src/Network/JSONApi/ResourceObject.hs +++ /dev/null @@ -1,57 +0,0 @@ -{- | -Module representing a JSON-API resource object. - -Specification: --} -module Network.JSONApi.ResourceObject -( ResourceId (..) -, ResourceObject (..) -, ResourceType (..) -) where - -import Data.Aeson (ToJSON, FromJSON, (.=), (.:), (.:?)) -import qualified Data.Aeson as AE -import Data.Text (Text) -import qualified GHC.Generics as G -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: --} -data ResourceObject a b = ResourceObject - { getResourceId :: ResourceId - , getResourceType :: ResourceType - , getResource :: a - , getLinks :: Maybe Links - , getMetaData :: Maybe (Meta b) - } deriving (Show, Eq, Ord, G.Generic) - -newtype ResourceId = ResourceId Text - deriving (Show, Eq, Ord, ToJSON, FromJSON, G.Generic) - -newtype ResourceType = ResourceType Text - deriving (Show, Eq, Ord, ToJSON, FromJSON, G.Generic) - -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" diff --git a/test/Network/JSONApi/DocumentSpec.hs b/test/Network/JSONApi/DocumentSpec.hs --- a/test/Network/JSONApi/DocumentSpec.hs +++ b/test/Network/JSONApi/DocumentSpec.hs @@ -19,7 +19,7 @@ spec = describe "JSON serialization" $ do it "JSON encodes/decodes a singleton resource" $ do - let resource = toResourceObject testObject + let resource = toResource testObject let jsonApiObj = Document (Singleton resource) emptyLinks emptyMeta let encodedJson = encodeDocumentObject jsonApiObj let decodedJson = decodeDocumentObject encodedJson @@ -28,7 +28,7 @@ isRight decodedJson `shouldBe` True it "JSON encodes/decodes a list of resources" $ do - let resources = [toResourceObject testObject, toResourceObject testObject2] + let resources = [toResource testObject, toResource testObject2] let jsonApiObj = Document (List resources) emptyLinks emptyMeta let encodedJson = encodeDocumentObject jsonApiObj let decodedJson = decodeDocumentObject encodedJson @@ -37,7 +37,7 @@ isRight decodedJson `shouldBe` True it "contains the allowable top-level keys" $ do - let resource = toResourceObject testObject + let resource = toResource testObject let jsonApiObj = Document (Singleton resource) emptyLinks emptyMeta let encodedJson = encodeDocumentObject jsonApiObj let dataObject = encodedJson ^? Lens.key "data" @@ -48,7 +48,7 @@ isJust metaObject `shouldBe` True it "allows an optional top-level links object" $ do - let resource = toResourceObject testObject + let resource = toResource testObject let jsonApiObj = Document (Singleton resource) (Just linksObj) emptyMeta let encodedJson = encodeDocumentObject jsonApiObj let decodedJson = decodeDocumentObject encodedJson @@ -57,7 +57,7 @@ isRight decodedJson `shouldBe` True it "allows an optional top-level meta object" $ do - let resource = toResourceObject testObject + let resource = toResource testObject let jsonApiObj = Document (Singleton resource) emptyLinks (Just testMetaObj) let encodedJson = encodeDocumentObject jsonApiObj let decodedJson = decodeDocumentObject encodedJson @@ -66,7 +66,7 @@ isRight decodedJson `shouldBe` True it "allows an optional top-level meta object" $ do - let resource = toResourceObject testObject + let resource = toResource testObject let jsonApiObj = Document (Singleton resource) (Just linksObj) (Just testMetaObj) let encodedJson = encodeDocumentObject jsonApiObj let decodedJson = decodeDocumentObject encodedJson @@ -75,7 +75,7 @@ isRight decodedJson `shouldBe` True decodeDocumentObject :: ByteString - -> Either String (Document TestResourceObject (Maybe Bool) (Maybe TestMetaObject)) + -> Either String (Document TestResource (Maybe Bool) (Maybe TestMetaObject)) decodeDocumentObject = AE.eitherDecode encodeDocumentObject :: (ToJSON a, ToJSON b, ToJSON c) => Document a b c -> ByteString diff --git a/test/Network/JSONApi/ResourceObjectSpec.hs b/test/Network/JSONApi/ResourceObjectSpec.hs deleted file mode 100644 --- a/test/Network/JSONApi/ResourceObjectSpec.hs +++ /dev/null @@ -1,60 +0,0 @@ -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 qualified GHC.Generics as G -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, G.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 - diff --git a/test/Network/JSONApi/ResourceSpec.hs b/test/Network/JSONApi/ResourceSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/JSONApi/ResourceSpec.hs @@ -0,0 +1,71 @@ +module Network.JSONApi.ResourceSpec where + +import qualified Data.Aeson as AE +import qualified Data.ByteString.Lazy.Char8 as BS +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Maybe (isJust, fromJust) +import Data.Text (Text, pack) +import qualified GHC.Generics as G +import Network.JSONApi.Resource +import Network.JSONApi.Link +import Network.JSONApi.Meta +import Network.URL (URL, importURL) +import TestHelpers (prettyEncode) +import Test.Hspec + +main :: IO () +main = hspec spec + +spec :: Spec +spec = + describe "ToResource" $ + 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 (Maybe Int)) + isJust decodedJson `shouldBe` True + {- putStrLn encodedJson -} + {- putStrLn $ show . fromJust $ decodedJson -} + +data TestObject = TestObject + { myId :: Int + , myName :: Text + , myAge :: Int + , myFavoriteFood :: Text + } deriving (Show, G.Generic) + +instance AE.ToJSON TestObject +instance AE.FromJSON TestObject + +toResource :: TestObject -> Resource TestObject Int +toResource obj = + Resource + (Identifier (pack . show . myId $ obj) "TestObject") + obj + (Just resourceLinks) + (Just resourceMetaData) + (Just resourceRelationships) + +resourceRelationships :: Map Text Relationship +resourceRelationships = Map.fromList $ [ ("friends", relationship) ] + +relationship :: Relationship +relationship = + fromJust $ mkRelationship + (Just $ Identifier "42" "FriendOfTestObject") + (Just resourceLinks) + +resourceLinks :: Links +resourceLinks = + toLinks [ ("self", toURL "/me") + , ("related", toURL "/tacos/4") + ] + +resourceMetaData :: Meta Int +resourceMetaData = Meta . Map.fromList $ [ ("extraData", 20) ] + +toURL :: String -> URL +toURL = fromJust . importURL + +testObject :: TestObject +testObject = TestObject 1 "Fred Armisen" 49 "Pizza" diff --git a/test/TestHelpers.hs b/test/TestHelpers.hs --- a/test/TestHelpers.hs +++ b/test/TestHelpers.hs @@ -17,40 +17,40 @@ 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, G.Generic) +data TestResource = TestResource + { myId :: Int + , myName :: Text + , myAge :: Int + , myFavoriteFood :: Text + } deriving (Show, G.Generic) -data TestMetaObject = - TestMetaObject { totalPages :: Int - , isSuperFun :: Bool - } deriving (Show, G.Generic) +data TestMetaObject = TestMetaObject + { totalPages :: Int + , isSuperFun :: Bool + } deriving (Show, G.Generic) -instance AE.ToJSON TestResourceObject -instance AE.FromJSON TestResourceObject +instance AE.ToJSON TestResource +instance AE.FromJSON TestResource instance AE.ToJSON TestMetaObject instance AE.FromJSON TestMetaObject -toResourceObject :: TestResourceObject -> ResourceObject TestResourceObject Bool -toResourceObject obj = - ResourceObject - (ResourceId . pack . show . myId $ obj) - (ResourceType "TestResourceObject") +toResource :: TestResource -> Resource TestResource Bool +toResource obj = + Resource + (Identifier (pack . show . myId $ obj) "TestResource") obj (Just $ objectLinks obj) (Just $ objectMetaData obj) + Nothing -objectLinks :: TestResourceObject -> Links +objectLinks :: TestResource -> Links objectLinks obj = toLinks [ ("self", toURL ("/me/" <> (show $ myId obj))) , ("related", toURL ("/friends/" <> (show $ myId obj))) ] -objectMetaData :: TestResourceObject -> Meta Bool +objectMetaData :: TestResource -> Meta Bool objectMetaData obj = Meta . Map.fromList $ [ ("isOld", myAge obj > 50) ] @@ -59,11 +59,11 @@ , ("related", toURL "http://some.domain.com/other/things/1") ] -testObject :: TestResourceObject -testObject = TestResourceObject 1 "Fred Armisen" 51 "Pizza" +testObject :: TestResource +testObject = TestResource 1 "Fred Armisen" 51 "Pizza" -testObject2 :: TestResourceObject -testObject2 = TestResourceObject 2 "Carrie Brownstein" 35 "Lunch" +testObject2 :: TestResource +testObject2 = TestResource 2 "Carrie Brownstein" 35 "Lunch" testMetaObj :: Meta TestMetaObject testMetaObj =