Modify.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types        #-}
module Data.JsonApi.Modify where

import           Control.Arrow
import           Data.JsonApi.Object.Resource
import           Data.Text


newtype AddRelationship a = AddRelationship
    { addRelationship :: forall rep. JsonApi rep
                      => (Text, rep RelationshipObject) -> rep a }


instance Functor AddRelationship where
    fmap f x = AddRelationship $ \r -> f <$> x `addRelationship` r

instance Applicative AddRelationship where
    pure a = AddRelationship $ const (pure a)
    (AddRelationship a) <*> (AddRelationship b) =
        AddRelationship $ \r -> (a r) <*> (b r)

instance JsonApi AddRelationship where
    resource x =
        AddRelationship $ \r -> resource $ x `addRelationship` r

    resourceObject t i attrs rs meta =
        AddRelationship $ \r ->
            resourceObject t i
                ((`addRelationship` r) <$> attrs)
                (r : (second (`addRelationship` r) <$> rs))
                ((`addRelationship` r) <$> meta)

    attributeObject as =
        AddRelationship $ const $ attributeObject as

    toOneRelationship a =
        AddRelationship $ \r ->
            toOneRelationship ((`addRelationship` r) <$> a)

    toManyRelationship as =
        AddRelationship $ \r ->
            toManyRelationship ((`addRelationship` r) <$> as)

    resourceIdentifier t i m =
        AddRelationship $ \r ->
            resourceIdentifier t i ((`addRelationship` r) <$> m)

    metaObject o = AddRelationship $ const $ metaObject o