{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | The types in this module have invariants which cannot be checked
-- if their constructors are in scope.  Preql.Wire exports the type
-- names only.

module Preql.Wire.Internal where

import Preql.Wire.Errors

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 (Int -> Query -> ShowS
[Query] -> ShowS
Query -> String
(Int -> Query -> ShowS)
-> (Query -> String) -> ([Query] -> ShowS) -> Show Query
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Query] -> ShowS
$cshowList :: [Query] -> ShowS
show :: Query -> String
$cshow :: Query -> String
showsPrec :: Int -> Query -> ShowS
$cshowsPrec :: Int -> Query -> ShowS
Show, String -> Query
(String -> Query) -> IsString Query
forall a. (String -> a) -> IsString a
fromString :: String -> Query
$cfromString :: String -> Query
IsString)

-- | @RowDecoder@ is 'Applicative' but not 'Monad' so that we can
-- assemble all of the OIDs before we read any of the field data sent
-- by Postgres.
data RowDecoder a = RowDecoder [PgType] (InternalDecoder a)
    deriving a -> RowDecoder b -> RowDecoder a
(a -> b) -> RowDecoder a -> RowDecoder b
(forall a b. (a -> b) -> RowDecoder a -> RowDecoder b)
-> (forall a b. a -> RowDecoder b -> RowDecoder a)
-> Functor RowDecoder
forall a b. a -> RowDecoder b -> RowDecoder a
forall a b. (a -> b) -> RowDecoder a -> RowDecoder b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RowDecoder b -> RowDecoder a
$c<$ :: forall a b. a -> RowDecoder b -> RowDecoder a
fmap :: (a -> b) -> RowDecoder a -> RowDecoder b
$cfmap :: forall a b. (a -> b) -> RowDecoder a -> RowDecoder b
Functor

instance Applicative RowDecoder where
    pure :: a -> RowDecoder a
pure a
a = [PgType] -> InternalDecoder a -> RowDecoder a
forall a. [PgType] -> InternalDecoder a -> RowDecoder a
RowDecoder [] (a -> InternalDecoder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
    RowDecoder [PgType]
t1 InternalDecoder (a -> b)
p1 <*> :: RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
<*> RowDecoder [PgType]
t2 InternalDecoder a
p2 = [PgType] -> InternalDecoder b -> RowDecoder b
forall a. [PgType] -> InternalDecoder a -> RowDecoder a
RowDecoder ([PgType]
t1 [PgType] -> [PgType] -> [PgType]
forall a. Semigroup a => a -> a -> a
<> [PgType]
t2) (InternalDecoder (a -> b)
p1 InternalDecoder (a -> b) -> InternalDecoder a -> InternalDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InternalDecoder a
p2)

-- TODO can I use ValidationT instead of ExceptT, since I ensure Column is incremented before errors?
-- | Internal because we need IO for the libpq FFI, but we promise not
-- to do any IO besides decoding.  We don't even make network calls to
-- Postgres in @InternalDecoder@
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 a -> PQ.Result -> PQ.Row -> ExceptT FieldError IO a
decodeRow :: RowDecoder a -> Result -> Row -> ExceptT FieldError IO a
decodeRow (RowDecoder [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