baikai-effectful (empty) → 0.1.0.0

raw patch · 9 files changed

+537/−0 lines, 9 filesdep +baikaidep +baikai-effectfuldep +baikai-openai

Dependencies added: baikai, baikai-effectful, baikai-openai, base, effectful-core, streamly, streamly-core, tasty, tasty-hunit, text, vector

Files

• LICENSE +30/−0
• README.md +85/−0
• baikai-effectful.cabal +69/−0
• src/Baikai/Effectful.hs +106/−0
• test/CompleteSpec.hs +23/−0
• test/LiveSpec.hs +42/−0
• test/Main.hs +18/−0
• test/StreamSpec.hs +49/−0
• test/StubProvider.hs +115/−0

@@ -0,0 +1,30 @@+Copyright (c) 2026 Nadeem Bitar++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Nadeem Bitar nor the names of other+      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+OWNER 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.

@@ -0,0 +1,85 @@+# baikai-effectful++A thin, **policy-free** [`effectful`](https://hackage.haskell.org/package/effectful)+binding over [baikai](../baikai)'s transport. It exposes one dynamic effect, `Baikai`,+whose operations mirror baikai's transport functions, plus interpreters that run those+operations against a real or isolated provider registry.++It is the *seam*, not the framework: it adds **no** retries, backoff, rate limiting,+budgets, caching, or error remapping. Failures propagate exactly as baikai produces them —+the blocking path throws `Baikai.Error.BaikaiError`; the streaming paths surface baikai's+terminal `EventError` event in-band. Policy belongs one layer up, written *in terms of* this+effect.++## The effect++```haskell+data Baikai :: Effect where+  Complete      :: Model -> Context -> Options -> Baikai m Response+  StreamCollect :: Model -> Context -> Options -> Baikai m [AssistantMessageEvent]+  StreamEach    :: Model -> Context -> Options -> (AssistantMessageEvent -> m ()) -> Baikai m ()+```++## Operations++| Operation                         | Meaning                                                        |+| --------------------------------- | ------------------------------------------------------------- |+| `complete m c o`                  | Blocking completion → `Response`. Throws `BaikaiError`.       |+| `streamCollect m c o`             | Drain the stream into the full `[AssistantMessageEvent]`.     |+| `streamEach m c o k`              | Run callback `k` once per event, in order, inside `Eff`.      |++`streamEach` preserves incrementality (the callback sees events as they arrive); a terminal+`EventError` appears in-band rather than as a thrown exception, matching baikai.++## Interpreters++```haskell+runBaikai     :: (IOE :> es) => Eff (Baikai : es) a -> Eff es a                       -- global registry+runBaikaiWith :: (IOE :> es) => ProviderRegistry -> Eff (Baikai : es) a -> Eff es a   -- explicit registry+```++The *operations* are registry-agnostic; the *interpreter* picks the registry, mirroring+baikai's own `completeRequest` vs `completeRequestWith` split. Because `Baikai` is a dynamic+effect, you can re-interpret the same operations — stub them in tests, record/replay,+intercept, or (one layer up) wrap them with retries/caching/tracing — without touching any+call site.++## Example++```haskell+import Baikai.Effectful+import Effectful (Eff, runEff)++describe :: (Baikai :> es) => Model -> Context -> Options -> Eff es Response+describe = complete++main :: IO ()+main = do+  -- against baikai's process-global registry (providers registered elsewhere):+  r <- runEff . runBaikai $ describe model ctx opts+  print r+```++For a hermetic test, register a stub provider in an isolated registry with+`Baikai.Provider.Registry.newProviderRegistry` / `registerApiProviderWith` and drive the+operations through `runEff . runBaikaiWith reg`. See `test/` in this package.++## Live demo++The test suite includes a live, network-touching demo gated on an environment variable, so+the default run stays hermetic:++```bash+# hermetic (default): no network, no key — the live case prints a skip line and passes+cabal test baikai-effectful-test++# live: registers the OpenAI provider and makes one real call+BAIKAI_EFFECTFUL_LIVE=1 OPENAI_API_KEY=sk-... cabal test baikai-effectful-test+```++## Why a separate package++The core `baikai` package deliberately carries no `effectful` dependency, and most baikai+users do not use `effectful`. Shipping the binding as its own artifact keeps the core+dependency-light while giving any `effectful` program a reusable baikai↔effectful seam — the+same way `baikai-claude` / `baikai-openai` layer on `baikai`.

