1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# 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)
import Data.Swagger (ToParamSchema (..), ToSchema (..),
genericDeclareNamedSchema)
import Data.Text (Text)
import Data.UUID (UUID)
import Database.Persist
import Database.Persist.Sql (PersistFieldSql,
runSqlPersistMPool)
import Database.Persist.TH
import GTFS
import PersistOrphans
import Servant (FromHttpApiData, ToHttpApiData)
import Conduit (ResourceT)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Logger (NoLoggingT)
import Control.Monad.Reader (ReaderT)
import Data.Data (Proxy (..))
import Data.Pool (Pool)
import Data.Time (NominalDiffTime,
UTCTime (utctDay), addUTCTime,
dayOfWeek, diffUTCTime,
getCurrentTime, nominalDay)
import Database.Persist.Postgresql (SqlBackend)
import GHC.Generics (Generic)
import Web.PathPieces (PathPiece)
newtype Token = Token UUID
deriving newtype
( Show, ToJSON, FromJSON, Eq, Ord, FromHttpApiData
, ToJSONKey, PersistField, PersistFieldSql, PathPiece
, ToHttpApiData, Read )
instance ToSchema Token where
declareNamedSchema _ = declareNamedSchema (Proxy @String)
instance ToParamSchema Token where
toParamSchema _ = toParamSchema (Proxy @String)
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
RunningTrip sql=tt_tracker_token
Id Token default=uuid_generate_v4()
expires UTCTime
blocked Bool
tripNumber Text
deriving Eq Show Generic
TripPing json sql=tt_trip_ping
token RunningTripId
latitude Double
longitude Double
delay Double
timestamp UTCTime
deriving Show Generic Eq
|]
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 pool = liftIO . flip runSqlPersistMPool pool
|
