Safe Haskell | None |
---|
IHP.ModelSupport
Contents
Synopsis
- data RecordNotFoundException = RecordNotFoundException {
- queryAndParams :: (ByteString, [Action])
- data FieldWithUpdate name value
- data FieldWithDefault valueType
- = Default
- | NonDefault valueType
- data MetaBag = MetaBag {
- annotations :: ![(Text, Text)]
- touchedFields :: ![Text]
- originalDatabaseRecord :: Maybe Dynamic
- type NormalizeModel model = GetModelByTableName (GetTableName model)
- class Record model where
- newRecord :: model
- type family Include' (name :: [Symbol]) model where ...
- type family Include (name :: Symbol) model
- class ParsePrimaryKey primaryKey where
- parsePrimaryKey :: Text -> Maybe primaryKey
- type Id model = Id' (GetTableName model)
- newtype Id' table = Id (PrimaryKey table)
- type family PrimaryKey (tableName :: Symbol)
- type family GetModelName model :: Symbol
- type FieldName = ByteString
- class InputValue a where
- inputValue :: a -> Text
- class CanUpdate a where
- updateRecord :: (?modelContext :: ModelContext) => a -> IO a
- class CanCreate a where
- create :: (?modelContext :: ModelContext) => a -> IO a
- createMany :: (?modelContext :: ModelContext) => [a] -> IO [a]
- type family GetModelByTableName (tableName :: Symbol) :: Type
- type family GetTableName model :: Symbol
- type family GetModelById id :: Type where ...
- data ModelContext = ModelContext {
- connectionPool :: Pool Connection
- transactionConnection :: Maybe Connection
- logger :: Logger
- trackTableReadCallback :: Maybe (ByteString -> IO ())
- notConnectedModelContext :: Logger -> ModelContext
- createModelContext :: NominalDiffTime -> Int -> ByteString -> Logger -> IO ModelContext
- createRecord :: (?modelContext :: ModelContext, CanCreate model) => model -> IO model
- isNew :: forall model id. (HasField "id" model id, Default id, Eq id) => model -> Bool
- getModelName :: forall model. KnownSymbol (GetModelName model) => Text
- recordToInputValue :: (HasField "id" entity (Id entity), Show (PrimaryKey (GetTableName entity))) => entity -> Text
- textToId :: (ParsePrimaryKey (PrimaryKey model), ConvertibleStrings text Text) => text -> Id' model
- measureTimeIfLogging :: (?modelContext :: ModelContext, Show q) => IO a -> Query -> q -> IO a
- sqlQuery :: (?modelContext :: ModelContext, ToRow q, FromRow r, Show q) => Query -> q -> IO [r]
- sqlExec :: (?modelContext :: ModelContext, ToRow q, Show q) => Query -> q -> IO Int64
- withDatabaseConnection :: (?modelContext :: ModelContext) => (Connection -> IO a) -> IO a
- sqlQueryScalar :: (?modelContext :: ModelContext) => (ToRow q, Show q, FromField value) => Query -> q -> IO value
- withTransaction :: (?modelContext :: ModelContext) => ((?modelContext :: ModelContext) => IO a) -> IO a
- transactionConnectionOrError :: (?modelContext :: ModelContext) => Connection
- commitTransaction :: (?modelContext :: ModelContext) => IO ()
- rollbackTransaction :: (?modelContext :: ModelContext) => IO ()
- withTransactionConnection :: (?modelContext :: ModelContext) => ((?modelContext :: ModelContext) => IO a) -> IO a
- tableName :: forall model. KnownSymbol (GetTableName model) => Text
- tableNameByteString :: forall model. KnownSymbol (GetTableName model) => ByteString
- logQuery :: (?modelContext :: ModelContext, Show query, Show parameters) => query -> parameters -> NominalDiffTime -> IO ()
- deleteRecord :: forall model id. (?modelContext :: ModelContext, Show id, KnownSymbol (GetTableName model), HasField "id" model id, ToField id) => model -> IO ()
- deleteRecordById :: forall model id. (?modelContext :: ModelContext, Show id, KnownSymbol (GetTableName model), HasField "id" model id, ToField id) => id -> IO ()
- deleteRecords :: forall record id. (?modelContext :: ModelContext, Show id, KnownSymbol (GetTableName record), HasField "id" record id, record ~ GetModelById id, ToField id) => [record] -> IO ()
- deleteAll :: forall record. (?modelContext :: ModelContext, KnownSymbol (GetTableName record)) => IO ()
- ids :: HasField "id" record id => [record] -> [id]
- didChangeRecord :: HasField "meta" record MetaBag => record -> Bool
- didChange :: forall fieldName fieldValue record. (KnownSymbol fieldName, HasField fieldName record fieldValue, HasField "meta" record MetaBag, Eq fieldValue, Typeable record) => Proxy fieldName -> record -> Bool
- fieldWithDefault :: (KnownSymbol name, HasField name model value, HasField "meta" model MetaBag) => Proxy name -> model -> FieldWithDefault value
- fieldWithUpdate :: (KnownSymbol name, HasField name model value, HasField "meta" model MetaBag) => Proxy name -> model -> FieldWithUpdate name value
- trackTableRead :: (?modelContext :: ModelContext) => ByteString -> IO ()
- withTableReadTracker :: (?modelContext :: ModelContext) => ((?modelContext :: ModelContext, ?touchedTables :: IORef (Set ByteString)) => IO ()) -> IO ()
- module IHP.Postgres.Point
- module IHP.Postgres.Inet
Documentation
data RecordNotFoundException Source #
Thrown by fetchOne
when the query result is empty
Constructors
RecordNotFoundException | |
Fields
|
Instances
Show RecordNotFoundException Source # | |
Defined in IHP.ModelSupport Methods showsPrec :: Int -> RecordNotFoundException -> ShowS # show :: RecordNotFoundException -> String showList :: [RecordNotFoundException] -> ShowS # | |
Exception RecordNotFoundException Source # | |
Defined in IHP.ModelSupport |
data FieldWithUpdate name value Source #
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
Instances
Eq value => Eq (FieldWithUpdate name value) Source # | |
Defined in IHP.ModelSupport Methods (==) :: FieldWithUpdate name value -> FieldWithUpdate name value -> Bool # (/=) :: FieldWithUpdate name value -> FieldWithUpdate name value -> Bool # | |
Show value => Show (FieldWithUpdate name value) Source # | |
Defined in IHP.ModelSupport Methods showsPrec :: Int -> FieldWithUpdate name value -> ShowS # show :: FieldWithUpdate name value -> String showList :: [FieldWithUpdate name value] -> ShowS # | |
(KnownSymbol name, ToField value) => ToField (FieldWithUpdate name value) Source # | |
Defined in IHP.ModelSupport Methods toField :: FieldWithUpdate name value -> Action |
data FieldWithDefault valueType Source #
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
Constructors
Default | |
NonDefault valueType |
Instances
Eq valueType => Eq (FieldWithDefault valueType) Source # | |
Defined in IHP.ModelSupport Methods (==) :: FieldWithDefault valueType -> FieldWithDefault valueType -> Bool # (/=) :: FieldWithDefault valueType -> FieldWithDefault valueType -> Bool # | |
Show valueType => Show (FieldWithDefault valueType) Source # | |
Defined in IHP.ModelSupport Methods showsPrec :: Int -> FieldWithDefault valueType -> ShowS # show :: FieldWithDefault valueType -> String showList :: [FieldWithDefault valueType] -> ShowS # | |
ToField valueType => ToField (FieldWithDefault valueType) Source # | |
Defined in IHP.ModelSupport Methods toField :: FieldWithDefault valueType -> Action |
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.
Constructors
MetaBag | |
Fields
|
type NormalizeModel model = GetModelByTableName (GetTableName model) Source #
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
class ParsePrimaryKey primaryKey where Source #
Methods
parsePrimaryKey :: Text -> Maybe primaryKey Source #
Instances
ParsePrimaryKey Text Source # | |
Defined in IHP.ModelSupport | |
ParsePrimaryKey UUID Source # | |
Defined in IHP.ModelSupport |
type Id model = Id' (GetTableName model) Source #
We need to map the model to it's 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
Constructors
Id (PrimaryKey table) |
Instances
Eq (PrimaryKey table) => Eq (Id' table) Source # | |
(KnownSymbol table, Data (PrimaryKey table)) => Data (Id' table) Source # | |
Defined in IHP.ModelSupport Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Id' table -> c (Id' table) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Id' table) # toConstr :: Id' table -> Constr # dataTypeOf :: Id' table -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Id' table)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Id' table)) # gmapT :: (forall b. Data b => b -> b) -> Id' table -> Id' table # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Id' table -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Id' table -> r # gmapQ :: (forall d. Data d => d -> u) -> Id' table -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Id' table -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Id' table -> m (Id' table) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Id' table -> m (Id' table) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Id' table -> m (Id' table) # | |
Ord (PrimaryKey table) => Ord (Id' table) Source # | |
Show (PrimaryKey model) => Show (Id' model) Source # | |
(Read (PrimaryKey model), ParsePrimaryKey (PrimaryKey model)) => IsString (Id' model) Source # | 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 |
Defined in IHP.ModelSupport Methods fromString :: String -> Id' model # | |
(KnownSymbol table, NFData (PrimaryKey table)) => NFData (Id' table) Source # | |
Defined in IHP.ModelSupport | |
Hashable (PrimaryKey table) => Hashable (Id' table) Source # | |
Defined in IHP.ModelSupport | |
Default (PrimaryKey model) => Default (Id' model) Source # | |
Defined in IHP.ModelSupport | |
IsEmpty (PrimaryKey table) => IsEmpty (Id' table) Source # | |
ToField (PrimaryKey model) => ToField (Id' model) Source # | |
Defined in IHP.ModelSupport | |
ToJSON (PrimaryKey a) => ToJSON (Id' a) Source # | |
Defined in IHP.ModelSupport | |
FromField (PrimaryKey model) => FromField (Id' model) Source # | |
Defined in IHP.ModelSupport | |
Newtype (Id' model) Source # | |
InputValue (PrimaryKey model') => InputValue (Id' model') Source # | |
Defined in IHP.ModelSupport Methods inputValue :: Id' model' -> Text Source # | |
ParamReader (PrimaryKey model') => ParamReader (Id' model') Source # | |
Defined in IHP.Controller.Param Methods readParameter :: ByteString -> Either ByteString (Id' model') Source # readParameterJSON :: Value -> Either ByteString (Id' model') Source # | |
(model ~ GetModelById (Id' table), value ~ Id' table, HasField "id" model value, ToField (PrimaryKey table), GetModelByTableName (GetTableName model) ~ model) => Fetchable [Id' table] model Source # | |
(model ~ GetModelById (Id' table), GetTableName model ~ table, FilterPrimaryKey table) => Fetchable (Maybe (Id' table)) model Source # | |
(model ~ GetModelById (Id' table), GetTableName model ~ table, FilterPrimaryKey table) => Fetchable (Id' table) model Source # | |
(TypeError (('Text "Looks like you forgot to pass a " :<>: 'ShowType (GetModelByTableName record)) :<>: 'Text " id to this data constructor.") :: Constraint) => Eq (Id' record -> controller) Source # | |
type O (Id' model) Source # | |
Defined in IHP.ModelSupport | |
type FetchResult [Id' table] model Source # | |
Defined in IHP.Fetch | |
type FetchResult (Maybe (Id' table)) model Source # | |
Defined in IHP.Fetch | |
type FetchResult (Id' table) model Source # | |
Defined in IHP.Fetch |
type family PrimaryKey (tableName :: Symbol) Source #
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 GetModelName model :: Symbol Source #
type FieldName = ByteString Source #
class InputValue a where Source #
Methods
inputValue :: a -> Text Source #
Instances
class CanUpdate a where Source #
Methods
updateRecord :: (?modelContext :: ModelContext) => a -> IO a Source #
class CanCreate a where Source #
Methods
create :: (?modelContext :: ModelContext) => a -> IO a Source #
createMany :: (?modelContext :: ModelContext) => [a] -> IO [a] Source #
type family GetModelByTableName (tableName :: Symbol) :: Type Source #
type family GetTableName model :: Symbol Source #
type family GetModelById id :: Type where ... Source #
Equations
GetModelById (Maybe (Id' tableName)) = Maybe (GetModelByTableName tableName) | |
GetModelById (Id' tableName) = GetModelByTableName tableName |
data ModelContext Source #
Provides the db connection and some IHP-specific db configuration
Constructors
ModelContext | |
Fields
|
Instances
LoggingProvider ModelContext Source # | |
Defined in IHP.ModelSupport Methods getLogger :: ModelContext -> Logger Source # |
notConnectedModelContext :: Logger -> ModelContext Source #
Provides a mock ModelContext to be used when a database connection is not available
createModelContext :: NominalDiffTime -> Int -> ByteString -> Logger -> IO ModelContext Source #
createRecord :: (?modelContext :: ModelContext, CanCreate model) => model -> IO model Source #
isNew :: forall model id. (HasField "id" model id, Default id, Eq id) => model -> Bool Source #
Returns True
when the record has not been saved to the database yet. Returns False
otherwise.
Example: Returns False
when a record has not been inserted yet.
>>>
let project = newRecord @Project
>>>
isNew project
False
Example: Returns True
after inserting a record.
>>>
project <- createRecord project
>>>
isNew project
True
Example: Returns True
for records which have been fetched from the database.
>>>
book <- query @Book |> fetchOne
>>>
isNew book
False
getModelName :: forall model. KnownSymbol (GetModelName model) => Text Source #
Returns the model name of a given model as Text
Example:
>>>
modelName @User
"User"
>>>
modelName @Project
"Project"
recordToInputValue :: (HasField "id" entity (Id entity), Show (PrimaryKey (GetTableName entity))) => entity -> Text Source #
textToId :: (ParsePrimaryKey (PrimaryKey model), ConvertibleStrings text Text) => text -> Id' model Source #
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
measureTimeIfLogging :: (?modelContext :: ModelContext, Show q) => IO a -> Query -> q -> IO a Source #
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.
sqlQuery :: (?modelContext :: ModelContext, ToRow q, FromRow r, Show q) => Query -> q -> IO [r] Source #
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.
sqlExec :: (?modelContext :: ModelContext, ToRow q, Show q) => Query -> q -> IO Int64 Source #
Runs a sql statement (like a CREATE statement)
Example:
sqlExec "CREATE TABLE users ()" ()
withDatabaseConnection :: (?modelContext :: ModelContext) => (Connection -> IO a) -> IO a Source #
sqlQueryScalar :: (?modelContext :: ModelContext) => (ToRow q, Show q, FromField value) => Query -> q -> IO value Source #
Runs a raw sql query which results in a single scalar value such as an integer or string
Example:
usersCount <- sqlQuery "SELECT COUNT(*) FROM users"
Take a look at IHP.QueryBuilder for a typesafe approach on building simple queries.
withTransaction :: (?modelContext :: ModelContext) => ((?modelContext :: ModelContext) => IO a) -> IO a Source #
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 (get #id company) |> createRecord company <- company |> set #ownerId (get #id user) |> updateRecord
transactionConnectionOrError :: (?modelContext :: ModelContext) => Connection Source #
Returns the postgres connection when called within a withTransaction
block
Throws an error if called from outside a withTransaction
commitTransaction :: (?modelContext :: ModelContext) => IO () Source #
rollbackTransaction :: (?modelContext :: ModelContext) => IO () Source #
withTransactionConnection :: (?modelContext :: ModelContext) => ((?modelContext :: ModelContext) => IO a) -> IO a Source #
tableName :: forall model. KnownSymbol (GetTableName model) => Text Source #
Returns the table name of a given model.
Example:
>>>
tableName @User
"users"
tableNameByteString :: forall model. KnownSymbol (GetTableName model) => ByteString Source #
Returns the table name of a given model as a bytestring.
Example:
>>>
tableNameByteString @User
"users"
logQuery :: (?modelContext :: ModelContext, Show query, Show parameters) => query -> parameters -> NominalDiffTime -> IO () Source #
deleteRecord :: forall model id. (?modelContext :: ModelContext, Show id, KnownSymbol (GetTableName model), HasField "id" model id, ToField id) => model -> IO () Source #
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.
deleteRecordById :: forall model id. (?modelContext :: ModelContext, Show id, KnownSymbol (GetTableName model), HasField "id" model id, ToField id) => id -> IO () Source #
Like deleteRecord
but using an Id
>>>
let project :: Id Project = ...
>>>
delete projectId
DELETE FROM projects WHERE id = '..'
deleteRecords :: forall record id. (?modelContext :: ModelContext, Show id, KnownSymbol (GetTableName record), HasField "id" record id, record ~ GetModelById id, ToField id) => [record] -> IO () Source #
Runs a DELETE
query for a list of records.
>>>
let projects :: [Project] = ...
>>>
deleteRecords projects
DELETE FROM projects WHERE id IN (..)
deleteAll :: forall record. (?modelContext :: ModelContext, KnownSymbol (GetTableName record)) => IO () Source #
Runs a DELETE
query to delete all rows in a table.
>>>
deleteAll @Project
DELETE FROM projects
ids :: HasField "id" record id => [record] -> [id] Source #
Returns the ids for a list of models
Shorthand for map (get #id) records
.
>>>
users <- query @User |> fetch
>>>
ids users
[227fbba3-0578-4eb8-807d-b9b692c3644f, 9d7874f2-5343-429b-bcc4-8ee62a5a6895, ...] :: [Id User]
didChangeRecord :: HasField "meta" record MetaBag => record -> Bool Source #
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
didChange :: forall fieldName fieldValue record. (KnownSymbol fieldName, HasField fieldName record fieldValue, HasField "meta" record MetaBag, Eq fieldValue, Typeable record) => Proxy fieldName -> record -> Bool Source #
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")
fieldWithDefault :: (KnownSymbol name, HasField name model value, HasField "meta" model MetaBag) => Proxy name -> model -> FieldWithDefault value Source #
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 $sel:touchedFields:MetaBag
attribute of the meta
field.
fieldWithUpdate :: (KnownSymbol name, HasField name model value, HasField "meta" model MetaBag) => Proxy name -> model -> FieldWithUpdate name value Source #
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 $sel:touchedFields:MetaBag
attribute of the meta
field.
trackTableRead :: (?modelContext :: ModelContext) => ByteString -> IO () Source #
withTableReadTracker :: (?modelContext :: ModelContext) => ((?modelContext :: ModelContext, ?touchedTables :: IORef (Set ByteString)) => IO ()) -> IO () Source #
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"]
module IHP.Postgres.Point
module IHP.Postgres.Inet
Orphan instances
Default Bool Source # | |
Default Text Source # | |
Default Day Source # | |
Default UTCTime Source # | |
Default LocalTime Source # | |
Default Value Source # | |
Default Point Source # | |
Default (Binary ByteString) Source # | |
Methods def :: Binary ByteString # | |
ToField value => ToField [value] Source # | This instancs allows us to avoid wrapping lists with PGArray when
using sql types such as |
Methods toField :: [value] -> Action | |
(FromField value, Typeable value) => FromField [value] Source # | This instancs allows us to avoid wrapping lists with PGArray when
using sql types such as |
Methods fromField :: FieldParser [value] | |
Newtype (Binary payload) Source # | |