aboutsummaryrefslogtreecommitdiff
path: root/lib/Persist.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Persist.hs')
-rw-r--r--lib/Persist.hs85
1 files changed, 85 insertions, 0 deletions
diff --git a/lib/Persist.hs b/lib/Persist.hs
new file mode 100644
index 0000000..b4df1fb
--- /dev/null
+++ b/lib/Persist.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# 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 #-}
+
+
+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)
+
+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)
+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 UUID default=uuid_generate_v4()
+ expires UTCTime
+ blocked Bool
+ tripNumber Text
+ deriving Eq Show Generic
+
+TripPing json sql=tt_trip_ping
+ token Token
+ latitude Double
+ longitude Double
+ delay Double
+ timestamp UTCTime
+ deriving Show Generic Eq
+
+|]
+
+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