From 195ce1a6285be14f43a15215eb459fb91c9fef4f Mon Sep 17 00:00:00 2001
From: Heinrich Apfelmus <apfelmus@quantentunnel.de>
Date: Tue, 23 Jul 2024 17:14:44 +0200
Subject: [PATCH] Add `SqlException` union type for convenience

---
 .../src/Database/Table/SQLite/Simple/Monad.hs | 32 +++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/lib/delta-table/src/Database/Table/SQLite/Simple/Monad.hs b/lib/delta-table/src/Database/Table/SQLite/Simple/Monad.hs
index ead6ad04a8f..a9874e8c1b2 100644
--- a/lib/delta-table/src/Database/Table/SQLite/Simple/Monad.hs
+++ b/lib/delta-table/src/Database/Table/SQLite/Simple/Monad.hs
@@ -19,6 +19,7 @@ module Database.Table.SQLite.Simple.Monad
     , SqlM
     , runSqlM
     , rawSqlite
+    , SqlException (..)
     ) where
 
 import Prelude
@@ -28,6 +29,10 @@ import Control.Concurrent.MVar
     , newMVar
     , withMVar
     )
+import Control.Exception
+    ( Exception (..)
+    , SomeException (..)
+    )
 import Control.Monad.Class.MonadThrow
     ( MonadCatch (..)
     , MonadThrow (..)
@@ -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