-}
-{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE Arrows #-}
+{-# LANGUAGE ConstraintKinds, ScopedTypeVariables #-}
+{-# LANGUAGE LambdaCase #-}
module Gargantext.Database.Prelude where
+--import Control.Monad.Logger (MonadLogger)
import Control.Exception
import Control.Lens (Getter, view)
import Control.Monad.Except
import Database.PostgreSQL.Simple (Connection, connect)
import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(ConversionFailed), fromField, returnError)
import Database.PostgreSQL.Simple.Internal (Field)
+import Database.PostgreSQL.Simple.Types (Query(..))
import Gargantext.Core.Mail.Types (HasMail)
+import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Prelude
-import Gargantext.Prelude.Config (readIniFile', val)
-import Opaleye (Unpackspec, showSql, FromFields, Select, runSelect, SqlJsonb, DefaultFromField)
+import Gargantext.Prelude.Config (GargConfig(), readIniFile', val)
+import Opaleye (Unpackspec, showSql, FromFields, Select, runSelect, SqlJsonb, DefaultFromField, toFields, matchMaybe, MaybeFields)
import Opaleye.Aggregate (countRows)
-import System.IO (FilePath)
-import System.IO (stderr)
+import System.IO (FilePath, stderr)
import Text.Read (readMaybe)
import qualified Data.ByteString as DB
import qualified Data.List as DL
import qualified Database.PostgreSQL.Simple as PGS
-
-import Gargantext.Prelude.Config (GargConfig())
+import qualified Opaleye.Internal.Constant
+import qualified Opaleye.Internal.Operators
-------------------------------------------------------
class HasConnectionPool env where
, MonadError err m
, MonadBaseControl IO m
, MonadRandom m
+ --, MonadLogger m
)
type CmdM' env err m =
( MonadReader env m
, MonadError err m
, MonadBaseControl IO m
+ --, MonadLogger m
-- , MonadRandom m
)
-type CmdM env err m =
- ( CmdM' env err m
- , HasConnectionPool env
+type CmdCommon env =
+ ( HasConnectionPool env
, HasConfig env
, HasMail env
+ , HasNLPServer env )
+
+type CmdM env err m =
+ ( CmdM' env err m
+ , CmdCommon env
)
type CmdRandom env err m =
runPGSQuery_ q = mkCmd $ \conn -> catch (PGS.query_ conn q) printError
where
printError (SomeException e) = do
- printDebug "[G.D.P.runPGSQuery_]" ("TODO: format query error" :: Text)
+ hPutStrLn stderr (fromQuery q)
throw (SomeException e)
-
execPGSQuery :: PGS.ToRow a => PGS.Query -> a -> Cmd err Int64
execPGSQuery q a = mkCmd $ \conn -> PGS.execute conn q a
printSqlOpa :: Default Unpackspec a a => Select a -> IO ()
printSqlOpa = putStrLn . maybe "Empty query" identity . showSql
+dbCheck :: CmdM env err m => m Bool
+dbCheck = do
+ r :: [PGS.Only Text] <- runPGSQuery_ "select username from public.auth_user"
+ case r of
+ [] -> return False
+ _ -> return True
+
+restrictMaybe :: ( Default Opaleye.Internal.Operators.IfPP b b
+ , (Default Opaleye.Internal.Constant.ToFields Bool b))
+ => MaybeFields a -> (a -> b) -> b
+restrictMaybe v cond = matchMaybe v $ \case
+ Nothing -> toFields True
+ Just v' -> cond v'