{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Servant.API.ContentTypes.Waargonaut ( WaargJSON ) where
import Control.Category ((.))
import Prelude (show)
import Data.Bifunctor (first)
import Data.Function (($))
import Data.Proxy (Proxy (..))
import Data.Typeable (Typeable)
import qualified Data.List.NonEmpty as NE
import qualified Network.HTTP.Media as M
import Servant.API.ContentTypes (Accept (..), MimeRender (..),
MimeUnrender (..))
import qualified Data.ByteString.Lazy as BL
import qualified Text.PrettyPrint.Annotated.WL as WL
import Waargonaut.Attoparsec (pureDecodeAttoparsecByteString)
import qualified Waargonaut.Decode as D
import qualified Waargonaut.Encode as E
import Waargonaut.Generic (JsonDecode, JsonEncode)
import qualified Waargonaut.Generic as G
data WaargJSON t
deriving Typeable
instance Accept (WaargJSON t) where
contentTypes _ = "application" M.// "json" M./: ("charset", "utf-8") NE.:| [ "application" M.// "json" ]
instance JsonDecode t a => MimeUnrender (WaargJSON t) a where
mimeUnrender _ = first handleErr
. pureDecodeAttoparsecByteString (G.proxy G.mkDecoder (Proxy :: Proxy t))
. BL.toStrict
where
handleErr (dErr, hist) = WL.display . WL.renderPrettyDefault $
WL.text (show dErr) WL.<##> D.ppCursorHistory hist
instance JsonEncode t a => MimeRender (WaargJSON t) a where
mimeRender _ = E.simplePureEncodeByteStringNoSpaces (G.proxy G.mkEncoder (Proxy :: Proxy t))