valiant-bluefin (empty) → 0.1.0.0

raw patch · 7 files changed

+414/−0 lines, 7 filesdep +basedep +bluefindep +bytestring

Dependencies added: base, bluefin, bytestring, hspec, pg-wire, text, valiant, valiant-bluefin

Files

CHANGELOG.md +14/−0
LICENSE +27/−0
README.md +36/−0
src/Valiant/Bluefin.hs +113/−0
test/Main.hs +76/−0
test/TestSupport.hs +63/−0
valiant-bluefin.cabal +85/−0

+ CHANGELOG.md view

@@ -0,0 +1,14 @@+# Changelog++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/),+and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).++## [0.1.0.0] - 2026-04-25++Initial release. Bluefin effect adapter for the+[`valiant`](https://hackage.haskell.org/package/valiant) PostgreSQL+runtime. Provides a `ValiantHandle` parameterised by an effect tag, a+`runValiantB` runner, and explicit-handle versions of the standard+query, command, and transaction operations.++[0.1.0.0]: https://github.com/joshburgess/valiant/releases/tag/v0.1.0.0

+ LICENSE view

@@ -0,0 +1,27 @@+Copyright (c) 2026 Josh Burgess++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+   this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from this+   software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,36 @@+# valiant-bluefin++[Bluefin](https://hackage.haskell.org/package/bluefin) effect adapter+for [`valiant`](https://hackage.haskell.org/package/valiant).++Bluefin uses explicit effect handles rather than type-level effect+lists. This adapter wraps a `Pool` as a `ValiantHandle e` that you+pass to functions that need database access.++## Quick start++```haskell+import Valiant (newPool, defaultPoolConfig, poolConnString)+import Valiant.Bluefin++myApp :: ValiantHandle e -> IO [User]+myApp db = fetchAllB db listUsers ()++main :: IO ()+main = do+  pool <- newPool defaultPoolConfig { poolConnString = "postgres://..." }+  result <- runValiantB pool myApp+  print result+```++## What you get++- `runValiantB :: Pool -> (forall e. ValiantHandle e -> IO a) -> IO a`+- Query operations: `fetchOneB`, `fetchAllB`, `fetchScalarB`,+  `fetchOneOrThrowB`, `fetchExistsB`+- Command operations: `executeB`, `executeReturningB`, `executeBatchB`+- Transactions: `withTransactionB`+- Raw access: `withConnectionB`++See the [valiant tutorial](https://github.com/joshburgess/valiant/blob/main/docs/TUTORIAL.md)+for the underlying `Statement` and `valiant prepare` workflow.

+ src/Valiant/Bluefin.hs view

@@ -0,0 +1,113 @@+-- | Bluefin effect adapter for valiant.+--+-- Bluefin uses explicit effect handles rather than type-level effect+-- lists. The 'ValiantHandle' provides database operations that can be+-- passed to functions explicitly.+--+-- @+-- import Bluefin.Eff+-- import Valiant.Bluefin+--+-- myApp :: ValiantHandle e -> Eff e [User]+-- myApp db = do+--   users <- fetchAllB db listUsers ()+--   pure users+--+-- main :: IO ()+-- main = do+--   pool <- newPool defaultPoolConfig { poolConnString = "..." }+--   result <- runValiantB pool $ \\db -> myApp db+--   print result+-- @+module Valiant.Bluefin+  ( -- * Handle+    ValiantHandle++    -- * Runner+  , runValiantB++    -- * Query operations+  , fetchOneB+  , fetchAllB+  , fetchScalarB+  , fetchOneOrThrowB+  , fetchExistsB++    -- * Command operations+  , executeB+  , executeReturningB+  , executeBatchB++    -- * Transaction operations+  , withTransactionB++    -- * Raw access+  , withConnectionB+  ) where++import Data.Int (Int64)+import Valiant (Connection, Pool, Statement, Transaction)+import Valiant qualified+import PgWire.Pool (withResource)++-- | An opaque handle to an valiant database connection pool.+-- Pass this explicitly to functions that need database access.+newtype ValiantHandle e = ValiantHandle { unHandle :: Pool }++-- | Run an action with an valiant database handle backed by a pool.+--+-- @+-- result <- runValiantB pool $ \\db -> do+--   users <- fetchAllB db listUsers ()+--   pure users+-- @+runValiantB :: Pool -> (forall e. ValiantHandle e -> IO a) -> IO a+runValiantB pool f = f (ValiantHandle pool)++-- | Fetch zero or one row.+fetchOneB :: ValiantHandle e -> Statement p r -> p -> IO (Maybe r)+fetchOneB h stmt params =+  withResource (unHandle h) $ \conn -> Valiant.fetchOne conn stmt params++-- | Fetch all rows.+fetchAllB :: ValiantHandle e -> Statement p r -> p -> IO [r]+fetchAllB h stmt params =+  withResource (unHandle h) $ \conn -> Valiant.fetchAll conn stmt params++-- | Fetch exactly one scalar value.+fetchScalarB :: ValiantHandle e -> Statement p r -> p -> IO r+fetchScalarB h stmt params =+  withResource (unHandle h) $ \conn -> Valiant.fetchScalar conn stmt params++-- | Fetch one row, throwing if none returned.+fetchOneOrThrowB :: ValiantHandle e -> Statement p r -> p -> IO r+fetchOneOrThrowB h stmt params =+  withResource (unHandle h) $ \conn -> Valiant.fetchOneOrThrow conn stmt params++-- | Check if a query returns any rows.+fetchExistsB :: ValiantHandle e -> Statement p r -> p -> IO Bool+fetchExistsB h stmt params =+  withResource (unHandle h) $ \conn -> Valiant.fetchExists conn stmt params++-- | Execute a command. Returns rows affected.+executeB :: ValiantHandle e -> Statement p () -> p -> IO Int64+executeB h stmt params =+  withResource (unHandle h) $ \conn -> Valiant.execute conn stmt params++-- | Execute with RETURNING.+executeReturningB :: ValiantHandle e -> Statement p r -> p -> IO (Int64, [r])+executeReturningB h stmt params =+  withResource (unHandle h) $ \conn -> Valiant.executeReturning conn stmt params++-- | Execute a batch of commands (pipelined).+executeBatchB :: ValiantHandle e -> Statement p () -> [p] -> IO Int64+executeBatchB h stmt paramsList =+  withResource (unHandle h) $ \conn -> Valiant.executeBatch conn stmt paramsList++-- | Run an action in a transaction.+withTransactionB :: ValiantHandle e -> (Transaction -> IO a) -> IO a+withTransactionB h = Valiant.withTransaction (unHandle h)++-- | Run an action with a raw connection.+withConnectionB :: ValiantHandle e -> (Connection -> IO a) -> IO a+withConnectionB h = withResource (unHandle h)

