blob: 8923b9226c946ad0ca95fcec5ba456190bece79d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
module Servant.GTFS.Realtime (Proto) where
import Servant
( MimeRender(..),
MimeUnrender(mimeUnrender),
Accept(contentType),
Proxy(Proxy) )
import Text.ProtocolBuffers
( Wire, ReflectDescriptor, messagePut, messageGet )
import Network.HTTP.Media ((//))
import Data.Either.Combinators (mapRight)
import Data.Swagger (ToSchema(..))
-- | A servant encoding for protobuf-encoded messages
data Proto
instance Accept Proto where
contentType _ = "application" // "octet-stream"
instance (Wire msg, ReflectDescriptor msg) => MimeUnrender Proto msg where
mimeUnrender _ = mapRight fst . messageGet @msg
instance (Wire msg, ReflectDescriptor msg) => MimeRender Proto msg where
mimeRender _ = messagePut
-- TODO: this instance is horrible; ideally it should at least include
-- the name of the message type (if at all possible)
instance {-# OVERLAPPABLE #-} Wire msg => ToSchema msg where
declareNamedSchema _ = declareNamedSchema (Proxy @String)
|
