Implement MonadThrow instance for AppM(fix #62)

vacationlabs · Dec 21, 2016 · 463b565 · 463b565
1 parent 7dabc30
commit 463b565
Show file tree

Hide file tree

Showing 2 changed files with 6 additions and 0 deletions.
diff --git a/ServantOpaleye2/ServantOpaleye2.cabal b/ServantOpaleye2/ServantOpaleye2.cabal
@@ -61,6 +61,7 @@ library
                        ,unordered-containers
                        ,template-haskell
                        ,lifted-base
+                       ,exceptions
   default-language:    Haskell2010
 
 executable ServantOpaleye2-exe

diff --git a/ServantOpaleye2/src/AppM.hs b/ServantOpaleye2/src/AppM.hs
@@ -8,6 +8,8 @@ import           Control.Monad.Trans.Except
 import           Control.Monad.Trans.Reader
 import           Control.Monad.Trans.Writer
 import           Database.PostgreSQL.Simple
+import           Control.Monad.Catch
+import           Control.Monad.Trans.Class
 
 type AppM  = WriterT String (ReaderT (Connection, Maybe Tenant, Maybe User) (ExceptT SomeException IO))
 
@@ -25,3 +27,6 @@ instance DbConnection AppM where
   getConnection = do
     (conn, tenant, _) <- R.ask
     return conn
+
+instance MonadThrow AppM where
+  throwM e = lift $ lift $ ExceptT (return $ Left $ SomeException e)