Produce.hs

module Potoki.Hasql.Produce (
  vectorStatefulSession,
  statefulSession
) where

import           Potoki.Hasql.Prelude
import qualified Data.Vector               as D
import qualified Hasql.Connection          as F
import qualified Hasql.Session             as G
import qualified Potoki.Core.Fetch         as A
import           Potoki.Core.Produce
import qualified Potoki.Produce            as K
import qualified Potoki.Transform          as J
import qualified Potoki.Hasql.Error.Hasql  as I
import           Potoki.Hasql.Error.Types


vectorStatefulSession :: (state -> G.Session (Vector a, state)) -> state -> F.Settings -> Int -> Produce (Either Error a)
vectorStatefulSession vectorSession initialState connectionConfig buffering =
  K.transform
    (right' (J.takeWhile (not . D.null) >>> J.vector >>> J.bufferize buffering))
    (statefulSession vectorSession initialState connectionConfig)

statefulSession :: (state -> G.Session (a, state)) -> state -> F.Settings -> Produce (Either Error a)
statefulSession session initialState =
  havingConnection $ \ connection -> do
    stateRef <- newIORef initialState
    return $ A.Fetch $ \ nil just -> do
      state <- readIORef stateRef
      sessionResult <- G.run (session state) connection
      case sessionResult of
        Left error -> return (just (Left (I.sessionError error)))
        Right (result, newState) -> do
          writeIORef stateRef newState
          return (just (Right result))

havingConnection :: (F.Connection -> IO (A.Fetch (Either Error a))) -> F.Settings -> Produce (Either Error a)
havingConnection cont connectionSettings =
  Produce $ do
    errorOrConnection <- F.acquire connectionSettings
    case errorOrConnection of
      Left error ->
        let
          fetch =
            A.Fetch $ \ stop yield -> return (yield (Left (I.connectionError error)))
          kill =
            return ()
          in return (fetch, kill)
      Right connection -> do
        fetch <- cont connection
        let
          kill = F.release connection
          in return (fetch, kill)