[db] added database functions

gargantext-prelude.cabal

-cabal-version: 1.12
+cabal-version: 2.0
 
 -- This file has been generated from package.yaml by hpack version 0.35.2.
 --
@@ -35,6 +35,7 @@ library
       Gargantext.Prelude.Crypto.QRCode
       Gargantext.Prelude.Crypto.Share
       Gargantext.Prelude.Crypto.Symmetric
+      Gargantext.Prelude.Database
       Gargantext.Prelude.Fibonacci
       Gargantext.Prelude.Mail
       Gargantext.Prelude.Mail.Types
@@ -85,6 +86,7 @@ library
     , network
     , network-uri
     , password
+    , postgresql-simple ^>= 0.6.4
     , protolude
     , qrcode-core
     , qrcode-juicypixels

src/Gargantext/Prelude/Database.hs

+{-|
+Module      : Gargantext.Prelude.Database
+Description : Useful database functions in prelude
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE QuasiQuotes #-}
+
+module Gargantext.Prelude.Database
+  where
+
+import Control.Exception (throw)
+import Data.Text (pack)
+import Database.PostgreSQL.Simple qualified as PGS
+import Database.PostgreSQL.Simple.FromField (FromField(fromField), fromJSONField)
+import Database.PostgreSQL.Simple.SqlQQ (sql)
+import Database.PostgreSQL.Simple.ToField qualified as PGS
+import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
+import Gargantext.Prelude
+
+
+
+runPGSExecute :: (PGS.ToRow q)
+              => PGS.Connection -> PGS.Query -> q -> IO Int64
+runPGSExecute c qs a = catch (PGS.execute c qs a) printError
+  where
+    printError (SomeException e) = do
+      --q' <- PGS.formatQuery c qs a
+      _ <- panic $ pack $ show e
+      throw (SomeException e)
+
+runPGSExecuteMany :: (PGS.ToRow q)
+                  => PGS.Connection -> PGS.Query -> [q] -> IO Int64
+runPGSExecuteMany c qs a = catch (PGS.executeMany c qs a) printError
+  where
+    printError (SomeException e) = do
+      --q' <- PGS.formatQuery c qs a
+      _ <- panic $ pack $ show e
+      throw (SomeException e)
+
+runPGSReturning :: (PGS.ToRow q, PGS.FromRow r)
+                => PGS.Connection -> PGS.Query -> [q] -> IO [r]
+runPGSReturning c qs a = catch (PGS.returning c qs a) printError
+  where
+    printError (SomeException e) = do
+      --q' <- PGS.formatQuery c qs a
+      _ <- panic $ pack $ show e
+      throw (SomeException e)
+
+
+runPGSQuery :: (PGS.FromRow r, PGS.ToRow q)
+            => PGS.Connection -> PGS.Query -> q -> IO [r]
+runPGSQuery c q a = catch (PGS.query c q a) printError
+  where
+    printError (SomeException e) = do
+      q' <- PGS.formatQuery c q a
+      hPutStrLn stderr q'
+      throw (SomeException e)
+
+runPGSQuery' :: (PGS.FromRow r)
+             => PGS.Connection -> PGS.Query -> IO [r]
+runPGSQuery' c q = catch (PGS.query_ c q) printError
+  where
+    printError (SomeException e) = do
+      -- q' <- PGS.formatQuery c q []
+      hPutStrLn stderr (show q :: Text)
+      throw (SomeException e)
+
+runPGSAdvisoryLock :: PGS.Connection -> Int -> IO ()
+runPGSAdvisoryLock c id = do
+  _ <- runPGSQuery c [sql| SELECT pg_advisory_lock(?) |]
+                     (PGS.Only id) :: IO [PGS.Only ()]
+  pure ()
+
+runPGSAdvisoryUnlock :: PGS.Connection -> Int -> IO ()
+runPGSAdvisoryUnlock c id = do
+  _ <- runPGSQuery c [sql| SELECT pg_advisory_unlock(?) |]
+                     (PGS.Only id) :: IO [PGS.Only Bool]
+  pure ()
+
+runPGSAdvisoryXactLock :: PGS.Connection -> Int -> IO ()
+runPGSAdvisoryXactLock c id = do
+  _ <- runPGSQuery c [sql| SELECT pg_advisory_xact_lock(?) |]
+                     (PGS.Only id) :: IO [PGS.Only ()]
+  pure ()