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)
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 { 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
mkRelationship :: Maybe Identifier -> Maybe Links -> Maybe Relationship
mkRelationship Nothing Nothing = Nothing
mkRelationship resId links = Just $ Relationship resId links
makeLenses ''Resource
showLink :: ResourcefulEntity e => e -> Links
showLink resource = mkLinks [ ("self", selfLink) ]
where
selfLink = "/" <> resourceType resource <> "/" <> resourceIdentifier resource
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