| Safe Haskell | Safe-Inferred | 
|---|---|
| Language | Haskell2010 | 
Unison.Sqlite
Description
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 theConnectionargument as an explicit argument.
- Unison.Sqlite.Transaction provides a safer interface that executes queries in transactions, with automatic
     retries on SQLITE_BUSYdue 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
- runTransactionExceptT :: (MonadIO m, HasCallStack) => Connection -> ExceptT e Transaction a -> m (Either e 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
- likeEscape :: Char -> Text -> Text
- 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 Methods showsPrec :: Int -> Connection -> ShowS # show :: Connection -> String # showList :: [Connection] -> ShowS # | |
Arguments
| :: 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.
runTransactionExceptT :: (MonadIO m, HasCallStack) => Connection -> ExceptT e Transaction a -> m (Either e a) Source #
Run a transaction wrapped in an ExceptT. If the ExceptT fails, the transaction is rolled back.
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 entire- Sqlfragment
- IN :colon, which denotes an- INexpression, where the right-hand side is a list of scalars
- VALUES :colon, which denotes an entire- VALUESliteral (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 (ListorStream), 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 ColorRow, 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 #
Utilities
likeEscape :: Char -> Text -> Text Source #
Escape special characters for LIKE matches.
Prepared statements prevent sql injection, but it's still possible some user may be able to craft a query using a fake "hash" that would let them see more than they ought to.
You still need to provide the escape char in the sql query, E.g.
@
   SELECT * FROM table
     WHERE txt LIKE ? ESCAPE '\'
 @
>>>likeEscape '\\' "Nat.%""Nat.\%"
Rows modified
Data version
newtype DataVersion Source #
Constructors
| DataVersion Int64 | 
Instances
| Show DataVersion Source # | |
| Defined in Unison.Sqlite.DataVersion Methods showsPrec :: Int -> DataVersion -> ShowS # show :: DataVersion -> String # showList :: [DataVersion] -> ShowS # | |
| Eq DataVersion Source # | |
| Defined in Unison.Sqlite.DataVersion | |
Journal mode
data JournalMode Source #
Constructors
| JournalMode'DELETE | |
| JournalMode'TRUNCATE | |
| JournalMode'PERSIST | |
| JournalMode'MEMORY | |
| JournalMode'WAL | |
| JournalMode'OFF | 
Instances
| Show JournalMode Source # | |
| Defined in Unison.Sqlite.JournalMode Methods showsPrec :: Int -> JournalMode -> ShowS # show :: JournalMode -> String # showList :: [JournalMode] -> ShowS # | |
| Eq JournalMode Source # | |
| Defined in Unison.Sqlite.JournalMode | |
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.
Constructors
| forall e.Exception e => SomeSqliteException e | 
Instances
| Exception SomeSqliteException Source # | |
| Defined in Unison.Sqlite.Exception Methods toException :: SomeSqliteException -> SomeException # fromException :: SomeException -> Maybe SomeSqliteException # | |
| Show SomeSqliteException Source # | |
| Defined in Unison.Sqlite.Exception Methods showsPrec :: Int -> SomeSqliteException -> ShowS # show :: SomeSqliteException -> String # showList :: [SomeSqliteException] -> ShowS # | |
data SqliteConnectException Source #
An exception thrown during establishing a connection.
Instances
| Exception SqliteConnectException Source # | |
| Defined in Unison.Sqlite.Exception | |
| Show SqliteConnectException Source # | |
| Defined in Unison.Sqlite.Exception Methods 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 # | |
| Defined in Unison.Sqlite.Exception Methods toException :: SqliteQueryException -> SomeException # fromException :: SomeException -> Maybe SqliteQueryException # | |
| Show SqliteQueryException Source # | |
| Defined in Unison.Sqlite.Exception Methods 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 #
Constructors
| forall e.SqliteExceptionReason e => SomeSqliteExceptionReason e | 
Instances
| Show SomeSqliteExceptionReason Source # | |
| Defined in Unison.Sqlite.Exception Methods 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.
Constructors
| ExpectedAtMostOneRowException | |
Instances
| Show ExpectedAtMostOneRowException Source # | |
| Defined in Unison.Sqlite.Connection Methods showsPrec :: Int -> ExpectedAtMostOneRowException -> ShowS # show :: ExpectedAtMostOneRowException -> String # showList :: [ExpectedAtMostOneRowException] -> ShowS # | |
| SqliteExceptionReason ExpectedAtMostOneRowException Source # | |
| Defined in Unison.Sqlite.Connection | |
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.
Constructors
| ExpectedExactlyOneRowException | |
Instances
| Show ExpectedExactlyOneRowException Source # | |
| Defined in Unison.Sqlite.Connection Methods showsPrec :: Int -> ExpectedExactlyOneRowException -> ShowS # show :: ExpectedExactlyOneRowException -> String # showList :: [ExpectedExactlyOneRowException] -> ShowS # | |
| SqliteExceptionReason ExpectedExactlyOneRowException Source # | |
| Defined in Unison.Sqlite.Connection | |
data SetJournalModeException Source #
Constructors
| SetJournalModeException | |
| Fields | |
Instances
| Show SetJournalModeException Source # | |
| Defined in Unison.Sqlite.JournalMode Methods 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
  ....
Constructors
| 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.
Methods
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 }
instance FromRow 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.
Minimal complete definition
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 Methods 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
Constructors
| SQLInteger !Int64 | |
| SQLFloat !Double | |
| SQLText !Text | |
| SQLBlob !ByteString | |
| SQLNull | 
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.
Minimal complete definition
Nothing