module Network.JSONApi.Resource
( PageNum (..)
, PageSize (..)
, Resource (..)
, ResourceCount (..)
, 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 qualified Data.Map as Map
import Data.Maybe (fromMaybe)
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", buildLink) ]
where
buildLink = "/" <> resourceType resource <> "/" <> resourceIdentifier resource
newtype PageSize = PageSize {
getPageSize :: Int
} deriving Show
newtype PageNum = PageNum {
getPageNum :: Int
} deriving Show
newtype ResourceCount = ResourceCount {
getResourceCount :: Int
} deriving Show
indexLinks :: ResourcefulEntity e => e -> Maybe Text -> PageSize -> PageNum -> ResourceCount -> Links
indexLinks resource baseUrl pageSize pageNum resourceCount = mkLinks [
("self", genLink pgNum)
,("first", genLink (0 :: Int))
,("prev", genLink (if pgNum - 1 < 0 then 0 else pgNum - 1))
,("next", genLink (pgNum + 1))
,("last", genLink ((resCount `quot` pgSize) - 1))]
where
pgNum = if getPageNum pageNum < 0 then 0 else getPageNum pageNum
pgSize = if getPageSize pageSize <= 0 then 1 else getPageSize pageSize
resCount = if getResourceCount resourceCount < 0 then 0 else getResourceCount resourceCount
genLink no = fromMaybe "" baseUrl <> "/" <> resourceType resource <> "?" <>
encodeText "page[number]" <> "=" <> (pack . show) no <>
"&" <> encodeText "page[size]" <> "=" <> (pack . show) pgSize