Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
The Unison monorepo interface to SQLite.
This module provides a high(-er) level interface to SQLite than the sqlite-simple
library, which it wraps. Code
that interacts with SQLite in this monorepo should use this interface, rather than sqlite-simple
or direct-sqlite
directly.
Three variants of the main query interface are provided:
- Unison.Sqlite.Connection provides an interface in
IO
, which takes theConnection
argument as an explicit argument. - Unison.Sqlite.Transaction provides a safer interface that executes queries in transactions, with automatic
retries on
SQLITE_BUSY
due to concurrent writers.
Synopsis
- data Connection
- withConnection :: MonadUnliftIO m => String -> FilePath -> (Connection -> m a) -> m a
- data Transaction a
- runTransaction :: (MonadIO m, HasCallStack) => Connection -> Transaction a -> m a
- runTransactionWithRollback :: (MonadIO m, HasCallStack) => Connection -> ((forall void. a -> Transaction void) -> Transaction a) -> m a
- runReadOnlyTransaction :: (MonadUnliftIO m, HasCallStack) => Connection -> ((forall x. Transaction x -> m x) -> m a) -> m a
- runWriteTransaction :: (HasCallStack, MonadUnliftIO m) => Connection -> ((forall x. Transaction x -> m x) -> m a) -> m a
- cacheTransaction :: forall k v. Cache k v -> (k -> Transaction v) -> k -> Transaction v
- savepoint :: Transaction (Either a a) -> Transaction a
- unsafeIO :: HasCallStack => IO a -> Transaction a
- unsafeUnTransaction :: Transaction a -> Connection -> IO a
- data Sql
- sql :: QuasiQuoter
- execute :: HasCallStack => Sql -> Transaction ()
- executeStatements :: HasCallStack => Text -> Transaction ()
- queryStreamRow :: (FromRow a, HasCallStack) => Sql -> (Transaction (Maybe a) -> Transaction r) -> Transaction r
- queryStreamCol :: forall a r. (FromField a, HasCallStack) => Sql -> (Transaction (Maybe a) -> Transaction r) -> Transaction r
- queryListRow :: (FromRow a, HasCallStack) => Sql -> Transaction [a]
- queryListCol :: (FromField a, HasCallStack) => Sql -> Transaction [a]
- queryMaybeRow :: (FromRow a, HasCallStack) => Sql -> Transaction (Maybe a)
- queryMaybeCol :: (FromField a, HasCallStack) => Sql -> Transaction (Maybe a)
- queryOneRow :: (FromRow a, HasCallStack) => Sql -> Transaction a
- queryOneCol :: (FromField a, HasCallStack) => Sql -> Transaction a
- queryListRowCheck :: (FromRow a, SqliteExceptionReason e, HasCallStack) => Sql -> ([a] -> Either e r) -> Transaction r
- queryListColCheck :: (FromField a, SqliteExceptionReason e, HasCallStack) => Sql -> ([a] -> Either e r) -> Transaction r
- queryMaybeRowCheck :: (FromRow a, SqliteExceptionReason e, HasCallStack) => Sql -> (a -> Either e r) -> Transaction (Maybe r)
- queryMaybeColCheck :: (FromField a, SqliteExceptionReason e, HasCallStack) => Sql -> (a -> Either e r) -> Transaction (Maybe r)
- queryOneRowCheck :: (FromRow a, SqliteExceptionReason e, HasCallStack) => Sql -> (a -> Either e r) -> Transaction r
- queryOneColCheck :: (FromField a, SqliteExceptionReason e, HasCallStack) => Sql -> (a -> Either e r) -> Transaction r
- rowsModified :: Transaction Int
- newtype DataVersion = DataVersion Int64
- getDataVersion :: Transaction DataVersion
- data JournalMode
- trySetJournalMode :: MonadIO m => Connection -> JournalMode -> m ()
- vacuum :: Connection -> IO Bool
- vacuumInto :: Connection -> FilePath -> IO ()
- data SomeSqliteException = forall e.Exception e => SomeSqliteException e
- isCantOpenException :: SomeSqliteException -> Bool
- data SqliteConnectException
- data SqliteQueryException
- class (Show e, Typeable e) => SqliteExceptionReason e
- data SomeSqliteExceptionReason = forall e.SqliteExceptionReason e => SomeSqliteExceptionReason e
- newtype ExpectedAtMostOneRowException = ExpectedAtMostOneRowException {}
- newtype ExpectedExactlyOneRowException = ExpectedExactlyOneRowException {}
- data SetJournalModeException = SetJournalModeException {}
- field :: FromField a => RowParser a
- data h :. t = h :. t
- class FromField a where
- fromField :: FieldParser a
- class FromRow a where
- newtype Only a = Only {
- fromOnly :: a
- data RowParser a
- data SQLData
- = SQLInteger !Int64
- | SQLFloat !Double
- | SQLText !Text
- | SQLBlob !ByteString
- | SQLNull
- class ToField a where
- class ToRow a where
Connection management
data Connection Source #
A non-thread safe connection to a SQLite database.
Instances
Show Connection Source # | |
Defined in Unison.Sqlite.Connection.Internal showsPrec :: Int -> Connection -> ShowS # show :: Connection -> String # showList :: [Connection] -> ShowS # |
:: MonadUnliftIO m | |
=> String | Connection name, for debugging. |
-> FilePath | Path to SQLite database file. |
-> (Connection -> m a) | |
-> m a |
Perform an action with a connection to a SQLite database.
Note: the connection is created with PRAGMA foreign_keys = ON
automatically, to work around the fact that SQLite
does not automatically enforce foreign key integrity, because it elected to maintain backwards compatibility with
code that was written before the foreign key integrity feature was implemented.
Transaction interface
data Transaction a Source #
Instances
runTransaction :: (MonadIO m, HasCallStack) => Connection -> Transaction a -> m a Source #
Run a transaction on the given connection.
runTransactionWithRollback :: (MonadIO m, HasCallStack) => Connection -> ((forall void. a -> Transaction void) -> Transaction a) -> m a Source #
Run a transaction on the given connection, providing a function that can short-circuit (and roll back) the transaction.
runReadOnlyTransaction :: (MonadUnliftIO m, HasCallStack) => Connection -> ((forall x. Transaction x -> m x) -> m a) -> m a Source #
Run a transaction that is known to only perform reads.
The action is provided a function that peels off the Transaction
newtype without sending the corresponding
BEGIN/COMMIT statements.
The transaction is never retried, so it is (more) safe to interleave arbitrary IO actions. If the transaction does attempt a write and gets SQLITE_BUSY, it's your fault!
runWriteTransaction :: (HasCallStack, MonadUnliftIO m) => Connection -> ((forall x. Transaction x -> m x) -> m a) -> m a Source #
Run a transaction that is known to perform at least one write.
The action is provided a function that peels off the Transaction
newtype without sending the corresponding
BEGIN/COMMIT statements.
The transaction is never retried, so it is (more) safe to interleave arbitrary IO actions.
cacheTransaction :: forall k v. Cache k v -> (k -> Transaction v) -> k -> Transaction v Source #
Wrap a transaction with a cache; cache hits will not hit SQLite.
savepoint :: Transaction (Either a a) -> Transaction a Source #
Perform an atomic sub-computation within a transaction; if it returns Left
, it's rolled back.
Unsafe things
unsafeIO :: HasCallStack => IO a -> Transaction a Source #
Perform IO inside a transaction, which should be idempotent, because it may be run more than once if the transaction needs to retry.
Warning: attempting to run a transaction inside a transaction will cause an exception!
unsafeUnTransaction :: Transaction a -> Connection -> IO a Source #
Unwrap the transaction newtype, throwing away the sending of BEGIN/COMMIT + automatic retry.
Executing queries
A SQL query.
sql :: QuasiQuoter Source #
A quasi-quoter for producing a Sql
from a SQL query string, using the Haskell variables in scope for each named
parameter.
For example, the query
let qux = 5 :: Int [sql| SELECT foo FROM bar WHERE baz = :qux |]
would produce a value like
Sql { query = "SELECT foo FROM bar WHERE baz = ?" , params = [SQLInteger 5] }
which, of course, will require a qux
with a ToField
instance in scope.
There are five valid syntaxes for interpolating a variable:
:colon
, which denotes a single-field variable@at
, followed by 1+ bare@
, which denotes a multi-field variable$dollar
, which denotes an entireSql
fragmentIN :colon
, which denotes anIN
expression, where the right-hand side is a list of scalarsVALUES :colon
, which denotes an entireVALUES
literal (1+ tuples)
As an example of the @at
syntax, consider a variable plonk
with a two-field ToRow
instance. A
query that interpolates plonk
might look like:
[sql| SELECT foo FROM bar WHERE stuff = @plonk AND other = @ |]
As an example of $dollar
syntax,
let foo = [sql| bar |] in [sql| $foo baz |]
splices foo
into the second fragment, and is equivalent to
[sql| bar baz |]
As an example of IN :colon
syntax, the query
[sql| IN :foo |]
will require a list "foo" to be in scope, whose elements have ToField
instances, and will expand to SQL that looks
like
IN (?, ?, ?, ?)
depending on how man elements "foo" has.
As an example of VALUES :colon
syntax, the query
[sql| VALUES :foo |]
will require a non-empty list "foo" to be in scope, whose elements have ToRow
instances, and will expand to
SQL that looks like
VALUES (?, ?), (?, ?), (?, ?)
depending on how many elements "foo" has, and how wide its rows are.
Without results
execute :: HasCallStack => Sql -> Transaction () Source #
executeStatements :: HasCallStack => Text -> Transaction () Source #
With results
Queries that return results have many different variants.
Every function name begins with the string query
.
- Row count. The caller may expect exactly one, zero or one, or zero or more rows, in which case the
function name includes the string
One
,Maybe
, or (List
orStream
), respectively. Example:queryListRow
. - Row width. The caller may expect the returned rows may contain exactly one or more than one column, in
which case the function name includes the string
Col
orRow
, respectively. Example:queryOneCol
. - Result checks. The caller may want to perform additional validation on the returned rows, in which case the
function name includes the string
Check
. Example:queryMaybeColCheck
.
All together, the full anatomy of a query function is:
query(List|Maybe|One)(Row|Col)[Check]
queryStreamRow :: (FromRow a, HasCallStack) => Sql -> (Transaction (Maybe a) -> Transaction r) -> Transaction r Source #
queryStreamCol :: forall a r. (FromField a, HasCallStack) => Sql -> (Transaction (Maybe a) -> Transaction r) -> Transaction r Source #
queryListRow :: (FromRow a, HasCallStack) => Sql -> Transaction [a] Source #
queryListCol :: (FromField a, HasCallStack) => Sql -> Transaction [a] Source #
queryMaybeRow :: (FromRow a, HasCallStack) => Sql -> Transaction (Maybe a) Source #
queryMaybeCol :: (FromField a, HasCallStack) => Sql -> Transaction (Maybe a) Source #
queryOneRow :: (FromRow a, HasCallStack) => Sql -> Transaction a Source #
queryOneCol :: (FromField a, HasCallStack) => Sql -> Transaction a Source #
With checks
queryListRowCheck :: (FromRow a, SqliteExceptionReason e, HasCallStack) => Sql -> ([a] -> Either e r) -> Transaction r Source #
queryListColCheck :: (FromField a, SqliteExceptionReason e, HasCallStack) => Sql -> ([a] -> Either e r) -> Transaction r Source #
queryMaybeRowCheck :: (FromRow a, SqliteExceptionReason e, HasCallStack) => Sql -> (a -> Either e r) -> Transaction (Maybe r) Source #
queryMaybeColCheck :: (FromField a, SqliteExceptionReason e, HasCallStack) => Sql -> (a -> Either e r) -> Transaction (Maybe r) Source #
queryOneRowCheck :: (FromRow a, SqliteExceptionReason e, HasCallStack) => Sql -> (a -> Either e r) -> Transaction r Source #
queryOneColCheck :: (FromField a, SqliteExceptionReason e, HasCallStack) => Sql -> (a -> Either e r) -> Transaction r Source #
Rows modified
Data version
newtype DataVersion Source #
Instances
Show DataVersion Source # | |
Defined in Unison.Sqlite.DataVersion showsPrec :: Int -> DataVersion -> ShowS # show :: DataVersion -> String # showList :: [DataVersion] -> ShowS # | |
Eq DataVersion Source # | |
Defined in Unison.Sqlite.DataVersion (==) :: DataVersion -> DataVersion -> Bool # (/=) :: DataVersion -> DataVersion -> Bool # |
Journal mode
data JournalMode Source #
JournalMode'DELETE | |
JournalMode'TRUNCATE | |
JournalMode'PERSIST | |
JournalMode'MEMORY | |
JournalMode'WAL | |
JournalMode'OFF |
Instances
Show JournalMode Source # | |
Defined in Unison.Sqlite.JournalMode showsPrec :: Int -> JournalMode -> ShowS # show :: JournalMode -> String # showList :: [JournalMode] -> ShowS # | |
Eq JournalMode Source # | |
Defined in Unison.Sqlite.JournalMode (==) :: JournalMode -> JournalMode -> Bool # (/=) :: JournalMode -> JournalMode -> Bool # |
trySetJournalMode :: MonadIO m => Connection -> JournalMode -> m () Source #
Vacuum
vacuum :: Connection -> IO Bool Source #
VACUUM
, and return whether or not the vacuum succeeded. A vacuum fails if the connection has any open
transactions.
vacuumInto :: Connection -> FilePath -> IO () Source #
VACUUM INTO
Exceptions
data SomeSqliteException Source #
The root exception for all exceptions thrown by this library.
SomeException (from base) └── SomeSqliteException └── SqliteConnectException └── SqliteQueryException
A SomeSqliteException
should not be inspected or used for control flow when run in a trusted environment, where the
database can be assumed to be uncorrupt. Rather, wherever possible, the user of this library should write code that
is guaranteed not to throw exceptions, by checking the necessary preconditions first. If that is not possible, it
should be considered a bug in this library.
When actions are run on an untrusted codebase, e.g. one downloaded from a remote server, it is sufficient to catch
just one exception type, SomeSqliteException
.
forall e.Exception e => SomeSqliteException e |
Instances
Exception SomeSqliteException Source # | |
Defined in Unison.Sqlite.Exception | |
Show SomeSqliteException Source # | |
Defined in Unison.Sqlite.Exception showsPrec :: Int -> SomeSqliteException -> ShowS # show :: SomeSqliteException -> String # showList :: [SomeSqliteException] -> ShowS # |
data SqliteConnectException Source #
An exception thrown during establishing a connection.
Instances
Exception SqliteConnectException Source # | |
Show SqliteConnectException Source # | |
Defined in Unison.Sqlite.Exception showsPrec :: Int -> SqliteConnectException -> ShowS # show :: SqliteConnectException -> String # showList :: [SqliteConnectException] -> ShowS # |
data SqliteQueryException Source #
A SqliteQueryException
represents an exception thrown during processing a query, paired with some context that
resulted in the exception.
A SqliteQueryException
may result from a number of different conditions:
- The underlying sqlite library threw an exception.
- A postcondition violation of a function like
queryMaybeRow
, which asserts that the resulting relation will have certain number of rows, - A postcondition violation of a function like
queryListRowCheck
, which takes a user-defined check as an argument.
A SqliteQueryException
should not be inspected or used for control flow when run in a trusted environment, where
the database can be assumed to be uncorrupt. Rather, wherever possible, the user of this library should write code
that is guaranteed not to throw exceptions, by checking the necessary preconditions first. If that is not possible,
it should be considered a bug in this library.
When actions are run on an untrusted codebase, e.g. one downloaded from a remote server, it is sufficient to catch
just one exception type, SqliteQueryException
.
Instances
Exception SqliteQueryException Source # | |
Show SqliteQueryException Source # | |
Defined in Unison.Sqlite.Exception showsPrec :: Int -> SqliteQueryException -> ShowS # show :: SqliteQueryException -> String # showList :: [SqliteQueryException] -> ShowS # |
class (Show e, Typeable e) => SqliteExceptionReason e Source #
A type that is intended to be used as additional context for a sqlite-related exception.
Instances
data SomeSqliteExceptionReason Source #
forall e.SqliteExceptionReason e => SomeSqliteExceptionReason e |
Instances
Show SomeSqliteExceptionReason Source # | |
Defined in Unison.Sqlite.Exception showsPrec :: Int -> SomeSqliteExceptionReason -> ShowS # show :: SomeSqliteExceptionReason -> String # showList :: [SomeSqliteExceptionReason] -> ShowS # | |
SqliteExceptionReason SomeSqliteExceptionReason Source # | |
Defined in Unison.Sqlite.Exception |
newtype ExpectedAtMostOneRowException Source #
A query was expected to return exactly one row, but it did not. The exception carries a string representation of the rows that were actually returned.
Instances
newtype ExpectedExactlyOneRowException Source #
A query was expected to return exactly one row, but it did not. The exception carries a string representation of the rows that were actually returned.
Instances
data SetJournalModeException Source #
Instances
Show SetJournalModeException Source # | |
Defined in Unison.Sqlite.JournalMode showsPrec :: Int -> SetJournalModeException -> ShowS # show :: SetJournalModeException -> String # showList :: [SetJournalModeException] -> ShowS # | |
SqliteExceptionReason SetJournalModeException Source # | |
Defined in Unison.Sqlite.JournalMode |
Re-exports
A composite type to parse your custom data structures without having to define dummy newtype wrappers every time.
instance FromRow MyData where ...
instance FromRow MyData2 where ...
then I can do the following for free:
res <- query' c "..." forM res $ \(MyData{..} :. MyData2{..}) -> do ....
h :. t infixr 3 |
Instances
(Read h, Read t) => Read (h :. t) | |
(Show h, Show t) => Show (h :. t) | |
(Eq h, Eq t) => Eq (h :. t) | |
(Ord h, Ord t) => Ord (h :. t) | |
Defined in Database.SQLite.Simple.Types | |
(FromRow a, FromRow b) => FromRow (a :. b) | |
Defined in Database.SQLite.Simple.FromRow | |
(ToRow a, ToRow b) => ToRow (a :. b) | |
Defined in Database.SQLite.Simple.ToRow |
A type that may be converted from a SQL type.
fromField :: FieldParser a #
Convert a SQL value to a Haskell value.
Returns a list of exceptions if the conversion fails. In the case of
library instances, this will usually be a single ResultError
, but
may be a UnicodeException
.
Implementations of fromField
should not retain any references to
the Field
nor the ByteString
arguments after the result has
been evaluated to WHNF. Such a reference causes the entire
LibPQ.
to be retained.Result
For example, the instance for ByteString
uses copy
to avoid
such a reference, and that using bytestring functions such as drop
and takeWhile
alone will also trigger this memory leak.
Instances
A collection type that can be converted from a sequence of fields. Instances are provided for tuples up to 10 elements and lists of any length.
Note that instances can defined outside of sqlite-simple, which is often useful. For example, here's an instance for a user-defined pair:
data User = User { name :: String, fileQuota :: Int } instanceFromRow
User where fromRow = User <$>field
<*>field
The number of calls to field
must match the number of fields returned
in a single row of the query result. Otherwise, a ConversionFailed
exception will be thrown.
Note the caveats associated with user-defined implementations of
fromRow
.
Generic implementation
Since version 0.4.18.1 it is possible in some cases to derive a
generic implementation for FromRow
. With a Generic
instance
for User
, the example above could be written:
instance FromRow
User where
With -XDeriveAnyClass -XDerivingStrategies
the same can be written:
deriving anyclass instance FromRow
User
For more details refer to GFromRow
.
Nothing
Instances
The 1-tuple type or single-value "collection".
This type is structurally equivalent to the
Identity
type, but its intent is more
about serving as the anonymous 1-tuple type missing from Haskell for attaching
typeclass instances.
Parameter usage example:
encodeSomething (Only
(42::Int))
Result usage example:
xs <- decodeSomething
forM_ xs $ \(Only
id) -> {- ... -}
Instances
Functor Only | |
Data a => Data (Only a) | |
Defined in Data.Tuple.Only gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Only a -> c (Only a) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Only a) # toConstr :: Only a -> Constr # dataTypeOf :: Only a -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Only a)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Only a)) # gmapT :: (forall b. Data b => b -> b) -> Only a -> Only a # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Only a -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Only a -> r # gmapQ :: (forall d. Data d => d -> u) -> Only a -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Only a -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Only a -> m (Only a) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Only a -> m (Only a) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Only a -> m (Only a) # | |
Generic (Only a) | |
Read a => Read (Only a) | |
Show a => Show (Only a) | |
NFData a => NFData (Only a) | |
Defined in Data.Tuple.Only | |
Eq a => Eq (Only a) | |
Ord a => Ord (Only a) | |
FromField a => FromRow (Only a) | |
Defined in Database.SQLite.Simple.FromRow | |
ToField a => ToRow (Only a) | |
Defined in Database.SQLite.Simple.ToRow | |
type Rep (Only a) | |
Defined in Data.Tuple.Only |
Instances
Instances
A type that may be used as a single parameter to a SQL query.
Instances
A collection type that can be turned into a list of SQLData
elements.
Since version 0.4.18.1 it is possible in some cases to derive a
generic implementation for ToRow
. Refer to the documentation for
FromRow
to see how this can be
done.
Nothing