{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Servant.API.ContentTypes.Persist where

import Data.Proxy (Proxy(..))
import Network.HTTP.Media ((//))
import qualified Data.List.NonEmpty as NonEmpty

import Servant.API.ContentTypes
import Data.Persist
import qualified Data.ByteString.Lazy as BSL (toStrict, fromStrict)

-- | Content-type for instances of the 'Persist' class in the package
-- "persist". Trailing garbage is ignored.
data PersistFmt

-- | Mime-type using the word "hackage" and the name of the package "persist".
instance Accept PersistFmt where
    contentTypes :: Proxy PersistFmt -> NonEmpty MediaType
contentTypes Proxy PersistFmt
Proxy = forall a. [a] -> NonEmpty a
NonEmpty.fromList
        [ ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"x-hackage-persist"
        , ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"vnd.hackage.persist"
        ]

-- |
--
-- >>> mimeRender (Proxy :: Proxy PersistFmt) (3.14 :: Float)
-- "\195\245H@"
instance Persist a => MimeRender PersistFmt a where
    mimeRender :: Proxy PersistFmt -> a -> ByteString
mimeRender Proxy PersistFmt
Proxy = ByteString -> ByteString
BSL.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Persist a => a -> ByteString
encode

-- |
--
-- >>> let bsl = mimeRender (Proxy :: Proxy PersistFmt) (3.14 :: Float)
-- >>> mimeUnrender (Proxy :: Proxy PersistFmt) bsl :: Either String Float
-- Right 3.14
--
-- >>> mimeUnrender (Proxy :: Proxy PersistFmt) (bsl <> "trailing garbage") :: Either String Float
-- Right 3.14
--
-- Persist doesn't detect this preceding garbage.
--
-- >>> mimeUnrender (Proxy :: Proxy PersistFmt) ("preceding garbage" <> bsl) :: Either String Float
-- Right ...
--
-- >>> mimeUnrender (Proxy :: Proxy PersistFmt) "garbage" :: Either String (Float, Float)
-- Left "Data.Persist.decode: LengthException 4 \"Not enough bytes available\""
instance Persist a => MimeUnrender PersistFmt a where
    mimeUnrender :: Proxy PersistFmt -> ByteString -> Either String a
mimeUnrender Proxy PersistFmt
Proxy = forall {a} {b} {b}. (a -> b) -> Either a b -> Either b b
mapLeft (String
"Data.Persist.decode: " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Persist a => ByteString -> Either String a
decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict
      where
        mapLeft :: (a -> b) -> Either a b -> Either b b
mapLeft a -> b
f = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) forall a b. b -> Either a b
Right