{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeOperators #-}
module Preql.Wire.Internal where
import Preql.Wire.Errors
import Control.Monad.Trans.Except
import Control.Monad.Trans.State
import Data.String (IsString)
import GHC.TypeNats
import Preql.Imports
import qualified Data.Vector.Sized as VS
import qualified Database.PostgreSQL.LibPQ as PQ
newtype Query (n :: Nat) = Query ByteString
deriving (Int -> Query n -> ShowS
[Query n] -> ShowS
Query n -> String
(Int -> Query n -> ShowS)
-> (Query n -> String) -> ([Query n] -> ShowS) -> Show (Query n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: Nat). Int -> Query n -> ShowS
forall (n :: Nat). [Query n] -> ShowS
forall (n :: Nat). Query n -> String
showList :: [Query n] -> ShowS
$cshowList :: forall (n :: Nat). [Query n] -> ShowS
show :: Query n -> String
$cshow :: forall (n :: Nat). Query n -> String
showsPrec :: Int -> Query n -> ShowS
$cshowsPrec :: forall (n :: Nat). Int -> Query n -> ShowS
Show, String -> Query n
(String -> Query n) -> IsString (Query n)
forall a. (String -> a) -> IsString a
forall (n :: Nat). String -> Query n
fromString :: String -> Query n
$cfromString :: forall (n :: Nat). String -> Query n
IsString)
data RowDecoder (n :: Nat) a = RowDecoder (VS.Vector n PgType) (InternalDecoder a)
deriving a -> RowDecoder n b -> RowDecoder n a
(a -> b) -> RowDecoder n a -> RowDecoder n b
(forall a b. (a -> b) -> RowDecoder n a -> RowDecoder n b)
-> (forall a b. a -> RowDecoder n b -> RowDecoder n a)
-> Functor (RowDecoder n)
forall a b. a -> RowDecoder n b -> RowDecoder n a
forall a b. (a -> b) -> RowDecoder n a -> RowDecoder n b
forall (n :: Nat) a b. a -> RowDecoder n b -> RowDecoder n a
forall (n :: Nat) a b. (a -> b) -> RowDecoder n a -> RowDecoder n b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RowDecoder n b -> RowDecoder n a
$c<$ :: forall (n :: Nat) a b. a -> RowDecoder n b -> RowDecoder n a
fmap :: (a -> b) -> RowDecoder n a -> RowDecoder n b
$cfmap :: forall (n :: Nat) a b. (a -> b) -> RowDecoder n a -> RowDecoder n b
Functor
pureDecoder :: a -> RowDecoder 0 a
pureDecoder :: a -> RowDecoder 0 a
pureDecoder a
a = Vector 0 PgType -> InternalDecoder a -> RowDecoder 0 a
forall (n :: Nat) a.
Vector n PgType -> InternalDecoder a -> RowDecoder n a
RowDecoder Vector 0 PgType
forall a. Vector 0 a
VS.empty (a -> InternalDecoder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
applyDecoder :: RowDecoder m (a -> b) -> RowDecoder n a -> RowDecoder (m+n) b
applyDecoder :: RowDecoder m (a -> b) -> RowDecoder n a -> RowDecoder (m + n) b
applyDecoder (RowDecoder Vector m PgType
vm InternalDecoder (a -> b)
f) (RowDecoder Vector n PgType
vn InternalDecoder a
a) = Vector (m + n) PgType -> InternalDecoder b -> RowDecoder (m + n) b
forall (n :: Nat) a.
Vector n PgType -> InternalDecoder a -> RowDecoder n a
RowDecoder (Vector m PgType
vm Vector m PgType -> Vector n PgType -> Vector (m + n) PgType
forall (n :: Nat) (m :: Nat) a.
Vector n a -> Vector m a -> Vector (n + m) a
VS.++ Vector n PgType
vn) (InternalDecoder (a -> b)
f InternalDecoder (a -> b) -> InternalDecoder a -> InternalDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InternalDecoder a
a)
type InternalDecoder = StateT DecoderState (ExceptT FieldError IO)
data DecoderState = DecoderState
{ DecoderState -> Result
result :: PQ.Result
, DecoderState -> Row
row :: PQ.Row
, DecoderState -> Column
column :: PQ.Column
}
deriving (Int -> DecoderState -> ShowS
[DecoderState] -> ShowS
DecoderState -> String
(Int -> DecoderState -> ShowS)
-> (DecoderState -> String)
-> ([DecoderState] -> ShowS)
-> Show DecoderState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecoderState] -> ShowS
$cshowList :: [DecoderState] -> ShowS
show :: DecoderState -> String
$cshow :: DecoderState -> String
showsPrec :: Int -> DecoderState -> ShowS
$cshowsPrec :: Int -> DecoderState -> ShowS
Show, DecoderState -> DecoderState -> Bool
(DecoderState -> DecoderState -> Bool)
-> (DecoderState -> DecoderState -> Bool) -> Eq DecoderState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecoderState -> DecoderState -> Bool
$c/= :: DecoderState -> DecoderState -> Bool
== :: DecoderState -> DecoderState -> Bool
$c== :: DecoderState -> DecoderState -> Bool
Eq)
decodeRow :: RowDecoder n a -> PQ.Result -> PQ.Row -> ExceptT FieldError IO a
decodeRow :: RowDecoder n a -> Result -> Row -> ExceptT FieldError IO a
decodeRow (RowDecoder Vector n PgType
_ InternalDecoder a
parsers) Result
result Row
row =
InternalDecoder a -> DecoderState -> ExceptT FieldError IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT InternalDecoder a
parsers (Result -> Row -> Column -> DecoderState
DecoderState Result
result Row
row Column
0)
getNextValue :: InternalDecoder (Maybe ByteString)
getNextValue :: InternalDecoder (Maybe ByteString)
getNextValue = do
s :: DecoderState
s@DecoderState{Result
Column
Row
column :: Column
row :: Row
result :: Result
$sel:column:DecoderState :: DecoderState -> Column
$sel:row:DecoderState :: DecoderState -> Row
$sel:result:DecoderState :: DecoderState -> Result
..} <- StateT DecoderState (ExceptT FieldError IO) DecoderState
forall (m :: * -> *) s. Monad m => StateT s m s
get
DecoderState -> StateT DecoderState (ExceptT FieldError IO) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (DecoderState
s { $sel:column:DecoderState :: Column
column = Column
column Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
1 } :: DecoderState)
IO (Maybe ByteString) -> InternalDecoder (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> InternalDecoder (Maybe ByteString))
-> IO (Maybe ByteString) -> InternalDecoder (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Result -> Row -> Column -> IO (Maybe ByteString)
PQ.getvalue Result
result Row
row Column
column