{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts, AllowAmbiguousTypes, UndecidableInstances, FlexibleInstances, IncoherentInstances, DataKinds, PolyKinds, TypeApplications, ScopedTypeVariables, ConstraintKinds, TypeOperators, GADTs, GeneralizedNewtypeDeriving #-}

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 qualified GHC.Conc
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
    { ModelContext -> Pool Connection
connectionPool :: Pool.Pool Connection -- ^ Used to get database connections when no 'transactionConnection' is set
    , ModelContext -> Maybe Connection
transactionConnection :: Maybe Connection -- ^ Set to a specific database connection when executing a database transaction
    -- | Logs all queries to this logger at log level info
    , ModelContext -> Logger
logger :: Logger
    -- | A callback that is called whenever a specific table is accessed using a SELECT query
    , ModelContext -> Maybe (ByteString -> IO ())
trackTableReadCallback :: Maybe (ByteString -> IO ())
    -- | Is set to a value if row level security was enabled at runtime
    , ModelContext -> Maybe RowLevelSecurityContext
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
    { RowLevelSecurityContext -> Text
rlsAuthenticatedRole :: Text -- ^ Default is @ihp_authenticated@. This value comes from the @IHP_RLS_AUTHENTICATED_ROLE@  env var.
    , RowLevelSecurityContext -> Action
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
notConnectedModelContext Logger
logger = ModelContext
    { connectionPool :: Pool Connection
connectionPool = [Char] -> Pool Connection
forall a. HasCallStack => [Char] -> a
error [Char]
"Not connected"
    , transactionConnection :: Maybe Connection
transactionConnection = Maybe Connection
forall a. Maybe a
Nothing
    , logger :: Logger
logger = Logger
logger
    , trackTableReadCallback :: Maybe (ByteString -> IO ())
trackTableReadCallback = Maybe (ByteString -> IO ())
forall a. Maybe a
Nothing
    , rowLevelSecurity :: Maybe RowLevelSecurityContext
rowLevelSecurity = Maybe RowLevelSecurityContext
forall a. Maybe a
Nothing
    }

createModelContext :: NominalDiffTime -> Int -> ByteString -> Logger -> IO ModelContext
createModelContext :: NominalDiffTime -> Int -> ByteString -> Logger -> IO ModelContext
createModelContext NominalDiffTime
idleTime Int
maxConnections ByteString
databaseUrl Logger
logger = do
    let poolConfig :: PoolConfig Connection
poolConfig = IO Connection
-> (Connection -> IO ()) -> Double -> Int -> PoolConfig Connection
forall a. IO a -> (a -> IO ()) -> Double -> Int -> PoolConfig a
Pool.defaultPoolConfig (ByteString -> IO Connection
PG.connectPostgreSQL ByteString
databaseUrl) Connection -> IO ()
PG.close (NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
idleTime) Int
maxConnections
    Pool Connection
connectionPool <- PoolConfig Connection -> IO (Pool Connection)
forall a. PoolConfig a -> IO (Pool a)
Pool.newPool PoolConfig Connection
poolConfig

    let trackTableReadCallback :: Maybe a
trackTableReadCallback = Maybe a
forall a. Maybe a
Nothing
    let transactionConnection :: Maybe a
transactionConnection = Maybe a
forall a. Maybe a
Nothing
    let rowLevelSecurity :: Maybe a
rowLevelSecurity = Maybe a
forall a. Maybe a
Nothing
    ModelContext -> IO ModelContext
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModelContext { Maybe Connection
Maybe RowLevelSecurityContext
Maybe (ByteString -> IO ())
Logger
Pool Connection
forall a. Maybe a
connectionPool :: Pool Connection
transactionConnection :: Maybe Connection
logger :: Logger
trackTableReadCallback :: Maybe (ByteString -> IO ())
rowLevelSecurity :: Maybe RowLevelSecurityContext
logger :: Logger
connectionPool :: Pool Connection
trackTableReadCallback :: forall a. Maybe a
transactionConnection :: forall a. Maybe a
rowLevelSecurity :: forall a. Maybe a
.. }

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 a
record = do
        a
_ <- a -> IO a
forall model.
(?modelContext::ModelContext, CanCreate model) =>
model -> IO model
createRecord a
record
        () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
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 a
record = do
        a
_ <- a -> IO a
forall a. (CanUpdate a, ?modelContext::ModelContext) => a -> IO a
updateRecord a
record
        () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

{-# INLINE createRecord #-}
createRecord :: (?modelContext :: ModelContext, CanCreate model) => model -> IO model
createRecord :: forall model.
(?modelContext::ModelContext, CanCreate model) =>
model -> IO model
createRecord = model -> IO model
forall a. (CanCreate a, ?modelContext::ModelContext) => a -> IO a
create

class InputValue a where
    inputValue :: a -> Text

instance InputValue Text where
    inputValue :: Text -> Text
inputValue Text
text = Text
text

instance InputValue Int where
    inputValue :: Int -> Text
inputValue = Int -> Text
forall a. Show a => a -> Text
tshow

instance InputValue Integer where
    inputValue :: Integer -> Text
inputValue = Integer -> Text
forall a. Show a => a -> Text
tshow

instance InputValue Double where
    inputValue :: Double -> Text
inputValue Double
double = [Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
Numeric.showFFloat Maybe Int
forall a. Maybe a
Nothing Double
double [Char]
"")

instance InputValue Float where
    inputValue :: Float -> Text
inputValue Float
float = [Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
Numeric.showFFloat Maybe Int
forall a. Maybe a
Nothing Float
float [Char]
"")

instance InputValue Bool where
    inputValue :: Bool -> Text
inputValue Bool
True = Text
"on"
    inputValue Bool
False = Text
"off"

instance InputValue Data.UUID.UUID where
    inputValue :: UUID -> Text
inputValue = UUID -> Text
Data.UUID.toText

instance InputValue () where
    inputValue :: () -> Text
inputValue () = Text
"error: inputValue(()) not supported"

instance InputValue UTCTime where
    inputValue :: UTCTime -> Text
inputValue UTCTime
time = [Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (UTCTime -> [Char]
forall t. ISO8601 t => t -> [Char]
iso8601Show UTCTime
time)

instance InputValue LocalTime where
    inputValue :: LocalTime -> Text
inputValue LocalTime
time = [Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (LocalTime -> [Char]
forall t. ISO8601 t => t -> [Char]
iso8601Show LocalTime
time)

instance InputValue Day where
    inputValue :: Day -> Text
inputValue Day
date = [Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Day -> [Char]
forall t. ISO8601 t => t -> [Char]
iso8601Show Day
date)

instance InputValue TimeOfDay where
    inputValue :: TimeOfDay -> Text
inputValue TimeOfDay
timeOfDay = TimeOfDay -> Text
forall a. Show a => a -> Text
tshow TimeOfDay
timeOfDay

instance InputValue PGInterval where
    inputValue :: PGInterval -> Text
inputValue (PGInterval ByteString
pgInterval) = ByteString -> Text
forall a. Show a => a -> Text
tshow ByteString
pgInterval

instance InputValue fieldType => InputValue (Maybe fieldType) where
    inputValue :: Maybe fieldType -> Text
inputValue (Just fieldType
value) = fieldType -> Text
forall a. InputValue a => a -> Text
inputValue fieldType
value
    inputValue Maybe fieldType
Nothing = Text
""

instance InputValue value => InputValue [value] where
    inputValue :: [value] -> Text
inputValue [value]
list = [value]
list [value] -> ([value] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (value -> Text) -> [value] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map value -> Text
forall a. InputValue a => a -> Text
inputValue [Text] -> ([Text] -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Element [Text] -> [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element [Text]
Text
","

instance InputValue Aeson.Value where
    inputValue :: Value -> Text
inputValue Value
json = Value
json Value -> (Value -> ByteString) -> ByteString
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode ByteString -> (ByteString -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs

instance InputValue Scientific where
    inputValue :: Scientific -> Text
inputValue = Scientific -> Text
forall a. Show a => a -> Text
tshow

instance Default Text where
    {-# INLINE def #-}
    def :: Text
def = Text
""

instance Default Bool where
    {-# INLINE def #-}
    def :: Bool
def = Bool
False

instance Default Point where
    def :: Point
def = Double -> Double -> Point
Point Double
forall a. Default a => a
def Double
forall a. Default a => a
def

instance Default Polygon where
    def :: Polygon
def = [Point] -> Polygon
Polygon [Point
forall a. Default a => a
def]

instance Default TSVector where
    def :: TSVector
def = [Lexeme] -> TSVector
TSVector [Lexeme]
forall a. Default a => a
def

instance Default Scientific where
    def :: Scientific
def = Scientific
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 :: forall model. HasField "meta" model MetaBag => model -> Bool
isNew model
model = Maybe Dynamic -> Bool
forall a. Maybe a -> Bool
isNothing model
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 :: forall model. KnownSymbol (GetModelName model) => Text
getModelName = [Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$! Proxy (GetModelName model) -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy (GetModelName model)
forall {k} (t :: k). Proxy t
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 :: Id' model' -> Text
inputValue = PrimaryKey model' -> Text
forall a. InputValue a => a -> Text
inputValue (PrimaryKey model' -> Text)
-> (Id' model' -> PrimaryKey model') -> Id' model' -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Id' model' -> PrimaryKey model'
forall (model :: Symbol). Id' model -> PrimaryKey model
unpackId

instance IsEmpty (PrimaryKey table) => IsEmpty (Id' table) where
    isEmpty :: Id' table -> Bool
isEmpty (Id PrimaryKey table
primaryKey) = PrimaryKey table -> Bool
forall value. IsEmpty value => value -> Bool
isEmpty PrimaryKey table
primaryKey

recordToInputValue :: (HasField "id" entity (Id entity), Show (PrimaryKey (GetTableName entity))) => entity -> Text
recordToInputValue :: forall entity.
(HasField "id" entity (Id entity),
 Show (PrimaryKey (GetTableName entity))) =>
entity -> Text
recordToInputValue entity
entity =
    entity
entity.id
    Id entity
-> (Id entity -> PrimaryKey (GetTableName entity))
-> PrimaryKey (GetTableName entity)
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Id entity -> PrimaryKey (GetTableName entity)
forall (model :: Symbol). Id' model -> PrimaryKey model
unpackId
    PrimaryKey (GetTableName entity)
-> (PrimaryKey (GetTableName entity) -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> PrimaryKey (GetTableName entity) -> Text
forall a. Show a => a -> Text
tshow
{-# INLINE recordToInputValue #-}

instance FromField (PrimaryKey model) => FromField (Id' model) where
    {-# INLINE fromField #-}
    fromField :: FieldParser (Id' model)
fromField Field
value Maybe ByteString
metaData = do
        PrimaryKey model
fieldValue <- FieldParser (PrimaryKey model)
forall a. FromField a => FieldParser a
fromField Field
value Maybe ByteString
metaData
        Id' model -> Conversion (Id' model)
forall a. a -> Conversion a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimaryKey model -> Id' model
forall (table :: Symbol). PrimaryKey table -> Id' table
Id PrimaryKey model
fieldValue)

instance ToField (PrimaryKey model) => ToField (Id' model) where
    {-# INLINE toField #-}
    toField :: Id' model -> Action
toField = PrimaryKey model -> Action
forall a. ToField a => a -> Action
toField (PrimaryKey model -> Action)
-> (Id' model -> PrimaryKey model) -> Id' model -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Id' model -> PrimaryKey model
forall (model :: Symbol). Id' model -> PrimaryKey model
unpackId

instance Show (PrimaryKey model) => Show (Id' model) where
    {-# INLINE show #-}
    show :: Id' model -> [Char]
show = PrimaryKey model -> [Char]
forall a. Show a => a -> [Char]
show (PrimaryKey model -> [Char])
-> (Id' model -> PrimaryKey model) -> Id' model -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Id' model -> PrimaryKey model
forall (model :: Symbol). Id' model -> PrimaryKey model
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 :: forall (table :: Symbol). PrimaryKey table -> Id' table
packId PrimaryKey model
uuid = PrimaryKey model -> Id' model
forall (table :: Symbol). PrimaryKey table -> Id' table
Id PrimaryKey model
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 :: forall (model :: Symbol). Id' model -> PrimaryKey model
unpackId (Id PrimaryKey model
uuid) = PrimaryKey model
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 { forall a b. LabeledData a b -> a
labelValue :: a, forall a b. LabeledData a b -> b
contentValue :: b }
    deriving (Int -> LabeledData a b -> ShowS
[LabeledData a b] -> ShowS
LabeledData a b -> [Char]
(Int -> LabeledData a b -> ShowS)
-> (LabeledData a b -> [Char])
-> ([LabeledData a b] -> ShowS)
-> Show (LabeledData a b)
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> LabeledData a b -> ShowS
forall a b. (Show a, Show b) => [LabeledData a b] -> ShowS
forall a b. (Show a, Show b) => LabeledData a b -> [Char]
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> LabeledData a b -> ShowS
showsPrec :: Int -> LabeledData a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => LabeledData a b -> [Char]
show :: LabeledData a b -> [Char]
$cshowList :: forall a b. (Show a, Show b) => [LabeledData a b] -> ShowS
showList :: [LabeledData a b] -> ShowS
Show)

instance (FromField label, PG.FromRow a) => PGFR.FromRow (LabeledData label a) where
    fromRow :: RowParser (LabeledData label a)
fromRow = label -> a -> LabeledData label a
forall a b. a -> b -> LabeledData a b
LabeledData (label -> a -> LabeledData label a)
-> RowParser label -> RowParser (a -> LabeledData label a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser label
forall a. FromField a => RowParser a
PGFR.field RowParser (a -> LabeledData label a)
-> RowParser a -> RowParser (LabeledData label a)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser a
forall a. FromRow a => RowParser a
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 :: [Char] -> Id' model
fromString [Char]
uuid = [Char] -> Id' model
forall (model :: Symbol) text.
(HasCallStack, ParsePrimaryKey (PrimaryKey model),
 ConvertibleStrings text Text) =>
text -> Id' model
textToId [Char]
uuid
    {-# INLINE fromString #-}

class ParsePrimaryKey primaryKey where
    parsePrimaryKey :: Text -> Maybe primaryKey

instance ParsePrimaryKey UUID where
    parsePrimaryKey :: Text -> Maybe UUID
parsePrimaryKey = [Char] -> Maybe UUID
forall a. Read a => [Char] -> Maybe a
Read.readMaybe ([Char] -> Maybe UUID) -> (Text -> [Char]) -> Text -> Maybe UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs

instance ParsePrimaryKey Text where
    parsePrimaryKey :: Text -> Maybe Text
parsePrimaryKey Text
text = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
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 :: forall (model :: Symbol) text.
(HasCallStack, ParsePrimaryKey (PrimaryKey model),
 ConvertibleStrings text Text) =>
text -> Id' model
textToId text
text = case Text -> Maybe (PrimaryKey model)
forall primaryKey.
ParsePrimaryKey primaryKey =>
Text -> Maybe primaryKey
parsePrimaryKey (text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs text
text) of
        Just PrimaryKey model
id -> PrimaryKey model -> Id' model
forall (table :: Symbol). PrimaryKey table -> Id' table
Id PrimaryKey model
id
        Maybe (PrimaryKey model)
Nothing -> [Char] -> Id' model
forall a. HasCallStack => [Char] -> a
error (Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Text
"Unable to convert " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs text
text :: Text) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 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) => IO a -> Query -> q -> IO a
measureTimeIfLogging :: forall q a.
(?modelContext::ModelContext, ToRow q) =>
IO a -> Query -> q -> IO a
measureTimeIfLogging IO a
queryAction Query
theQuery q
theParameters = do
    let currentLogLevel :: LogLevel
currentLogLevel = ?modelContext::ModelContext
ModelContext
?modelContext.logger.level
    if LogLevel
currentLogLevel LogLevel -> LogLevel -> Bool
forall a. Eq a => a -> a -> Bool
== LogLevel
Debug
        then do
            UTCTime
start <- IO UTCTime
getCurrentTime
            IO a
queryAction IO a -> IO () -> IO a
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
`finally` do
                UTCTime
end <- IO UTCTime
getCurrentTime
                let theTime :: NominalDiffTime
theTime = UTCTime
end UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
start
                Query -> q -> NominalDiffTime -> IO ()
forall parameters.
(?modelContext::ModelContext, ToRow parameters) =>
Query -> parameters -> NominalDiffTime -> IO ()
logQuery Query
theQuery q
theParameters NominalDiffTime
theTime
        else IO a
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 :: forall q r.
(?modelContext::ModelContext, ToRow q, FromRow r) =>
Query -> q -> IO [r]
sqlQuery Query
theQuery q
theParameters = do
    IO [r] -> Query -> q -> IO [r]
forall q a.
(?modelContext::ModelContext, ToRow q) =>
IO a -> Query -> q -> IO a
measureTimeIfLogging
        ((Connection -> IO [r]) -> IO [r]
forall a.
(?modelContext::ModelContext) =>
(Connection -> IO a) -> IO a
withDatabaseConnection \Connection
connection -> Query -> q -> IO [r] -> IO [r]
forall parameters a.
ToRow parameters =>
Query -> parameters -> IO a -> IO a
enhanceSqlError Query
theQuery q
theParameters do
            (Query -> [Action] -> IO [r]) -> Query -> q -> IO [r]
forall params result.
(?modelContext::ModelContext, ToRow params) =>
(Query -> [Action] -> result) -> Query -> params -> result
withRLSParams (Connection -> Query -> [Action] -> IO [r]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
PG.query Connection
connection) Query
theQuery q
theParameters
        )
        Query
theQuery
        q
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 :: forall query record.
(?modelContext::ModelContext, ToRow query, FromRow record) =>
Query -> query -> IO record
sqlQuerySingleRow Query
theQuery query
theParameters = do
    [record]
result <- Query -> query -> IO [record]
forall q r.
(?modelContext::ModelContext, ToRow q, FromRow r) =>
Query -> q -> IO [r]
sqlQuery Query
theQuery query
theParameters
    case [record]
result of
        [] -> [Char] -> IO record
forall a. HasCallStack => [Char] -> a
error ([Char]
"sqlQuerySingleRow: Expected a single row to be returned. Query: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Query -> [Char]
forall a. Show a => a -> [Char]
show Query
theQuery)
        [record
record] -> record -> IO record
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure record
record
        [record]
otherwise -> [Char] -> IO record
forall a. HasCallStack => [Char] -> a
error ([Char]
"sqlQuerySingleRow: Expected a single row to be returned. But got " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show ([record] -> Int
forall mono. MonoFoldable mono => mono -> Int
length [record]
otherwise) [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" 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 :: forall q.
(?modelContext::ModelContext, ToRow q) =>
Query -> q -> IO Int64
sqlExec Query
theQuery q
theParameters = do
    IO Int64 -> Query -> q -> IO Int64
forall q a.
(?modelContext::ModelContext, ToRow q) =>
IO a -> Query -> q -> IO a
measureTimeIfLogging
        ((Connection -> IO Int64) -> IO Int64
forall a.
(?modelContext::ModelContext) =>
(Connection -> IO a) -> IO a
withDatabaseConnection \Connection
connection -> Query -> q -> IO Int64 -> IO Int64
forall parameters a.
ToRow parameters =>
Query -> parameters -> IO a -> IO a
enhanceSqlError Query
theQuery q
theParameters do
            (Query -> [Action] -> IO Int64) -> Query -> q -> IO Int64
forall params result.
(?modelContext::ModelContext, ToRow params) =>
(Query -> [Action] -> result) -> Query -> params -> result
withRLSParams (Connection -> Query -> [Action] -> IO Int64
forall q. ToRow q => Connection -> Query -> q -> IO Int64
PG.execute Connection
connection) Query
theQuery q
theParameters
        )
        Query
theQuery
        q
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 :: forall q.
(?modelContext::ModelContext, ToRow q) =>
Query -> q -> IO ()
sqlExecDiscardResult Query
theQuery q
theParameters = do
    Int64
_ <- Query -> q -> IO Int64
forall q.
(?modelContext::ModelContext, ToRow q) =>
Query -> q -> IO Int64
sqlExec Query
theQuery q
theParameters
    () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
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 :: forall params result.
(?modelContext::ModelContext, ToRow params) =>
(Query -> [Action] -> result) -> Query -> params -> result
withRLSParams Query -> [Action] -> result
runQuery Query
query params
params = do
    case ?modelContext::ModelContext
ModelContext
?modelContext.rowLevelSecurity of
        Just RowLevelSecurityContext { Text
rlsAuthenticatedRole :: RowLevelSecurityContext -> Text
rlsAuthenticatedRole :: Text
rlsAuthenticatedRole, Action
rlsUserId :: RowLevelSecurityContext -> Action
rlsUserId :: Action
rlsUserId } -> do
            let query' :: Query
query' = Query
"SET LOCAL ROLE ?; SET LOCAL rls.ihp_user_id = ?; " Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
query
            let params' :: [Action]
params' = [Identifier -> Action
forall a. ToField a => a -> Action
PG.toField (Text -> Identifier
PG.Identifier Text
rlsAuthenticatedRole), Action -> Action
forall a. ToField a => a -> Action
PG.toField Action
rlsUserId] [Action] -> [Action] -> [Action]
forall a. Semigroup a => a -> a -> a
<> params -> [Action]
forall a. ToRow a => a -> [Action]
PG.toRow params
params
            Query -> [Action] -> result
runQuery Query
query' [Action]
params'
        Maybe RowLevelSecurityContext
Nothing -> Query -> [Action] -> result
runQuery Query
query (params -> [Action]
forall a. ToRow a => a -> [Action]
PG.toRow params
params)

withDatabaseConnection :: (?modelContext :: ModelContext) => (Connection -> IO a) -> IO a
withDatabaseConnection :: forall a.
(?modelContext::ModelContext) =>
(Connection -> IO a) -> IO a
withDatabaseConnection Connection -> IO a
block =
    let
        ModelContext { Pool Connection
connectionPool :: ModelContext -> Pool Connection
connectionPool :: Pool Connection
connectionPool, Maybe Connection
transactionConnection :: ModelContext -> Maybe Connection
transactionConnection :: Maybe Connection
transactionConnection, Maybe RowLevelSecurityContext
rowLevelSecurity :: ModelContext -> Maybe RowLevelSecurityContext
rowLevelSecurity :: Maybe RowLevelSecurityContext
rowLevelSecurity } = ?modelContext::ModelContext
ModelContext
?modelContext
    in case Maybe Connection
transactionConnection of
        Just Connection
transactionConnection -> Connection -> IO a
block Connection
transactionConnection
        Maybe Connection
Nothing -> Pool Connection -> (Connection -> IO a) -> IO a
forall a r. Pool a -> (a -> IO r) -> IO r
Pool.withResource Pool Connection
connectionPool Connection -> IO a
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 :: forall q value.
(?modelContext::ModelContext, ToRow q, FromField value) =>
Query -> q -> IO value
sqlQueryScalar Query
theQuery q
theParameters = do
    [Only value]
result <- IO [Only value] -> Query -> q -> IO [Only value]
forall q a.
(?modelContext::ModelContext, ToRow q) =>
IO a -> Query -> q -> IO a
measureTimeIfLogging
        ((Connection -> IO [Only value]) -> IO [Only value]
forall a.
(?modelContext::ModelContext) =>
(Connection -> IO a) -> IO a
withDatabaseConnection \Connection
connection -> Query -> q -> IO [Only value] -> IO [Only value]
forall parameters a.
ToRow parameters =>
Query -> parameters -> IO a -> IO a
enhanceSqlError Query
theQuery q
theParameters do
            Connection -> Query -> q -> IO [Only value]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
PG.query Connection
connection Query
theQuery q
theParameters
        )
        Query
theQuery
        q
theParameters
    value -> IO value
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure case [Only value]
result of
        [PG.Only value
result] -> value
result
        [Only value]
_ -> [Char] -> value
forall a. HasCallStack => [Char] -> a
error [Char]
"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 :: forall q value.
(?modelContext::ModelContext, ToRow q, FromField value) =>
Query -> q -> IO (Maybe value)
sqlQueryScalarOrNothing Query
theQuery q
theParameters = do
    [Only value]
result <- IO [Only value] -> Query -> q -> IO [Only value]
forall q a.
(?modelContext::ModelContext, ToRow q) =>
IO a -> Query -> q -> IO a
measureTimeIfLogging
        ((Connection -> IO [Only value]) -> IO [Only value]
forall a.
(?modelContext::ModelContext) =>
(Connection -> IO a) -> IO a
withDatabaseConnection \Connection
connection -> Query -> q -> IO [Only value] -> IO [Only value]
forall parameters a.
ToRow parameters =>
Query -> parameters -> IO a -> IO a
enhanceSqlError Query
theQuery q
theParameters do
            Connection -> Query -> q -> IO [Only value]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
PG.query Connection
connection Query
theQuery q
theParameters
        )
        Query
theQuery
        q
theParameters
    Maybe value -> IO (Maybe value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure case [Only value]
result of
        [] -> Maybe value
forall a. Maybe a
Nothing
        [PG.Only value
result] -> value -> Maybe value
forall a. a -> Maybe a
Just value
result
        [Only value]
_ -> [Char] -> Maybe value
forall a. HasCallStack => [Char] -> a
error [Char]
"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 :: forall a.
(?modelContext::ModelContext) =>
((?modelContext::ModelContext) => IO a) -> IO a
withTransaction (?modelContext::ModelContext) => IO a
block = ((?modelContext::ModelContext) => IO a) -> IO a
forall a.
(?modelContext::ModelContext) =>
((?modelContext::ModelContext) => IO a) -> IO a
withTransactionConnection do
    let connection :: Connection
connection = ?modelContext::ModelContext
ModelContext
?modelContext.transactionConnection
            Maybe Connection -> (Maybe Connection -> Connection) -> Connection
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> \case
                Just Connection
connection -> Connection
connection
                Maybe Connection
Nothing -> [Char] -> Connection
forall a. HasCallStack => [Char] -> a
error [Char]
"withTransaction: transactionConnection not set as expected"
    Connection -> IO a -> IO a
forall a. Connection -> IO a -> IO a
PG.withTransaction Connection
connection IO a
(?modelContext::ModelContext) => IO a
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 :: forall a.
(?modelContext::ModelContext) =>
((?modelContext::ModelContext) => IO a) -> IO a
withRowLevelSecurityDisabled (?modelContext::ModelContext) => IO a
block = do
    let currentModelContext :: ModelContext
currentModelContext = ?modelContext::ModelContext
ModelContext
?modelContext
    let ?modelContext = ModelContext
currentModelContext { rowLevelSecurity = Nothing } in IO a
(?modelContext::ModelContext) => IO a
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::ModelContext) => Connection
transactionConnectionOrError = ?modelContext::ModelContext
ModelContext
?modelContext.transactionConnection
            Maybe Connection -> (Maybe Connection -> Connection) -> Connection
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> \case
                Just Connection
connection -> Connection
connection
                Maybe Connection
Nothing -> [Char] -> Connection
forall a. HasCallStack => [Char] -> a
error [Char]
"getTransactionConnectionOrError: Not in a transaction state"

commitTransaction :: (?modelContext :: ModelContext) => IO ()
commitTransaction :: (?modelContext::ModelContext) => IO ()
commitTransaction = Connection -> IO ()
PG.commit Connection
(?modelContext::ModelContext) => Connection
transactionConnectionOrError
{-# INLINABLE commitTransaction #-}

rollbackTransaction :: (?modelContext :: ModelContext) => IO ()
rollbackTransaction :: (?modelContext::ModelContext) => IO ()
rollbackTransaction = Connection -> IO ()
PG.rollback Connection
(?modelContext::ModelContext) => Connection
transactionConnectionOrError
{-# INLINABLE rollbackTransaction #-}

withTransactionConnection :: (?modelContext :: ModelContext) => ((?modelContext :: ModelContext) => IO a) -> IO a
withTransactionConnection :: forall a.
(?modelContext::ModelContext) =>
((?modelContext::ModelContext) => IO a) -> IO a
withTransactionConnection (?modelContext::ModelContext) => IO a
block = do
    let ModelContext { Pool Connection
connectionPool :: ModelContext -> Pool Connection
connectionPool :: Pool Connection
connectionPool } = ?modelContext::ModelContext
ModelContext
?modelContext
    Pool Connection -> (Connection -> IO a) -> IO a
forall a r. Pool a -> (a -> IO r) -> IO r
Pool.withResource Pool Connection
connectionPool \Connection
connection -> do
        let modelContext :: ModelContext
modelContext = ?modelContext::ModelContext
ModelContext
?modelContext { transactionConnection = Just connection }
        let ?modelContext = ?modelContext::ModelContext
ModelContext
modelContext in IO a
(?modelContext::ModelContext) => IO a
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 = forall (symbol :: Symbol). KnownSymbol symbol => Text
symbolToText @(GetTableName record)
    {-# INLINE tableName #-}

    -- | Returns the table name of a given model as a bytestring.
    --
    -- __Example:__
    --
    -- >>> tableNameByteString @User
    -- "users"
    --
    tableNameByteString :: ByteString
    tableNameByteString = Text -> ByteString
Text.encodeUtf8 (forall record. Table record => Text
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 :: forall record. Table record => ByteString
primaryKeyConditionColumnSelector = 
    let 
        qualifyColumnName :: ByteString -> ByteString
qualifyColumnName ByteString
col = forall record. Table record => ByteString
tableNameByteString @record ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"." ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
col
    in
    case forall record. Table record => [ByteString]
primaryKeyColumnNames @record of
            [] -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error ([Char] -> ByteString) -> (Text -> [Char]) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
"Impossible happened in primaryKeyConditionColumnSelector. No primary keys found for table " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall record. Table record => Text
tableName @record Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". At least one primary key is required."
            [ByteString
s] -> ByteString -> ByteString
qualifyColumnName ByteString
s
            [ByteString]
conds -> ByteString
"(" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Element [ByteString] -> [ByteString] -> Element [ByteString]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate ByteString
Element [ByteString]
", " ((ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ByteString -> ByteString
qualifyColumnName [ByteString]
conds) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
")"

-- | 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 :: forall record.
(HasField "id" record (Id record), Table record) =>
record -> Action
primaryKeyCondition record
record = forall record. Table record => Id record -> Action
primaryKeyConditionForId @record record
record.id

logQuery :: (?modelContext :: ModelContext, PG.ToRow parameters) => Query -> parameters -> NominalDiffTime -> IO ()
logQuery :: forall parameters.
(?modelContext::ModelContext, ToRow parameters) =>
Query -> parameters -> NominalDiffTime -> IO ()
logQuery Query
query parameters
parameters NominalDiffTime
time = do
        let ?context = ?context::ModelContext
?modelContext::ModelContext
ModelContext
?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 :: Double
queryTimeInMs = (NominalDiffTime
time NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
1000) NominalDiffTime -> (NominalDiffTime -> Rational) -> Rational
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> NominalDiffTime -> Rational
forall a. Real a => a -> Rational
toRational Rational -> (Rational -> Double) -> Double
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall a. Fractional a => Rational -> a
fromRational @Double
        let formatRLSInfo :: a -> a
formatRLSInfo a
userId = a
" { ihp_user_id = " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
userId a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" }"
        let rlsInfo :: Text
rlsInfo = case ?context::ModelContext
ModelContext
?context.rowLevelSecurity of
                Just RowLevelSecurityContext { rlsUserId :: RowLevelSecurityContext -> Action
rlsUserId = PG.Plain Builder
rlsUserId } -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
formatRLSInfo (ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Builder -> ByteString
Builder.toLazyByteString Builder
rlsUserId))
                Just RowLevelSecurityContext { rlsUserId :: RowLevelSecurityContext -> Action
rlsUserId = Action
rlsUserId } -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
formatRLSInfo (Action -> Text
forall a. Show a => a -> Text
tshow Action
rlsUserId)
                Maybe RowLevelSecurityContext
Nothing -> Text
""
        let
            -- We don't use the normal 'show' here as it adds lots of noise like 'Escape' or 'Plain' to the output
            showAction :: Action -> b
showAction (PG.Plain Builder
builder) = ByteString -> b
forall a b. ConvertibleStrings a b => a -> b
cs (Builder -> ByteString
Builder.toLazyByteString Builder
builder)
            showAction (PG.Escape ByteString
byteString) = ByteString -> b
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
byteString
            showAction (PG.EscapeByteA ByteString
byteString) = ByteString -> b
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
byteString
            showAction (PG.EscapeIdentifier ByteString
byteString) = ByteString -> b
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
byteString
            showAction (PG.Many [Action]
actions) = (Element [Action] -> b) -> [Action] -> b
forall mono m.
(MonoFoldable mono, Monoid m) =>
(Element mono -> m) -> mono -> m
concatMap Element [Action] -> b
Action -> b
showAction [Action]
actions
        Text -> IO ()
forall context string.
(?context::context, LoggingProvider context, ToLogStr string) =>
string -> IO ()
Log.debug (Text
"Query (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  Double -> Text
forall a. Show a => a -> Text
tshow Double
queryTimeInMs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"ms): " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Query -> Text
forall a. Show a => a -> Text
tshow Query
query Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Element [Text] -> [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element [Text]
Text
", " ([Text] -> Element [Text]) -> [Text] -> Element [Text]
forall a b. (a -> b) -> a -> b
$ (Action -> Text) -> [Action] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Action -> Text
forall {b}.
(ConvertibleStrings ByteString b, ConvertibleStrings ByteString b,
 Monoid b) =>
Action -> b
showAction ([Action] -> [Text]) -> [Action] -> [Text]
forall a b. (a -> b) -> a -> b
$ parameters -> [Action]
forall a. ToRow a => a -> [Action]
PG.toRow parameters
parameters) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rlsInfo)
{-# 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 :: forall record (table :: Symbol).
(?modelContext::ModelContext, Table record,
 Show (PrimaryKey table), HasField "id" record (Id record),
 GetTableName record ~ table, record ~ GetModelByTableName table) =>
record -> IO ()
deleteRecord record
record =
    forall record (table :: Symbol).
(?modelContext::ModelContext, Table record,
 Show (PrimaryKey table), GetTableName record ~ table,
 record ~ GetModelByTableName table) =>
Id' table -> IO ()
deleteRecordById @record 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 :: forall record (table :: Symbol).
(?modelContext::ModelContext, Table record,
 Show (PrimaryKey table), GetTableName record ~ table,
 record ~ GetModelByTableName table) =>
Id' table -> IO ()
deleteRecordById Id' table
id = do
    let theQuery :: ByteString
theQuery = ByteString
"DELETE FROM " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> forall record. Table record => ByteString
tableNameByteString @record ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" WHERE " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (forall record. Table record => ByteString
primaryKeyConditionColumnSelector @record) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" = ?"
    let theParameters :: Only Action
theParameters = Action -> Only Action
forall a. a -> Only a
PG.Only (Action -> Only Action) -> Action -> Only Action
forall a b. (a -> b) -> a -> b
$ forall record. Table record => Id record -> Action
primaryKeyConditionForId @record Id' table
Id record
id
    Query -> Only Action -> IO Int64
forall q.
(?modelContext::ModelContext, ToRow q) =>
Query -> q -> IO Int64
sqlExec (ByteString -> Query
PG.Query (ByteString -> Query) -> ByteString -> Query
forall a b. (a -> b) -> a -> b
$! ByteString
theQuery) Only Action
theParameters
    () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
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 :: forall record (table :: Symbol).
(?modelContext::ModelContext, Show (PrimaryKey table),
 Table record, HasField "id" record (Id' table),
 GetTableName record ~ table, record ~ GetModelByTableName table) =>
[record] -> IO ()
deleteRecords [record]
records =
    forall record (table :: Symbol).
(?modelContext::ModelContext, Show (PrimaryKey table),
 Table record, GetTableName record ~ table,
 record ~ GetModelByTableName table) =>
[Id' table] -> IO ()
deleteRecordByIds @record ([record] -> [Id' table]
forall record id. HasField "id" record id => [record] -> [id]
ids [record]
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 :: forall record (table :: Symbol).
(?modelContext::ModelContext, Show (PrimaryKey table),
 Table record, GetTableName record ~ table,
 record ~ GetModelByTableName table) =>
[Id' table] -> IO ()
deleteRecordByIds [Id' table]
ids = do
    let theQuery :: ByteString
theQuery = ByteString
"DELETE FROM " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> forall record. Table record => ByteString
tableNameByteString @record ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" WHERE " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (forall record. Table record => ByteString
primaryKeyConditionColumnSelector @record) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" IN ?"
    let theParameters :: Only (In [Action])
theParameters = In [Action] -> Only (In [Action])
forall a. a -> Only a
PG.Only (In [Action] -> Only (In [Action]))
-> In [Action] -> Only (In [Action])
forall a b. (a -> b) -> a -> b
$ [Action] -> In [Action]
forall a. a -> In a
PG.In ([Action] -> In [Action]) -> [Action] -> In [Action]
forall a b. (a -> b) -> a -> b
$ (Id' table -> Action) -> [Id' table] -> [Action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (forall record. Table record => Id record -> Action
primaryKeyConditionForId @record) [Id' table]
ids
    Query -> Only (In [Action]) -> IO Int64
forall q.
(?modelContext::ModelContext, ToRow q) =>
Query -> q -> IO Int64
sqlExec (ByteString -> Query
PG.Query (ByteString -> Query) -> ByteString -> Query
forall a b. (a -> b) -> a -> b
$! ByteString
theQuery) Only (In [Action])
theParameters
    () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
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 :: forall record. (?modelContext::ModelContext, Table record) => IO ()
deleteAll = do
    let theQuery :: Text
theQuery = Text
"DELETE FROM " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall record. Table record => Text
tableName @record
    Query -> () -> IO Int64
forall q.
(?modelContext::ModelContext, ToRow q) =>
Query -> q -> IO Int64
sqlExec (ByteString -> Query
PG.Query (ByteString -> Query) -> (Text -> ByteString) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$! Text
theQuery) ()
    () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
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 :: NominalDiffTime
def = NominalDiffTime
0

instance Default TimeOfDay where
    def :: TimeOfDay
def = Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
0 Int
0 Pico
0

instance Default LocalTime where
    def :: LocalTime
def = Day -> TimeOfDay -> LocalTime
LocalTime Day
forall a. Default a => a
def TimeOfDay
forall a. Default a => a
def

instance Default Day where
    def :: Day
def = Integer -> Day
ModifiedJulianDay Integer
0

instance Default UTCTime where
    def :: UTCTime
def = Day -> DiffTime -> UTCTime
UTCTime Day
forall a. Default a => a
def DiffTime
0

instance Default (PG.Binary ByteString) where
    def :: Binary ByteString
def = ByteString -> Binary ByteString
forall a. a -> Binary a
PG.Binary ByteString
""

instance Default PGInterval where
    def :: PGInterval
def = ByteString -> PGInterval
PGInterval ByteString
"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 :: forall record id. HasField "id" record id => [record] -> [id]
ids [record]
records = (record -> id) -> [record] -> [id]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (.id) [record]
records
{-# INLINE ids #-}

-- | The error message of a validator can be either a plain text value or a HTML formatted value
data Violation
    = TextViolation { Violation -> Text
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 (Violation -> Violation -> Bool
(Violation -> Violation -> Bool)
-> (Violation -> Violation -> Bool) -> Eq Violation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Violation -> Violation -> Bool
== :: Violation -> Violation -> Bool
$c/= :: Violation -> Violation -> Bool
/= :: Violation -> Violation -> Bool
Eq, Int -> Violation -> ShowS
[Violation] -> ShowS
Violation -> [Char]
(Int -> Violation -> ShowS)
-> (Violation -> [Char])
-> ([Violation] -> ShowS)
-> Show Violation
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Violation -> ShowS
showsPrec :: Int -> Violation -> ShowS
$cshow :: Violation -> [Char]
show :: Violation -> [Char]
$cshowList :: [Violation] -> ShowS
showList :: [Violation] -> ShowS
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
    { MetaBag -> [(Text, Violation)]
annotations            :: ![(Text, Violation)] -- ^ Stores validation failures, as a list of (field name, error) pairs. E.g. @annotations = [ ("name", TextViolation "cannot be empty") ]@
    , MetaBag -> [Text]
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'
    , MetaBag -> Maybe Dynamic
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 (Int -> MetaBag -> ShowS
[MetaBag] -> ShowS
MetaBag -> [Char]
(Int -> MetaBag -> ShowS)
-> (MetaBag -> [Char]) -> ([MetaBag] -> ShowS) -> Show MetaBag
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MetaBag -> ShowS
showsPrec :: Int -> MetaBag -> ShowS
$cshow :: MetaBag -> [Char]
show :: MetaBag -> [Char]
$cshowList :: [MetaBag] -> ShowS
showList :: [MetaBag] -> ShowS
Show)

instance Eq MetaBag where
    MetaBag { [(Text, Violation)]
annotations :: MetaBag -> [(Text, Violation)]
annotations :: [(Text, Violation)]
annotations, [Text]
touchedFields :: MetaBag -> [Text]
touchedFields :: [Text]
touchedFields } == :: MetaBag -> MetaBag -> Bool
== MetaBag { annotations :: MetaBag -> [(Text, Violation)]
annotations = [(Text, Violation)]
annotations', touchedFields :: MetaBag -> [Text]
touchedFields = [Text]
touchedFields' } = [(Text, Violation)]
annotations [(Text, Violation)] -> [(Text, Violation)] -> Bool
forall a. Eq a => a -> a -> Bool
== [(Text, Violation)]
annotations' Bool -> Bool -> Bool
&& [Text]
touchedFields [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text]
touchedFields'

instance Default MetaBag where
    def :: MetaBag
def = MetaBag { annotations :: [(Text, Violation)]
annotations = [], touchedFields :: [Text]
touchedFields = [], originalDatabaseRecord :: Maybe Dynamic
originalDatabaseRecord = Maybe Dynamic
forall a. Maybe a
Nothing }
    {-# INLINE def #-}

instance SetField "annotations" MetaBag [(Text, Violation)] where
    setField :: [(Text, Violation)] -> MetaBag -> MetaBag
setField [(Text, Violation)]
value MetaBag
meta = MetaBag
meta { annotations = value }
    {-# INLINE setField #-}

instance SetField "touchedFields" MetaBag [Text] where
    setField :: [Text] -> MetaBag -> MetaBag
setField [Text]
value MetaBag
meta = MetaBag
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 :: forall model. HasField "meta" model MetaBag => model -> Bool
didChangeRecord record
record = [Text] -> Bool
forall value. IsEmpty value => value -> Bool
isEmpty record
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 :: forall (fieldName :: Symbol) fieldValue record.
(KnownSymbol fieldName, HasField fieldName record fieldValue,
 HasField "meta" record MetaBag, Eq fieldValue, Typeable record) =>
Proxy fieldName -> record -> Bool
didChange Proxy fieldName
field record
record = Proxy fieldName -> record -> Bool
forall (fieldName :: Symbol) fieldValue record.
(KnownSymbol fieldName, HasField fieldName record fieldValue,
 HasField "meta" record MetaBag, Eq fieldValue, Typeable record) =>
Proxy fieldName -> record -> Bool
didTouchField Proxy fieldName
field record
record Bool -> Bool -> Bool
&& Bool
didChangeField
    where
        didChangeField :: Bool
        didChangeField :: Bool
didChangeField = fieldValue
originalFieldValue fieldValue -> fieldValue -> Bool
forall a. Eq a => a -> a -> Bool
/= fieldValue
fieldValue

        fieldValue :: fieldValue
        fieldValue :: fieldValue
fieldValue = record
record record -> (record -> fieldValue) -> fieldValue
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @fieldName

        originalFieldValue :: fieldValue
        originalFieldValue :: fieldValue
originalFieldValue =
            record
record.meta.originalDatabaseRecord
            Maybe Dynamic -> (Maybe Dynamic -> Dynamic) -> Dynamic
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Dynamic -> Maybe Dynamic -> Dynamic
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Dynamic
forall a. HasCallStack => [Char] -> a
error [Char]
"didChange called on a record without originalDatabaseRecord")
            Dynamic -> (Dynamic -> Maybe record) -> Maybe record
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall a. Typeable a => Dynamic -> Maybe a
fromDynamic @record
            Maybe record -> (Maybe record -> record) -> record
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> record -> Maybe record -> record
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> record
forall a. HasCallStack => [Char] -> a
error [Char]
"didChange failed to retrieve originalDatabaseRecord")
            record -> (record -> fieldValue) -> fieldValue
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
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 :: forall (fieldName :: Symbol) fieldValue record.
(KnownSymbol fieldName, HasField fieldName record fieldValue,
 HasField "meta" record MetaBag, Eq fieldValue, Typeable record) =>
Proxy fieldName -> record -> Bool
didTouchField Proxy fieldName
field record
record =
    record
record.meta.touchedFields
    [Text] -> ([Text] -> Bool) -> Bool
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Element [Text] -> [Text] -> Bool
forall container.
(MonoFoldable container, Eq (Element container)) =>
Element container -> container -> Bool
includes (forall (symbol :: Symbol). KnownSymbol symbol => Text
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 (FieldWithDefault valueType -> FieldWithDefault valueType -> Bool
(FieldWithDefault valueType -> FieldWithDefault valueType -> Bool)
-> (FieldWithDefault valueType
    -> FieldWithDefault valueType -> Bool)
-> Eq (FieldWithDefault valueType)
forall valueType.
Eq valueType =>
FieldWithDefault valueType -> FieldWithDefault valueType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall valueType.
Eq valueType =>
FieldWithDefault valueType -> FieldWithDefault valueType -> Bool
== :: FieldWithDefault valueType -> FieldWithDefault valueType -> Bool
$c/= :: forall valueType.
Eq valueType =>
FieldWithDefault valueType -> FieldWithDefault valueType -> Bool
/= :: FieldWithDefault valueType -> FieldWithDefault valueType -> Bool
Eq, Int -> FieldWithDefault valueType -> ShowS
[FieldWithDefault valueType] -> ShowS
FieldWithDefault valueType -> [Char]
(Int -> FieldWithDefault valueType -> ShowS)
-> (FieldWithDefault valueType -> [Char])
-> ([FieldWithDefault valueType] -> ShowS)
-> Show (FieldWithDefault valueType)
forall valueType.
Show valueType =>
Int -> FieldWithDefault valueType -> ShowS
forall valueType.
Show valueType =>
[FieldWithDefault valueType] -> ShowS
forall valueType.
Show valueType =>
FieldWithDefault valueType -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall valueType.
Show valueType =>
Int -> FieldWithDefault valueType -> ShowS
showsPrec :: Int -> FieldWithDefault valueType -> ShowS
$cshow :: forall valueType.
Show valueType =>
FieldWithDefault valueType -> [Char]
show :: FieldWithDefault valueType -> [Char]
$cshowList :: forall valueType.
Show valueType =>
[FieldWithDefault valueType] -> ShowS
showList :: [FieldWithDefault valueType] -> ShowS
Show)

instance ToField valueType => ToField (FieldWithDefault valueType) where
  toField :: FieldWithDefault valueType -> Action
toField FieldWithDefault valueType
Default = Builder -> Action
Plain Builder
"DEFAULT"
  toField (NonDefault valueType
a) = valueType -> Action
forall a. ToField a => a -> Action
toField valueType
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 :: forall (name :: Symbol) model value.
(KnownSymbol name, HasField name model value,
 HasField "meta" model MetaBag) =>
Proxy name -> model -> FieldWithDefault value
fieldWithDefault Proxy name
name model
model
  | [Char] -> Element [Text]
forall a b. ConvertibleStrings a b => a -> b
cs (Proxy name -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal Proxy name
name) Element [Text] -> [Text] -> Bool
forall container.
(MonoFoldable container, Eq (Element container)) =>
Element container -> container -> Bool
`elem` model
model.meta.touchedFields =
    value -> FieldWithDefault value
forall valueType. valueType -> FieldWithDefault valueType
NonDefault (Proxy name -> model -> value
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get Proxy name
name model
model)
  | Bool
otherwise = FieldWithDefault value
forall valueType. FieldWithDefault valueType
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 (FieldWithUpdate name value -> FieldWithUpdate name value -> Bool
(FieldWithUpdate name value -> FieldWithUpdate name value -> Bool)
-> (FieldWithUpdate name value
    -> FieldWithUpdate name value -> Bool)
-> Eq (FieldWithUpdate name value)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (name :: k) value.
Eq value =>
FieldWithUpdate name value -> FieldWithUpdate name value -> Bool
$c== :: forall k (name :: k) value.
Eq value =>
FieldWithUpdate name value -> FieldWithUpdate name value -> Bool
== :: FieldWithUpdate name value -> FieldWithUpdate name value -> Bool
$c/= :: forall k (name :: k) value.
Eq value =>
FieldWithUpdate name value -> FieldWithUpdate name value -> Bool
/= :: FieldWithUpdate name value -> FieldWithUpdate name value -> Bool
Eq, Int -> FieldWithUpdate name value -> ShowS
[FieldWithUpdate name value] -> ShowS
FieldWithUpdate name value -> [Char]
(Int -> FieldWithUpdate name value -> ShowS)
-> (FieldWithUpdate name value -> [Char])
-> ([FieldWithUpdate name value] -> ShowS)
-> Show (FieldWithUpdate name value)
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
forall k (name :: k) value.
Show value =>
Int -> FieldWithUpdate name value -> ShowS
forall k (name :: k) value.
Show value =>
[FieldWithUpdate name value] -> ShowS
forall k (name :: k) value.
Show value =>
FieldWithUpdate name value -> [Char]
$cshowsPrec :: forall k (name :: k) value.
Show value =>
Int -> FieldWithUpdate name value -> ShowS
showsPrec :: Int -> FieldWithUpdate name value -> ShowS
$cshow :: forall k (name :: k) value.
Show value =>
FieldWithUpdate name value -> [Char]
show :: FieldWithUpdate name value -> [Char]
$cshowList :: forall k (name :: k) value.
Show value =>
[FieldWithUpdate name value] -> ShowS
showList :: [FieldWithUpdate name value] -> ShowS
Show)

instance (KnownSymbol name, ToField value) => ToField (FieldWithUpdate name value) where
  toField :: FieldWithUpdate name value -> Action
toField (NoUpdate Proxy name
name) =
    Builder -> Action
Plain ([Char] -> Builder
forall a. IsString a => [Char] -> a
ClassyPrelude.fromString ([Char] -> Builder) -> [Char] -> Builder
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> Text
fieldNameToColumnName (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy name -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal Proxy name
name)
  toField (Update value
a) = value -> Action
forall a. ToField a => a -> Action
toField value
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 :: forall (name :: Symbol) model value.
(KnownSymbol name, HasField name model value,
 HasField "meta" model MetaBag) =>
Proxy name -> model -> FieldWithUpdate name value
fieldWithUpdate Proxy name
name model
model
  | [Char] -> Element [Text]
forall a b. ConvertibleStrings a b => a -> b
cs (Proxy name -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal Proxy name
name) Element [Text] -> [Text] -> Bool
forall container.
(MonoFoldable container, Eq (Element container)) =>
Element container -> container -> Bool
`elem` model
model.meta.touchedFields =
    value -> FieldWithUpdate name value
forall {k} (name :: k) value. value -> FieldWithUpdate name value
Update (Proxy name -> model -> value
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get Proxy name
name model
model)
  | Bool
otherwise = Proxy name -> FieldWithUpdate name value
forall {k} (name :: k) value.
Proxy name -> FieldWithUpdate name value
NoUpdate Proxy name
name

instance (ToJSON (PrimaryKey a)) => ToJSON (Id' a) where
  toJSON :: Id' a -> Value
toJSON (Id PrimaryKey a
a) = PrimaryKey a -> Value
forall a. ToJSON a => a -> Value
toJSON PrimaryKey a
a

instance (FromJSON (PrimaryKey a)) => FromJSON (Id' a) where
    parseJSON :: Value -> Parser (Id' a)
parseJSON Value
value = PrimaryKey a -> Id' a
forall (table :: Symbol). PrimaryKey table -> Id' table
Id (PrimaryKey a -> Id' a) -> Parser (PrimaryKey a) -> Parser (Id' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (PrimaryKey a)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value

-- | Thrown by 'fetchOne' when the query result is empty
data RecordNotFoundException
    = RecordNotFoundException { RecordNotFoundException -> (ByteString, [Action])
queryAndParams :: (ByteString, [Action]) }
    deriving (Int -> RecordNotFoundException -> ShowS
[RecordNotFoundException] -> ShowS
RecordNotFoundException -> [Char]
(Int -> RecordNotFoundException -> ShowS)
-> (RecordNotFoundException -> [Char])
-> ([RecordNotFoundException] -> ShowS)
-> Show RecordNotFoundException
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RecordNotFoundException -> ShowS
showsPrec :: Int -> RecordNotFoundException -> ShowS
$cshow :: RecordNotFoundException -> [Char]
show :: RecordNotFoundException -> [Char]
$cshowList :: [RecordNotFoundException] -> ShowS
showList :: [RecordNotFoundException] -> ShowS
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
    { EnhancedSqlError -> Query
sqlErrorQuery :: Query
    , EnhancedSqlError -> [Action]
sqlErrorQueryParams :: [Action]
    , EnhancedSqlError -> SqlError
sqlError :: PG.SqlError
    } deriving (Int -> EnhancedSqlError -> ShowS
[EnhancedSqlError] -> ShowS
EnhancedSqlError -> [Char]
(Int -> EnhancedSqlError -> ShowS)
-> (EnhancedSqlError -> [Char])
-> ([EnhancedSqlError] -> ShowS)
-> Show EnhancedSqlError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnhancedSqlError -> ShowS
showsPrec :: Int -> EnhancedSqlError -> ShowS
$cshow :: EnhancedSqlError -> [Char]
show :: EnhancedSqlError -> [Char]
$cshowList :: [EnhancedSqlError] -> ShowS
showList :: [EnhancedSqlError] -> ShowS
Show)

-- | Catches 'SqlError' and wraps them in 'EnhancedSqlError'
enhanceSqlError :: PG.ToRow parameters => Query -> parameters -> IO a -> IO a
enhanceSqlError :: forall parameters a.
ToRow parameters =>
Query -> parameters -> IO a -> IO a
enhanceSqlError Query
sqlErrorQuery parameters
sqlErrorQueryParams IO a
block = IO a -> (SqlError -> IO a) -> IO a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch IO a
block (\SqlError
sqlError -> EnhancedSqlError -> IO a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO EnhancedSqlError { Query
sqlErrorQuery :: Query
sqlErrorQuery :: Query
sqlErrorQuery, sqlErrorQueryParams :: [Action]
sqlErrorQueryParams = parameters -> [Action]
forall a. ToRow a => a -> [Action]
PG.toRow parameters
sqlErrorQueryParams, SqlError
sqlError :: SqlError
sqlError :: SqlError
sqlError })
{-# INLINE enhanceSqlError #-}

instance Exception EnhancedSqlError

instance Default Aeson.Value where
    def :: Value
def = Value
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 :: [value] -> Action
toField [value]
list = PGArray value -> Action
forall a. ToField a => a -> Action
toField ([value] -> PGArray value
forall a. [a] -> PGArray a
PG.PGArray [value]
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 :: FieldParser [value]
fromField Field
field Maybe ByteString
value = PGArray value -> [value]
forall a. PGArray a -> [a]
PG.fromPGArray (PGArray value -> [value])
-> Conversion (PGArray value) -> Conversion [value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FieldParser (PGArray value)
forall a. FromField a => FieldParser a
fromField Field
field Maybe ByteString
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 :: (?modelContext::ModelContext) => ByteString -> IO ()
trackTableRead ByteString
tableName = case ?modelContext::ModelContext
ModelContext
?modelContext.trackTableReadCallback of
    Just ByteString -> IO ()
callback -> ByteString -> IO ()
callback ByteString
tableName
    Maybe (ByteString -> IO ())
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
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 :: (?modelContext::ModelContext) =>
((?modelContext::ModelContext,
  ?touchedTables::IORef (Set ByteString)) =>
 IO ())
-> IO ()
withTableReadTracker (?modelContext::ModelContext,
 ?touchedTables::IORef (Set ByteString)) =>
IO ()
trackedSection = do
    IORef (Set ByteString)
touchedTablesVar <- Set ByteString -> IO (IORef (Set ByteString))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Set ByteString
forall a. Set a
Set.empty
    let trackTableReadCallback :: Maybe (ByteString -> IO ())
trackTableReadCallback = (ByteString -> IO ()) -> Maybe (ByteString -> IO ())
forall a. a -> Maybe a
Just \ByteString
tableName -> IORef (Set ByteString)
-> (Set ByteString -> Set ByteString) -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef' IORef (Set ByteString)
touchedTablesVar (ByteString -> Set ByteString -> Set ByteString
forall a. Ord a => a -> Set a -> Set a
Set.insert ByteString
tableName)
    let oldModelContext :: ModelContext
oldModelContext = ?modelContext::ModelContext
ModelContext
?modelContext
    let ?modelContext = ModelContext
oldModelContext { trackTableReadCallback }
    let ?touchedTables = ?touchedTables::IORef (Set ByteString)
IORef (Set ByteString)
touchedTablesVar
    IO ()
(?modelContext::ModelContext,
 ?touchedTables::IORef (Set ByteString)) =>
IO ()
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 :: forall record (fieldName :: Symbol) value.
(KnownSymbol fieldName, HasField fieldName record value,
 Eq value) =>
Proxy fieldName -> value -> [record] -> [record]
onlyWhere Proxy fieldName
field value
value [record]
records = (Element [record] -> Bool) -> [record] -> [record]
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter (\Element [record]
record -> Proxy fieldName -> record -> value
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get Proxy fieldName
field record
Element [record]
record value -> value -> Bool
forall a. Eq a => a -> a -> Bool
== value
value) [record]
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 :: forall record (fieldName :: Symbol) value referencedRecord.
(KnownSymbol fieldName, HasField fieldName record value, Eq value,
 HasField "id" referencedRecord value) =>
Proxy fieldName -> referencedRecord -> [record] -> [record]
onlyWhereReferences Proxy fieldName
field referencedRecord
referenced [record]
records = (Element [record] -> Bool) -> [record] -> [record]
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter (\Element [record]
record -> Proxy fieldName -> record -> value
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get Proxy fieldName
field record
Element [record]
record value -> value -> Bool
forall a. Eq a => a -> a -> Bool
== referencedRecord
referenced.id) [record]
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 :: forall record (fieldName :: Symbol) value referencedRecord.
(KnownSymbol fieldName, HasField fieldName record (Maybe value),
 Eq value, HasField "id" referencedRecord value) =>
Proxy fieldName -> referencedRecord -> [record] -> [record]
onlyWhereReferencesMaybe Proxy fieldName
field referencedRecord
referenced [record]
records = (Element [record] -> Bool) -> [record] -> [record]
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter (\Element [record]
record -> Proxy fieldName -> record -> Maybe value
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get Proxy fieldName
field record
Element [record]
record Maybe value -> Maybe value -> Bool
forall a. Eq a => a -> a -> Bool
== value -> Maybe value
forall a. a -> Maybe a
Just referencedRecord
referenced.id) [record]
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 :: forall model. HasField "meta" model MetaBag => model -> Bool
isValid record
record = [(Text, Violation)] -> Bool
forall value. IsEmpty value => value -> Bool
isEmpty record
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 :: forall record id.
(Table record, SetField "id" record id, Default id,
 SetField "meta" record MetaBag) =>
record -> record
copyRecord record
existingRecord =
    let
        fieldsExceptId :: [ByteString]
fieldsExceptId = (forall record. Table record => [ByteString]
columnNames @record) [ByteString] -> ([ByteString] -> [ByteString]) -> [ByteString]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Element [ByteString] -> Bool) -> [ByteString] -> [ByteString]
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter (\Element [ByteString]
field -> ByteString
Element [ByteString]
field ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"id")

        meta :: MetaBag
        meta :: MetaBag
meta = MetaBag
forall a. Default a => a
def { touchedFields = map (IHP.NameSupport.columnNameToFieldName . cs) fieldsExceptId }
    in
        record
existingRecord
            record -> (record -> record) -> record
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Proxy "id" -> id -> record -> record
forall model (name :: Symbol) value.
(KnownSymbol name, SetField name model value) =>
Proxy name -> value -> model -> model
set Proxy "id"
#id id
forall a. Default a => a
def
            record -> (record -> record) -> record
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Proxy "meta" -> MetaBag -> record -> record
forall model (name :: Symbol) value.
(KnownSymbol name, SetField name model value) =>
Proxy name -> value -> model -> model
set Proxy "meta"
#meta MetaBag
meta