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
  18 module Gargantext.Database.Utils where
  19
  20 import qualified Database.PostgreSQL.Simple as PGS
  21
  22 import Data.Aeson (Result(Error,Success), fromJSON, FromJSON)
  23 import Data.Typeable (Typeable)
  24 import Data.Monoid ((<>))
  25 import Data.Either.Extra (Either(Left, Right))
  26 import Database.PostgreSQL.Simple.Internal  (Field)
  27 import qualified Data.ByteString      as DB
  28 import Database.PostgreSQL.Simple.FromField ( Conversion
  29                                             , ResultError(ConversionFailed)
  30                                             , fromField
  31                                             , returnError
  32                                             )
  33
  34 import Data.Ini (readIniFile, lookupValue)
  35 import Data.Text (unpack, pack)
  36 import Data.Word (Word16)
  37 import Database.PostgreSQL.Simple (Connection, connect)
  38 import Gargantext.Prelude
  39 import System.IO (FilePath)
  40 import Text.Read (read)
  41
  42 -- Utilities
  43 import Opaleye (Query, Unpackspec, showSqlForPostgres)
  44 import Data.Profunctor.Product.Default (Default)
  45 import Data.Maybe (maybe)
  46 -- TODO add a reader Monad here
  47 -- read this in the init file
  48
  49 databaseParameters :: FilePath -> IO PGS.ConnectInfo
  50 databaseParameters fp = do
  51   ini         <- readIniFile fp
  52   let ini'' = case ini of
  53         Left e     -> panic (pack $ "No ini file error" <> show e)
  54         Right ini' -> ini'
  55
  56   let val x = case (lookupValue (pack "django") (pack x) ini'') of
  57         Left _ -> panic (pack $ "no" <> x)
  58         Right p' -> unpack p'
  59
  60   pure $ PGS.ConnectInfo { PGS.connectHost     = val       "DB_HOST"
  61                          , PGS.connectPort     = read (val "DB_PORT") :: Word16
  62                          , PGS.connectUser     = val       "DB_USER"
  63                          , PGS.connectPassword = val       "DB_PASS"
  64                          , PGS.connectDatabase = val       "DB_NAME"
  65                          }
  66
  67 connectGargandb :: FilePath -> IO Connection
  68 connectGargandb fp = databaseParameters fp >>= \params -> connect params
  69
  70 printSql :: Default Unpackspec a a => Query a -> IO ()
  71 printSql = putStrLn . maybe "Empty query" identity . showSqlForPostgres
  72
  73 fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DB.ByteString -> Conversion b
  74 fromField' field mb = do
  75     v <- fromField field mb
  76     valueToHyperdata v
  77       where
  78           valueToHyperdata v = case fromJSON v of
  79              Success a  -> pure a
  80              Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
  81
  82
  83