@@ -0,0 +1,69 @@+cabal-version:   3.4+name:            baikai-effectful+version:         0.1.0.0+synopsis:        effectful binding for the baikai AI-provider transport+description:+  A thin, policy-free effectful binding over baikai's transport. Provides the dynamic+  `Baikai` effect (Complete / StreamCollect / StreamEach) and interpreters over a real or+  isolated provider registry. Adds no retries, caching, budgets, or error remapping.++category:        AI+license:         BSD-3-Clause+license-file:    LICENSE+author:          Nadeem Bitar+maintainer:      nadeem@gmail.com+copyright:       (c) 2026 Nadeem Bitar+build-type:      Simple+extra-doc-files: README.md++common common-options+  ghc-options:+    -Wall -Wcompat -Widentities -Wincomplete-uni-patterns+    -Wincomplete-record-updates -Wredundant-constraints+    -fhide-source-paths -Wmissing-export-lists -Wpartial-fields+    -Wmissing-deriving-strategies++  default-language:   GHC2024+  default-extensions:+    DeriveAnyClass+    DuplicateRecordFields+    OverloadedLabels+    OverloadedStrings++library+  import:          common-options+  hs-source-dirs:  src+  exposed-modules: Baikai.Effectful+  build-depends:+    , baikai          ^>=0.1.0+    , base            >=4.20   && <5+    , effectful-core+    , streamly        >=0.11   && <0.13+    , streamly-core   >=0.3    && <0.5+    , text            ^>=2.1+    , vector++test-suite baikai-effectful-test+  import:         common-options+  type:           exitcode-stdio-1.0+  hs-source-dirs: test+  main-is:        Main.hs+  ghc-options:    -threaded -with-rtsopts=-N+  other-modules:+    CompleteSpec+    LiveSpec+    StreamSpec+    StubProvider++  build-depends:+    , baikai+    , baikai-effectful+    , baikai-openai+    , base              >=4.20 && <5+    , effectful-core+    , streamly+    , streamly-core+    , tasty+    , tasty-hunit+    , text+    , vector

