From 9e89c93b3b84b5c82c186cff62c33218a0a4d298 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Thu, 16 Jun 2022 00:25:15 +0200
Subject: actually use the database

(at least for a few simple things)

Also, more modules!
---
 lib/Persist.hs | 85 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 85 insertions(+)
 create mode 100644 lib/Persist.hs

(limited to 'lib/Persist.hs')

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