11module Database.Postgres
22 ( Query (..)
3- , Client ()
4- , DB ()
5- , ConnectionInfo ()
6- , ConnectionString ()
7- , mkConnectionString
3+ , Client
4+ , Pool
5+ , DB
6+ , ConnectionInfo
7+ , ClientConfig
8+ , PoolConfig
9+ , ConnectionString
10+ , connectionInfoFromConfig
11+ , connectionInfoFromString
12+ , defaultPoolConfig
813 , connect
9- , disconnect
14+ , release
1015 , end
1116 , execute , execute_
1217 , query , query_
1318 , queryValue , queryValue_
1419 , queryOne , queryOne_
15- , withConnection
1620 , withClient
21+ , mkPool
1722 ) where
1823
1924import Prelude
2025
2126import Control.Monad.Aff (Aff , bracket )
27+ import Control.Monad.Aff.Compat (EffFnAff , fromEffFnAff )
2228import Control.Monad.Eff (kind Effect , Eff )
2329import Control.Monad.Eff.Class (liftEff )
2430import Control.Monad.Eff.Exception (error )
@@ -28,128 +34,149 @@ import Data.Array ((!!))
2834import Data.Either (Either , either )
2935import Data.Foreign (Foreign , MultipleErrors )
3036import Data.Foreign.Class (class Decode , decode )
31- import Data.Function.Uncurried (Fn2 , runFn2 )
3237import Data.Maybe (Maybe (Just, Nothing), maybe )
3338import Data.Traversable (sequence )
3439import Database.Postgres.SqlValue (SqlValue )
40+ import Unsafe.Coerce (unsafeCoerce )
3541
3642newtype Query a = Query String
3743
44+ foreign import data Pool :: Type
45+
3846foreign import data Client :: Type
3947
4048foreign import data DB :: Effect
4149
50+ foreign import data ConnectionInfo :: Type
51+
4252type ConnectionString = String
4353
44- type ConnectionInfo =
54+ connectionInfoFromString :: ConnectionString -> ConnectionInfo
55+ connectionInfoFromString s = unsafeCoerce { connectionString: s }
56+
57+ type ClientConfig =
4558 { host :: String
46- , db :: String
59+ , database :: String
4760 , port :: Int
4861 , user :: String
4962 , password :: String
63+ , ssl :: Boolean
5064 }
5165
52- mkConnectionString :: ConnectionInfo -> ConnectionString
53- mkConnectionString ci =
54- " postgres://"
55- <> ci.user <> " :"
56- <> ci.password <> " @"
57- <> ci.host <> " :"
58- <> show ci.port <> " /"
59- <> ci.db
66+ type PoolConfig =
67+ { connectionTimeoutMillis :: Int
68+ , idleTimeoutMillis :: Int
69+ , max :: Int
70+ }
6071
61- -- | Makes a connection to the database.
62- connect :: forall eff . ConnectionInfo -> Aff (db :: DB | eff ) Client
63- connect = connect' <<< mkConnectionString
72+ defaultPoolConfig :: PoolConfig
73+ defaultPoolConfig =
74+ { connectionTimeoutMillis: 0
75+ , idleTimeoutMillis: 30000
76+ , max: 10
77+ }
78+
79+ connectionInfoFromConfig :: ClientConfig -> PoolConfig -> ConnectionInfo
80+ connectionInfoFromConfig c p = unsafeCoerce
81+ { host: c.host
82+ , database: c.database
83+ , port: c.port
84+ , user: c.user
85+ , password: c.password
86+ , ssl: c.ssl
87+ , connectionTimeoutMillis: p.connectionTimeoutMillis
88+ , idleTimeoutMillis: p.idleTimeoutMillis
89+ , max: p.max
90+ }
91+
92+ -- | Makes a connection to the database via a Client.
93+ connect :: forall eff . Pool -> Aff (db :: DB | eff ) Client
94+ connect = fromEffFnAff <<< connect'
6495
6596-- | Runs a query and returns nothing.
6697execute :: forall eff a . Query a -> Array SqlValue -> Client -> Aff (db :: DB | eff ) Unit
67- execute (Query sql) params client = void $ runQuery sql params client
98+ execute (Query sql) params client = void $ fromEffFnAff $ runQuery sql params client
6899
69100-- | Runs a query and returns nothing
70101execute_ :: forall eff a . Query a -> Client -> Aff (db :: DB | eff ) Unit
71- execute_ (Query sql) client = void $ runQuery_ sql client
102+ execute_ (Query sql) client = void $ fromEffFnAff $ runQuery_ sql client
72103
73104-- | Runs a query and returns all results.
74105query :: forall eff a
75- . ( Decode a )
106+ . Decode a
76107 => Query a -> Array SqlValue -> Client -> Aff (db :: DB | eff ) (Array a )
77108query (Query sql) params client = do
78- rows <- runQuery sql params client
109+ rows <- fromEffFnAff $ runQuery sql params client
79110 either liftError pure (runExcept (sequence $ decode <$> rows))
80111
81112-- | Just like `query` but does not make any param replacement
82- query_ :: forall eff a . (Decode a ) => Query a -> Client -> Aff (db :: DB | eff ) (Array a )
113+ query_ :: forall eff a
114+ . Decode a
115+ => Query a -> Client -> Aff (db :: DB | eff ) (Array a )
83116query_ (Query sql) client = do
84- rows <- runQuery_ sql client
117+ rows <- fromEffFnAff $ runQuery_ sql client
85118 either liftError pure (runExcept (sequence $ decode <$> rows))
86119
87120-- | Runs a query and returns the first row, if any
88121queryOne :: forall eff a
89- . ( Decode a )
122+ . Decode a
90123 => Query a -> Array SqlValue -> Client -> Aff (db :: DB | eff ) (Maybe a )
91124queryOne (Query sql) params client = do
92- rows <- runQuery sql params client
125+ rows <- fromEffFnAff $ runQuery sql params client
93126 maybe (pure Nothing ) (either liftError (pure <<< Just )) (decodeFirst rows)
94127
95128-- | Just like `queryOne` but does not make any param replacement
96- queryOne_ :: forall eff a . (Decode a ) => Query a -> Client -> Aff (db :: DB | eff ) (Maybe a )
129+ queryOne_ :: forall eff a
130+ . Decode a
131+ => Query a -> Client -> Aff (db :: DB | eff ) (Maybe a )
97132queryOne_ (Query sql) client = do
98- rows <- runQuery_ sql client
133+ rows <- fromEffFnAff $ runQuery_ sql client
99134 maybe (pure Nothing ) (either liftError (pure <<< Just )) (decodeFirst rows)
100135
101136-- | Runs a query and returns a single value, if any.
102137queryValue :: forall eff a
103- . ( Decode a )
138+ . Decode a
104139 => Query a -> Array SqlValue -> Client -> Aff (db :: DB | eff ) (Maybe a )
105140queryValue (Query sql) params client = do
106- val <- runQueryValue sql params client
141+ val <- fromEffFnAff $ runQueryValue sql params client
107142 pure $ either (const Nothing ) Just (runExcept (decode val))
108143
109144-- | Just like `queryValue` but does not make any param replacement
110- queryValue_ :: forall eff a . (Decode a ) => Query a -> Client -> Aff (db :: DB | eff ) (Maybe a )
145+ queryValue_ :: forall eff a
146+ . Decode a
147+ => Query a -> Client -> Aff (db :: DB | eff ) (Maybe a )
111148queryValue_ (Query sql) client = do
112- val <- runQueryValue_ sql client
149+ val <- fromEffFnAff $ runQueryValue_ sql client
113150 either liftError (pure <<< Just ) $ runExcept (decode val)
114151
115152-- | Connects to the database, calls the provided function with the client
116153-- | and returns the results.
117- withConnection :: forall eff a
118- . ConnectionInfo
119- -> (Client -> Aff (db :: DB | eff ) a )
120- -> Aff (db :: DB | eff ) a
121- withConnection info p =
154+ withClient :: forall eff a
155+ . Pool -> (Client -> Aff (db :: DB | eff ) a ) -> Aff (db :: DB | eff ) a
156+ withClient pool p =
122157 bracket
123- (connect info )
124- (liftEff <<< end )
158+ (connect pool )
159+ (liftEff <<< release )
125160 p
126161
127- -- | Takes a Client from the connection pool, runs the given function with
128- -- | the client and returns the results.
129- withClient :: forall eff a
130- . ConnectionInfo
131- -> (Client -> Aff (db :: DB | eff ) a )
132- -> Aff (db :: DB | eff ) a
133- withClient info p = runFn2 _withClient (mkConnectionString info) p
134-
135162decodeFirst :: forall a . Decode a => Array Foreign -> Maybe (Either MultipleErrors a )
136163decodeFirst rows = runExcept <<< decode <$> (rows !! 0 )
137164
138165liftError :: forall e a . MultipleErrors -> Aff e a
139166liftError errs = throwError $ error (show errs)
140167
141- foreign import connect' :: forall eff . String -> Aff (db :: DB | eff ) Client
168+ foreign import mkPool :: forall eff . ConnectionInfo -> Eff (db :: DB | eff ) Pool
142169
143- foreign import _withClient :: forall eff a . Fn2 ConnectionString ( Client -> Aff (db :: DB | eff ) a ) ( Aff ( db :: DB | eff ) a )
170+ foreign import connect' :: forall eff . Pool -> EffFnAff (db :: DB | eff ) Client
144171
145- foreign import runQuery_ :: forall eff . String -> Client -> Aff (db :: DB | eff ) (Array Foreign )
172+ foreign import runQuery_ :: forall eff . String -> Client -> EffFnAff (db :: DB | eff ) (Array Foreign )
146173
147- foreign import runQuery :: forall eff . String -> Array SqlValue -> Client -> Aff (db :: DB | eff ) (Array Foreign )
174+ foreign import runQuery :: forall eff . String -> Array SqlValue -> Client -> EffFnAff (db :: DB | eff ) (Array Foreign )
148175
149- foreign import runQueryValue_ :: forall eff . String -> Client -> Aff (db :: DB | eff ) Foreign
176+ foreign import runQueryValue_ :: forall eff . String -> Client -> EffFnAff (db :: DB | eff ) Foreign
150177
151- foreign import runQueryValue :: forall eff . String -> Array SqlValue -> Client -> Aff (db :: DB | eff ) Foreign
178+ foreign import runQueryValue :: forall eff . String -> Array SqlValue -> Client -> EffFnAff (db :: DB | eff ) Foreign
152179
153- foreign import end :: forall eff . Client -> Eff (db :: DB | eff ) Unit
180+ foreign import release :: forall eff . Client -> Eff (db :: DB | eff ) Unit
154181
155- foreign import disconnect :: forall eff . Eff (db :: DB | eff ) Unit
182+ foreign import end :: forall eff . Pool -> Eff (db :: DB | eff ) Unit
0 commit comments