@@ -0,0 +1,106 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeFamilies #-}++-- | A thin, policy-free @effectful@ binding over baikai's transport.+--+-- This module exposes a single dynamic effect, 'Baikai', whose operations mirror+-- baikai's transport functions, plus two interpreters that run those operations+-- against a real (global) or isolated provider registry. It carries NO policy:+-- failures propagate exactly as baikai produces them — the blocking path+-- ('complete') throws 'Baikai.Error.BaikaiError'; the streaming paths+-- ('streamCollect', 'streamEach') surface baikai's terminal @EventError@ in-band.+-- Retries, caching, budgets, rate limiting, and error remapping belong one layer+-- up, in terms of this effect.+module Baikai.Effectful+  ( -- * The effect+    Baikai (..),++    -- * Operations+    complete,+    streamCollect,+    streamEach,++    -- * Interpreters+    runBaikai,+    runBaikaiWith,++    -- * Re-exports of the baikai request/response vocabulary+    Model,+    Context,+    Options,+    Response,+    AssistantMessageEvent,+  )+where++import Baikai (AssistantMessageEvent, Context, Model, Options, Response)+import Baikai qualified+import Baikai.Provider.Registry (ProviderRegistry)+import Effectful (Dispatch (Dynamic), DispatchOf, Eff, Effect, IOE, liftIO, (:>))+import Effectful.Dispatch.Dynamic (interpret, localSeqUnliftIO, send)+import Streamly.Data.Fold qualified as Fold+import Streamly.Data.Stream qualified as Stream++-- | The provider-neutral baikai transport effect. Operations mirror baikai's+-- transport functions; the interpreter selects the provider registry.+data Baikai :: Effect where+  -- | A blocking completion. Mirrors 'Baikai.completeRequest' — throws+  -- 'Baikai.Error.BaikaiError' on failure.+  Complete :: Model -> Context -> Options -> Baikai m Response+  -- | A streaming completion materialized into the full event list. Mirrors+  -- 'Baikai.streamRequest' drained to a list; a terminal @EventError@ appears+  -- as the last element on failure (baikai does not throw here).+  StreamCollect :: Model -> Context -> Options -> Baikai m [AssistantMessageEvent]+  -- | A streaming completion where each event is handed, in order, to a+  -- caller-supplied callback that runs inside the same effect context.+  StreamEach :: Model -> Context -> Options -> (AssistantMessageEvent -> m ()) -> Baikai m ()++type instance DispatchOf Baikai = 'Dynamic++-- | Issue a blocking completion. Throws baikai's 'Baikai.Error.BaikaiError' on+-- failure, just like 'Baikai.completeRequest' — this binding does not catch it.+complete :: (Baikai :> es) => Model -> Context -> Options -> Eff es Response+complete m c o = send (Complete m c o)++-- | Materialize a streaming completion into the full event list. Convenient when+-- you do not need incremental deltas. Does not throw on provider failure; a+-- terminal 'AssistantMessageEvent' @EventError@ appears as the last element.+streamCollect :: (Baikai :> es) => Model -> Context -> Options -> Eff es [AssistantMessageEvent]+streamCollect m c o = send (StreamCollect m c o)++-- | Stream a completion, invoking the callback on each event in order, inside+-- 'Eff'. Preserves incrementality: the callback sees events as they arrive, in+-- the same effect context as the caller.+streamEach ::+  (Baikai :> es) =>+  Model ->+  Context ->+  Options ->+  (AssistantMessageEvent -> Eff es ()) ->+  Eff es ()+streamEach m c o k = send (StreamEach m c o k)++-- | Interpret 'Baikai' against an explicit provider registry. Requires 'IOE'+-- because the operations are ultimately baikai 'IO' calls. No retries, caching,+-- or error remapping.+runBaikaiWith :: (IOE :> es) => ProviderRegistry -> Eff (Baikai : es) a -> Eff es a+runBaikaiWith reg = interpret $ \env -> \case+  Complete m c o ->+    liftIO (Baikai.completeRequestWith reg m c o)+  StreamCollect m c o ->+    liftIO (Stream.toList (Baikai.streamRequestWith reg m c o))+  StreamEach m c o k ->+    -- @k@ is the caller's @Eff@ action (a higher-order argument). @localSeqUnliftIO@+    -- gives a function @unlift :: forall r. Eff localEs r -> IO r@ valid for the+    -- duration of the block, so we run @k event@ as IO inside a streamly fold that+    -- drains the stream — one callback invocation per event, in order.+    localSeqUnliftIO env $ \unlift ->+      Stream.fold+        (Fold.drainMapM (\event -> unlift (k event)))+        (Baikai.streamRequestWith reg m c o)++-- | Interpret 'Baikai' against baikai's process-global provider registry.+runBaikai :: (IOE :> es) => Eff (Baikai : es) a -> Eff es a+runBaikai = runBaikaiWith Baikai.globalProviderRegistry

@@ -0,0 +1,23 @@+-- | Hermetic end-to-end test of the blocking 'complete' operation: a value flows+-- @call site → send → interpret → baikai (isolated registry) → Response → Eff@.+module CompleteSpec (tests) where++import Baikai (flattenAssistantBlocks)+import Baikai.Effectful (complete, runBaikaiWith)+import Effectful (runEff)+import StubProvider (flattenAssistantText, stubContext, stubModel, stubOptions, stubRegistry)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "CompleteSpec"+    [ testCase "complete returns stub text" $ do+        reg <- stubRegistry "hello from stub"+        out <-+          runEff . runBaikaiWith reg $ do+            r <- complete stubModel stubContext stubOptions+            pure (flattenAssistantText (flattenAssistantBlocks r))+        out @?= "hello from stub"+    ]