+ test/Main.hs view

@@ -0,0 +1,76 @@+module Main where++import Data.ByteString (ByteString)+import Data.ByteString.Char8 qualified as BS8+import Data.Int (Int32)+import Data.Text (Text)+import Valiant (defaultPoolConfig, newPool, closePool)+import Valiant qualified+import Valiant.Bluefin (runValiantB, fetchAllB, fetchOneB, executeB)+import PgWire.Pool.Config (PoolConfig (..))+import System.Environment (lookupEnv)+import Test.Hspec+import TestSupport++main :: IO ()+main = hspec $ do+  describe "Valiant.Bluefin" $ do+    it "fetchAllB returns all rows" $ do+      withTestConnection $ \conn -> withSchema conn $ do+        insertTestUsers conn+        pool <- mkPool+        result <- runValiantB pool $ \db -> fetchAllB db stmtListAll ()+        closePool pool+        length result `shouldBe` 5++    it "fetchOneB returns Just for existing row" $ do+      withTestConnection $ \conn -> withSchema conn $ do+        insertTestUsers conn+        pool <- mkPool+        result <- runValiantB pool $ \db -> fetchOneB db stmtSelectOne 1+        closePool pool+        case result of+          Just (_, name, _) -> name `shouldBe` "Alice"+          Nothing -> expectationFailure "Expected a row"++    it "fetchOneB returns Nothing for missing row" $ do+      withTestConnection $ \conn -> withSchema conn $ do+        pool <- mkPool+        result <- runValiantB pool $ \db -> fetchOneB db stmtSelectOne (-1)+        closePool pool+        result `shouldBe` (Nothing :: Maybe (Int32, Text, Maybe Text))++    it "executeB returns rows affected" $ do+      withTestConnection $ \conn -> withSchema conn $ do+        insertTestUsers conn+        pool <- mkPool+        let stmtDel = Valiant.mkStatement "DELETE FROM users_bluefin WHERE id = $1" [23] [] "<test>" :: Valiant.Statement Int32 ()+        n <- runValiantB pool $ \db -> executeB db stmtDel (1 :: Int32)+        closePool pool+        n `shouldBe` 1++    it "composes multiple operations" $ do+      withTestConnection $ \conn -> withSchema conn $ do+        insertTestUsers conn+        pool <- mkPool+        (users, mUser) <- runValiantB pool $ \db -> do+          us <- fetchAllB db stmtListAll ()+          mu <- fetchOneB db stmtSelectOne 1+          pure (us, mu)+        closePool pool+        length users `shouldBe` 5+        case mUser of+          Just (_, name, _) -> name `shouldBe` "Alice"+          Nothing -> expectationFailure "Expected a row"++mkPool :: IO Valiant.Pool+mkPool = do+  url <- requireDatabaseUrl'+  newPool defaultPoolConfig { poolConnString = url, poolSize = 2, poolAcquireTimeout = 5 }++requireDatabaseUrl' :: IO ByteString+requireDatabaseUrl' = do+  mUrl <- lookupEnv "DATABASE_URL"+  case mUrl of+    Just url -> pure (BS8.pack url)+    Nothing -> error "DATABASE_URL is not set."

