{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | module Preql.Wire.Internal where import Control.Monad.Trans.Except import Control.Monad.Trans.State import Data.String (IsString) import Preql.Imports import qualified Database.PostgreSQL.LibPQ as PQ -- TODO less ambiguous name (or rename others) -- | The IsString instance does no validation; the limited instances -- discourage directly manipulating strings, with the high risk of SQL -- injection. newtype Query = Query ByteString deriving (Show, IsString) -- TODO PgType for non-builtin types data RowDecoder a = RowDecoder [PQ.Oid] (InternalDecoder a) deriving Functor instance Applicative RowDecoder where pure a = RowDecoder [] (pure a) RowDecoder t1 p1 <*> RowDecoder t2 p2 = RowDecoder (t1 <> t2) (p1 <*> p2) -- TODO can I use ValidationT instead of ExceptT, since I ensure Column is incremented before errors? type InternalDecoder = StateT DecoderState (ExceptT (LocatedError FieldError) IO) data DecoderState = DecoderState { result :: PQ.Result , row :: PQ.Row , column :: PQ.Column } deriving (Show, Eq) data LocatedError a = LocatedError { errorRow :: PQ.Row , errorColumn :: PQ.Column , failure :: a } deriving (Eq, Show, Typeable) instance (Show a, Typeable a) => Exception (LocatedError a) data FieldError = UnexpectedNull | ParseFailure Text deriving (Eq, Show, Typeable) decodeRow :: RowDecoder a -> PQ.Result -> PQ.Row -> ExceptT (LocatedError FieldError) IO a decodeRow (RowDecoder _ parsers) result row = evalStateT parsers (DecoderState result row 0) getNextValue :: InternalDecoder (Maybe ByteString) getNextValue = do s@DecoderState{..} <- get put (s { column = column + 1 } :: DecoderState) liftIO $ PQ.getvalue result row column