aboutsummaryrefslogtreecommitdiff
path: root/gtfs/Servant
diff options
context:
space:
mode:
Diffstat (limited to 'gtfs/Servant')
-rw-r--r--gtfs/Servant/GTFS/Realtime.hs38
1 files changed, 38 insertions, 0 deletions
diff --git a/gtfs/Servant/GTFS/Realtime.hs b/gtfs/Servant/GTFS/Realtime.hs
new file mode 100644
index 0000000..8923b92
--- /dev/null
+++ b/gtfs/Servant/GTFS/Realtime.hs
@@ -0,0 +1,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)