aboutsummaryrefslogtreecommitdiff
path: root/lib/Persist.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Persist.hs')
-rw-r--r--lib/Persist.hs20
1 files changed, 10 insertions, 10 deletions
diff --git a/lib/Persist.hs b/lib/Persist.hs
index b4df1fb..3115ce3 100644
--- a/lib/Persist.hs
+++ b/lib/Persist.hs
@@ -6,19 +6,16 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
-
+-- | Data types that are or might yet be saved in the database, and possibly
+-- also a few little convenience functions for using persistent.
module Persist where
import Data.Aeson (FromJSON, ToJSON, ToJSONKey)
@@ -32,7 +29,7 @@ import Database.Persist.Sql (PersistFieldSql,
import Database.Persist.TH
import GTFS
import PersistOrphans
-import Servant (FromHttpApiData)
+import Servant (FromHttpApiData, ToHttpApiData)
import Conduit (ResourceT)
import Control.Monad.IO.Class (MonadIO (liftIO))
@@ -53,7 +50,8 @@ import Web.PathPieces (PathPiece)
newtype Token = Token UUID
deriving newtype
( Show, ToJSON, FromJSON, Eq, Ord, FromHttpApiData
- , ToJSONKey, PersistField, PersistFieldSql, PathPiece)
+ , ToJSONKey, PersistField, PersistFieldSql, PathPiece
+ , ToHttpApiData, Read )
instance ToSchema Token where
declareNamedSchema _ = declareNamedSchema (Proxy @String)
instance ToParamSchema Token where
@@ -62,14 +60,14 @@ instance ToParamSchema Token where
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
RunningTrip sql=tt_tracker_token
- Id UUID default=uuid_generate_v4()
+ Id Token default=uuid_generate_v4()
expires UTCTime
blocked Bool
tripNumber Text
deriving Eq Show Generic
TripPing json sql=tt_trip_ping
- token Token
+ token RunningTripId
latitude Double
longitude Double
delay Double
@@ -78,8 +76,10 @@ TripPing json sql=tt_trip_ping
|]
+instance ToSchema RunningTripId where
+ declareNamedSchema _ = declareNamedSchema (Proxy @UUID)
instance ToSchema TripPing where
declareNamedSchema = genericDeclareNamedSchema (swaggerOptions "ping")
-runSql :: MonadIO m => Pool SqlBackend -> (ReaderT SqlBackend (NoLoggingT (ResourceT IO)) a) -> m a
+runSql :: MonadIO m => Pool SqlBackend -> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) a -> m a
runSql pool = liftIO . flip runSqlPersistMPool pool