diff --git a/example/example.cabal b/example/example.cabal --- a/example/example.cabal +++ b/example/example.cabal @@ -44,6 +44,7 @@ default-extensions: OverloadedStrings RecordWildCards + TemplateHaskell ghc-options: -Wall 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.1.1 +version: 0.1.1.2 homepage: https://github.com/toddmohney/json-api bug-reports: https://github.com/toddmohney/json-api/issues license: MIT @@ -38,6 +38,7 @@ , base >= 4.7 && < 5.0 , containers >= 0.5.7.1 && < 0.5.8.0 , data-default >= 0.5.3 && < 5.6.0 + , lens >= 4.13 && < 5.0 , lens-aeson >= 1.0.0.5 && < 1.0.1.0 , text >= 1.2.2.1 && < 1.2.3.0 , unordered-containers >= 0.2.7.1 && < 0.2.8.0 @@ -50,11 +51,13 @@ 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 @@ -104,6 +107,7 @@ other-modules: Network.JSONApi.ErrorSpec Network.JSONApi.DocumentSpec + Network.JSONApi.IdentifierSpec Network.JSONApi.MetaSpec Network.JSONApi.ResourceSpec TestHelpers diff --git a/src/Network/JSONApi.hs b/src/Network/JSONApi.hs --- a/src/Network/JSONApi.hs +++ b/src/Network/JSONApi.hs @@ -2,27 +2,37 @@ Entry-point module for this package. -} module Network.JSONApi - ( D.Document - , D.ErrorDocument (..) - , D.Included - , E.Error (..) - , R.Relationship - , R.Resource (..) - , R.ResourcefulEntity (..) - , R.Identifier (..) - , L.Links - , M.Meta (..) - , M.MetaObject (..) - , L.mkLinks - , R.mkRelationship - , D.mkDocument - , D.mkCompoundDocument - , D.mkIncludedResource - , M.mkMeta - ) where +( 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 (..) +, L.mkLinks +, R.mkRelationship +, R.mkRelationships +, 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 + 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 @@ -3,10 +3,15 @@ -} module Network.JSONApi.Document ( Document + , ResourceData (..) , ErrorDocument (..) , Included , mkDocument + , mkDocument' + , singleton + , list , mkCompoundDocument + , mkCompoundDocument' , mkIncludedResource ) where @@ -29,7 +34,7 @@ import qualified Network.JSONApi.Resource as R {- | -The @Document@ type represents the top-level JSON-API requirement. +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. @@ -67,13 +72,13 @@ return (Document d l m i) {- | -The @Included@ type is an abstraction used to constrain the "included" +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. +constrain the 'Value' to a heterogeneous list of Resource types. +See 'mkIncludedResource' for creating 'Included' types. -} data Included = Included [Value] deriving (Show) @@ -85,7 +90,7 @@ {- | Constructor function for the Document data type. -See @mkCompoundDocument@ for constructing compound Document +See 'mkCompoundDocument' for constructing compound Document including 'side-loaded' resources -} mkDocument :: ResourcefulEntity a => @@ -93,9 +98,15 @@ -> Maybe Links -> Maybe Meta -> Document a -mkDocument res links meta = +mkDocument res = mkDocument' (toResourceData res) + +mkDocument' :: ResourceData a + -> Maybe Links + -> Maybe Meta + -> Document a +mkDocument' res links meta = Document - { _data = toResourceData res + { _data = res , _links = links , _meta = meta , _included = [] @@ -103,7 +114,7 @@ {- | Constructor function for the Document data type. -See @mkIncludedResource@ for constructing the @Included@ type. +See 'mkIncludedResource' for constructing the 'Included' type. Supports building compound documents @@ -114,9 +125,16 @@ -> Maybe Meta -> Included -> Document a -mkCompoundDocument res links meta (Included included) = +mkCompoundDocument res = mkCompoundDocument' (toResourceData res) + +mkCompoundDocument' :: ResourceData a + -> Maybe Links + -> Maybe Meta + -> Included + -> Document a +mkCompoundDocument' res links meta (Included included) = Document - { _data = toResourceData res + { _data = res , _links = links , _meta = meta , _included = included @@ -133,20 +151,26 @@ toResourceData :: ResourcefulEntity a => [a] -> ResourceData a toResourceData (r:[]) = Singleton (R.toResource r) -toResourceData rs = List (map R.toResource rs) +toResourceData rs = List (map R.toResource rs) {- | -The @Resource@ type encapsulates the underlying 'Resource' +The 'Resource' type encapsulates the underlying 'Resource' -Included in the top-level 'Document', the @Resource@ may be either +Included in the top-level 'Document', the 'Resource' may be either a singleton resource or a list. For more information see: -} data ResourceData a = Singleton (Resource a) - | List [ Resource a ] - deriving (Show, Eq, G.Generic) + | 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 @@ -157,7 +181,7 @@ parseJSON _ = mzero {- | -The @ErrorDocument@ type represents the alternative form of the top-level +The 'ErrorDocument' type represents the alternative form of the top-level JSON-API requirement. @error@ attribute - a descriptive object encapsulating application-specific diff --git a/src/Network/JSONApi/Identifier.hs b/src/Network/JSONApi/Identifier.hs new file mode 100644 --- /dev/null +++ b/src/Network/JSONApi/Identifier.hs @@ -0,0 +1,58 @@ +{- | +Module representing a JSON-API resource object. + +Specification: +-} +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 qualified Data.Aeson.Types 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: +-} +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 diff --git a/src/Network/JSONApi/Link.hs b/src/Network/JSONApi/Link.hs --- a/src/Network/JSONApi/Link.hs +++ b/src/Network/JSONApi/Link.hs @@ -25,9 +25,9 @@ Example JSON: @ -"links": { - "self": "http://example.com/posts/1" -} + "links": { + "self": "http://example.com/posts/1" + } @ Specification: diff --git a/src/Network/JSONApi/Meta.hs b/src/Network/JSONApi/Meta.hs --- a/src/Network/JSONApi/Meta.hs +++ b/src/Network/JSONApi/Meta.hs @@ -4,7 +4,7 @@ Specification: -} module Network.JSONApi.Meta -( Meta (..) +( Meta , MetaObject (..) , mkMeta )where @@ -22,15 +22,15 @@ Example JSON: @ -"meta": { - "copyright": "Copyright 2015 Example Corp.", - "authors": [ - "Andre Dawson", - "Kirby Puckett", - "Don Mattingly", - "Ozzie Guillen" - ] -} + "meta": { + "copyright": "Copyright 2015 Example Corp.", + "authors": [ + "Andre Dawson", + "Kirby Puckett", + "Don Mattingly", + "Ozzie Guillen" + ] + } @ Specification: @@ -50,14 +50,14 @@ Example usage: @ -data Pagination = Pagination - { currentPage :: Int - , totalPages :: Int - } deriving (Show, Generic) + data Pagination = Pagination + { currentPage :: Int + , totalPages :: Int + } deriving (Show, Generic) -instance ToJSON Pagination -instance MetaObject Pagination where - typeName _ = "pagination" + instance ToJSON Pagination + instance MetaObject Pagination where + typeName _ = "pagination" @ -} class (ToJSON a) => MetaObject a where diff --git a/src/Network/JSONApi/Resource.hs b/src/Network/JSONApi/Resource.hs --- a/src/Network/JSONApi/Resource.hs +++ b/src/Network/JSONApi/Resource.hs @@ -4,19 +4,24 @@ Specification: -} module Network.JSONApi.Resource -( Identifier (..) -, Resource (..) +( Resource (..) +, Relationships , ResourcefulEntity (..) , Relationship , mkRelationship +, mkRelationships ) where +import Control.Lens.TH import Data.Aeson (ToJSON, FromJSON, (.=), (.:), (.:?)) import qualified Data.Aeson as AE import qualified Data.Aeson.Types as AE import Data.Map (Map) +import qualified Data.Map as Map +import Data.Monoid import Data.Text (Text) -import qualified GHC.Generics as G +import GHC.Generics hiding (Meta) +import Network.JSONApi.Identifier (HasIdentifier (..), Identifier (..)) import Network.JSONApi.Link (Links) import Network.JSONApi.Meta (Meta) import Prelude hiding (id) @@ -24,8 +29,7 @@ {- | Type representing a JSON-API resource object. -A Resource supplies standardized data and metadata about a -resource. +A Resource supplies standardized data and metadata about a resource. Specification: -} @@ -33,12 +37,11 @@ { getIdentifier :: Identifier , getResource :: a , getLinks :: Maybe Links - , getMetaData :: Maybe Meta - , getRelationships :: Maybe (Map Text Relationship) - } deriving (Show, Eq, G.Generic) + , getRelationships :: Maybe Relationships + } deriving (Show, Eq, Generic) instance (ToJSON a) => ToJSON (Resource a) where - toJSON (Resource (Identifier resId resType) resObj linksObj metaObj rels) = + toJSON (Resource (Identifier resId resType metaObj) resObj linksObj rels) = AE.object [ "id" .= resId , "type" .= resType , "attributes" .= resObj @@ -55,8 +58,11 @@ links <- v .:? "links" meta <- v .:? "meta" rels <- v .:? "relationships" - return $ Resource (Identifier id typ) attrs links meta rels + 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 -} @@ -65,7 +71,7 @@ resourceType :: a -> Text resourceLinks :: a -> Maybe Links resourceMetaData :: a -> Maybe Meta - resourceRelationships :: a -> Maybe (Map Text Relationship) + resourceRelationships :: a -> Maybe Relationships fromResource :: Resource a -> a fromResource = getResource @@ -73,10 +79,9 @@ toResource :: a -> Resource a toResource a = Resource - (Identifier (resourceIdentifier a) (resourceType a)) + (Identifier (resourceIdentifier a) (resourceType a) (resourceMetaData a)) a (resourceLinks a) - (resourceMetaData a) (resourceRelationships a) {- | @@ -90,7 +95,7 @@ data Relationship = Relationship { _data :: Maybe Identifier , _links :: Maybe Links - } deriving (Show, Eq, G.Generic) + } deriving (Show, Eq, Generic) instance ToJSON Relationship where toJSON = AE.genericToJSON @@ -100,6 +105,28 @@ parseJSON = AE.genericParseJSON AE.defaultOptions { AE.fieldLabelModifier = drop 1 } + +data Relationships = Relationships (Map Text Relationship) + deriving (Show, Eq, Generic) + +instance ToJSON Relationships +instance FromJSON Relationships + +instance Monoid Relationships where + mempty = Relationships Map.empty + mappend (Relationships a) (Relationships b) = Relationships (a <> b) + +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 @@ -109,23 +136,4 @@ 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 } +makeLenses ''Resource 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 @@ -5,7 +5,7 @@ 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 qualified Data.ByteString.Lazy.Char8 as BS -} import Data.Either (isRight) import Data.Maybe import Data.Monoid @@ -70,7 +70,7 @@ let jsonApiObj = mkCompoundDocument [testObject] Nothing Nothing includedResources let encodedJson = encodeDocumentObject jsonApiObj let decodedJson = decodeDocumentObject encodedJson - putStrLn (BS.unpack encodedJson) + {- putStrLn (BS.unpack encodedJson) -} {- putStrLn $ show decodedJson -} isRight decodedJson `shouldBe` True diff --git a/test/Network/JSONApi/IdentifierSpec.hs b/test/Network/JSONApi/IdentifierSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/JSONApi/IdentifierSpec.hs @@ -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) diff --git a/test/Network/JSONApi/MetaSpec.hs b/test/Network/JSONApi/MetaSpec.hs --- a/test/Network/JSONApi/MetaSpec.hs +++ b/test/Network/JSONApi/MetaSpec.hs @@ -3,7 +3,6 @@ import Data.Aeson (ToJSON) import qualified Data.Aeson as AE import qualified Data.ByteString.Lazy.Char8 as BS -import qualified Data.HashMap.Strict as HM import Data.Maybe (isJust) import Data.Monoid ((<>)) import Data.Text (Text) @@ -18,29 +17,11 @@ spec :: Spec spec = do describe "JSON serialization" $ do - it "serializes/deserializes maps simple heterogeneous values" $ do - let testMeta = Meta . HM.fromList $ [ ("numData", AE.toJSON (5 :: Int)) - , ("strData", AE.toJSON ("hello" :: String)) - ] - let encIntJson = BS.unpack . prettyEncode $ testMeta - let decIntJson = AE.decode (BS.pack encIntJson) :: Maybe Meta - isJust decIntJson `shouldBe` True - it "serializes/deserializes heterogeneous maps of ToJSON types" $ do - let boolTestData = Meta . HM.fromList $ [ ("objData", AE.toJSON testObject) - , ("otherObjData", AE.toJSON otherTestObject) - ] + let boolTestData = mkMeta testObject <> mkMeta otherTestObject let encBoolJson = BS.unpack . prettyEncode $ boolTestData let decBoolJson = AE.decode (BS.pack encBoolJson) :: Maybe Meta isJust decBoolJson `shouldBe` True - - describe "monoid instance" $ - it "combines" $ do - let monoidialConstruction = mkMeta testObject <> mkMeta otherTestObject - let manualConstruction = Meta . HM.fromList $ [ ("testObject", AE.toJSON testObject) - , ("otherTestObject", AE.toJSON otherTestObject) - ] - monoidialConstruction `shouldBe` manualConstruction testObject :: TestObject testObject = TestObject 99 102 "Zapp Brannigan" diff --git a/test/Network/JSONApi/ResourceSpec.hs b/test/Network/JSONApi/ResourceSpec.hs --- a/test/Network/JSONApi/ResourceSpec.hs +++ b/test/Network/JSONApi/ResourceSpec.hs @@ -2,12 +2,10 @@ 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 qualified Data.HashMap.Strict as HM import Data.Maybe (isJust, fromJust) +import Data.Monoid import Data.Text (Text, pack) -import qualified GHC.Generics as G +import GHC.Generics (Generic) import Network.JSONApi import Network.URL (URL, importURL) import TestHelpers (prettyEncode) @@ -31,26 +29,44 @@ , myName :: Text , myAge :: Int , myFavoriteFood :: Text - } deriving (Show, G.Generic) + } 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 _ = Just myResourceRelationships + resourceRelationships _ = Just myRelationshipss -myResourceRelationships :: Map Text Relationship -myResourceRelationships = Map.fromList $ [ ("friends", relationship) ] +data Pagination = Pagination + { currentPage :: Int + , totalPages :: Int + } deriving (Show, Generic) +instance AE.ToJSON Pagination +instance AE.FromJSON Pagination +instance MetaObject Pagination where + typeName _ = "pagination" + +myRelationshipss :: Relationships +myRelationshipss = + mkRelationships relationship <> mkRelationships otherRelationship + relationship :: Relationship relationship = fromJust $ mkRelationship - (Just $ Identifier "42" "FriendOfTestObject") + (Just $ Identifier "42" "FriendOfTestObject" Nothing) (Just myResourceLinks) +otherRelationship :: Relationship +otherRelationship = + fromJust $ mkRelationship + (Just $ Identifier "49" "CousinOfTestObject" Nothing) + (Just myResourceLinks) + myResourceLinks :: Links myResourceLinks = mkLinks [ ("self", toURL "/me") @@ -58,7 +74,7 @@ ] myResourceMetaData :: Meta -myResourceMetaData = Meta . HM.fromList $ [ ("extraData", AE.toJSON (20 :: Int)) ] +myResourceMetaData = mkMeta (Pagination 1 14) toURL :: String -> URL toURL = fromJust . importURL diff --git a/test/TestHelpers.hs b/test/TestHelpers.hs --- a/test/TestHelpers.hs +++ b/test/TestHelpers.hs @@ -4,7 +4,6 @@ import qualified Data.Aeson.Encode.Pretty as AE import qualified Data.ByteString.Lazy.Char8 as BS import Data.Maybe (fromJust) -import qualified Data.HashMap.Strict as HM import Data.Text (Text, pack) import GHC.Generics (Generic) import Network.JSONApi @@ -65,6 +64,8 @@ instance AE.ToJSON TestMetaObject instance AE.FromJSON TestMetaObject +instance MetaObject TestMetaObject where + typeName _ = "importantData" toResource' :: (HasIdentifiers a) => a -> Maybe Links @@ -72,10 +73,9 @@ -> Resource a toResource' obj links meta = Resource - (Identifier (pack . show . uniqueId $ obj) (typeDescriptor obj)) + (Identifier (pack . show . uniqueId $ obj) (typeDescriptor obj) meta) obj links - meta Nothing linksObj :: Links @@ -93,8 +93,7 @@ otherTestObject = OtherTestResource 999 "Atom Smasher" 100 "Atom Smashers, Inc" testMetaObj :: Meta -testMetaObj = - Meta . HM.fromList $ [ ("importantData", (AE.toJSON $ TestMetaObject 3 True)) ] +testMetaObj = mkMeta (TestMetaObject 3 True) emptyMeta :: Maybe Meta emptyMeta = Nothing