diff --git a/src/Data.Postgres.Unresult.purs b/src/Data.Postgres.Unresult.purs new file mode 100644 index 0000000..ba80f53 --- /dev/null +++ b/src/Data.Postgres.Unresult.purs @@ -0,0 +1,32 @@ +module Data.Postgres.Unresult where + +import Prelude + +import Control.Monad.Error.Class (class MonadThrow, liftMaybe) +import Control.Monad.Morph (hoist) +import Control.Monad.State (StateT(..), runStateT, state) +import Control.Monad.Trans.Class (lift) +import Data.Array as Array +import Data.Maybe (fromMaybe, maybe) +import Data.Postgres (class Deserialize, class Rep, RepT, deserialize, smash) +import Data.Postgres.Raw (Raw) +import Data.Postgres.Result (fromRow) +import Data.Tuple (fst) +import Data.Tuple.Nested ((/\)) +import Effect.Aff (error) +import Effect.Class (class MonadEffect, liftEffect) +import Effect.Exception (Error) + +-- | Monad used to incrementally deserialize columns from a row +type UnresultT m a = StateT {ix :: Int, row :: Array Raw} m a + +-- | Run an `UnresultT` +unresult :: forall m a. Monad m => Array Raw -> UnresultT m a -> m a +unresult row m = fst <$> runStateT m {ix: 0, row} + +-- | Take the next column from the row, unmarshalling into `a` +take :: forall m a. MonadThrow Error m => Deserialize a => MonadEffect m => UnresultT m a +take = do + raw <- state (\r -> Array.index r.row r.ix /\ r {ix = r.ix + 1}) + raw' <- liftMaybe (error "Ran out of columns!") raw + liftEffect $ smash $ deserialize raw' diff --git a/src/Data.Postgres.purs b/src/Data.Postgres.purs index 89c0cab..d10b9c2 100644 --- a/src/Data.Postgres.purs +++ b/src/Data.Postgres.purs @@ -41,7 +41,7 @@ derive newtype instance ReadForeign a => ReadForeign (JSON a) foreign import modifyPgTypes :: Effect Unit -- | The serialization & deserialization monad. -type RepT a = ExceptT (NonEmptyList ForeignError) Effect a +type RepT = ExceptT (NonEmptyList ForeignError) Effect -- | Flatten to an Effect, `show`ing errors smash :: forall a. RepT a -> Effect a