content: {-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts, AllowAmbiguousTypes, UndecidableInstances, FlexibleInstances, IncoherentInstances, DataKinds, PolyKinds, TypeApplications, ScopedTypeVariables, ConstraintKinds, TypeOperators, GADTs, GeneralizedNewtypeDeriving, CPP #-}
  
  module IHP.ModelSupport
  ( module IHP.ModelSupport
  , module IHP.Postgres.Point
  , module IHP.Postgres.Polygon
  , module IHP.Postgres.Inet
  , module IHP.Postgres.TSVector
  , module IHP.Postgres.TimeParser
  ) where
  
  import IHP.HaskellSupport
  import IHP.NameSupport
  import ClassyPrelude hiding (UTCTime, find, ModifiedJulianDay)
  import Database.PostgreSQL.Simple (Connection)
  import Database.PostgreSQL.Simple.Types (Query)
  import Database.PostgreSQL.Simple.FromField hiding (Field, name)
  import Database.PostgreSQL.Simple.ToField
  import Data.Default
  import Data.Time.Format.ISO8601 (iso8601Show)
  import Data.String.Conversions (cs ,ConvertibleStrings)
  import Data.Time.Clock
  import Data.Time.LocalTime
  import Data.Time.Calendar
  import Data.UUID
  import qualified Database.PostgreSQL.Simple as PG
  import qualified Database.PostgreSQL.Simple.Types as PG
  import qualified Database.PostgreSQL.Simple.FromRow as PGFR
  import qualified Database.PostgreSQL.Simple.ToField as PG
  import qualified Database.PostgreSQL.Simple.ToRow as PG
  import GHC.Records
  import GHC.TypeLits
  import GHC.Types
  import Data.Proxy
  import Data.Data
  import Data.Aeson (ToJSON (..), FromJSON (..))
  import qualified Data.Aeson as Aeson
  import qualified Data.Set as Set
  import qualified Text.Read as Read
  import qualified Data.Pool as Pool
  import IHP.Postgres.Point
  import IHP.Postgres.Interval ()
  import IHP.Postgres.Polygon
  import IHP.Postgres.Inet ()
  import IHP.Postgres.TSVector
  import IHP.Postgres.TimeParser
  import IHP.Log.Types
  import qualified IHP.Log as Log
  import Data.Dynamic
  import Data.Scientific
  import GHC.Stack
  import qualified Numeric
  import qualified Data.Text.Encoding as Text
  import qualified Data.ByteString.Builder as Builder
  
  -- | Provides the db connection and some IHP-specific db configuration
  data ModelContext = ModelContext
      { connectionPool :: Pool.Pool Connection -- ^ Used to get database connections when no 'transactionConnection' is set
      , transactionConnection :: Maybe Connection -- ^ Set to a specific database connection when executing a database transaction
      -- | Logs all queries to this logger at log level info
      , logger :: Logger
      -- | A callback that is called whenever a specific table is accessed using a SELECT query
      , trackTableReadCallback :: Maybe (ByteString -> IO ())
      -- | Is set to a value if row level security was enabled at runtime
      , rowLevelSecurity :: Maybe RowLevelSecurityContext
      }
  
  -- | When row level security is enabled at runtime, this keeps track of the current
  -- logged in user and the postgresql role to switch to.
  data RowLevelSecurityContext = RowLevelSecurityContext
      { rlsAuthenticatedRole :: Text -- ^ Default is @ihp_authenticated@. This value comes from the @IHP_RLS_AUTHENTICATED_ROLE@  env var.
      , rlsUserId :: PG.Action -- ^ The user id of the current logged in user
      }
  
  -- | Provides a mock ModelContext to be used when a database connection is not available
  notConnectedModelContext :: Logger -> ModelContext
  notConnectedModelContext logger = ModelContext
      { connectionPool = error "Not connected"
      , transactionConnection = Nothing
      , logger = logger
      , trackTableReadCallback = Nothing
      , rowLevelSecurity = Nothing
      }
  
  createModelContext :: NominalDiffTime -> Int -> ByteString -> Logger -> IO ModelContext
  createModelContext idleTime maxConnections databaseUrl logger = do
      let poolConfig = Pool.defaultPoolConfig (PG.connectPostgreSQL databaseUrl) PG.close (realToFrac idleTime) maxConnections
      connectionPool <- Pool.newPool poolConfig
  
      let trackTableReadCallback = Nothing
      let transactionConnection = Nothing
      let rowLevelSecurity = Nothing
      pure ModelContext { .. }
  
  type family GetModelById id :: Type where
      GetModelById (Maybe (Id' tableName)) = Maybe (GetModelByTableName tableName)
      GetModelById (Id' tableName) = GetModelByTableName tableName
  type family GetTableName model :: Symbol
  type family GetModelByTableName (tableName :: Symbol) :: Type
  
  class CanCreate a where
      create :: (?modelContext :: ModelContext) => a -> IO a
      createMany :: (?modelContext :: ModelContext) => [a] -> IO [a]
      
      -- | Like 'createRecord' but doesn't return the created record
      createRecordDiscardResult :: (?modelContext :: ModelContext) => a -> IO ()
      createRecordDiscardResult record = do
          _ <- createRecord record
          pure ()
  
  class CanUpdate a where
      updateRecord :: (?modelContext :: ModelContext) => a -> IO a
  
      -- | Like 'updateRecord' but doesn't return the updated record
      updateRecordDiscardResult :: (?modelContext :: ModelContext) => a -> IO ()
      updateRecordDiscardResult record = do
          _ <- updateRecord record
          pure ()
  
  {-# INLINE createRecord #-}
  createRecord :: (?modelContext :: ModelContext, CanCreate model) => model -> IO model
  createRecord = create
  
  class InputValue a where
      inputValue :: a -> Text
  
  instance InputValue Text where
      inputValue text = text
  
  instance InputValue Int where
      inputValue = tshow
  
  instance InputValue Integer where
      inputValue = tshow
  
  instance InputValue Double where
      inputValue double = cs (Numeric.showFFloat Nothing double "")
  
  instance InputValue Float where
      inputValue float = cs (Numeric.showFFloat Nothing float "")
  
  instance InputValue Bool where
      inputValue True = "on"
      inputValue False = "off"
  
  instance InputValue Data.UUID.UUID where
      inputValue = Data.UUID.toText
  
  instance InputValue () where
      inputValue () = "error: inputValue(()) not supported"
  
  instance InputValue UTCTime where
      inputValue time = cs (iso8601Show time)
  
  instance InputValue LocalTime where
      inputValue time = cs (iso8601Show time)
  
  instance InputValue Day where
      inputValue date = cs (iso8601Show date)
  
  instance InputValue TimeOfDay where
      inputValue timeOfDay = tshow timeOfDay
  
  instance InputValue PGInterval where
      inputValue (PGInterval pgInterval) = tshow pgInterval
  
  instance InputValue fieldType => InputValue (Maybe fieldType) where
      inputValue (Just value) = inputValue value
      inputValue Nothing = ""
  
  instance InputValue value => InputValue [value] where
      inputValue list = list |> map inputValue |> intercalate ","
  
  instance InputValue Aeson.Value where
      inputValue json = json |> Aeson.encode |> cs
  
  instance InputValue Scientific where
      inputValue = tshow
  
  instance Default Text where
      {-# INLINE def #-}
      def = ""
  
  #if !MIN_VERSION_data_default(0,8,0)
  instance Default Bool where
      {-# INLINE def #-}
      def = False
  #endif
  
  instance Default Point where
      def = Point def def
  
  instance Default Polygon where
      def = Polygon [def]
  
  instance Default TSVector where
      def = TSVector def
  
  instance Default Scientific where
      def = 0
  
  type FieldName = ByteString
  
  -- | Returns @True@ when the record has not been saved to the database yet. Returns @False@ otherwise.
  --
  -- __Example:__ Returns @True@ when a record has not been inserted yet.
  --
  -- >>> let project = newRecord @Project
  -- >>> isNew project
  -- True
  --
  -- __Example:__ Returns @False@ after inserting a record.
  --
  -- >>> project <- createRecord project
  -- >>> isNew project
  -- False
  --
  -- __Example:__ Returns @False@ for records which have been fetched from the database.
  --
  -- >>> book <- query @Book |> fetchOne
  -- >>> isNew book
  -- False
  isNew :: forall model. (HasField "meta" model MetaBag) => model -> Bool
  isNew model = isNothing model.meta.originalDatabaseRecord
  {-# INLINABLE isNew #-}
  
  type family GetModelName model :: Symbol
  
  -- | Provides the primary key type for a given table. The instances are usually declared
  -- by the generated haskell code in Generated.Types
  --
  -- __Example:__ Defining the primary key for a users table
  --
  -- > type instance PrimaryKey "users" = UUID
  --
  --
  -- __Example:__ Defining the primary key for a table with a SERIAL pk
  --
  -- > type instance PrimaryKey "projects" = Int
  --
  type family PrimaryKey (tableName :: Symbol)
  
  -- | Returns the model name of a given model as Text
  --
  -- __Example:__
  --
  -- >>> modelName @User
  -- "User"
  --
  -- >>> modelName @Project
  -- "Project"
  getModelName :: forall model. KnownSymbol (GetModelName model) => Text
  getModelName = cs $! symbolVal (Proxy :: Proxy (GetModelName model))
  {-# INLINE getModelName #-}
  
  newtype Id' table = Id (PrimaryKey table)
  
  deriving instance (Eq (PrimaryKey table)) => Eq (Id' table)
  deriving instance (Ord (PrimaryKey table)) => Ord (Id' table)
  deriving instance (Hashable (PrimaryKey table)) => Hashable (Id' table)
  deriving instance (KnownSymbol table, Data (PrimaryKey table)) => Data (Id' table)
  deriving instance (KnownSymbol table, NFData (PrimaryKey table)) => NFData (Id' table)
  
  -- | We need to map the model to its table name to prevent infinite recursion in the model data definition
  -- E.g. `type Project = Project' { id :: Id Project }` will not work
  -- But `type Project = Project' { id :: Id "projects" }` will
  type Id model = Id' (GetTableName model)
  
  instance InputValue (PrimaryKey model') => InputValue (Id' model') where
      {-# INLINE inputValue #-}
      inputValue = inputValue . unpackId
  
  instance IsEmpty (PrimaryKey table) => IsEmpty (Id' table) where
      isEmpty (Id primaryKey) = isEmpty primaryKey
  
  recordToInputValue :: (HasField "id" entity (Id entity), Show (PrimaryKey (GetTableName entity))) => entity -> Text
  recordToInputValue entity =
      entity.id
      |> unpackId
      |> tshow
  {-# INLINE recordToInputValue #-}
  
  instance FromField (PrimaryKey model) => FromField (Id' model) where
      {-# INLINE fromField #-}
      fromField value metaData = do
          fieldValue <- fromField value metaData
          pure (Id fieldValue)
  
  instance ToField (PrimaryKey model) => ToField (Id' model) where
      {-# INLINE toField #-}
      toField = toField . unpackId
  
  instance Show (PrimaryKey model) => Show (Id' model) where
      {-# INLINE show #-}
      show = show . unpackId
  
  -- | Turns an @UUID@ into a @Id@ type
  --
  -- > let uuid :: UUID = "5240e79c-97ff-4a5f-8567-84112541aaba"
  -- > let userId :: Id User = packId uuid
  --
  packId :: PrimaryKey model -> Id' model
  packId uuid = Id uuid
  
  -- | Unwraps a @Id@ value into an @UUID@
  --
  -- >>> unpackId ("296e5a50-b237-4ee9-83b0-17fb1e6f208f" :: Id User)
  -- "296e5a50-b237-4ee9-83b0-17fb1e6f208f" :: UUID
  --
  unpackId :: Id' model -> PrimaryKey model
  unpackId (Id uuid) = uuid
  
  -- | Record type for objects of model types labeled with values from different database tables. (e.g. comments labeled with the IDs of the posts they belong to).
  data LabeledData a b = LabeledData { labelValue :: a, contentValue :: b }
      deriving (Show)
  
  instance (FromField label, PG.FromRow a) => PGFR.FromRow (LabeledData label a) where
      fromRow = LabeledData <$> PGFR.field <*> PGFR.fromRow
  
  -- | Sometimes you have a hardcoded UUID value which represents some record id. This instance allows you
  -- to write the Id like a string:
  --
  -- > let projectId = "ca63aace-af4b-4e6c-bcfa-76ca061dbdc6" :: Id Project
  instance (Read (PrimaryKey model), ParsePrimaryKey (PrimaryKey model)) => IsString (Id' model) where
      fromString uuid = textToId uuid
      {-# INLINE fromString #-}
  
  class ParsePrimaryKey primaryKey where
      parsePrimaryKey :: Text -> Maybe primaryKey
  
  instance ParsePrimaryKey UUID where
      parsePrimaryKey = Read.readMaybe . cs
  
  instance ParsePrimaryKey Text where
      parsePrimaryKey text = Just text
  
  -- | Transforms a text, bytestring or string into an Id. Throws an exception if the input is invalid.
  --
  -- __Example:__
  --
  -- > let projectIdText = "7cbc76e2-1c4f-49b6-a7d9-5015e7575a9b" :: Text
  -- > let projectId = (textToId projectIdText) :: Id Project
  --
  -- In case your UUID value is hardcoded, there is also an 'IsString' instance, so you
  -- can just write it like:
  --
  -- > let projectId = "ca63aace-af4b-4e6c-bcfa-76ca061dbdc6" :: Id Project
  textToId :: (HasCallStack, ParsePrimaryKey (PrimaryKey model), ConvertibleStrings text Text) => text -> Id' model
  textToId text = case parsePrimaryKey (cs text) of
          Just id -> Id id
          Nothing -> error (cs $ "Unable to convert " <> (cs text :: Text) <> " to Id value. Is it a valid uuid?")
  {-# INLINE textToId #-}
  
  -- | Measure and log the query time for a given query action if the log level is Debug.
  -- If the log level is greater than debug, just perform the query action without measuring time.
  measureTimeIfLogging :: (?modelContext :: ModelContext, PG.ToRow q) => Text -> PG.Connection -> IO a -> Query -> q -> IO a
  measureTimeIfLogging logPrefix connection queryAction theQuery theParameters = do
      let currentLogLevel = ?modelContext.logger.level
      if currentLogLevel == Debug
          then do
              start <- getCurrentTime
              queryAction `finally` do
                  end <- getCurrentTime
                  let theTime = end `diffUTCTime` start
                  logQuery logPrefix connection theQuery theParameters theTime
          else queryAction
  
  -- | Runs a raw sql query
  --
  -- __Example:__
  --
  -- > users <- sqlQuery "SELECT id, firstname, lastname FROM users" ()
  --
  -- Take a look at "IHP.QueryBuilder" for a typesafe approach on building simple queries.
  --
  -- *AutoRefresh:* When using 'sqlQuery' with AutoRefresh, you need to use 'trackTableRead' to let AutoRefresh know that you have accessed a certain table. Otherwise AutoRefresh will not watch table of your custom sql query.
  --
  -- Use 'sqlQuerySingleRow' if you expect only a single row to be returned.
  --
  sqlQuery :: (?modelContext :: ModelContext, PG.ToRow q, PG.FromRow r) => Query -> q -> IO [r]
  sqlQuery theQuery theParameters = do
      withDatabaseConnection \connection -> enhanceSqlError theQuery theParameters do
          withRLSParams (\theQuery theParameters -> measureTimeIfLogging "🔍" connection (PG.query connection theQuery theParameters) theQuery theParameters) theQuery theParameters
  {-# INLINABLE sqlQuery #-}
  
  
  -- | Runs a raw sql query, that is expected to return a single result row
  --
  -- Like 'sqlQuery', but useful when you expect only a single row as the result
  --
  -- __Example:__
  --
  -- > user <- sqlQuerySingleRow "SELECT id, firstname, lastname FROM users WHERE id = ?" (Only user.id)
  --
  -- Take a look at "IHP.QueryBuilder" for a typesafe approach on building simple queries.
  --
  -- *AutoRefresh:* When using 'sqlQuerySingleRow' with AutoRefresh, you need to use 'trackTableRead' to let AutoRefresh know that you have accessed a certain table. Otherwise AutoRefresh will not watch table of your custom sql query.
  --
  sqlQuerySingleRow :: (?modelContext :: ModelContext, PG.ToRow query, PG.FromRow record) => Query -> query -> IO record
  sqlQuerySingleRow theQuery theParameters = do
      result <- sqlQuery theQuery theParameters
      case result of
          [] -> error ("sqlQuerySingleRow: Expected a single row to be returned. Query: " <> show theQuery)
          [record] -> pure record
          otherwise -> error ("sqlQuerySingleRow: Expected a single row to be returned. But got " <> show (length otherwise) <> " rows")
  {-# INLINABLE sqlQuerySingleRow #-}
  
  -- | Runs a sql statement (like a CREATE statement)
  --
  -- __Example:__
  --
  -- > sqlExec "CREATE TABLE users ()" ()
  sqlExec :: (?modelContext :: ModelContext, PG.ToRow q) => Query -> q -> IO Int64
  sqlExec theQuery theParameters = do
      withDatabaseConnection \connection -> enhanceSqlError theQuery theParameters do
          withRLSParams (\theQuery theParameters -> measureTimeIfLogging "💾" connection (PG.execute connection theQuery theParameters) theQuery theParameters) theQuery theParameters
  {-# INLINABLE sqlExec #-}
  
  -- | Runs a sql statement (like a CREATE statement), but doesn't return any result
  --
  -- __Example:__
  --
  -- > sqlExecDiscardResult "CREATE TABLE users ()" ()
  sqlExecDiscardResult :: (?modelContext :: ModelContext, PG.ToRow q) => Query -> q -> IO ()
  sqlExecDiscardResult theQuery theParameters = do
      _ <- sqlExec theQuery theParameters
      pure ()
  {-# INLINABLE sqlExecDiscardResult #-}
  
  -- | Wraps the query with Row level security boilerplate, if a row level security context was provided
  --
  -- __Example:__
  --
  -- If a row level security context is given, this will turn a query like the following
  --
  -- > withRLSParams runQuery "SELECT * FROM projects WHERE id = ?" (Only "..")
  --
  -- Into the following equivalent:
  --
  -- > runQuery "SET LOCAL ROLE ?; SET LOCAL rls.ihp_user_id = ?; SELECT * FROM projects WHERE id = ?" ["ihp_authenticated", "<user id>", .."]
  --
  withRLSParams :: (?modelContext :: ModelContext, PG.ToRow params) => (PG.Query -> [PG.Action] -> result) -> PG.Query -> params -> result
  withRLSParams runQuery query params = do
      case ?modelContext.rowLevelSecurity of
          Just RowLevelSecurityContext { rlsAuthenticatedRole, rlsUserId } -> do
              let query' = "SET LOCAL ROLE ?; SET LOCAL rls.ihp_user_id = ?; " <> query
              let params' = [PG.toField (PG.Identifier rlsAuthenticatedRole), PG.toField rlsUserId] <> PG.toRow params
              runQuery query' params'
          Nothing -> runQuery query (PG.toRow params)
  
  withDatabaseConnection :: (?modelContext :: ModelContext) => (Connection -> IO a) -> IO a
  withDatabaseConnection block =
      let
          ModelContext { connectionPool, transactionConnection, rowLevelSecurity } = ?modelContext
      in case transactionConnection of
          Just transactionConnection -> block transactionConnection
          Nothing -> Pool.withResource connectionPool block
  {-# INLINABLE withDatabaseConnection #-}
  
  -- | Runs a raw sql query which results in a single scalar value such as an integer or string
  --
  -- __Example:__
  --
  -- > usersCount <- sqlQueryScalar "SELECT COUNT(*) FROM users"
  --
  -- Take a look at "IHP.QueryBuilder" for a typesafe approach on building simple queries.
  sqlQueryScalar :: (?modelContext :: ModelContext) => (PG.ToRow q, FromField value) => Query -> q -> IO value
  sqlQueryScalar theQuery theParameters = do
      result <- sqlQuery theQuery theParameters
      pure case result of
          [PG.Only result] -> result
          _ -> error "sqlQueryScalar: Expected a scalar result value"
  {-# INLINABLE sqlQueryScalar #-}
  
  -- | Runs a raw sql query which results in a single scalar value such as an integer or string, or nothing
  --
  -- __Example:__
  --
  -- > usersCount <- sqlQueryScalarOrNothing "SELECT COUNT(*) FROM users"
  --
  -- Take a look at "IHP.QueryBuilder" for a typesafe approach on building simple queries.
  sqlQueryScalarOrNothing :: (?modelContext :: ModelContext) => (PG.ToRow q, FromField value) => Query -> q -> IO (Maybe value)
  sqlQueryScalarOrNothing theQuery theParameters = do
      result <- sqlQuery theQuery theParameters
      pure case result of
          [] -> Nothing
          [PG.Only result] -> Just result
          _ -> error "sqlQueryScalarOrNothing: Expected a scalar result value or an empty result set"
  {-# INLINABLE sqlQueryScalarOrNothing #-}
  
  -- | Executes the given block with a database transaction
  --
  -- __Example:__
  --
  -- > withTransaction do
  -- >    company <- newRecord @Company |> createRecord
  -- >
  -- >    -- When creating the user fails, there will be no company left over
  -- >    user <- newRecord @User
  -- >        |> set #companyId company.id
  -- >        |> createRecord
  -- >
  -- >    company <- company
  -- >        |> set #ownerId user.id
  -- >        |> updateRecord
  withTransaction :: (?modelContext :: ModelContext) => ((?modelContext :: ModelContext) => IO a) -> IO a
  withTransaction block = withTransactionConnection do
      let connection = ?modelContext.transactionConnection
              |> \case
                  Just connection -> connection
                  Nothing -> error "withTransaction: transactionConnection not set as expected"
      PG.withTransaction connection block
  {-# INLINABLE withTransaction #-}
  
  -- | Executes the given block with the main database role and temporarly sidesteps the row level security policies.
  --
  -- This is used e.g. by IHP AutoRefresh to be able to set up it's database triggers. When trying to set up a database
  -- trigger from the ihp_authenticated role, it typically fails because it's missing permissions. Using 'withRowLevelSecurityDisabled'
  -- we switch to the main role which is allowed to set up database triggers.
  --
  -- SQL queries run from within the passed block are executed in their own transaction.
  --
  -- __Example:__
  --
  -- > -- SQL code executed here might be run from the ihp_authenticated role
  -- > withRowLevelSecurityDisabled do
  -- >    -- SQL code executed here is run as the main IHP db role
  -- >    sqlExec "CREATE OR REPLACE FUNCTION .." ()
  --
  withRowLevelSecurityDisabled :: (?modelContext :: ModelContext) => ((?modelContext :: ModelContext) => IO a) -> IO a
  withRowLevelSecurityDisabled block = do
      let currentModelContext = ?modelContext
      let ?modelContext = currentModelContext { rowLevelSecurity = Nothing } in block
  {-# INLINABLE withRowLevelSecurityDisabled #-}
  
  -- | Returns the postgres connection when called within a 'withTransaction' block
  --
  -- Throws an error if called from outside a 'withTransaction'
  transactionConnectionOrError :: (?modelContext :: ModelContext) => Connection
  transactionConnectionOrError = ?modelContext.transactionConnection
              |> \case
                  Just connection -> connection
                  Nothing -> error "getTransactionConnectionOrError: Not in a transaction state"
  
  commitTransaction :: (?modelContext :: ModelContext) => IO ()
  commitTransaction = PG.commit transactionConnectionOrError
  {-# INLINABLE commitTransaction #-}
  
  rollbackTransaction :: (?modelContext :: ModelContext) => IO ()
  rollbackTransaction = PG.rollback transactionConnectionOrError
  {-# INLINABLE rollbackTransaction #-}
  
  withTransactionConnection :: (?modelContext :: ModelContext) => ((?modelContext :: ModelContext) => IO a) -> IO a
  withTransactionConnection block = do
      let ModelContext { connectionPool } = ?modelContext
      Pool.withResource connectionPool \connection -> do
          let modelContext = ?modelContext { transactionConnection = Just connection }
          let ?modelContext = modelContext in block
  {-# INLINABLE withTransactionConnection #-}
  
  -- | Access meta data for a database table
  class
      ( KnownSymbol (GetTableName record)
      ) => Table record where
      -- | Returns the table name of a given model.
      --
      -- __Example:__
      --
      -- >>> tableName @User
      -- "users"
      --
  
      tableName :: Text
      tableName = symbolToText @(GetTableName record)
      {-# INLINE tableName #-}
  
      -- | Returns the table name of a given model as a bytestring.
      --
      -- __Example:__
      --
      -- >>> tableNameByteString @User
      -- "users"
      --
      tableNameByteString :: ByteString
      tableNameByteString = Text.encodeUtf8 (tableName @record)
      {-# INLINE tableNameByteString #-}
  
      -- | Returns the list of column names for a given model
      --
      -- __Example:__
      --
      -- >>> columnNames @User
      -- ["id", "email", "created_at"]
      --
      columnNames :: [ByteString]
  
      -- | Returns the list of column names, that are contained in the primary key for a given model
      --
      -- __Example:__
      --
      -- >>> primaryKeyColumnNames @User
      -- ["id"]
      --
      -- >>> primaryKeyColumnNames @PostTagging
      -- ["post_id", "tag_id"]
      --
      primaryKeyColumnNames :: [ByteString]
  
      -- | Returns the parameters for a WHERE conditions to match an entity by it's primary key, given the entities id
      --
      -- For tables with a simple primary key this simply the id:
      --
      -- >>> primaryKeyConditionForId project.id
      -- Plain "d619f3cf-f355-4614-8a4c-e9ea4f301e39"
      --
      -- If the table has a composite primary key, this returns multiple elements:
      --
      -- >>> primaryKeyConditionForId postTag.id
      -- Many [Plain "(", Plain "0ace9270-568f-4188-b237-3789aa520588", Plain ",", Plain "0b58fdf5-4bbb-4e57-a5b7-aa1c57148e1c", Plain ")"]
      -- 
      -- The order of the elements for a composite primary key must match the order of the columns returned by 'primaryKeyColumnNames'
      primaryKeyConditionForId :: Id record -> PG.Action
  
  -- | Returns ByteString, that represents the part of an SQL where clause, that matches on a tuple consisting of all the primary keys
  -- For table with simple primary keys this simply returns the name of the primary key column, without wrapping in a tuple
  -- >>> primaryKeyColumnSelector @PostTag
  -- "(post_tags.post_id, post_tags.tag_id)"
  -- >>> primaryKeyColumnSelector @Post
  -- "post_tags.post_id"
  primaryKeyConditionColumnSelector :: forall record. (Table record) => ByteString
  primaryKeyConditionColumnSelector = 
      let 
          qualifyColumnName col = tableNameByteString @record <> "." <> col
      in
      case primaryKeyColumnNames @record of
              [] -> error . cs $ "Impossible happened in primaryKeyConditionColumnSelector. No primary keys found for table " <> tableName @record <> ". At least one primary key is required."
              [s] -> qualifyColumnName s
              conds -> "(" <> intercalate ", " (map qualifyColumnName conds) <> ")"
  
  -- | Returns WHERE conditions to match an entity by it's primary key
  --
  -- For tables with a simple primary key this returns a tuple with the id:
  --
  -- >>> primaryKeyCondition project
  -- Plain "d619f3cf-f355-4614-8a4c-e9ea4f301e39"
  --
  -- If the table has a composite primary key, this returns multiple elements:
  --
  -- >>> primaryKeyCondition postTag
  -- Many [Plain "(", Plain "0ace9270-568f-4188-b237-3789aa520588", Plain ",", Plain "0b58fdf5-4bbb-4e57-a5b7-aa1c57148e1c", Plain ")"]
  primaryKeyCondition :: forall record. (HasField "id" record (Id record), Table record) => record -> PG.Action
  primaryKeyCondition record = primaryKeyConditionForId @record record.id
  
  logQuery :: (?modelContext :: ModelContext, PG.ToRow parameters) => Text -> PG.Connection -> Query -> parameters -> NominalDiffTime -> IO ()
  logQuery logPrefix connection query parameters time = do
          let ?context = ?modelContext
          -- NominalTimeDiff is represented as seconds, and doesn't provide a FormatTime option for printing in ms.
          -- To get around that we convert to and from a rational so we can format as desired.
          let queryTimeInMs = (time * 1000) |> toRational |> fromRational @Double |> round
          let formatRLSInfo userId = " { ihp_user_id = " <> userId <> " }"
          let rlsInfo = case ?context.rowLevelSecurity of
                  Just RowLevelSecurityContext { rlsUserId = PG.Plain rlsUserId } -> formatRLSInfo (cs (Builder.toLazyByteString rlsUserId))
                  Just RowLevelSecurityContext { rlsUserId = rlsUserId } -> formatRLSInfo (tshow rlsUserId)
                  Nothing -> ""
  
          formatted <- PG.formatQuery connection query parameters
          Log.debug (logPrefix <> " " <> cs formatted <> rlsInfo <> " (" <> tshow queryTimeInMs <> "ms)")
  {-# INLINABLE logQuery #-}
  
  -- | Runs a @DELETE@ query for a record.
  --
  -- >>> let project :: Project = ...
  -- >>> deleteRecord project
  -- DELETE FROM projects WHERE id = '..'
  --
  -- Use 'deleteRecords' if you want to delete multiple records.
  --
  deleteRecord :: forall record table. (?modelContext :: ModelContext, Table record, Show (PrimaryKey table), HasField "id" record (Id record), GetTableName record ~ table, record ~ GetModelByTableName table) => record -> IO ()
  deleteRecord record =
      deleteRecordById @record record.id
  {-# INLINABLE deleteRecord #-}
  
  -- | Like 'deleteRecord' but using an Id
  --
  -- >>> let project :: Id Project = ...
  -- >>> delete projectId
  -- DELETE FROM projects WHERE id = '..'
  --
  deleteRecordById :: forall record table. (?modelContext :: ModelContext, Table record, Show (PrimaryKey table), GetTableName record ~ table, record ~ GetModelByTableName table) => Id' table -> IO ()
  deleteRecordById id = do
      let theQuery = "DELETE FROM " <> tableNameByteString @record <> " WHERE " <> (primaryKeyConditionColumnSelector @record) <> " = ?"
      let theParameters = PG.Only $ primaryKeyConditionForId @record id
      sqlExec (PG.Query $! theQuery) theParameters
      pure ()
  {-# INLINABLE deleteRecordById #-}
  
  -- | Runs a @DELETE@ query for a list of records.
  --
  -- >>> let projects :: [Project] = ...
  -- >>> deleteRecords projects
  -- DELETE FROM projects WHERE id IN (..)
  deleteRecords :: forall record table. (?modelContext :: ModelContext, Show (PrimaryKey table), Table record, HasField "id" record (Id' table), GetTableName record ~ table, record ~ GetModelByTableName table) => [record] -> IO ()
  deleteRecords records =
      deleteRecordByIds @record (ids records)
  {-# INLINABLE deleteRecords #-}
  
  -- | Like 'deleteRecordById' but for a list of Ids.
  --
  -- >>> let projectIds :: [ Id Project ] = ...
  -- >>> delete projectIds
  -- DELETE FROM projects WHERE id IN ('..')
  --
  deleteRecordByIds :: forall record table. (?modelContext :: ModelContext, Show (PrimaryKey table), Table record, GetTableName record ~ table, record ~ GetModelByTableName table) => [Id' table] -> IO ()
  deleteRecordByIds ids = do
      let theQuery = "DELETE FROM " <> tableNameByteString @record <> " WHERE " <> (primaryKeyConditionColumnSelector @record) <> " IN ?"
      let theParameters = PG.Only $ PG.In $ map (primaryKeyConditionForId @record) ids
      sqlExec (PG.Query $! theQuery) theParameters
      pure ()
  {-# INLINABLE deleteRecordByIds #-}
  
  -- | Runs a @DELETE@ query to delete all rows in a table.
  --
  -- >>> deleteAll @Project
  -- DELETE FROM projects
  deleteAll :: forall record. (?modelContext :: ModelContext, Table record) => IO ()
  deleteAll = do
      let theQuery = "DELETE FROM " <> tableName @record
      sqlExec (PG.Query . cs $! theQuery) ()
      pure ()
  {-# INLINABLE deleteAll #-}
  
  type family Include (name :: GHC.Types.Symbol) model
  
  type family Include' (name :: [GHC.Types.Symbol]) model where
      Include' '[] model = model
      Include' (x:xs) model = Include' xs (Include x model)
  
  instance Default NominalDiffTime where
      def = 0
  
  instance Default TimeOfDay where
      def = TimeOfDay 0 0 0
  
  instance Default LocalTime where
      def = LocalTime def def
  
  instance Default Day where
      def = ModifiedJulianDay 0
  
  instance Default UTCTime where
      def = UTCTime def 0
  
  instance Default (PG.Binary ByteString) where
      def = PG.Binary ""
  
  instance Default PGInterval where
      def = PGInterval "00:00:00"
  
  class Record model where
      newRecord :: model
  
  -- | Helper type to deal with models where relations are included or that are only partially fetched
  -- Examples:
  --
  -- >>> NormalizeModel (Include "author_id" Post)
  -- Post
  --
  -- >>> NormalizeModel Post
  -- Post
  type NormalizeModel model = GetModelByTableName (GetTableName model)
  
  -- | Returns the ids for a list of models
  --
  -- Shorthand for @map (.id) records@.
  --
  -- >>> users <- query @User |> fetch
  -- >>> ids users
  -- [227fbba3-0578-4eb8-807d-b9b692c3644f, 9d7874f2-5343-429b-bcc4-8ee62a5a6895, ...] :: [Id User]
  ids :: (HasField "id" record id) => [record] -> [id]
  ids records = map (.id) records
  {-# INLINE ids #-}
  
  -- | The error message of a validator can be either a plain text value or a HTML formatted value
  data Violation
      = TextViolation { message :: !Text } -- ^ Plain text validation error, like "cannot be empty"
      | HtmlViolation { message :: !Text } -- ^ HTML formatted, already pre-escaped validation error, like "Invalid, please <a href="http://example.com">check the documentation</a>"
      deriving (Eq, Show)
  
  -- | Every IHP database record has a magic @meta@ field which keeps a @MetaBag@ inside. This data structure is used e.g. to keep track of the validation errors that happend.
  data MetaBag = MetaBag
      { annotations            :: ![(Text, Violation)] -- ^ Stores validation failures, as a list of (field name, error) pairs. E.g. @annotations = [ ("name", TextViolation "cannot be empty") ]@
      , touchedFields          :: ![Text] -- ^ Whenever a 'set' is callled on a field, it will be marked as touched. Only touched fields are saved to the database when you call 'updateRecord'
      , originalDatabaseRecord :: Maybe Dynamic -- ^ When the record has been fetched from the database, we save the initial database record here. This is used by 'didChange' to check if a field value is different from the initial database value.
      } deriving (Show)
  
  instance Eq MetaBag where
      MetaBag { annotations, touchedFields } == MetaBag { annotations = annotations', touchedFields = touchedFields' } = annotations == annotations' && touchedFields == touchedFields'
  
  instance Default MetaBag where
      def = MetaBag { annotations = [], touchedFields = [], originalDatabaseRecord = Nothing }
      {-# INLINE def #-}
  
  instance SetField "annotations" MetaBag [(Text, Violation)] where
      setField value meta = meta { annotations = value }
      {-# INLINE setField #-}
  
  instance SetField "touchedFields" MetaBag [Text] where
      setField value meta = meta { touchedFields = value }
      {-# INLINE setField #-}
  
  -- | Returns 'True' if any fields of the record have unsaved changes
  --
  -- __Example:__ Returns 'False' for freshly fetched records
  --
  -- >>> let projectId = "227fbba3-0578-4eb8-807d-b9b692c3644f" :: Id Project
  -- >>> project <- fetch projectId
  -- >>> didChangeRecord project
  -- False
  --
  -- __Example:__ Returns 'True' after setting a field
  --
  -- >>> let projectId = "227fbba3-0578-4eb8-807d-b9b692c3644f" :: Id Project
  -- >>> project <- fetch projectId
  -- >>> project |> set #name "New Name" |> didChangeRecord
  -- True
  didChangeRecord :: (HasField "meta" record MetaBag) => record -> Bool
  didChangeRecord record = isEmpty record.meta.touchedFields
  
  -- | Returns 'True' if the specific field of the record has unsaved changes
  --
  -- __Example:__ Returns 'False' for freshly fetched records
  --
  -- >>> let projectId = "227fbba3-0578-4eb8-807d-b9b692c3644f" :: Id Project
  -- >>> project <- fetch projectId
  -- >>> didChange #name project
  -- False
  --
  -- __Example:__ Returns 'True' after setting a field
  --
  -- >>> let projectId = "227fbba3-0578-4eb8-807d-b9b692c3644f" :: Id Project
  -- >>> project <- fetch projectId
  -- >>> project |> set #name "New Name" |> didChange #name
  -- True
  --
  -- __Example:__ Setting a flash message after updating the profile picture
  --
  -- > when (user |> didChange #profilePictureUrl) (setSuccessMessage "Your Profile Picture has been updated. It might take a few minutes until it shows up everywhere")
  didChange :: forall fieldName fieldValue record. (KnownSymbol fieldName, HasField fieldName record fieldValue, HasField "meta" record MetaBag, Eq fieldValue, Typeable record) => Proxy fieldName -> record -> Bool
  didChange field record = didTouchField field record && didChangeField
      where
          didChangeField :: Bool
          didChangeField = originalFieldValue /= fieldValue
  
          fieldValue :: fieldValue
          fieldValue = record |> getField @fieldName
  
          originalFieldValue :: fieldValue
          originalFieldValue =
              record.meta.originalDatabaseRecord
              |> fromMaybe (error "didChange called on a record without originalDatabaseRecord")
              |> fromDynamic @record
              |> fromMaybe (error "didChange failed to retrieve originalDatabaseRecord")
              |> getField @fieldName
  
  -- | Returns 'True' if 'set' was called on that field
  --
  -- __Example:__ Returns 'False' for freshly fetched records
  --
  -- >>> let projectId = "227fbba3-0578-4eb8-807d-b9b692c3644f" :: Id Project
  -- >>> project <- fetch projectId
  -- >>> didTouchField #name project
  -- False
  --
  -- __Example:__ Returns 'True' after setting a field
  --
  -- >>> let projectId = "227fbba3-0578-4eb8-807d-b9b692c3644f" :: Id Project
  -- >>> project <- fetch projectId
  -- >>> project |> set #name project.name |> didTouchField #name
  -- True
  --
  didTouchField :: forall fieldName fieldValue record. (KnownSymbol fieldName, HasField fieldName record fieldValue, HasField "meta" record MetaBag, Eq fieldValue, Typeable record) => Proxy fieldName -> record -> Bool
  didTouchField field record =
      record.meta.touchedFields
      |> includes (symbolToText @fieldName)
  
  -- | Represents fields that have a default value in an SQL schema
  --
  --   The 'Default' constructor represents the default value from the schema,
  --   while the 'NonDefault' constructor holds some other value for the field
  data FieldWithDefault valueType = Default | NonDefault valueType deriving (Eq, Show)
  
  instance ToField valueType => ToField (FieldWithDefault valueType) where
    toField Default = Plain "DEFAULT"
    toField (NonDefault a) = toField a
  
  -- | Construct a 'FieldWithDefault'
  --
  --   Use the default SQL value when the field hasn't been touched since the
  --   record was created. This information is stored in the 'touchedFields'
  --   attribute of the 'meta' field.
  fieldWithDefault
    :: ( KnownSymbol name
       , HasField name model value
       , HasField "meta" model MetaBag
       )
    => Proxy name
    -> model
    -> FieldWithDefault value
  fieldWithDefault name model
    | cs (symbolVal name) `elem` model.meta.touchedFields =
      NonDefault (get name model)
    | otherwise = Default
  
  -- | Represents fields that may have been updated
  --
  --   The 'NoUpdate' constructor represents the existing value in the database,
  --   while the 'Update' constructor holds some new value for the field
  data FieldWithUpdate name value
    = NoUpdate (Proxy name)
    | Update value
    deriving (Eq, Show)
  
  instance (KnownSymbol name, ToField value) => ToField (FieldWithUpdate name value) where
    toField (NoUpdate name) =
      Plain (ClassyPrelude.fromString $ cs $ fieldNameToColumnName $ cs $ symbolVal name)
    toField (Update a) = toField a
  
  -- | Construct a 'FieldWithUpdate'
  --
  --   Use the current database value when the field hasn't been touched since the
  --   record was accessed. This information is stored in the 'touchedFields'
  --   attribute of the 'meta' field.
  fieldWithUpdate
    :: ( KnownSymbol name
      , HasField name model value
      , HasField "meta" model MetaBag
      )
    => Proxy name
    -> model
    -> FieldWithUpdate name value
  fieldWithUpdate name model
    | cs (symbolVal name) `elem` model.meta.touchedFields =
      Update (get name model)
    | otherwise = NoUpdate name
  
  instance (ToJSON (PrimaryKey a)) => ToJSON (Id' a) where
    toJSON (Id a) = toJSON a
  
  instance (FromJSON (PrimaryKey a)) => FromJSON (Id' a) where
      parseJSON value = Id <$> parseJSON value
  
  -- | Thrown by 'fetchOne' when the query result is empty
  data RecordNotFoundException
      = RecordNotFoundException { queryAndParams :: (ByteString, [Action]) }
      deriving (Show)
  
  instance Exception RecordNotFoundException
  
  -- | Whenever calls to 'Database.PostgreSQL.Simple.query' or 'Database.PostgreSQL.Simple.execute'
  -- raise an 'Database.PostgreSQL.Simple.SqlError' exception, we wrap that exception in this data structure.
  -- This allows us to show the actual database query that has triggered the error.
  data EnhancedSqlError
      = EnhancedSqlError
      { sqlErrorQuery :: Query
      , sqlErrorQueryParams :: [Action]
      , sqlError :: PG.SqlError
      } deriving (Show)
  
  -- | Catches 'SqlError' and wraps them in 'EnhancedSqlError'
  enhanceSqlError :: PG.ToRow parameters => Query -> parameters -> IO a -> IO a
  enhanceSqlError sqlErrorQuery sqlErrorQueryParams block = catch block (\sqlError -> throwIO EnhancedSqlError { sqlErrorQuery, sqlErrorQueryParams = PG.toRow sqlErrorQueryParams, sqlError })
  {-# INLINE enhanceSqlError #-}
  
  instance Exception EnhancedSqlError
  
  instance Default Aeson.Value where
      def = Aeson.Null
  
  -- | This instance allows us to avoid wrapping lists with PGArray when
  -- using sql types such as @INT[]@
  instance ToField value => ToField [value] where
      toField list = toField (PG.PGArray list)
  
  -- | This instancs allows us to avoid wrapping lists with PGArray when
  -- using sql types such as @INT[]@
  instance (FromField value, Typeable value) => FromField [value] where
      fromField field value = PG.fromPGArray <$> (fromField field value)
  
  -- | Useful to manually mark a table read when doing a custom sql query inside AutoRefresh or 'withTableReadTracker'.
  --
  -- When using 'fetch' on a query builder, this function is automatically called. That's why you only need to call
  -- it yourself when using 'sqlQuery' to run a custom query.
  --
  -- __Example:__
  --
  -- > action MyAction = autoRefresh do
  -- >     users <- sqlQuery "SELECT * FROM users WHERE .."
  -- >     trackTableRead "users"
  -- >
  -- >     render MyView { .. }
  --
  --
  trackTableRead :: (?modelContext :: ModelContext) => ByteString -> IO ()
  trackTableRead tableName = case ?modelContext.trackTableReadCallback of
      Just callback -> callback tableName
      Nothing -> pure ()
  {-# INLINABLE trackTableRead #-}
  
  -- | Track all tables in SELECT queries executed within the given IO action.
  --
  -- You can read the touched tables by this function by accessing the variable @?touchedTables@ inside your given IO action.
  --
  -- __Example:__
  --
  -- > withTableReadTracker do
  -- >     project <- query @Project |> fetchOne
  -- >     user <- query @User |> fetchOne
  -- >
  -- >     tables <- readIORef ?touchedTables
  -- >     -- tables = Set.fromList ["projects", "users"]
  -- >
  withTableReadTracker :: (?modelContext :: ModelContext) => ((?modelContext :: ModelContext, ?touchedTables :: IORef (Set ByteString)) => IO ()) -> IO ()
  withTableReadTracker trackedSection = do
      touchedTablesVar <- newIORef Set.empty
      let trackTableReadCallback = Just \tableName -> modifyIORef' touchedTablesVar (Set.insert tableName)
      let oldModelContext = ?modelContext
      let ?modelContext = oldModelContext { trackTableReadCallback }
      let ?touchedTables = touchedTablesVar
      trackedSection
  
  
  -- | Shorthand filter function
  --
  -- In IHP code bases you often write filter functions such as these:
  --
  -- > getUserPosts user posts =
  -- >     filter (\p -> p.userId == user.id) posts
  --
  -- This can be written in a shorter way using 'onlyWhere':
  --
  -- > getUserPosts user posts =
  -- >     posts |> onlyWhere #userId user.id
  --
  -- Because the @userId@ field is an Id, we can use 'onlyWhereReferences' to make it even shorter:
  --
  -- > getUserPosts user posts =
  -- >     posts |> onlyWhereReferences #userId user
  --
  -- If the Id field is nullable, we need to use 'onlyWhereReferencesMaybe':
  --
  -- > getUserTasks user tasks =
  -- >     tasks |> onlyWhereReferencesMaybe #optionalUserId user
  --
  onlyWhere :: forall record fieldName value. (KnownSymbol fieldName, HasField fieldName record value, Eq value) => Proxy fieldName -> value -> [record] -> [record]
  onlyWhere field value records = filter (\record -> get field record == value) records
  
  -- | Shorthand filter function for Id fields
  --
  -- In IHP code bases you often write filter functions such as these:
  --
  -- > getUserPosts user posts =
  -- >     filter (\p -> p.userId == user.id) posts
  --
  -- This can be written in a shorter way using 'onlyWhereReferences':
  --
  -- > getUserPosts user posts =
  -- >     posts |> onlyWhereReferences #userId user
  --
  -- If the Id field is nullable, we need to use 'onlyWhereReferencesMaybe':
  --
  -- > getUserTasks user tasks =
  -- >     tasks |> onlyWhereReferencesMaybe #optionalUserId user
  --
  --
  -- See 'onlyWhere' for more details.
  onlyWhereReferences :: forall record fieldName value referencedRecord. (KnownSymbol fieldName, HasField fieldName record value, Eq value, HasField "id" referencedRecord value) => Proxy fieldName -> referencedRecord -> [record] -> [record]
  onlyWhereReferences field referenced records = filter (\record -> get field record == referenced.id) records
  
  -- | Shorthand filter function for nullable Id fields
  --
  -- In IHP code bases you often write filter functions such as these:
  --
  -- > getUserTasks user tasks =
  -- >     filter (\task -> task.optionalUserId == Just user.id) tasks
  --
  -- This can be written in a shorter way using 'onlyWhereReferencesMaybe':
  --
  -- > getUserTasks user tasks =
  -- >     tasks |> onlyWhereReferencesMaybe #optionalUserId user
  --
  -- See 'onlyWhere' for more details.
  onlyWhereReferencesMaybe :: forall record fieldName value referencedRecord. (KnownSymbol fieldName, HasField fieldName record (Maybe value), Eq value, HasField "id" referencedRecord value) => Proxy fieldName -> referencedRecord -> [record] -> [record]
  onlyWhereReferencesMaybe field referenced records = filter (\record -> get field record == Just referenced.id) records
  
  -- | Returns True when a record has no validation errors attached from a previous validation call
  --
  -- Example:
  --
  -- > isValidProject :: Project -> Bool
  -- > isValidProject project =
  -- >     project
  -- >     |> validateField #name isNonEmpty
  -- >     |> isValid
  --
  isValid :: forall record. (HasField "meta" record MetaBag) => record -> Bool
  isValid record = isEmpty record.meta.annotations
  
  -- | Copies all the fields (except the 'id' field) into a new record
  --
  -- Example: Duplicate a database record (except the primary key of course)
  --
  -- > project <- fetch projectId
  -- > duplicatedProject <- createRecord (copyRecord project)
  --
  copyRecord :: forall record id. (Table record, SetField "id" record id, Default id, SetField "meta" record MetaBag) => record -> record
  copyRecord existingRecord =
      let
          fieldsExceptId = (columnNames @record) |> filter (\field -> field /= "id")
  
          meta :: MetaBag
          meta = def { touchedFields = map (IHP.NameSupport.columnNameToFieldName . cs) fieldsExceptId }
      in
          existingRecord
              |> set #id def
              |> set #meta meta
  
  -- | Runs sql queries without logging them
  --
  -- Example:
  --
  -- > users <- withoutQueryLogging (sqlQuery "SELECT * FROM users" ())
  --
  withoutQueryLogging :: (?modelContext :: ModelContext) => ((?modelContext :: ModelContext) => result) -> result
  withoutQueryLogging callback =
      let
          modelContext = ?modelContext
          nullLogger = modelContext.logger { write = \_ -> pure ()}
      in
          let ?modelContext = modelContext { logger = nullLogger }
          in
              callback