Skip to content

Commit

Permalink
Add SqlException union type for convenience
Browse files Browse the repository at this point in the history
  • Loading branch information
HeinrichApfelmus committed Jul 23, 2024
1 parent 515c30f commit 195ce1a
Showing 1 changed file with 32 additions and 0 deletions.
32 changes: 32 additions & 0 deletions lib/delta-table/src/Database/Table/SQLite/Simple/Monad.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,7 @@ module Database.Table.SQLite.Simple.Monad
, SqlM
, runSqlM
, rawSqlite
, SqlException (..)
) where

import Prelude
Expand All @@ -28,6 +29,10 @@ import Control.Concurrent.MVar
, newMVar
, withMVar
)
import Control.Exception
( Exception (..)
, SomeException (..)
)
import Control.Monad.Class.MonadThrow
( MonadCatch (..)
, MonadThrow (..)
Expand Down Expand Up @@ -110,3 +115,30 @@ runSqlM (SqlM action) Connection{lock,connection} =
-- | Wrap a function from "Database.SQLite.Simple" in 'SqlM'.
rawSqlite :: (Sqlite.Connection -> IO a) -> SqlM a
rawSqlite = SqlM . ReaderT

-- | Union of exceptions that can occur with "Database.SQLite.Simple".
data SqlException
= SqlFormatError Sqlite.FormatError
| SqlResultError Sqlite.ResultError
| SqlSQLError Sqlite.SQLError
deriving (Eq, Show)

-- | When converting to and from 'SomeException',
-- the constructors of the 'SqlException' type are stripped.
-- In other words, the type 'SqlException' represents a structural union,
-- not a nominal sum of the individual exceptions.
-- This makes it easier to catch the individual exceptions as a union.
--
-- Example:
--
-- > throw (Sqlite.SQLError Sqlite.ErrorIOData "" "")
-- > `catch` \e -> print (e :: SqlException)
instance Exception SqlException where
toException (SqlFormatError e) = SomeException e
toException (SqlResultError e) = SomeException e
toException (SqlSQLError e) = SomeException e
fromException e0
| Just e <- fromException e0 = Just $ SqlFormatError e
| Just e <- fromException e0 = Just $ SqlResultError e
| Just e <- fromException e0 = Just $ SqlSQLError e
| otherwise = Nothing

0 comments on commit 195ce1a

Please sign in to comment.