module Network.JSONApi.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 GHC.Generics hiding (Meta)
import Network.JSONApi.Identifier (HasIdentifier (..), Identifier (..))
import Network.JSONApi.Link (Links)
import Network.JSONApi.Meta (Meta)
import Prelude hiding (id)
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
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)
data Relationship = Relationship
{ _data :: Maybe Identifier
, _links :: Maybe Links
} deriving (Show, Eq, 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 }
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
mkRelationship :: Maybe Identifier -> Maybe Links -> Maybe Relationship
mkRelationship Nothing Nothing = Nothing
mkRelationship resId links = Just $ Relationship resId links
makeLenses ''Resource