+ test/TestSupport.hs view

@@ -0,0 +1,63 @@+module TestSupport+  ( withTestConnection+  , withSchema+  , insertTestUsers+  , stmtListAll+  , stmtSelectOne+  ) where++import Data.ByteString (ByteString)+import Data.ByteString.Char8 qualified as BS8+import Data.Int (Int32)+import Data.Text (Text)+import Valiant+import System.Environment (lookupEnv)++requireDatabaseUrl :: IO ByteString+requireDatabaseUrl = do+  mUrl <- lookupEnv "DATABASE_URL"+  case mUrl of+    Just url -> pure (BS8.pack url)+    Nothing -> error "DATABASE_URL is not set."++withTestConnection :: (Connection -> IO a) -> IO a+withTestConnection action = do+  url <- requireDatabaseUrl+  conn <- connectString url+  result <- action conn+  close conn+  pure result++withSchema :: Connection -> IO a -> IO a+withSchema conn action = do+  _ <- simpleQuery conn "DROP TABLE IF EXISTS users_bluefin CASCADE"+  _ <- simpleQuery conn+    "CREATE TABLE users_bluefin (\+    \  id SERIAL PRIMARY KEY,\+    \  name TEXT NOT NULL,\+    \  email TEXT\+    \)"+  result <- action+  _ <- simpleQuery conn "DROP TABLE IF EXISTS users_bluefin CASCADE"+  pure result++insertTestUsers :: Connection -> IO ()+insertTestUsers conn = do+  _ <- simpleQuery conn+    "INSERT INTO users_bluefin (name, email) VALUES \+    \('Alice', 'alice@example.com'),\+    \('Bob', 'bob@example.com'),\+    \('Carol', NULL),\+    \('Dave', 'dave@example.com'),\+    \('Eve', 'eve@example.com')"+  pure ()++stmtListAll :: Statement () (Int32, Text)+stmtListAll = mkStatement+  "SELECT id, name FROM users_bluefin ORDER BY id"+  [] ["id", "name"] "<test>"++stmtSelectOne :: Statement Int32 (Int32, Text, Maybe Text)+stmtSelectOne = mkStatement+  "SELECT id, name, email FROM users_bluefin WHERE id = $1"+  [23] ["id", "name", "email"] "<test>"

+ valiant-bluefin.cabal view

@@ -0,0 +1,85 @@+cabal-version:   3.0+name:            valiant-bluefin+version:         0.1.0.0+synopsis:        Bluefin effect adapter for valiant+description:+  Provides an @Valiant@ effect handle for the @bluefin@ effect system,+  enabling compile-time checked SQL queries with explicit effect passing.++  @+  import Valiant.Bluefin++  myApp :: Valiant e -> Eff es [User]+  myApp db = do+    users <- fetchAllB db listUsers ()+    pure users+  @+license:         BSD-3-Clause+license-file:    LICENSE+author:          Josh Burgess+maintainer:      joshburgess.webdev@gmail.com+category:        Database+homepage:        https://github.com/joshburgess/valiant+bug-reports:     https://github.com/joshburgess/valiant/issues+build-type:      Simple+extra-doc-files:+  README.md+  CHANGELOG.md+tested-with:     GHC ==9.10.3++source-repository head+  type:     git+  location: https://github.com/joshburgess/valiant+  subdir:   adapters/valiant-bluefin++flag werror+  description: Enable -Werror for development builds.+  default:     False+  manual:      True++common warnings+  ghc-options: -Wall -Wcompat -Wno-unticked-promoted-constructors -funbox-strict-fields -fspecialise-aggressively+  if flag(werror)+    ghc-options: -Werror++library+  import:           warnings+  hs-source-dirs:   src+  default-language: GHC2021+  default-extensions:+    DerivingStrategies+    LambdaCase+    OverloadedStrings+    StrictData++  exposed-modules:+    Valiant.Bluefin++  build-depends:+    , base            >=4.17 && <5+    , bluefin         >=0.0  && <0.2+    , valiant         >=0.1  && <0.2+    , pg-wire         >=0.1  && <0.2++test-suite valiant-bluefin-test+  import:           warnings+  type:             exitcode-stdio-1.0+  hs-source-dirs:   test+  main-is:          Main.hs+  default-language: GHC2021+  default-extensions:+    OverloadedStrings++  ghc-options: -rtsopts "-with-rtsopts=-K8K"++  other-modules:+    TestSupport++  build-depends:+    , base            >=4.17 && <5+    , bytestring      >=0.11 && <0.13+    , hspec           >=2.11 && <2.13+    , valiant+    , valiant-bluefin+    , pg-wire+    , text            >=2.0  && <2.2