Support GET /trips
In the spirit of support CRUDL, I added a GET /trips, which lists all of the trips in the Trips table.
This commit is contained in:
parent
2f73d1db6c
commit
0637da36cc
3 changed files with 15 additions and 0 deletions
|
@ -18,3 +18,6 @@ type API = "user"
|
||||||
:<|> "trip"
|
:<|> "trip"
|
||||||
:> ReqBody '[JSON] T.Trip
|
:> ReqBody '[JSON] T.Trip
|
||||||
:> Post '[JSON] NoContent
|
:> Post '[JSON] NoContent
|
||||||
|
-- Read
|
||||||
|
:<|> "trips"
|
||||||
|
:> Get '[JSON] [T.Trip]
|
||||||
|
|
|
@ -20,10 +20,12 @@ server :: FilePath -> Server API
|
||||||
server dbFile = userAddH
|
server dbFile = userAddH
|
||||||
:<|> userGetH
|
:<|> userGetH
|
||||||
:<|> createTripH
|
:<|> createTripH
|
||||||
|
:<|> listTripsH
|
||||||
where
|
where
|
||||||
userAddH newUser = liftIO $ userAdd newUser
|
userAddH newUser = liftIO $ userAdd newUser
|
||||||
userGetH name = liftIO $ userGet name
|
userGetH name = liftIO $ userGet name
|
||||||
createTripH trip = liftIO $ createTrip trip
|
createTripH trip = liftIO $ createTrip trip
|
||||||
|
listTripsH = liftIO $ listTrips
|
||||||
|
|
||||||
-- TODO(wpcarro): Handle failed CONSTRAINTs instead of sending 500s
|
-- TODO(wpcarro): Handle failed CONSTRAINTs instead of sending 500s
|
||||||
userAdd :: T.Account -> IO (Maybe T.Session)
|
userAdd :: T.Account -> IO (Maybe T.Session)
|
||||||
|
@ -48,6 +50,9 @@ server dbFile = userAddH
|
||||||
(trip & T.tripFields)
|
(trip & T.tripFields)
|
||||||
pure NoContent
|
pure NoContent
|
||||||
|
|
||||||
|
listTrips :: IO [T.Trip]
|
||||||
|
listTrips = withConnection dbFile $ \conn -> do
|
||||||
|
query_ conn "SELECT * FROM Trips"
|
||||||
mkApp :: FilePath -> IO Application
|
mkApp :: FilePath -> IO Application
|
||||||
mkApp dbFile = do
|
mkApp dbFile = do
|
||||||
pure $ serve (Proxy @ API) $ server dbFile
|
pure $ serve (Proxy @ API) $ server dbFile
|
||||||
|
|
|
@ -192,6 +192,13 @@ data Trip = Trip
|
||||||
, tripComment :: Comment
|
, tripComment :: Comment
|
||||||
} deriving (Eq, Show, Generic)
|
} deriving (Eq, Show, Generic)
|
||||||
|
|
||||||
|
instance FromRow Trip where
|
||||||
|
fromRow = Trip <$> field
|
||||||
|
<*> field
|
||||||
|
<*> field
|
||||||
|
<*> field
|
||||||
|
<*> field
|
||||||
|
|
||||||
-- | Return the tuple representation of a Trip record for SQL.
|
-- | Return the tuple representation of a Trip record for SQL.
|
||||||
tripFields :: Trip -> (Username, Destination, Date, Date, Comment)
|
tripFields :: Trip -> (Username, Destination, Date, Date, Comment)
|
||||||
tripFields (Trip{ tripUsername
|
tripFields (Trip{ tripUsername
|
||||||
|
|
Loading…
Add table
Reference in a new issue