simple on-board tools

these are just enough to send train positions to tracktrain with the
current API, but are somewhat brittle (e.g. will fail if not restarted
between trips, etc.)

1 files changed, 7 insertions, 2 deletions

diff --git a/lib/API.hs b/lib/API.hs
index 79a467a..5bf9877 100644
--- a/lib/API.hs
+++ b/lib/API.hs
@@ -14,7 +14,8 @@ import           Data.Swagger                (MimeList (MimeList),
                                               PathItem (_pathItemGet),
                                               Scheme (Wss), Swagger,
                                               ToSchema (..), _swaggerPaths,
-                                              genericDeclareNamedSchema)
+                                              genericDeclareNamedSchema, type_,
+                                              NamedSchema(..), SwaggerType (SwaggerObject))
 import           Data.Swagger.ParamSchema    (ToParamSchema (..))
 import           Data.Text                   (Text)
 import           Data.Time                   (Day, UTCTime)
@@ -31,7 +32,7 @@ import           Servant.Swagger             (HasSwagger (..))
 import           Web.Internal.FormUrlEncoded (Form)
 
 import           Control.Lens                (At (at), (&), (?~))
-import           Data.Aeson                  (FromJSON (..), genericParseJSON)
+import           Data.Aeson                  (FromJSON (..), genericParseJSON, Value)
 import           Data.ByteString.Lazy        (ByteString)
 import           Data.HashMap.Strict.InsOrd  (singleton)
 import           GHC.Generics                (Generic)
@@ -50,10 +51,14 @@ instance FromJSON RegisterJson where
   parseJSON = genericParseJSON (aesonOptions "register")
 instance ToSchema RegisterJson where
   declareNamedSchema = genericDeclareNamedSchema (swaggerOptions "register")
+instance ToSchema Value where
+  declareNamedSchema _ = pure $ NamedSchema (Just "json") $ mempty
+      & type_ ?~ SwaggerObject
 
 -- | The server's API (as it is actually intended).
 type API = "stations" :> Get '[JSON] (Map StationID Station)
   :<|> "timetable" :> Capture "Station ID" StationID :> QueryParam "day" Day :> Get '[JSON] (Map TripID (Trip Deep Deep))
+  :<|> "timetable" :> "stops" :> Capture "Date" Day :> Get '[JSON] Value
   :<|> "trip" :> Capture "Trip ID" TripID :> Get '[JSON] (Trip Deep Deep)
   -- ingress API (put this behind BasicAuth?)
   -- TODO: perhaps require a first ping for registration?