@@ -0,0 +1,42 @@+-- | A live, end-to-end demo proving the binding works against a real provider.+--+-- It is gated at runtime on the environment variable @BAIKAI_EFFECTFUL_LIVE@: with+-- @BAIKAI_EFFECTFUL_LIVE=1@ (and a valid @OPENAI_API_KEY@) it registers the OpenAI+-- provider, runs 'complete' through the global registry via 'runBaikai', and asserts+-- a non-empty reply. Without the variable it prints a skip line and stays green, so+-- the default test run remains hermetic (no network, no key).+module LiveSpec (tests) where++import Baikai hiding (complete)+import Baikai.Effectful (complete, runBaikai)+import Baikai.Models.Generated (openai_gpt_4o_mini)+import Baikai.Prelude+import Baikai.Provider.OpenAI.Api qualified as OpenAI+import Data.Text qualified as T+import Data.Vector qualified as V+import Effectful (runEff)+import StubProvider (flattenAssistantText)+import System.Environment (lookupEnv)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, testCase)++tests :: TestTree+tests =+  testGroup+    "LiveSpec"+    [ testCase "live provider call returns text" $ do+        live <- lookupEnv "BAIKAI_EFFECTFUL_LIVE"+        case live of+          Just "1" -> do+            OpenAI.register+            let ctx = _Context & #messages .~ V.singleton (user "Reply with a single word.")+                opts = _Options & #maxTokens .~ Just 16+            out <-+              runEff . runBaikai $ do+                r <- complete openai_gpt_4o_mini ctx opts+                pure (flattenAssistantText (flattenAssistantBlocks r))+            putStrLn ("LIVE: " <> T.unpack out)+            assertBool "non-empty reply" (not (T.null out))+          _ ->+            putStrLn "BAIKAI_EFFECTFUL_LIVE not set; skipping live test"+    ]

@@ -0,0 +1,18 @@+-- | Test entry point for baikai-effectful. Drives the hermetic specs through one+-- tasty 'defaultMain'. The live spec (M4) is gated at runtime on an env var.+module Main (main) where++import CompleteSpec qualified+import LiveSpec qualified+import StreamSpec qualified+import Test.Tasty (defaultMain, testGroup)++main :: IO ()+main =+  defaultMain $+    testGroup+      "baikai-effectful"+      [ CompleteSpec.tests,+        StreamSpec.tests,+        LiveSpec.tests+      ]

@@ -0,0 +1,49 @@+-- | Hermetic tests of the two streaming operations. 'streamCollect' materializes+-- the event list; 'streamEach' runs a caller-supplied 'Eff' callback once per+-- event. The agreement test proves the higher-order interpreter delivers every+-- event, in order, inside 'Eff'.+module StreamSpec (tests) where++import Baikai (AssistantMessageEvent (..), DeltaPayload (..))+import Baikai.Effectful (runBaikaiWith, streamCollect, streamEach)+import Data.IORef (modifyIORef', newIORef, readIORef)+import Data.Text qualified as T+import Effectful (liftIO, runEff)+import StubProvider (stubContext, stubModel, stubOptions, stubRegistry)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, testCase, (@?=))++-- | The text the stub provider emits; it surfaces in the stream as a TextDelta.+stubText :: T.Text+stubText = "hello stream"++tests :: TestTree+tests =+  testGroup+    "StreamSpec"+    [ testCase "streamCollect returns event sequence" $ do+        reg <- stubRegistry stubText+        events <-+          runEff . runBaikaiWith reg $+            streamCollect stubModel stubContext stubOptions+        assertBool "non-empty" (not (null events))+        assertBool+          "first event is EventStart"+          (case events of EventStart {} : _ -> True; _ -> False)+        assertBool+          "last event is EventDone"+          (case reverse events of EventDone {} : _ -> True; _ -> False)+        let deltas = [t | TextDelta DeltaPayload {delta = t} <- events]+        T.concat deltas @?= stubText,+      testCase "streamEach observes each event in order" $ do+        reg <- stubRegistry stubText+        ref <- newIORef []+        runEff . runBaikaiWith reg $+          streamEach stubModel stubContext stubOptions $ \e ->+            liftIO (modifyIORef' ref (e :))+        observed <- reverse <$> readIORef ref+        collected <-+          runEff . runBaikaiWith reg $+            streamCollect stubModel stubContext stubOptions+        observed @?= collected+    ]

