[FIX] removing printDebug
[gargantext.git] / src / Gargantext / Database / Prelude.hs
index 370df7d8f4539f4dd2eec37d5ddb51e06f01c7d0..54a6732dc666eea27e5a240b71a9ddce576b0049 100644 (file)
@@ -1,6 +1,6 @@
 {-|
 Module      : Gargantext.Database.Prelude
-Description : 
+Description : Specific Prelude for Database management
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
 Maintainer  : team@gargantext.org
@@ -13,29 +13,26 @@ Portability : POSIX
 
 module Gargantext.Database.Prelude where
 
-
 import Control.Exception
 import Control.Lens (Getter, view)
-import Control.Monad.Error.Class -- (MonadError(..), Error)
 import Control.Monad.Except
+import Control.Monad.Random
 import Control.Monad.Reader
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Data.Aeson (Result(Error,Success), fromJSON, FromJSON)
 import Data.ByteString.Char8 (hPutStrLn)
 import Data.Either.Extra (Either(Left, Right))
 import Data.Ini (readIniFile, lookupValue)
-import Data.Maybe (maybe)
-import Data.Monoid ((<>))
 import Data.Pool (Pool, withResource)
 import Data.Profunctor.Product.Default (Default)
-import Data.Text (unpack, pack)
-import Data.Typeable (Typeable)
+import Data.Text (unpack, pack, Text)
 import Data.Word (Word16)
 import Database.PostgreSQL.Simple (Connection, connect)
 import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(ConversionFailed), fromField, returnError)
 import Database.PostgreSQL.Simple.Internal  (Field)
 import Gargantext.Prelude
-import Opaleye (Query, Unpackspec, showSqlForPostgres, FromFields, Select, runQuery)
+import Gargantext.Prelude.Config (GargConfig())
+import Opaleye (Query, Unpackspec, showSqlForPostgres, FromFields, Select, runQuery, PGJsonb, QueryRunnerColumnDefault)
 import Opaleye.Aggregate (countRows)
 import System.IO (FilePath)
 import System.IO (stderr)
@@ -45,27 +42,55 @@ import qualified Data.List as DL
 import qualified Database.PostgreSQL.Simple as PGS
 
 -------------------------------------------------------
-
 class HasConnectionPool env where
   connPool :: Getter env (Pool Connection)
 
 instance HasConnectionPool (Pool Connection) where
   connPool = identity
 
+class HasConfig env where
+  hasConfig :: Getter env GargConfig
+
+instance HasConfig GargConfig where
+  hasConfig = identity
+
+-------------------------------------------------------
+type JSONB = QueryRunnerColumnDefault PGJsonb
+-------------------------------------------------------
+
+type CmdM'' env err m =
+  ( MonadReader     env     m
+  , MonadError          err m
+  , MonadBaseControl IO     m
+  , MonadRandom             m
+  )
+
 type CmdM' env err m =
-  ( MonadReader env m
-  , MonadError err m
-  , MonadBaseControl IO m
+  ( MonadReader     env     m
+  , MonadError          err m
+  , MonadBaseControl IO     m
+  -- , MonadRandom             m
   )
 
 type CmdM env err m =
-  ( CmdM' env err m
+  ( CmdM'             env err m
   , HasConnectionPool env
+  , HasConfig         env
   )
 
-type Cmd' env err a = forall m. CmdM' env err m => m a
+type CmdRandom env err m =
+  ( CmdM'             env err m
+  , HasConnectionPool env
+  , HasConfig         env
+  , MonadRandom             m
+  )
+
+type Cmd'' env err a = forall m.     CmdM''    env err m => m a
+type Cmd'  env err a = forall m.     CmdM'     env err m => m a
+type Cmd       err a = forall m env. CmdM      env err m => m a
+type CmdR      err a = forall m env. CmdRandom env err m => m a
+
 
-type Cmd err a = forall m env. CmdM env err m => m a
 
 fromInt64ToInt :: Int64 -> Int
 fromInt64ToInt = fromIntegral
@@ -77,12 +102,14 @@ mkCmd k = do
   withResource pool (liftBase . k)
 
 runCmd :: (HasConnectionPool env)
-       => env -> Cmd' env err a
+       => env
+       -> Cmd'' env err a
        -> IO (Either err a)
 runCmd env m = runExceptT $ runReaderT m env
 
 runOpaQuery :: Default FromFields fields haskells
-            => Select fields -> Cmd err [haskells]
+            => Select fields
+            -> Cmd err [haskells]
 runOpaQuery q = mkCmd $ \c -> runQuery c q
 
 runCountOpaQuery :: Select a -> Cmd err Int
@@ -98,9 +125,10 @@ formatPGSQuery q a = mkCmd $ \conn -> PGS.formatQuery conn q a
 runPGSQuery' :: (PGS.ToRow a, PGS.FromRow b) => PGS.Query -> a -> Cmd err [b]
 runPGSQuery' q a = mkCmd $ \conn -> PGS.query conn q a
 
-runPGSQuery :: (MonadError err m, MonadReader env m, MonadBaseControl IO m,
-                PGS.FromRow r, PGS.ToRow q, HasConnectionPool env)
-                => PGS.Query -> q -> m [r]
+runPGSQuery :: ( CmdM env err m
+               , PGS.FromRow r, PGS.ToRow q
+               )
+               => PGS.Query -> q -> m [r]
 runPGSQuery q a = mkCmd $ \conn -> catch (PGS.query conn q a) (printError conn)
   where
     printError c (SomeException e) = do
@@ -108,6 +136,18 @@ runPGSQuery q a = mkCmd $ \conn -> catch (PGS.query conn q a) (printError conn)
       hPutStrLn stderr q'
       throw (SomeException e)
 
+-- | TODO catch error
+runPGSQuery_ :: ( CmdM env err m
+               , PGS.FromRow r
+               )
+               => PGS.Query -> m [r]
+runPGSQuery_ q = mkCmd $ \conn -> catch (PGS.query_ conn q) printError
+  where
+    printError (SomeException e) = do
+      printDebug "[G.D.P.runPGSQuery_]" ("TODO: format query error query" :: Text)
+      throw (SomeException e)
+
+
 
 execPGSQuery :: PGS.ToRow a => PGS.Query -> a -> Cmd err Int64
 execPGSQuery q a = mkCmd $ \conn -> PGS.execute conn q a
@@ -121,7 +161,7 @@ databaseParameters fp = do
         Left e     -> panic (pack $ "No ini file error" <> show e)
         Right ini' -> ini'
 
-  let val x = case (lookupValue (pack "django") (pack x) ini'') of
+  let val x = case (lookupValue (pack "database") (pack x) ini'') of
         Left _ -> panic (pack $ "no" <> x)
         Right p' -> unpack p'