src/Gargantext/Database/Utils.hs

   1 {-|
   2 Module      : Gargantext.Database.Util
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 Here is a longer description of this module, containing some
  11 commentary with @some markup@.
  12 -}
  13
  14 {-# LANGUAGE FlexibleContexts  #-}
  15 {-# LANGUAGE NoImplicitPrelude #-}
  16 {-# LANGUAGE OverloadedStrings #-}
  17 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  18
  19 module Gargantext.Database.Utils where
  20
  21 import Control.Applicative (Applicative)
  22 import Control.Monad.Reader
  23 import Data.Aeson (Result(Error,Success), fromJSON, FromJSON)
  24 import Data.Either.Extra (Either(Left, Right))
  25 import Data.Ini (readIniFile, lookupValue)
  26 import Data.Maybe (maybe)
  27 import Data.Monoid ((<>))
  28 import Data.Profunctor.Product.Default (Default)
  29 import Data.Text (unpack, pack)
  30 import Data.Typeable (Typeable)
  31 import Data.Word (Word16)
  32 import Database.PostgreSQL.Simple (Connection, connect)
  33 import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(ConversionFailed), fromField, returnError)
  34 import Database.PostgreSQL.Simple.Internal  (Field)
  35 import Gargantext.Prelude
  36 import Opaleye (Query, Unpackspec, showSqlForPostgres)
  37 import System.IO (FilePath)
  38 import Text.Read (read)
  39 import qualified Data.ByteString      as DB
  40 import qualified Database.PostgreSQL.Simple as PGS
  41
  42 ------------------------------------------------------------------------
  43 {- | Reader Monad reinvented here:
  44
  45 newtype Cmd a = Cmd { unCmd :: Connection -> IO a }
  46
  47 instance Monad Cmd where
  48   return a = Cmd $ \_ -> return a
  49
  50   m >>= f = Cmd $ \c -> do
  51     a <- unCmd m c
  52     unCmd (f a) c
  53 -}
  54
  55 --type Cmd' a = forall m. (MonadReader env m, HasConnection env, MonadIO m) => m a
  56
  57 newtype Cmd a = Cmd (ReaderT Connection IO a)
  58   deriving (Functor, Applicative, Monad, MonadReader Connection, MonadIO)
  59
  60 runCmd :: Connection -> Cmd a -> IO a
  61 runCmd c (Cmd f) = runReaderT f c
  62
  63 mkCmd :: (Connection -> IO a) -> Cmd a
  64 mkCmd = Cmd . ReaderT
  65
  66 ------------------------------------------------------------------------
  67
  68 databaseParameters :: FilePath -> IO PGS.ConnectInfo
  69 databaseParameters fp = do
  70   ini         <- readIniFile fp
  71   let ini'' = case ini of
  72         Left e     -> panic (pack $ "No ini file error" <> show e)
  73         Right ini' -> ini'
  74
  75   let val x = case (lookupValue (pack "django") (pack x) ini'') of
  76         Left _ -> panic (pack $ "no" <> x)
  77         Right p' -> unpack p'
  78
  79   pure $ PGS.ConnectInfo { PGS.connectHost     = val       "DB_HOST"
  80                          , PGS.connectPort     = read (val "DB_PORT") :: Word16
  81                          , PGS.connectUser     = val       "DB_USER"
  82                          , PGS.connectPassword = val       "DB_PASS"
  83                          , PGS.connectDatabase = val       "DB_NAME"
  84                          }
  85
  86 connectGargandb :: FilePath -> IO Connection
  87 connectGargandb fp = databaseParameters fp >>= \params -> connect params
  88
  89 printSql :: Default Unpackspec a a => Query a -> IO ()
  90 printSql = putStrLn . maybe "Empty query" identity . showSqlForPostgres
  91
  92 fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DB.ByteString -> Conversion b
  93 fromField' field mb = do
  94     v <- fromField field mb
  95     valueToHyperdata v
  96       where
  97           valueToHyperdata v = case fromJSON v of
  98              Success a  -> pure a
  99              Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
 100
 101 -- | Opaleye leftJoin* functions
 102 -- TODO add here from Node.hs