]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Utils.hs
[FEAT] Syntactic convention (proposition to be discussed).
[gargantext.git] / 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.Monoid ((<>))
23 import Data.Either.Extra (Either(Left, Right))
24 import Gargantext.Prelude
25 import Data.Text (unpack, pack)
26 import Text.Read (read)
27 import Data.Ini (readIniFile, lookupValue)
28 import Data.Word (Word16)
29 import System.IO (FilePath)
30 import Database.PostgreSQL.Simple (Connection, connect)
31
32 -- Utilities
33 import Opaleye (Query, Unpackspec, showSqlForPostgres)
34 import Data.Profunctor.Product.Default (Default)
35 import Data.Maybe (maybe)
36 import Prelude (id, putStrLn)
37 -- TODO add a reader Monad here
38 -- read this in the init file
39
40 databaseParameters :: FilePath -> IO PGS.ConnectInfo
41 databaseParameters fp = do
42 ini <- readIniFile fp
43 let ini'' = case ini of
44 Left e -> panic (pack $ "No ini file error" <> show e)
45 Right ini' -> ini'
46
47 let val x = case (lookupValue (pack "django") (pack x) ini'') of
48 Left _ -> panic (pack $ "no" <> x)
49 Right p' -> unpack p'
50
51 pure $ PGS.ConnectInfo { PGS.connectHost = val "DB_HOST"
52 , PGS.connectPort = read (val "DB_PORT") :: Word16
53 , PGS.connectUser = val "DB_USER"
54 , PGS.connectPassword = val "DB_PASS"
55 , PGS.connectDatabase = val "DB_NAME"
56 }
57
58 connectGargandb :: FilePath -> IO Connection
59 connectGargandb fp = do
60 parameters <- databaseParameters fp
61 connect parameters
62
63 printSql :: Default Unpackspec a a => Query a -> IO ()
64 printSql = putStrLn . maybe "Empty query" id . showSqlForPostgres
65