Tighten up the interface and module exports

src/Gargantext/Database/Query/Table/Node/Error.hs

@@ -24,6 +24,7 @@ module Gargantext.Database.Query.Table.Node.Error (
   , nodeCreationError
   , nodeLookupError
   , catchNodeError
+  , dbFailWith
   ) where
 
 import Control.Lens (Prism', (#), (^?))
@@ -34,6 +35,7 @@ import Gargantext.Database.Admin.Types.Node (ListId, NodeId(..), ContextId, User
 import Gargantext.Prelude hiding (sum, head)
 import Prelude hiding (null, id, map, sum, show)
 import Prelude qualified
+import Gargantext.Database.Transactional
 
 data NodeCreationError
   = UserParentAlreadyExists UserId ParentId
@@ -155,3 +157,7 @@ nodeLookupError ne = throwError $ _NodeError # NodeLookupFailed ne
 
 catchNodeError :: (MonadError e m, HasNodeError e) => m a -> (NodeError -> m a) -> m a
 catchNodeError f g = catchError f (\e -> maybe (throwError e) g (e ^? _NodeError))
+
+
+dbFailWith :: HasNodeError err => T.Text -> DBTx err r b
+dbFailWith x = dbFail $ _NodeError # (NodeError $ toException $ userError $ T.unpack x)

src/Gargantext/Database/Transactional.hs

 {-# LANGUAGE KindSignatures      #-}
 {-# LANGUAGE LambdaCase          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications    #-}
-{-# LANGUAGE TypeFamilies        #-}
-{-# LANGUAGE TypeOperators       #-}
-{-# LANGUAGE ConstraintKinds #-}
-module Gargantext.Database.Transactional where
+module Gargantext.Database.Transactional (
+    DBOperation
+  , DBTransactionOp -- opaque
+  , DBTx -- opaque
+  , DBUpdate
+  , DBQuery
+  -- * Executing queries and updates
+  , runDBQuery
+  , runDBTx
+
+  -- * Smart constructors
+  , mkPGQuery
+  , mkPGUpdate
+  , mkOpaQuery
+  , mkOpaUpdate
+  , mkOpaInsert
+
+  -- * Throwing errors (which allow rollbacks)
+  , dbFail
+  ) where
 
-import Control.Exception
 import Control.Lens
 import Control.Monad.Base
 import Control.Monad.Error.Class
@@ -15,11 +29,9 @@ import Control.Monad.Free
 import Control.Monad.Trans.Control (MonadBaseControl, control)
 import Data.Pool (withResource, Pool)
 import Data.Profunctor.Product.Default
-import Data.Text qualified as T
 import Database.PostgreSQL.Simple qualified as PG
 import Database.PostgreSQL.Simple.Transaction qualified as PG
 import Gargantext.Database.Prelude
-import Gargantext.Database.Query.Table.Node.Error
 import Opaleye
 import Prelude
 
@@ -54,12 +66,6 @@ type DBQuery err r a    = DBTx err r a
 type DBUpdate err a     = DBTx err DBWrite a
 type DBReadOnly err r a = DBTx err DBRead a
 
-dbFail :: HasNodeError err => err -> DBTx err r b
-dbFail = DBTx . liftF . DBFail
-
-dbFailWith :: HasNodeError err => T.Text -> DBTx err r b
-dbFailWith x = dbFail $ _NodeError # (NodeError $ toException $ userError $ T.unpack x)
-
 instance Functor (DBTransactionOp err r) where
   fmap f = \case
     PGQuery   q params cont -> PGQuery   q params (f . cont)
@@ -96,7 +102,7 @@ withReadOnlyTransactionM conn action =
     tmode :: PG.TransactionMode
     tmode = PG.TransactionMode PG.DefaultIsolationLevel PG.ReadOnly
 
-runDBTx :: HasNodeError err => DBUpdate err a -> DBCmd err a
+runDBTx :: DBUpdate err a -> DBCmd err a
 runDBTx (DBTx m) = do
   pool <- view connPool
   withResourceM pool $ \conn -> withTransactionM conn $ foldFree (evalOp conn) m
@@ -104,12 +110,14 @@ runDBTx (DBTx m) = do
 -- | /NOTE/ the input type is 'DBReadOnly', i.e. a transaction where /all/
 -- the operations are 'DBRead'. This makes impossible to sneak in updates
 -- into otherwise read-only queries.
-runDBQuery :: HasNodeError err => DBReadOnly err r a -> DBCmd err a
+runDBQuery :: DBReadOnly err r a -> DBCmd err a
 runDBQuery (DBTx m) = do
   pool <- view connPool
   withResourceM pool $ \conn -> withReadOnlyTransactionM conn $ foldFree (evalOp conn) m
 
-evalOp :: HasNodeError err => PG.Connection -> DBTransactionOp err r a -> DBCmd err a
+-- | The main evaluator, turns our pure operations into side-effects that run into the
+-- 'DBCmd'.
+evalOp :: PG.Connection -> DBTransactionOp err r a -> DBCmd err a
 evalOp conn = \case
   PGQuery   qr q cc -> cc <$> liftBase (PG.query conn qr q)
   PGUpdate  qr a cc -> cc <$> liftBase (fromIntegral <$> PG.execute conn qr a)
@@ -118,6 +126,13 @@ evalOp conn = \case
   OpaUpdate upd  cc -> cc <$> liftBase (runUpdate conn upd)
   DBFail    err  -> throwError err
 
+--
+-- Smart constructors
+--
+
+dbFail :: err -> DBTx err r b
+dbFail = DBTx . liftF . DBFail
+
 mkPGQuery :: (PG.ToRow q, PG.FromRow a)
            => PG.Query
            -> q