Skip to content

updates for 0.12, remove foreign-generics #21

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Jun 9, 2018
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
29 changes: 14 additions & 15 deletions bower.json
Original file line number Diff line number Diff line change
Expand Up @@ -26,22 +26,21 @@
"output"
],
"dependencies": {
"purescript-arrays": "^4.2.1",
"purescript-either": "^3.1.0",
"purescript-foreign": "^4.0.1",
"purescript-foldable-traversable": "^3.6.1",
"purescript-transformers": "^3.4.0",
"purescript-aff": "^4.0.0",
"purescript-integers": "^3.1.0",
"purescript-datetime": "^3.4.0",
"purescript-unsafe-coerce": "^3.0.0",
"purescript-nullable": "^3.0.0",
"purescript-prelude": "^3.1.0",
"purescript-foreign-generic": "^5.0.0"
"purescript-arrays": "^5.0.0",
"purescript-either": "^4.0.0",
"purescript-foreign": "^5.0.0",
"purescript-foldable-traversable": "^4.0.0",
"purescript-transformers": "^4.1.0",
"purescript-aff": "^5.0.0",
"purescript-integers": "^4.0.0",
"purescript-datetime": "^4.0.0",
"purescript-unsafe-coerce": "^4.0.0",
"purescript-nullable": "^4.0.0",
"purescript-prelude": "^4.0.0"
},
"devDependencies": {
"purescript-spec": "^2.0.0",
"purescript-generics": "^4.0.0",
"purescript-js-date": "^5.1.0"
"purescript-spec": "^3.0.0",
"purescript-js-date": "^6.0.0",
"purescript-simple-json": "^4.0.0"
}
}
123 changes: 54 additions & 69 deletions src/Database/Postgres.purs
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,6 @@ module Database.Postgres
( Query(..)
, Client
, Pool
, DB
, ConnectionInfo
, ClientConfig
, PoolConfig
Expand All @@ -23,20 +22,17 @@ module Database.Postgres

import Prelude

import Control.Monad.Aff (Aff, bracket)
import Control.Monad.Aff.Compat (EffFnAff, fromEffFnAff)
import Control.Monad.Eff (kind Effect, Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Exception (error)
import Control.Monad.Error.Class (throwError)
import Control.Monad.Except (runExcept)
import Data.Array ((!!))
import Data.Either (Either, either)
import Data.Foreign (Foreign, MultipleErrors)
import Data.Foreign.Class (class Decode, decode)
import Data.Maybe (Maybe(Just, Nothing), maybe)
import Data.Traversable (sequence)
import Database.Postgres.SqlValue (SqlValue)
import Effect (Effect)
import Effect.Aff (Aff, Error, bracket)
import Effect.Aff.Compat (EffectFnAff, fromEffectFnAff)
import Effect.Class (liftEffect)
import Foreign (Foreign)
import Unsafe.Coerce (unsafeCoerce)

newtype Query a = Query String
Expand All @@ -45,8 +41,6 @@ foreign import data Pool :: Type

foreign import data Client :: Type

foreign import data DB :: Effect

foreign import data ConnectionInfo :: Type

type ConnectionString = String
Expand Down Expand Up @@ -90,93 +84,84 @@ connectionInfoFromConfig c p = unsafeCoerce
}

-- | Makes a connection to the database via a Client.
connect :: forall eff. Pool -> Aff (db :: DB | eff) Client
connect = fromEffFnAff <<< connect'
connect :: Pool -> Aff Client
connect = fromEffectFnAff <<< connect'

-- | Runs a query and returns nothing.
execute :: forall eff a. Query a -> Array SqlValue -> Client -> Aff (db :: DB | eff) Unit
execute (Query sql) params client = void $ fromEffFnAff $ runQuery sql params client
execute :: forall a. Query a -> Array SqlValue -> Client -> Aff Unit
execute (Query sql) params client = void $ fromEffectFnAff $ runQuery sql params client

-- | Runs a query and returns nothing
execute_ :: forall eff a. Query a -> Client -> Aff (db :: DB | eff) Unit
execute_ (Query sql) client = void $ fromEffFnAff $ runQuery_ sql client
execute_ :: forall a. Query a -> Client -> Aff Unit
execute_ (Query sql) client = void $ fromEffectFnAff $ runQuery_ sql client

-- | Runs a query and returns all results.
query :: forall eff a
. Decode a
=> Query a -> Array SqlValue -> Client -> Aff (db :: DB | eff) (Array a)
query (Query sql) params client = do
rows <- fromEffFnAff $ runQuery sql params client
either liftError pure (runExcept (sequence $ decode <$> rows))
query :: forall a
. (Foreign -> Either Error a) -> Query a -> Array SqlValue -> Client -> Aff (Array a)
query decode (Query sql) params client = do
rows <- fromEffectFnAff $ runQuery sql params client
either throwError pure (sequence $ decode <$> rows)

-- | Just like `query` but does not make any param replacement
query_ :: forall eff a
. Decode a
=> Query a -> Client -> Aff (db :: DB | eff) (Array a)
query_ (Query sql) client = do
rows <- fromEffFnAff $ runQuery_ sql client
either liftError pure (runExcept (sequence $ decode <$> rows))
query_ :: forall a
. (Foreign -> Either Error a) -> Query a -> Client -> Aff (Array a)
query_ decode (Query sql) client = do
rows <- fromEffectFnAff $ runQuery_ sql client
either throwError pure (sequence $ decode <$> rows)

-- | Runs a query and returns the first row, if any
queryOne :: forall eff a
. Decode a
=> Query a -> Array SqlValue -> Client -> Aff (db :: DB | eff) (Maybe a)
queryOne (Query sql) params client = do
rows <- fromEffFnAff $ runQuery sql params client
maybe (pure Nothing) (either liftError (pure <<< Just)) (decodeFirst rows)
queryOne :: forall a
. (Foreign -> Either Error a) -> Query a -> Array SqlValue -> Client -> Aff (Maybe a)
queryOne decode (Query sql) params client = do
rows <- fromEffectFnAff $ runQuery sql params client
maybe (pure Nothing) (either throwError (pure <<< Just)) (decodeFirst decode rows)

-- | Just like `queryOne` but does not make any param replacement
queryOne_ :: forall eff a
. Decode a
=> Query a -> Client -> Aff (db :: DB | eff) (Maybe a)
queryOne_ (Query sql) client = do
rows <- fromEffFnAff $ runQuery_ sql client
maybe (pure Nothing) (either liftError (pure <<< Just)) (decodeFirst rows)
queryOne_ :: forall a
. (Foreign -> Either Error a) -> Query a -> Client -> Aff (Maybe a)
queryOne_ decode (Query sql) client = do
rows <- fromEffectFnAff $ runQuery_ sql client
maybe (pure Nothing) (either throwError (pure <<< Just)) (decodeFirst decode rows)

-- | Runs a query and returns a single value, if any.
queryValue :: forall eff a
. Decode a
=> Query a -> Array SqlValue -> Client -> Aff (db :: DB | eff) (Maybe a)
queryValue (Query sql) params client = do
val <- fromEffFnAff $ runQueryValue sql params client
pure $ either (const Nothing) Just (runExcept (decode val))
queryValue :: forall a
. (Foreign -> Either Error a) -> Query a -> Array SqlValue -> Client -> Aff (Maybe a)
queryValue decode (Query sql) params client = do
val <- fromEffectFnAff $ runQueryValue sql params client
pure $ either (const Nothing) Just (decode val)

-- | Just like `queryValue` but does not make any param replacement
queryValue_ :: forall eff a
. Decode a
=> Query a -> Client -> Aff (db :: DB | eff) (Maybe a)
queryValue_ (Query sql) client = do
val <- fromEffFnAff $ runQueryValue_ sql client
either liftError (pure <<< Just) $ runExcept (decode val)
queryValue_ :: forall a
. (Foreign -> Either Error a) -> Query a -> Client -> Aff (Maybe a)
queryValue_ decode (Query sql) client = do
val <- fromEffectFnAff $ runQueryValue_ sql client
either throwError (pure <<< Just) $ (decode val)

-- | Connects to the database, calls the provided function with the client
-- | and returns the results.
withClient :: forall eff a
. Pool -> (Client -> Aff (db :: DB | eff) a) -> Aff (db :: DB | eff) a
withClient :: forall a
. Pool -> (Client -> Aff a) -> Aff a
withClient pool p =
bracket
(connect pool)
(liftEff <<< release)
(liftEffect <<< release)
p

decodeFirst :: forall a. Decode a => Array Foreign -> Maybe (Either MultipleErrors a)
decodeFirst rows = runExcept <<< decode <$> (rows !! 0)

liftError :: forall e a. MultipleErrors -> Aff e a
liftError errs = throwError $ error (show errs)
decodeFirst :: forall a. (Foreign -> Either Error a) -> Array Foreign -> Maybe (Either Error a)
decodeFirst decode rows = decode <$> (rows !! 0)

foreign import mkPool :: forall eff. ConnectionInfo -> Eff (db :: DB | eff) Pool
foreign import mkPool :: ConnectionInfo -> Effect Pool

foreign import connect' :: forall eff. Pool -> EffFnAff (db :: DB | eff) Client
foreign import connect' :: Pool -> EffectFnAff Client

foreign import runQuery_ :: forall eff. String -> Client -> EffFnAff (db :: DB | eff) (Array Foreign)
foreign import runQuery_ :: String -> Client -> EffectFnAff (Array Foreign)

foreign import runQuery :: forall eff. String -> Array SqlValue -> Client -> EffFnAff (db :: DB | eff) (Array Foreign)
foreign import runQuery :: String -> Array SqlValue -> Client -> EffectFnAff (Array Foreign)

foreign import runQueryValue_ :: forall eff. String -> Client -> EffFnAff (db :: DB | eff) Foreign
foreign import runQueryValue_ :: String -> Client -> EffectFnAff Foreign

foreign import runQueryValue :: forall eff. String -> Array SqlValue -> Client -> EffFnAff (db :: DB | eff) Foreign
foreign import runQueryValue :: String -> Array SqlValue -> Client -> EffectFnAff Foreign

foreign import release :: forall eff. Client -> Eff (db :: DB | eff) Unit
foreign import release :: Client -> Effect Unit

foreign import end :: forall eff. Pool -> Eff (db :: DB | eff) Unit
foreign import end :: Pool -> Effect Unit
12 changes: 6 additions & 6 deletions src/Database/Postgres/Transaction.purs
Original file line number Diff line number Diff line change
@@ -1,11 +1,11 @@
module Database.Postgres.Transaction where

import Prelude
import Control.Monad.Aff (Aff, attempt)
import Effect.Aff (Aff, attempt)
import Control.Monad.Error.Class (throwError)
import Data.Either (either)

import Database.Postgres (DB, Client, Query(Query), execute_)
import Database.Postgres (Client, Query(Query), execute_)

-- | Runs an asynchronous action in a database transaction. The transaction
-- | will be rolled back if the computation fails and committed otherwise.
Expand All @@ -19,7 +19,7 @@ import Database.Postgres (DB, Client, Query(Query), execute_)
-- | throwError $ error "Something went wrong"
-- | execute_ (Query "insert into accounts ...") c
-- | ```
withTransaction :: forall eff a. (Client -> Aff (db :: DB | eff) a) -> Client -> Aff (db :: DB | eff) a
withTransaction :: forall a. (Client -> Aff a) -> Client -> Aff a
withTransaction act client = do
begin client
res <- attempt (act client)
Expand All @@ -28,11 +28,11 @@ withTransaction act client = do
rollback_ err = rollback client *> throwError err
commit_ v = commit client *> pure v

begin :: forall eff. Client -> Aff (db :: DB | eff) Unit
begin :: Client -> Aff Unit
begin = execute_ (Query "BEGIN TRANSACTION")

commit :: forall eff. Client -> Aff (db :: DB | eff) Unit
commit :: Client -> Aff Unit
commit = execute_ (Query "COMMIT")

rollback :: forall eff. Client -> Aff (db :: DB | eff) Unit
rollback :: Client -> Aff Unit
rollback = execute_ (Query "ROLLBACK")
Loading