Support MessagePack in your Servant APIs

Servant.MessagePack.hs

-- msgpack-aeson for msgpack instance derived from aeson instances
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}

module Servant.MessagePack
  ( MessagePack
  ) where

import           Data.Aeson               (FromJSON, ToJSON)
import           Data.List.NonEmpty       (NonEmpty ((:|)), (<|))
import           Data.MessagePack.Aeson   as MP
import           Network.HTTP.Media       ((//))
import           Servant.API.ContentTypes

data MessagePack

instance Accept MessagePack where
  contentTypes _ = "application" // "msgpack"
                <| "application" // "x-msgpack"
                <| "application" // "vnd.msgpack"
                :| []

instance ToJSON a => MimeRender MessagePack a where
  mimeRender _ = MP.packAeson

instance FromJSON a => MimeUnrender MessagePack a where
  mimeUnrender _ = presentError . MP.unpackAeson
    where
      presentError = maybe (Left "Error while parsing MessagePack") Right