@@ -0,0 +1,115 @@+-- | A hand-rolled, network-free baikai provider used by the hermetic tests.+--+-- It builds an isolated 'ProviderRegistry' (never the global one) whose single+-- 'ApiProvider' serves a known 'Api' tag. The provider's @complete@ returns a+-- fixed 'Response' carrying caller-chosen text; its @stream@ emits a fixed,+-- deterministic @EventStart … TextDelta … EventDone@ sequence carrying the same+-- text. The stream is hand-rolled (rather than synthesized from @complete@ via+-- 'liftCompleteToStream') so it carries no wall-clock timestamp — two separate+-- stream runs produce byte-identical event lists, which the streamEach/streamCollect+-- agreement test depends on.+module StubProvider+  ( stubRegistry,+    stubModel,+    stubContext,+    stubOptions,+    flattenAssistantText,+  )+where++import Baikai+import Baikai.Prelude+import Data.Text qualified as T+import Data.Vector qualified as V+import Streamly.Data.Stream (Stream)+import Streamly.Data.Stream qualified as Stream++-- | Concatenate the text of every 'AssistantText' block, ignoring thinking and+-- tool-call blocks. baikai has no library equivalent — its own smoke tests define+-- this same helper locally (see @baikai-smoke/test/Smoke.hs@).+flattenAssistantText :: V.Vector AssistantContent -> Text+flattenAssistantText = T.concat . V.toList . V.mapMaybe textOf+  where+    textOf (AssistantText (TextContent t)) = Just t+    textOf _ = Nothing++-- | The 'Api' tag the stub provider serves. A 'Custom' tag needs no catalog entry.+stubApi :: Api+stubApi = Custom "stub"++-- | A hand-built 'Model' whose 'api' routes to the stub provider.+stubModel :: Model+stubModel =+  _Model+    & #api+    .~ stubApi+    & #modelId+    .~ "stub-model"+    & #name+    .~ "stub"+    & #provider+    .~ "stub"++-- | A minimal request context (one user turn).+stubContext :: Context+stubContext = _Context & #messages .~ V.singleton (user "ping")++-- | Default request options.+stubOptions :: Options+stubOptions = _Options++-- | A blank assistant payload with a fixed (epoch) timestamp, reused as the base+-- for both the streaming skeleton and the terminal message so nothing varies run+-- to run. Borrowed from baikai's '_Response' fixture base.+stubPayload :: AssistantPayload+stubPayload = _Response ^. #message++-- | An assistant payload carrying the given text as its single text block.+stubPayloadWith :: Text -> AssistantPayload+stubPayloadWith t =+  stubPayload & #content .~ V.singleton (AssistantText (_TextContent & #text .~ t))++-- | A fixed assistant response carrying the given text as its single text block.+stubResponse :: Text -> Response+stubResponse t =+  _Response+    & #message+    .~ stubPayloadWith t+    & #model+    .~ stubModel+    & #api+    .~ stubApi+    & #provider+    .~ "stub"++-- | The provider's blocking completion: ignore the request, return fixed text.+stubComplete :: Text -> Model -> Context -> Options -> IO Response+stubComplete t _ _ _ = pure (stubResponse t)++-- | A deterministic, valid event sequence for the given text: exactly one+-- 'EventStart' first, one text block, and one 'EventDone' last.+stubEvents :: Text -> [AssistantMessageEvent]+stubEvents t =+  [ EventStart StartPayload {partial = AssistantMessage stubPayload},+    TextStart IndexPayload {contentIndex = 0},+    TextDelta DeltaPayload {contentIndex = 0, delta = t},+    TextEnd BlockEndPayload {contentIndex = 0, content = t},+    EventDone TerminalPayload {reason = Stop, message = AssistantMessage (stubPayloadWith t)}+  ]++-- | The provider's streaming completion: ignore the request, emit fixed events.+stubStream :: Text -> Model -> Context -> Options -> Stream IO AssistantMessageEvent+stubStream t _ _ _ = Stream.fromList (stubEvents t)++-- | Build an isolated registry whose stub provider returns/streams @t@.+stubRegistry :: Text -> IO ProviderRegistry+stubRegistry t = do+  reg <- newProviderRegistry+  registerApiProviderWith+    reg+    ApiProvider+      { apiTag = stubApi,+        complete = stubComplete t,+        stream = stubStream t+      }+  pure reg