From 8feb2556eda0604b6710309bf7ffddb72c22fc4a Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Thu, 16 Jun 2022 01:06:04 +0200
Subject: foreign keys are a thing

(and they can be useful, too!)

Also, documentation & deleting imports / extensions that aren't used.
---
 lib/Persist.hs | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

(limited to 'lib/Persist.hs')

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
-- 
cgit v1.2.3