From add2aecf6ce4e219f3e4e2b6b731e84e64da51a9 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Mon, 27 Jun 2022 22:30:33 +0200
Subject: optional date parameter for the timetable endpoint

(mostly to make debugging easier, but also more generially useful i guess)
---
 lib/API.hs | 35 +++++++++++++++++++++++------------
 1 file changed, 23 insertions(+), 12 deletions(-)

(limited to 'lib/API.hs')

diff --git a/lib/API.hs b/lib/API.hs
index dc348d3..51c3690 100644
--- a/lib/API.hs
+++ b/lib/API.hs
@@ -1,29 +1,36 @@
-{-# LANGUAGE DataKinds     #-}
-{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeApplications  #-}
+{-# LANGUAGE TypeOperators     #-}
 
 -- | The sole authorative definition of this server's API, given as a Servant-style
 -- Haskell type. All other descriptions of the API are generated from this one.
 module API (API, CompleteAPI) where
 
-import           Data.Map     (Map)
-import           Data.Swagger (Swagger)
+import           Data.Map                 (Map)
+import           Data.Proxy               (Proxy (..))
+import           Data.Swagger             (Swagger)
+import           Data.Swagger.ParamSchema (ToParamSchema (..))
+import           Data.Time                (Day, UTCTime)
 import           GTFS
 import           Persist
-import           Servant      (Application, FromHttpApiData (parseUrlPiece),
-                               Server, err401, err404, serve, throwError,
-                               type (:>))
-import           Servant.API  (Capture, FromHttpApiData, Get, JSON, Post,
-                               ReqBody, type (:<|>) ((:<|>)))
+import           Servant                  (Application,
+                                           FromHttpApiData (parseUrlPiece),
+                                           Server, err401, err404, serve,
+                                           throwError, type (:>))
+import           Servant.API              (Capture, FromHttpApiData, Get, JSON,
+                                           Post, QueryParam, ReqBody,
+                                           type (:<|>) ((:<|>)))
 
 -- | The server's API (as it is actually intended).
 type API = "stations" :> Get '[JSON] (Map StationID Station)
-  :<|> "timetable" :> Capture "Station ID" StationID :> Get '[JSON] (Map TripID (Trip Deep))
+  :<|> "timetable" :> Capture "Station ID" StationID :> QueryParam "day" Day :> Get '[JSON] (Map TripID (Trip Deep))
   :<|> "trip" :> Capture "Trip ID" TripID :> Get '[JSON] (Trip Deep)
   -- ingress API (put this behind BasicAuth?)
   -- TODO: perhaps require a first ping for registration?
-  :<|> "trip" :> "register" :> Capture "Trip ID" TripID :> Post '[JSON] Token
+  :<|> "train" :> "register" :> Capture "Trip ID" TripID :> Post '[JSON] Token
   -- TODO: perhaps a websocket instead?
-  :<|> "trip" :> "ping" :> ReqBody '[JSON] TripPing :> Post '[JSON] ()
+  :<|> "train" :> "ping" :> ReqBody '[JSON] TripPing :> Post '[JSON] ()
   -- debug things
   :<|> "debug" :> "state" :> Get '[JSON] (Map Token [TripPing])
 
@@ -33,6 +40,10 @@ type API = "stations" :> Get '[JSON] (Map StationID Station)
 type CompleteAPI = "debug" :> "openapi" :> Get '[JSON] Swagger
   :<|> API
 
+
+instance ToParamSchema (Maybe UTCTime) where
+  toParamSchema _ = toParamSchema (Proxy @UTCTime)
+
 {-
 TODO:
 there should be a basic API allowing the questions:
-- 
cgit v1.2.3