{-# LANGUAGE  CPP, BangPatterns, DoAndIfThenElse, RecordWildCards  #-}
{-# LANGUAGE  DeriveDataTypeable, DeriveGeneric                    #-}
{-# LANGUAGE  GeneralizedNewtypeDeriving                           #-}

------------------------------------------------------------------------------
-- |
-- Module:      Database.PostgreSQL.Simple.Internal
-- Copyright:   (c) 2011-2015 Leon P Smith
-- License:     BSD3
-- Maintainer:  Leon P Smith <leon@melding-monads.com>
-- Stability:   experimental
--
-- Internal bits.  This interface is less stable and can change at any time.
-- In particular this means that while the rest of the postgresql-simple
-- package endeavors to follow the package versioning policy,  this module
-- does not.  Also, at the moment there are things in here that aren't
-- particularly internal and are exported elsewhere;  these will eventually
-- disappear from this module.
--
------------------------------------------------------------------------------

module Database.PostgreSQL.Simple.Internal where

import           Control.Applicative
import           Control.Exception
import           Control.Concurrent.MVar
import           Control.Monad(MonadPlus(..))
import           Data.ByteString(ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import           Data.ByteString.Builder ( Builder, byteString )
import           Data.Char (ord)
import           Data.Int (Int64)
import qualified Data.IntMap as IntMap
import           Data.IORef
import           Data.Maybe(fromMaybe)
import           Data.Monoid
import           Data.String
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import           Data.Typeable
import           Data.Word
import           Database.PostgreSQL.LibPQ(Oid(..))
import qualified Database.PostgreSQL.LibPQ as PQ
import           Database.PostgreSQL.LibPQ(ExecStatus(..))
import           Database.PostgreSQL.Simple.Compat ( toByteString )
import           Database.PostgreSQL.Simple.Ok
import           Database.PostgreSQL.Simple.ToField (Action(..), inQuotes)
import           Database.PostgreSQL.Simple.Types (Query(..))
import           Database.PostgreSQL.Simple.TypeInfo.Types(TypeInfo)
import           Control.Monad.Trans.State.Strict
import           Control.Monad.Trans.Reader
import           Control.Monad.Trans.Class
import           GHC.Generics
import           GHC.IO.Exception
#if !defined(mingw32_HOST_OS)
import           Control.Concurrent(threadWaitRead, threadWaitWrite)
#endif

-- | A Field represents metadata about a particular field
--
-- You don't particularly want to retain these structures for a long
-- period of time,  as they will retain the entire query result,  not
-- just the field metadata

data Field = Field {
     Field -> Result
result   :: !PQ.Result
   , Field -> Column
column   :: {-# UNPACK #-} !PQ.Column
   , Field -> Oid
typeOid  :: {-# UNPACK #-} !PQ.Oid
     -- ^ This returns the type oid associated with the column.  Analogous
     --   to libpq's @PQftype@.
   }

type TypeInfoCache = IntMap.IntMap TypeInfo

data Connection = Connection {
     Connection -> MVar Connection
connectionHandle  :: {-# UNPACK #-} !(MVar PQ.Connection)
   , Connection -> MVar TypeInfoCache
connectionObjects :: {-# UNPACK #-} !(MVar TypeInfoCache)
   , Connection -> IORef Int64
connectionTempNameCounter :: {-# UNPACK #-} !(IORef Int64)
   } deriving (Typeable)

instance Eq Connection where
   Connection
x == :: Connection -> Connection -> Bool
== Connection
y = Connection -> MVar Connection
connectionHandle Connection
x MVar Connection -> MVar Connection -> Bool
forall a. Eq a => a -> a -> Bool
== Connection -> MVar Connection
connectionHandle Connection
y

data SqlError = SqlError {
     SqlError -> ByteString
sqlState       :: ByteString
   , SqlError -> ExecStatus
sqlExecStatus  :: ExecStatus
   , SqlError -> ByteString
sqlErrorMsg    :: ByteString
   , SqlError -> ByteString
sqlErrorDetail :: ByteString
   , SqlError -> ByteString
sqlErrorHint   :: ByteString
   } deriving (SqlError -> SqlError -> Bool
(SqlError -> SqlError -> Bool)
-> (SqlError -> SqlError -> Bool) -> Eq SqlError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SqlError -> SqlError -> Bool
$c/= :: SqlError -> SqlError -> Bool
== :: SqlError -> SqlError -> Bool
$c== :: SqlError -> SqlError -> Bool
Eq, Int -> SqlError -> ShowS
[SqlError] -> ShowS
SqlError -> String
(Int -> SqlError -> ShowS)
-> (SqlError -> String) -> ([SqlError] -> ShowS) -> Show SqlError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SqlError] -> ShowS
$cshowList :: [SqlError] -> ShowS
show :: SqlError -> String
$cshow :: SqlError -> String
showsPrec :: Int -> SqlError -> ShowS
$cshowsPrec :: Int -> SqlError -> ShowS
Show, Typeable)

fatalError :: ByteString -> SqlError
fatalError :: ByteString -> SqlError
fatalError ByteString
msg = ByteString
-> ExecStatus -> ByteString -> ByteString -> ByteString -> SqlError
SqlError ByteString
"" ExecStatus
FatalError ByteString
msg ByteString
"" ByteString
""

instance Exception SqlError

-- | Exception thrown if 'query' is used to perform an @INSERT@-like
-- operation, or 'execute' is used to perform a @SELECT@-like operation.
data QueryError = QueryError {
      QueryError -> String
qeMessage :: String
    , QueryError -> Query
qeQuery :: Query
    } deriving (QueryError -> QueryError -> Bool
(QueryError -> QueryError -> Bool)
-> (QueryError -> QueryError -> Bool) -> Eq QueryError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryError -> QueryError -> Bool
$c/= :: QueryError -> QueryError -> Bool
== :: QueryError -> QueryError -> Bool
$c== :: QueryError -> QueryError -> Bool
Eq, Int -> QueryError -> ShowS
[QueryError] -> ShowS
QueryError -> String
(Int -> QueryError -> ShowS)
-> (QueryError -> String)
-> ([QueryError] -> ShowS)
-> Show QueryError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryError] -> ShowS
$cshowList :: [QueryError] -> ShowS
show :: QueryError -> String
$cshow :: QueryError -> String
showsPrec :: Int -> QueryError -> ShowS
$cshowsPrec :: Int -> QueryError -> ShowS
Show, Typeable)

instance Exception QueryError

-- | Exception thrown if a 'Query' could not be formatted correctly.
-- This may occur if the number of \'@?@\' characters in the query
-- string does not match the number of parameters provided.
data FormatError = FormatError {
      FormatError -> String
fmtMessage :: String
    , FormatError -> Query
fmtQuery :: Query
    , FormatError -> [ByteString]
fmtParams :: [ByteString]
    } deriving (FormatError -> FormatError -> Bool
(FormatError -> FormatError -> Bool)
-> (FormatError -> FormatError -> Bool) -> Eq FormatError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormatError -> FormatError -> Bool
$c/= :: FormatError -> FormatError -> Bool
== :: FormatError -> FormatError -> Bool
$c== :: FormatError -> FormatError -> Bool
Eq, Int -> FormatError -> ShowS
[FormatError] -> ShowS
FormatError -> String
(Int -> FormatError -> ShowS)
-> (FormatError -> String)
-> ([FormatError] -> ShowS)
-> Show FormatError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormatError] -> ShowS
$cshowList :: [FormatError] -> ShowS
show :: FormatError -> String
$cshow :: FormatError -> String
showsPrec :: Int -> FormatError -> ShowS
$cshowsPrec :: Int -> FormatError -> ShowS
Show, Typeable)

instance Exception FormatError

data ConnectInfo = ConnectInfo {
      ConnectInfo -> String
connectHost :: String
    , ConnectInfo -> Word16
connectPort :: Word16
    , ConnectInfo -> String
connectUser :: String
    , ConnectInfo -> String
connectPassword :: String
    , ConnectInfo -> String
connectDatabase :: String
    } deriving ((forall x. ConnectInfo -> Rep ConnectInfo x)
-> (forall x. Rep ConnectInfo x -> ConnectInfo)
-> Generic ConnectInfo
forall x. Rep ConnectInfo x -> ConnectInfo
forall x. ConnectInfo -> Rep ConnectInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConnectInfo x -> ConnectInfo
$cfrom :: forall x. ConnectInfo -> Rep ConnectInfo x
Generic,ConnectInfo -> ConnectInfo -> Bool
(ConnectInfo -> ConnectInfo -> Bool)
-> (ConnectInfo -> ConnectInfo -> Bool) -> Eq ConnectInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectInfo -> ConnectInfo -> Bool
$c/= :: ConnectInfo -> ConnectInfo -> Bool
== :: ConnectInfo -> ConnectInfo -> Bool
$c== :: ConnectInfo -> ConnectInfo -> Bool
Eq,ReadPrec [ConnectInfo]
ReadPrec ConnectInfo
Int -> ReadS ConnectInfo
ReadS [ConnectInfo]
(Int -> ReadS ConnectInfo)
-> ReadS [ConnectInfo]
-> ReadPrec ConnectInfo
-> ReadPrec [ConnectInfo]
-> Read ConnectInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConnectInfo]
$creadListPrec :: ReadPrec [ConnectInfo]
readPrec :: ReadPrec ConnectInfo
$creadPrec :: ReadPrec ConnectInfo
readList :: ReadS [ConnectInfo]
$creadList :: ReadS [ConnectInfo]
readsPrec :: Int -> ReadS ConnectInfo
$creadsPrec :: Int -> ReadS ConnectInfo
Read,Int -> ConnectInfo -> ShowS
[ConnectInfo] -> ShowS
ConnectInfo -> String
(Int -> ConnectInfo -> ShowS)
-> (ConnectInfo -> String)
-> ([ConnectInfo] -> ShowS)
-> Show ConnectInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectInfo] -> ShowS
$cshowList :: [ConnectInfo] -> ShowS
show :: ConnectInfo -> String
$cshow :: ConnectInfo -> String
showsPrec :: Int -> ConnectInfo -> ShowS
$cshowsPrec :: Int -> ConnectInfo -> ShowS
Show,Typeable)

-- | Default information for setting up a connection.
--
-- Defaults are as follows:
--
-- * Server on @localhost@
--
-- * Port on @5432@
--
-- * User @postgres@
--
-- * No password
--
-- * Database @postgres@
--
-- Use as in the following example:
--
-- > connect defaultConnectInfo { connectHost = "db.example.com" }

defaultConnectInfo :: ConnectInfo
defaultConnectInfo :: ConnectInfo
defaultConnectInfo = ConnectInfo :: String -> Word16 -> String -> String -> String -> ConnectInfo
ConnectInfo {
                       connectHost :: String
connectHost = String
"127.0.0.1"
                     , connectPort :: Word16
connectPort = Word16
5432
                     , connectUser :: String
connectUser = String
"postgres"
                     , connectPassword :: String
connectPassword = String
""
                     , connectDatabase :: String
connectDatabase = String
""
                     }

-- | Connect with the given username to the given database. Will throw
--   an exception if it cannot connect.
connect :: ConnectInfo -> IO Connection
connect :: ConnectInfo -> IO Connection
connect = ByteString -> IO Connection
connectPostgreSQL (ByteString -> IO Connection)
-> (ConnectInfo -> ByteString) -> ConnectInfo -> IO Connection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectInfo -> ByteString
postgreSQLConnectionString

-- | Attempt to make a connection based on a libpq connection string.
--   See <https://www.postgresql.org/docs/9.5/static/libpq-connect.html#LIBPQ-CONNSTRING>
--   for more information.  Also note that environment variables also affect
--   parameters not provided, parameters provided as the empty string, and a
--   few other things; see
--   <https://www.postgresql.org/docs/9.5/static/libpq-envars.html>
--   for details.  Here is an example with some of the most commonly used
--   parameters:
--
-- > host='db.somedomain.com' port=5432 ...
--
--   This attempts to connect to @db.somedomain.com:5432@.  Omitting the port
--   will normally default to 5432.
--
--   On systems that provide unix domain sockets,  omitting the host parameter
--   will cause libpq to attempt to connect via unix domain sockets.
--   The default filesystem path to the socket is constructed from the
--   port number and the @DEFAULT_PGSOCKET_DIR@ constant defined in the
--   @pg_config_manual.h@ header file.  Connecting via unix sockets tends
--   to use the @peer@ authentication method, which is very secure and
--   does not require a password.
--
--   On Windows and other systems without unix domain sockets, omitting
--   the host will default to @localhost@.
--
-- > ... dbname='postgres' user='postgres' password='secret \' \\ pw'
--
--   This attempts to connect to a database named @postgres@ with
--   user @postgres@ and password @secret \' \\ pw@.  Backslash
--   characters will have to be double-quoted in literal Haskell strings,
--   of course.  Omitting @dbname@ and @user@ will both default to the
--   system username that the client process is running as.
--
--   Omitting @password@ will default to an appropriate password found
--   in the @pgpass@ file,  or no password at all if a matching line is
--   not found.  The path of the @pgpass@ file may be specified by setting
--   the @PGPASSFILE@ environment variable. See
--   <https://www.postgresql.org/docs/9.5/static/libpq-pgpass.html> for
--   more information regarding this file.
--
--   As all parameters are optional and the defaults are sensible,  the
--   empty connection string can be useful for development and
--   exploratory use,  assuming your system is set up appropriately.
--
--   On Unix,  such a setup would typically consist of a local
--   postgresql server listening on port 5432,  as well as a system user,
--   database user, and database sharing a common name,  with permissions
--   granted to the user on the database.
--
--   On Windows,  in addition you will either need @pg_hba.conf@
--   to specify the use of the @trust@ authentication method for
--   the connection,  which may not be appropriate for multiuser
--   or production machines, or you will need to use a @pgpass@ file
--   with the @password@ or @md5@ authentication methods.
--
--   See <https://www.postgresql.org/docs/9.5/static/client-authentication.html>
--   for more information regarding the authentication process.
--
--   SSL/TLS will typically "just work" if your postgresql server supports or
--   requires it.  However,  note that libpq is trivially vulnerable to a MITM
--   attack without setting additional SSL connection parameters.  In
--   particular,  @sslmode@ needs to be set to @require@, @verify-ca@, or
--   @verify-full@ in order to perform certificate validation.  When @sslmode@
--   is @require@,  then you will also need to specify a @sslrootcert@ file,
--   otherwise no validation of the server's identity will be performed.
--   Client authentication via certificates is also possible via the
--   @sslcert@ and @sslkey@ parameters.   See
--   <https://www.postgresql.org/docs/9.5/static/libpq-ssl.html>
--   for detailed information regarding libpq and SSL.

connectPostgreSQL :: ByteString -> IO Connection
connectPostgreSQL :: ByteString -> IO Connection
connectPostgreSQL ByteString
connstr = do
    Connection
conn <- ByteString -> IO Connection
connectdb ByteString
connstr
    ConnStatus
stat <- Connection -> IO ConnStatus
PQ.status Connection
conn
    case ConnStatus
stat of
      ConnStatus
PQ.ConnectionOk -> do
          MVar Connection
connectionHandle  <- Connection -> IO (MVar Connection)
forall a. a -> IO (MVar a)
newMVar Connection
conn
          MVar TypeInfoCache
connectionObjects <- TypeInfoCache -> IO (MVar TypeInfoCache)
forall a. a -> IO (MVar a)
newMVar (TypeInfoCache
forall a. IntMap a
IntMap.empty)
          IORef Int64
connectionTempNameCounter <- Int64 -> IO (IORef Int64)
forall a. a -> IO (IORef a)
newIORef Int64
0
          let wconn :: Connection
wconn = Connection :: MVar Connection -> MVar TypeInfoCache -> IORef Int64 -> Connection
Connection{IORef Int64
MVar TypeInfoCache
MVar Connection
connectionTempNameCounter :: IORef Int64
connectionObjects :: MVar TypeInfoCache
connectionHandle :: MVar Connection
connectionTempNameCounter :: IORef Int64
connectionObjects :: MVar TypeInfoCache
connectionHandle :: MVar Connection
..}
          Int
version <- Connection -> IO Int
PQ.serverVersion Connection
conn
          let settings :: Query
settings
                | Int
version Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
80200 = Query
"SET datestyle TO ISO;SET client_encoding TO UTF8"
                | Bool
otherwise       = Query
"SET datestyle TO ISO;SET client_encoding TO UTF8;SET standard_conforming_strings TO on"
          Int64
_ <- Connection -> Query -> IO Int64
execute_ Connection
wconn Query
settings
          Connection -> IO Connection
forall (m :: * -> *) a. Monad m => a -> m a
return Connection
wconn
      ConnStatus
_ -> do
          ByteString
msg <- ByteString
-> (ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"connectPostgreSQL error" ByteString -> ByteString
forall a. a -> a
id (Maybe ByteString -> ByteString)
-> IO (Maybe ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO (Maybe ByteString)
PQ.errorMessage Connection
conn
          SqlError -> IO Connection
forall e a. Exception e => e -> IO a
throwIO (SqlError -> IO Connection) -> SqlError -> IO Connection
forall a b. (a -> b) -> a -> b
$ ByteString -> SqlError
fatalError ByteString
msg

connectdb :: ByteString -> IO PQ.Connection
#if defined(mingw32_HOST_OS)
connectdb = PQ.connectdb
#else
connectdb :: ByteString -> IO Connection
connectdb ByteString
conninfo = do
    Connection
conn <- ByteString -> IO Connection
PQ.connectStart ByteString
conninfo
    Connection -> IO Connection
loop Connection
conn
  where
    funcName :: ByteString
funcName = ByteString
"Database.PostgreSQL.Simple.connectPostgreSQL"
    loop :: Connection -> IO Connection
loop Connection
conn = do
      PollingStatus
status <- Connection -> IO PollingStatus
PQ.connectPoll Connection
conn
      case PollingStatus
status of
        PollingStatus
PQ.PollingFailed  -> Connection -> ByteString -> IO Connection
forall a. Connection -> ByteString -> IO a
throwLibPQError Connection
conn ByteString
"connection failed"
        PollingStatus
PQ.PollingReading -> do
                                Maybe Fd
mfd <- Connection -> IO (Maybe Fd)
PQ.socket Connection
conn
                                case Maybe Fd
mfd of
                                  Maybe Fd
Nothing -> IOError -> IO Connection
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO Connection) -> IOError -> IO Connection
forall a b. (a -> b) -> a -> b
$! ByteString -> IOError
fdError ByteString
funcName
                                  Just Fd
fd -> do
                                      Fd -> IO ()
threadWaitRead Fd
fd
                                      Connection -> IO Connection
loop Connection
conn
        PollingStatus
PQ.PollingWriting -> do
                                Maybe Fd
mfd <- Connection -> IO (Maybe Fd)
PQ.socket Connection
conn
                                case Maybe Fd
mfd of
                                  Maybe Fd
Nothing -> IOError -> IO Connection
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO Connection) -> IOError -> IO Connection
forall a b. (a -> b) -> a -> b
$! ByteString -> IOError
fdError ByteString
funcName
                                  Just Fd
fd -> do
                                      Fd -> IO ()
threadWaitWrite Fd
fd
                                      Connection -> IO Connection
loop Connection
conn
        PollingStatus
PQ.PollingOk      -> Connection -> IO Connection
forall (m :: * -> *) a. Monad m => a -> m a
return Connection
conn

#endif

-- | Turns a 'ConnectInfo' data structure into a libpq connection string.

postgreSQLConnectionString :: ConnectInfo -> ByteString
postgreSQLConnectionString :: ConnectInfo -> ByteString
postgreSQLConnectionString ConnectInfo
connectInfo = String -> ByteString
forall a. IsString a => String -> a
fromString String
connstr
  where
    connstr :: String
connstr = String -> (ConnectInfo -> String) -> ShowS
forall (t :: * -> *).
Foldable t =>
String -> (ConnectInfo -> t Char) -> ShowS
str String
"host="     ConnectInfo -> String
connectHost
            ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> (ConnectInfo -> Word16) -> ShowS
forall a.
(Ord a, Num a, Show a) =>
String -> (ConnectInfo -> a) -> ShowS
num String
"port="     ConnectInfo -> Word16
connectPort
            ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> (ConnectInfo -> String) -> ShowS
forall (t :: * -> *).
Foldable t =>
String -> (ConnectInfo -> t Char) -> ShowS
str String
"user="     ConnectInfo -> String
connectUser
            ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> (ConnectInfo -> String) -> ShowS
forall (t :: * -> *).
Foldable t =>
String -> (ConnectInfo -> t Char) -> ShowS
str String
"password=" ConnectInfo -> String
connectPassword
            ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> (ConnectInfo -> String) -> ShowS
forall (t :: * -> *).
Foldable t =>
String -> (ConnectInfo -> t Char) -> ShowS
str String
"dbname="   ConnectInfo -> String
connectDatabase
            ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ []

    str :: String -> (ConnectInfo -> t Char) -> ShowS
str String
name ConnectInfo -> t Char
field
      | t Char -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t Char
value = ShowS
forall a. a -> a
id
      | Bool
otherwise  = String -> ShowS
showString String
name ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t Char -> ShowS
forall (t :: * -> *). Foldable t => t Char -> ShowS
addQuotes t Char
value ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
space
        where value :: t Char
value = ConnectInfo -> t Char
field ConnectInfo
connectInfo

    num :: String -> (ConnectInfo -> a) -> ShowS
num String
name ConnectInfo -> a
field
      | a
value a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0 = ShowS
forall a. a -> a
id
      | Bool
otherwise  = String -> ShowS
showString String
name ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
value ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
space
        where value :: a
value = ConnectInfo -> a
field ConnectInfo
connectInfo

    addQuotes :: t Char -> ShowS
addQuotes t Char
s String
rest = Char
'\'' Char -> ShowS
forall a. a -> [a] -> [a]
: (Char -> ShowS) -> String -> t Char -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> ShowS
delta (Char
'\'' Char -> ShowS
forall a. a -> [a] -> [a]
: String
rest) t Char
s
       where
         delta :: Char -> ShowS
delta Char
c String
cs = case Char
c of
                        Char
'\\' -> Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
: String
cs
                        Char
'\'' -> Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'\'' Char -> ShowS
forall a. a -> [a] -> [a]
: String
cs
                        Char
_    -> Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
cs

    space :: ShowS
space [] = []
    space String
xs = Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:String
xs



oid2int :: Oid -> Int
oid2int :: Oid -> Int
oid2int (Oid CUInt
x) = CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
x
{-# INLINE oid2int #-}

exec :: Connection
     -> ByteString
     -> IO PQ.Result
#if defined(mingw32_HOST_OS)
exec conn sql =
    withConnection conn $ \h -> do
        mres <- PQ.exec h sql
        case mres of
          Nothing  -> throwLibPQError h "PQexec returned no results"
          Just res -> return res
#else
exec :: Connection -> ByteString -> IO Result
exec Connection
conn ByteString
sql =
    Connection -> (Connection -> IO Result) -> IO Result
forall a. Connection -> (Connection -> IO a) -> IO a
withConnection Connection
conn ((Connection -> IO Result) -> IO Result)
-> (Connection -> IO Result) -> IO Result
forall a b. (a -> b) -> a -> b
$ \Connection
h -> do
        Bool
success <- Connection -> ByteString -> IO Bool
PQ.sendQuery Connection
h ByteString
sql
        if Bool
success
        then Connection -> Maybe Result -> IO Result
awaitResult Connection
h Maybe Result
forall a. Maybe a
Nothing
        else Connection -> ByteString -> IO Result
forall a. Connection -> ByteString -> IO a
throwLibPQError Connection
h ByteString
"PQsendQuery failed"
  where
    awaitResult :: Connection -> Maybe Result -> IO Result
awaitResult Connection
h Maybe Result
mres = do
        Maybe Fd
mfd <- Connection -> IO (Maybe Fd)
PQ.socket Connection
h
        case Maybe Fd
mfd of
          Maybe Fd
Nothing -> IOError -> IO Result
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO Result) -> IOError -> IO Result
forall a b. (a -> b) -> a -> b
$! ByteString -> IOError
fdError ByteString
"Database.PostgreSQL.Simple.Internal.exec"
          Just Fd
fd -> do
             Fd -> IO ()
threadWaitRead Fd
fd
             Bool
_ <- Connection -> IO Bool
PQ.consumeInput Connection
h  -- FIXME?
             Connection -> Maybe Result -> IO Result
getResult Connection
h Maybe Result
mres

    getResult :: Connection -> Maybe Result -> IO Result
getResult Connection
h Maybe Result
mres = do
        Bool
isBusy <- Connection -> IO Bool
PQ.isBusy Connection
h
        if Bool
isBusy
        then Connection -> Maybe Result -> IO Result
awaitResult Connection
h Maybe Result
mres
        else do
          Maybe Result
mres' <- Connection -> IO (Maybe Result)
PQ.getResult Connection
h
          case Maybe Result
mres' of
            Maybe Result
Nothing -> case Maybe Result
mres of
                         Maybe Result
Nothing  -> Connection -> ByteString -> IO Result
forall a. Connection -> ByteString -> IO a
throwLibPQError Connection
h ByteString
"PQgetResult returned no results"
                         Just Result
res -> Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
res
            Just Result
res -> do
                ExecStatus
status <- Result -> IO ExecStatus
PQ.resultStatus Result
res
                case ExecStatus
status of
                   -- FIXME: handle PQ.CopyBoth and PQ.SingleTuple
                   ExecStatus
PQ.EmptyQuery    -> Connection -> Maybe Result -> IO Result
getResult Connection
h Maybe Result
mres'
                   ExecStatus
PQ.CommandOk     -> Connection -> Maybe Result -> IO Result
getResult Connection
h Maybe Result
mres'
                   ExecStatus
PQ.TuplesOk      -> Connection -> Maybe Result -> IO Result
getResult Connection
h Maybe Result
mres'
                   ExecStatus
PQ.CopyOut       -> Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
res
                   ExecStatus
PQ.CopyIn        -> Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
res
                   ExecStatus
PQ.BadResponse   -> Connection -> Maybe Result -> IO Result
getResult Connection
h Maybe Result
mres'
                   ExecStatus
PQ.NonfatalError -> Connection -> Maybe Result -> IO Result
getResult Connection
h Maybe Result
mres'
                   ExecStatus
PQ.FatalError    -> Connection -> Maybe Result -> IO Result
getResult Connection
h Maybe Result
mres'
#endif

-- | A version of 'execute' that does not perform query substitution.
execute_ :: Connection -> Query -> IO Int64
execute_ :: Connection -> Query -> IO Int64
execute_ Connection
conn q :: Query
q@(Query ByteString
stmt) = do
  Result
result <- Connection -> ByteString -> IO Result
exec Connection
conn ByteString
stmt
  Connection -> Query -> Result -> IO Int64
finishExecute Connection
conn Query
q Result
result

finishExecute :: Connection -> Query -> PQ.Result -> IO Int64
finishExecute :: Connection -> Query -> Result -> IO Int64
finishExecute Connection
_conn Query
q Result
result = do
    ExecStatus
status <- Result -> IO ExecStatus
PQ.resultStatus Result
result
    case ExecStatus
status of
      -- FIXME: handle PQ.CopyBoth and PQ.SingleTuple
      ExecStatus
PQ.EmptyQuery -> QueryError -> IO Int64
forall e a. Exception e => e -> IO a
throwIO (QueryError -> IO Int64) -> QueryError -> IO Int64
forall a b. (a -> b) -> a -> b
$ String -> Query -> QueryError
QueryError String
"execute: Empty query" Query
q
      ExecStatus
PQ.CommandOk -> do
          Column
ncols <- Result -> IO Column
PQ.nfields Result
result
          if Column
ncols Column -> Column -> Bool
forall a. Eq a => a -> a -> Bool
/= Column
0
          then QueryError -> IO Int64
forall e a. Exception e => e -> IO a
throwIO (QueryError -> IO Int64) -> QueryError -> IO Int64
forall a b. (a -> b) -> a -> b
$ String -> Query -> QueryError
QueryError (String
"execute resulted in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Column -> String
forall a. Show a => a -> String
show Column
ncols String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                     String
"-column result") Query
q
          else do
            Maybe ByteString
nstr <- Result -> IO (Maybe ByteString)
PQ.cmdTuples Result
result
            Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> IO Int64) -> Int64 -> IO Int64
forall a b. (a -> b) -> a -> b
$ case Maybe ByteString
nstr of
                       Maybe ByteString
Nothing  -> Int64
0   -- is this appropriate?
                       Just ByteString
str -> ByteString -> Int64
forall a. Num a => ByteString -> a
mkInteger ByteString
str
      ExecStatus
PQ.TuplesOk -> do
          Column
ncols <- Result -> IO Column
PQ.nfields Result
result
          QueryError -> IO Int64
forall e a. Exception e => e -> IO a
throwIO (QueryError -> IO Int64) -> QueryError -> IO Int64
forall a b. (a -> b) -> a -> b
$ String -> Query -> QueryError
QueryError (String
"execute resulted in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Column -> String
forall a. Show a => a -> String
show Column
ncols String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                 String
"-column result") Query
q
      ExecStatus
PQ.CopyOut ->
          QueryError -> IO Int64
forall e a. Exception e => e -> IO a
throwIO (QueryError -> IO Int64) -> QueryError -> IO Int64
forall a b. (a -> b) -> a -> b
$ String -> Query -> QueryError
QueryError String
"execute: COPY TO is not supported" Query
q
      ExecStatus
PQ.CopyIn ->
          QueryError -> IO Int64
forall e a. Exception e => e -> IO a
throwIO (QueryError -> IO Int64) -> QueryError -> IO Int64
forall a b. (a -> b) -> a -> b
$ String -> Query -> QueryError
QueryError String
"execute: COPY FROM is not supported" Query
q
      ExecStatus
PQ.BadResponse   -> ByteString -> Result -> ExecStatus -> IO Int64
forall a. ByteString -> Result -> ExecStatus -> IO a
throwResultError ByteString
"execute" Result
result ExecStatus
status
      ExecStatus
PQ.NonfatalError -> ByteString -> Result -> ExecStatus -> IO Int64
forall a. ByteString -> Result -> ExecStatus -> IO a
throwResultError ByteString
"execute" Result
result ExecStatus
status
      ExecStatus
PQ.FatalError    -> ByteString -> Result -> ExecStatus -> IO Int64
forall a. ByteString -> Result -> ExecStatus -> IO a
throwResultError ByteString
"execute" Result
result ExecStatus
status
    where
     mkInteger :: ByteString -> a
mkInteger ByteString
str = (a -> Char -> a) -> a -> ByteString -> a
forall a. (a -> Char -> a) -> a -> ByteString -> a
B8.foldl' a -> Char -> a
forall p. Num p => p -> Char -> p
delta a
0 ByteString
str
                where
                  delta :: p -> Char -> p
delta p
acc Char
c =
                    if Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'
                    then p
10 p -> p -> p
forall a. Num a => a -> a -> a
* p
acc p -> p -> p
forall a. Num a => a -> a -> a
+ Int -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
                    else String -> p
forall a. HasCallStack => String -> a
error (String
"finishExecute:  not an int: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
B8.unpack ByteString
str)

throwResultError :: ByteString -> PQ.Result -> PQ.ExecStatus -> IO a
throwResultError :: ByteString -> Result -> ExecStatus -> IO a
throwResultError ByteString
_ Result
result ExecStatus
status = do
    ByteString
errormsg  <- ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" (Maybe ByteString -> ByteString)
-> IO (Maybe ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                 Result -> FieldCode -> IO (Maybe ByteString)
PQ.resultErrorField Result
result FieldCode
PQ.DiagMessagePrimary
    ByteString
detail    <- ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" (Maybe ByteString -> ByteString)
-> IO (Maybe ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                 Result -> FieldCode -> IO (Maybe ByteString)
PQ.resultErrorField Result
result FieldCode
PQ.DiagMessageDetail
    ByteString
hint      <- ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" (Maybe ByteString -> ByteString)
-> IO (Maybe ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                 Result -> FieldCode -> IO (Maybe ByteString)
PQ.resultErrorField Result
result FieldCode
PQ.DiagMessageHint
    ByteString
state'    <- ByteString
-> (ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" ByteString -> ByteString
forall a. a -> a
id (Maybe ByteString -> ByteString)
-> IO (Maybe ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result -> FieldCode -> IO (Maybe ByteString)
PQ.resultErrorField Result
result FieldCode
PQ.DiagSqlstate
    SqlError -> IO a
forall e a. Exception e => e -> IO a
throwIO (SqlError -> IO a) -> SqlError -> IO a
forall a b. (a -> b) -> a -> b
$ SqlError :: ByteString
-> ExecStatus -> ByteString -> ByteString -> ByteString -> SqlError
SqlError { sqlState :: ByteString
sqlState = ByteString
state'
                       , sqlExecStatus :: ExecStatus
sqlExecStatus = ExecStatus
status
                       , sqlErrorMsg :: ByteString
sqlErrorMsg = ByteString
errormsg
                       , sqlErrorDetail :: ByteString
sqlErrorDetail = ByteString
detail
                       , sqlErrorHint :: ByteString
sqlErrorHint = ByteString
hint }

disconnectedError :: SqlError
disconnectedError :: SqlError
disconnectedError = ByteString -> SqlError
fatalError ByteString
"connection disconnected"

-- | Atomically perform an action with the database handle, if there is one.
withConnection :: Connection -> (PQ.Connection -> IO a) -> IO a
withConnection :: Connection -> (Connection -> IO a) -> IO a
withConnection Connection{IORef Int64
MVar TypeInfoCache
MVar Connection
connectionTempNameCounter :: IORef Int64
connectionObjects :: MVar TypeInfoCache
connectionHandle :: MVar Connection
connectionTempNameCounter :: Connection -> IORef Int64
connectionObjects :: Connection -> MVar TypeInfoCache
connectionHandle :: Connection -> MVar Connection
..} Connection -> IO a
m = do
    MVar Connection -> (Connection -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Connection
connectionHandle ((Connection -> IO a) -> IO a) -> (Connection -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
        if Connection -> Bool
PQ.isNullConnection Connection
conn
          then SqlError -> IO a
forall e a. Exception e => e -> IO a
throwIO SqlError
disconnectedError
          else Connection -> IO a
m Connection
conn

close :: Connection -> IO ()
close :: Connection -> IO ()
close Connection{IORef Int64
MVar TypeInfoCache
MVar Connection
connectionTempNameCounter :: IORef Int64
connectionObjects :: MVar TypeInfoCache
connectionHandle :: MVar Connection
connectionTempNameCounter :: Connection -> IORef Int64
connectionObjects :: Connection -> MVar TypeInfoCache
connectionHandle :: Connection -> MVar Connection
..} =
    ((forall a. IO a -> IO a) -> IO ()) -> IO ()
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO ()) -> IO ())
-> ((forall a. IO a -> IO a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> (do
            Connection
conn <- MVar Connection -> IO Connection
forall a. MVar a -> IO a
takeMVar MVar Connection
connectionHandle
            IO () -> IO ()
forall a. IO a -> IO a
restore (Connection -> IO ()
PQ.finish Connection
conn)
        IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` do
            MVar Connection -> Connection -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Connection
connectionHandle (Connection -> IO ()) -> IO Connection -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Connection
PQ.newNullConnection
        )

newNullConnection :: IO Connection
newNullConnection :: IO Connection
newNullConnection = do
    MVar Connection
connectionHandle  <- Connection -> IO (MVar Connection)
forall a. a -> IO (MVar a)
newMVar (Connection -> IO (MVar Connection))
-> IO Connection -> IO (MVar Connection)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Connection
PQ.newNullConnection
    MVar TypeInfoCache
connectionObjects <- TypeInfoCache -> IO (MVar TypeInfoCache)
forall a. a -> IO (MVar a)
newMVar TypeInfoCache
forall a. IntMap a
IntMap.empty
    IORef Int64
connectionTempNameCounter <- Int64 -> IO (IORef Int64)
forall a. a -> IO (IORef a)
newIORef Int64
0
    Connection -> IO Connection
forall (m :: * -> *) a. Monad m => a -> m a
return Connection :: MVar Connection -> MVar TypeInfoCache -> IORef Int64 -> Connection
Connection{IORef Int64
MVar TypeInfoCache
MVar Connection
connectionTempNameCounter :: IORef Int64
connectionObjects :: MVar TypeInfoCache
connectionHandle :: MVar Connection
connectionTempNameCounter :: IORef Int64
connectionObjects :: MVar TypeInfoCache
connectionHandle :: MVar Connection
..}

data Row = Row {
     Row -> Row
row        :: {-# UNPACK #-} !PQ.Row
   , Row -> Result
rowresult  :: !PQ.Result
   }

newtype RowParser a = RP { RowParser a -> ReaderT Row (StateT Column Conversion) a
unRP :: ReaderT Row (StateT PQ.Column Conversion) a }
   deriving ( a -> RowParser b -> RowParser a
(a -> b) -> RowParser a -> RowParser b
(forall a b. (a -> b) -> RowParser a -> RowParser b)
-> (forall a b. a -> RowParser b -> RowParser a)
-> Functor RowParser
forall a b. a -> RowParser b -> RowParser a
forall a b. (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RowParser b -> RowParser a
$c<$ :: forall a b. a -> RowParser b -> RowParser a
fmap :: (a -> b) -> RowParser a -> RowParser b
$cfmap :: forall a b. (a -> b) -> RowParser a -> RowParser b
Functor, Functor RowParser
a -> RowParser a
Functor RowParser
-> (forall a. a -> RowParser a)
-> (forall a b. RowParser (a -> b) -> RowParser a -> RowParser b)
-> (forall a b c.
    (a -> b -> c) -> RowParser a -> RowParser b -> RowParser c)
-> (forall a b. RowParser a -> RowParser b -> RowParser b)
-> (forall a b. RowParser a -> RowParser b -> RowParser a)
-> Applicative RowParser
RowParser a -> RowParser b -> RowParser b
RowParser a -> RowParser b -> RowParser a
RowParser (a -> b) -> RowParser a -> RowParser b
(a -> b -> c) -> RowParser a -> RowParser b -> RowParser c
forall a. a -> RowParser a
forall a b. RowParser a -> RowParser b -> RowParser a
forall a b. RowParser a -> RowParser b -> RowParser b
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall a b c.
(a -> b -> c) -> RowParser a -> RowParser b -> RowParser c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: RowParser a -> RowParser b -> RowParser a
$c<* :: forall a b. RowParser a -> RowParser b -> RowParser a
*> :: RowParser a -> RowParser b -> RowParser b
$c*> :: forall a b. RowParser a -> RowParser b -> RowParser b
liftA2 :: (a -> b -> c) -> RowParser a -> RowParser b -> RowParser c
$cliftA2 :: forall a b c.
(a -> b -> c) -> RowParser a -> RowParser b -> RowParser c
<*> :: RowParser (a -> b) -> RowParser a -> RowParser b
$c<*> :: forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
pure :: a -> RowParser a
$cpure :: forall a. a -> RowParser a
$cp1Applicative :: Functor RowParser
Applicative, Applicative RowParser
RowParser a
Applicative RowParser
-> (forall a. RowParser a)
-> (forall a. RowParser a -> RowParser a -> RowParser a)
-> (forall a. RowParser a -> RowParser [a])
-> (forall a. RowParser a -> RowParser [a])
-> Alternative RowParser
RowParser a -> RowParser a -> RowParser a
RowParser a -> RowParser [a]
RowParser a -> RowParser [a]
forall a. RowParser a
forall a. RowParser a -> RowParser [a]
forall a. RowParser a -> RowParser a -> RowParser a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: RowParser a -> RowParser [a]
$cmany :: forall a. RowParser a -> RowParser [a]
some :: RowParser a -> RowParser [a]
$csome :: forall a. RowParser a -> RowParser [a]
<|> :: RowParser a -> RowParser a -> RowParser a
$c<|> :: forall a. RowParser a -> RowParser a -> RowParser a
empty :: RowParser a
$cempty :: forall a. RowParser a
$cp1Alternative :: Applicative RowParser
Alternative, Applicative RowParser
a -> RowParser a
Applicative RowParser
-> (forall a b. RowParser a -> (a -> RowParser b) -> RowParser b)
-> (forall a b. RowParser a -> RowParser b -> RowParser b)
-> (forall a. a -> RowParser a)
-> Monad RowParser
RowParser a -> (a -> RowParser b) -> RowParser b
RowParser a -> RowParser b -> RowParser b
forall a. a -> RowParser a
forall a b. RowParser a -> RowParser b -> RowParser b
forall a b. RowParser a -> (a -> RowParser b) -> RowParser b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> RowParser a
$creturn :: forall a. a -> RowParser a
>> :: RowParser a -> RowParser b -> RowParser b
$c>> :: forall a b. RowParser a -> RowParser b -> RowParser b
>>= :: RowParser a -> (a -> RowParser b) -> RowParser b
$c>>= :: forall a b. RowParser a -> (a -> RowParser b) -> RowParser b
$cp1Monad :: Applicative RowParser
Monad )

liftRowParser :: IO a -> RowParser a
liftRowParser :: IO a -> RowParser a
liftRowParser = ReaderT Row (StateT Column Conversion) a -> RowParser a
forall a. ReaderT Row (StateT Column Conversion) a -> RowParser a
RP (ReaderT Row (StateT Column Conversion) a -> RowParser a)
-> (IO a -> ReaderT Row (StateT Column Conversion) a)
-> IO a
-> RowParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Column Conversion a
-> ReaderT Row (StateT Column Conversion) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT Column Conversion a
 -> ReaderT Row (StateT Column Conversion) a)
-> (IO a -> StateT Column Conversion a)
-> IO a
-> ReaderT Row (StateT Column Conversion) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversion a -> StateT Column Conversion a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Conversion a -> StateT Column Conversion a)
-> (IO a -> Conversion a) -> IO a -> StateT Column Conversion a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> Conversion a
forall a. IO a -> Conversion a
liftConversion

newtype Conversion a = Conversion { Conversion a -> Connection -> IO (Ok a)
runConversion :: Connection -> IO (Ok a) }

liftConversion :: IO a -> Conversion a
liftConversion :: IO a -> Conversion a
liftConversion IO a
m = (Connection -> IO (Ok a)) -> Conversion a
forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion (\Connection
_ -> a -> Ok a
forall a. a -> Ok a
Ok (a -> Ok a) -> IO a -> IO (Ok a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
m)

instance Functor Conversion where
   fmap :: (a -> b) -> Conversion a -> Conversion b
fmap a -> b
f Conversion a
m = (Connection -> IO (Ok b)) -> Conversion b
forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion ((Connection -> IO (Ok b)) -> Conversion b)
-> (Connection -> IO (Ok b)) -> Conversion b
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> ((Ok a -> Ok b) -> IO (Ok a) -> IO (Ok b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Ok a -> Ok b) -> IO (Ok a) -> IO (Ok b))
-> ((a -> b) -> Ok a -> Ok b) -> (a -> b) -> IO (Ok a) -> IO (Ok b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Ok a -> Ok b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f (Conversion a -> Connection -> IO (Ok a)
forall a. Conversion a -> Connection -> IO (Ok a)
runConversion Conversion a
m Connection
conn)

instance Applicative Conversion where
   pure :: a -> Conversion a
pure a
a    = (Connection -> IO (Ok a)) -> Conversion a
forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion ((Connection -> IO (Ok a)) -> Conversion a)
-> (Connection -> IO (Ok a)) -> Conversion a
forall a b. (a -> b) -> a -> b
$ \Connection
_conn -> Ok a -> IO (Ok a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Ok a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
   Conversion (a -> b)
mf <*> :: Conversion (a -> b) -> Conversion a -> Conversion b
<*> Conversion a
ma = (Connection -> IO (Ok b)) -> Conversion b
forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion ((Connection -> IO (Ok b)) -> Conversion b)
-> (Connection -> IO (Ok b)) -> Conversion b
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
                   Ok (a -> b)
okf <- Conversion (a -> b) -> Connection -> IO (Ok (a -> b))
forall a. Conversion a -> Connection -> IO (Ok a)
runConversion Conversion (a -> b)
mf Connection
conn
                   case Ok (a -> b)
okf of
                     Ok a -> b
f -> ((Ok a -> Ok b) -> IO (Ok a) -> IO (Ok b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Ok a -> Ok b) -> IO (Ok a) -> IO (Ok b))
-> ((a -> b) -> Ok a -> Ok b) -> (a -> b) -> IO (Ok a) -> IO (Ok b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Ok a -> Ok b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f (Conversion a -> Connection -> IO (Ok a)
forall a. Conversion a -> Connection -> IO (Ok a)
runConversion Conversion a
ma Connection
conn)
                     Errors [SomeException]
errs -> Ok b -> IO (Ok b)
forall (m :: * -> *) a. Monad m => a -> m a
return ([SomeException] -> Ok b
forall a. [SomeException] -> Ok a
Errors [SomeException]
errs)

instance Alternative Conversion where
   empty :: Conversion a
empty     = (Connection -> IO (Ok a)) -> Conversion a
forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion ((Connection -> IO (Ok a)) -> Conversion a)
-> (Connection -> IO (Ok a)) -> Conversion a
forall a b. (a -> b) -> a -> b
$ \Connection
_conn -> Ok a -> IO (Ok a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ok a
forall (f :: * -> *) a. Alternative f => f a
empty
   Conversion a
ma <|> :: Conversion a -> Conversion a -> Conversion a
<|> Conversion a
mb = (Connection -> IO (Ok a)) -> Conversion a
forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion ((Connection -> IO (Ok a)) -> Conversion a)
-> (Connection -> IO (Ok a)) -> Conversion a
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
                   Ok a
oka <- Conversion a -> Connection -> IO (Ok a)
forall a. Conversion a -> Connection -> IO (Ok a)
runConversion Conversion a
ma Connection
conn
                   case Ok a
oka of
                     Ok a
_     -> Ok a -> IO (Ok a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ok a
oka
                     Errors [SomeException]
_ -> (Ok a
oka Ok a -> Ok a -> Ok a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>) (Ok a -> Ok a) -> IO (Ok a) -> IO (Ok a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Conversion a -> Connection -> IO (Ok a)
forall a. Conversion a -> Connection -> IO (Ok a)
runConversion Conversion a
mb Connection
conn

instance Monad Conversion where
#if !(MIN_VERSION_base(4,8,0))
   return = pure
#endif
   Conversion a
m >>= :: Conversion a -> (a -> Conversion b) -> Conversion b
>>= a -> Conversion b
f = (Connection -> IO (Ok b)) -> Conversion b
forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion ((Connection -> IO (Ok b)) -> Conversion b)
-> (Connection -> IO (Ok b)) -> Conversion b
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
                 Ok a
oka <- Conversion a -> Connection -> IO (Ok a)
forall a. Conversion a -> Connection -> IO (Ok a)
runConversion Conversion a
m Connection
conn
                 case Ok a
oka of
                   Ok a
a -> Conversion b -> Connection -> IO (Ok b)
forall a. Conversion a -> Connection -> IO (Ok a)
runConversion (a -> Conversion b
f a
a) Connection
conn
                   Errors [SomeException]
err -> Ok b -> IO (Ok b)
forall (m :: * -> *) a. Monad m => a -> m a
return ([SomeException] -> Ok b
forall a. [SomeException] -> Ok a
Errors [SomeException]
err)

instance MonadPlus Conversion where
   mzero :: Conversion a
mzero = Conversion a
forall (f :: * -> *) a. Alternative f => f a
empty
   mplus :: Conversion a -> Conversion a -> Conversion a
mplus = Conversion a -> Conversion a -> Conversion a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

conversionMap :: (Ok a -> Ok b) -> Conversion a -> Conversion b
conversionMap :: (Ok a -> Ok b) -> Conversion a -> Conversion b
conversionMap Ok a -> Ok b
f Conversion a
m = (Connection -> IO (Ok b)) -> Conversion b
forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion ((Connection -> IO (Ok b)) -> Conversion b)
-> (Connection -> IO (Ok b)) -> Conversion b
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> Ok a -> Ok b
f (Ok a -> Ok b) -> IO (Ok a) -> IO (Ok b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Conversion a -> Connection -> IO (Ok a)
forall a. Conversion a -> Connection -> IO (Ok a)
runConversion Conversion a
m Connection
conn

conversionError :: Exception err => err -> Conversion a
conversionError :: err -> Conversion a
conversionError err
err = (Connection -> IO (Ok a)) -> Conversion a
forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion ((Connection -> IO (Ok a)) -> Conversion a)
-> (Connection -> IO (Ok a)) -> Conversion a
forall a b. (a -> b) -> a -> b
$ \Connection
_ -> Ok a -> IO (Ok a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([SomeException] -> Ok a
forall a. [SomeException] -> Ok a
Errors [err -> SomeException
forall e. Exception e => e -> SomeException
toException err
err])

newTempName :: Connection -> IO Query
newTempName :: Connection -> IO Query
newTempName Connection{IORef Int64
MVar TypeInfoCache
MVar Connection
connectionTempNameCounter :: IORef Int64
connectionObjects :: MVar TypeInfoCache
connectionHandle :: MVar Connection
connectionTempNameCounter :: Connection -> IORef Int64
connectionObjects :: Connection -> MVar TypeInfoCache
connectionHandle :: Connection -> MVar Connection
..} = do
    !Int64
n <- IORef Int64 -> (Int64 -> (Int64, Int64)) -> IO Int64
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef Int64
connectionTempNameCounter
          (\Int64
n -> let !n' :: Int64
n' = Int64
nInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1 in (Int64
n', Int64
n'))
    Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return (Query -> IO Query) -> Query -> IO Query
forall a b. (a -> b) -> a -> b
$! ByteString -> Query
Query (ByteString -> Query) -> ByteString -> Query
forall a b. (a -> b) -> a -> b
$ String -> ByteString
B8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"temp" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int64 -> String
forall a. Show a => a -> String
show Int64
n

-- FIXME?  What error should getNotification and getCopyData throw?
fdError :: ByteString -> IOError
fdError :: ByteString -> IOError
fdError ByteString
funcName = IOError :: Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOError
IOError {
                     ioe_handle :: Maybe Handle
ioe_handle      = Maybe Handle
forall a. Maybe a
Nothing,
                     ioe_type :: IOErrorType
ioe_type        = IOErrorType
ResourceVanished,
                     ioe_location :: String
ioe_location    = ByteString -> String
B8.unpack ByteString
funcName,
                     ioe_description :: String
ioe_description = String
"failed to fetch file descriptor",
                     ioe_errno :: Maybe CInt
ioe_errno       = Maybe CInt
forall a. Maybe a
Nothing,
                     ioe_filename :: Maybe String
ioe_filename    = Maybe String
forall a. Maybe a
Nothing
                   }


libPQError :: ByteString -> IOError
libPQError :: ByteString -> IOError
libPQError ByteString
desc = IOError :: Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOError
IOError {
                    ioe_handle :: Maybe Handle
ioe_handle      = Maybe Handle
forall a. Maybe a
Nothing,
                    ioe_type :: IOErrorType
ioe_type        = IOErrorType
OtherError,
                    ioe_location :: String
ioe_location    = String
"libpq",
                    ioe_description :: String
ioe_description = ByteString -> String
B8.unpack ByteString
desc,
                    ioe_errno :: Maybe CInt
ioe_errno       = Maybe CInt
forall a. Maybe a
Nothing,
                    ioe_filename :: Maybe String
ioe_filename    = Maybe String
forall a. Maybe a
Nothing
                  }

throwLibPQError :: PQ.Connection -> ByteString -> IO a
throwLibPQError :: Connection -> ByteString -> IO a
throwLibPQError Connection
conn ByteString
default_desc = do
  ByteString
msg <- ByteString
-> (ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
default_desc ByteString -> ByteString
forall a. a -> a
id (Maybe ByteString -> ByteString)
-> IO (Maybe ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO (Maybe ByteString)
PQ.errorMessage Connection
conn
  IOError -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO a) -> IOError -> IO a
forall a b. (a -> b) -> a -> b
$! ByteString -> IOError
libPQError ByteString
msg


fmtError :: String -> Query -> [Action] -> a
fmtError :: String -> Query -> [Action] -> a
fmtError String
msg Query
q [Action]
xs = FormatError -> a
forall a e. Exception e => e -> a
throw FormatError :: String -> Query -> [ByteString] -> FormatError
FormatError {
                      fmtMessage :: String
fmtMessage = String
msg
                    , fmtQuery :: Query
fmtQuery = Query
q
                    , fmtParams :: [ByteString]
fmtParams = (Action -> ByteString) -> [Action] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Action -> ByteString
twiddle [Action]
xs
                    }
  where twiddle :: Action -> ByteString
twiddle (Plain Builder
b)            = Builder -> ByteString
toByteString Builder
b
        twiddle (Escape ByteString
s)           = ByteString
s
        twiddle (EscapeByteA ByteString
s)      = ByteString
s
        twiddle (EscapeIdentifier ByteString
s) = ByteString
s
        twiddle (Many [Action]
ys)            = [ByteString] -> ByteString
B.concat ((Action -> ByteString) -> [Action] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Action -> ByteString
twiddle [Action]
ys)

fmtErrorBs :: Query -> [Action] -> ByteString -> a
fmtErrorBs :: Query -> [Action] -> ByteString -> a
fmtErrorBs Query
q [Action]
xs ByteString
msg = String -> Query -> [Action] -> a
forall a. String -> Query -> [Action] -> a
fmtError (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 ByteString
msg) Query
q [Action]
xs

-- | Quote bytestring or throw 'FormatError'
quote :: Query -> [Action] -> Either ByteString ByteString -> Builder
quote :: Query -> [Action] -> Either ByteString ByteString -> Builder
quote Query
q [Action]
xs = (ByteString -> Builder)
-> (ByteString -> Builder)
-> Either ByteString ByteString
-> Builder
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Query -> [Action] -> ByteString -> Builder
forall a. Query -> [Action] -> ByteString -> a
fmtErrorBs Query
q [Action]
xs) (Builder -> Builder
inQuotes (Builder -> Builder)
-> (ByteString -> Builder) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
byteString)

buildAction :: Connection        -- ^ Connection for string escaping
            -> Query             -- ^ Query for message error
            -> [Action]          -- ^ List of parameters for message error
            -> Action            -- ^ Action to build
            -> IO Builder
buildAction :: Connection -> Query -> [Action] -> Action -> IO Builder
buildAction Connection
_ Query
_ [Action]
_     (Plain  Builder
b)            = Builder -> IO Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
b
buildAction Connection
conn Query
q [Action]
xs (Escape ByteString
s)            = Query -> [Action] -> Either ByteString ByteString -> Builder
quote Query
q [Action]
xs (Either ByteString ByteString -> Builder)
-> IO (Either ByteString ByteString) -> IO Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> ByteString -> IO (Either ByteString ByteString)
escapeStringConn Connection
conn ByteString
s
buildAction Connection
conn Query
q [Action]
xs (EscapeByteA ByteString
s)       = Query -> [Action] -> Either ByteString ByteString -> Builder
quote Query
q [Action]
xs (Either ByteString ByteString -> Builder)
-> IO (Either ByteString ByteString) -> IO Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> ByteString -> IO (Either ByteString ByteString)
escapeByteaConn Connection
conn ByteString
s
buildAction Connection
conn Query
q [Action]
xs (EscapeIdentifier ByteString
s) =
    (ByteString -> Builder)
-> (ByteString -> Builder)
-> Either ByteString ByteString
-> Builder
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Query -> [Action] -> ByteString -> Builder
forall a. Query -> [Action] -> ByteString -> a
fmtErrorBs Query
q [Action]
xs) ByteString -> Builder
byteString (Either ByteString ByteString -> Builder)
-> IO (Either ByteString ByteString) -> IO Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> ByteString -> IO (Either ByteString ByteString)
escapeIdentifier Connection
conn ByteString
s
buildAction Connection
conn Query
q [Action]
xs (Many  [Action]
ys)           =
    [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> IO [Builder] -> IO Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Action -> IO Builder) -> [Action] -> IO [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Connection -> Query -> [Action] -> Action -> IO Builder
buildAction Connection
conn Query
q [Action]
xs) [Action]
ys

checkError :: PQ.Connection -> Maybe a -> IO (Either ByteString a)
checkError :: Connection -> Maybe a -> IO (Either ByteString a)
checkError Connection
_ (Just a
x) = Either ByteString a -> IO (Either ByteString a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString a -> IO (Either ByteString a))
-> Either ByteString a -> IO (Either ByteString a)
forall a b. (a -> b) -> a -> b
$ a -> Either ByteString a
forall a b. b -> Either a b
Right a
x
checkError Connection
c Maybe a
Nothing  = ByteString -> Either ByteString a
forall a b. a -> Either a b
Left (ByteString -> Either ByteString a)
-> (Maybe ByteString -> ByteString)
-> Maybe ByteString
-> Either ByteString a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> (ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" ByteString -> ByteString
forall a. a -> a
id (Maybe ByteString -> Either ByteString a)
-> IO (Maybe ByteString) -> IO (Either ByteString a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO (Maybe ByteString)
PQ.errorMessage Connection
c

escapeWrap       :: (PQ.Connection -> ByteString -> IO (Maybe ByteString))
                 -> Connection
                 -> ByteString
                 -> IO (Either ByteString ByteString)
escapeWrap :: (Connection -> ByteString -> IO (Maybe ByteString))
-> Connection -> ByteString -> IO (Either ByteString ByteString)
escapeWrap Connection -> ByteString -> IO (Maybe ByteString)
f Connection
conn ByteString
s =
    Connection
-> (Connection -> IO (Either ByteString ByteString))
-> IO (Either ByteString ByteString)
forall a. Connection -> (Connection -> IO a) -> IO a
withConnection Connection
conn ((Connection -> IO (Either ByteString ByteString))
 -> IO (Either ByteString ByteString))
-> (Connection -> IO (Either ByteString ByteString))
-> IO (Either ByteString ByteString)
forall a b. (a -> b) -> a -> b
$ \Connection
c ->
    Connection -> ByteString -> IO (Maybe ByteString)
f Connection
c ByteString
s IO (Maybe ByteString)
-> (Maybe ByteString -> IO (Either ByteString ByteString))
-> IO (Either ByteString ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Connection -> Maybe ByteString -> IO (Either ByteString ByteString)
forall a. Connection -> Maybe a -> IO (Either ByteString a)
checkError Connection
c

escapeStringConn :: Connection -> ByteString -> IO (Either ByteString ByteString)
escapeStringConn :: Connection -> ByteString -> IO (Either ByteString ByteString)
escapeStringConn = (Connection -> ByteString -> IO (Maybe ByteString))
-> Connection -> ByteString -> IO (Either ByteString ByteString)
escapeWrap Connection -> ByteString -> IO (Maybe ByteString)
PQ.escapeStringConn

escapeIdentifier :: Connection -> ByteString -> IO (Either ByteString ByteString)
escapeIdentifier :: Connection -> ByteString -> IO (Either ByteString ByteString)
escapeIdentifier = (Connection -> ByteString -> IO (Maybe ByteString))
-> Connection -> ByteString -> IO (Either ByteString ByteString)
escapeWrap Connection -> ByteString -> IO (Maybe ByteString)
PQ.escapeIdentifier

escapeByteaConn :: Connection -> ByteString -> IO (Either ByteString ByteString)
escapeByteaConn :: Connection -> ByteString -> IO (Either ByteString ByteString)
escapeByteaConn = (Connection -> ByteString -> IO (Maybe ByteString))
-> Connection -> ByteString -> IO (Either ByteString ByteString)
escapeWrap Connection -> ByteString -> IO (Maybe ByteString)
PQ.escapeByteaConn

breakOnSingleQuestionMark :: ByteString -> (ByteString, ByteString)
breakOnSingleQuestionMark :: ByteString -> (ByteString, ByteString)
breakOnSingleQuestionMark ByteString
b = (ByteString, ByteString) -> (ByteString, ByteString)
go (ByteString
B8.empty, ByteString
b)
  where go :: (ByteString, ByteString) -> (ByteString, ByteString)
go (ByteString
x,ByteString
bs) = (ByteString
x ByteString -> ByteString -> ByteString
`B8.append` ByteString
x',ByteString
bs')
                -- seperate from first QM
          where tup :: (ByteString, ByteString)
tup@(ByteString
noQ, ByteString
restWithQ) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
B8.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'?') ByteString
bs
                -- if end of query, just return
                -- else check for second QM in 'go2'
                (ByteString
x', ByteString
bs') = (ByteString, ByteString)
-> ((Char, ByteString) -> (ByteString, ByteString))
-> Maybe (Char, ByteString)
-> (ByteString, ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString, ByteString)
tup (Char, ByteString) -> (ByteString, ByteString)
go2 (Maybe (Char, ByteString) -> (ByteString, ByteString))
-> Maybe (Char, ByteString) -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$
                    -- drop found QM and peek at next char
                    ByteString -> Maybe (Char, ByteString)
B8.uncons ByteString
restWithQ Maybe (Char, ByteString)
-> ((Char, ByteString) -> Maybe (Char, ByteString))
-> Maybe (Char, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe (Char, ByteString)
B8.uncons (ByteString -> Maybe (Char, ByteString))
-> ((Char, ByteString) -> ByteString)
-> (Char, ByteString)
-> Maybe (Char, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, ByteString) -> ByteString
forall a b. (a, b) -> b
snd
                -- another QM after the first means:
                -- take literal QM and keep going.
                go2 :: (Char, ByteString) -> (ByteString, ByteString)
go2 (Char
'?', ByteString
t2) = (ByteString, ByteString) -> (ByteString, ByteString)
go (ByteString
noQ ByteString -> Char -> ByteString
`B8.snoc` Char
'?',ByteString
t2)
                -- Anything else means
                go2 (Char, ByteString)
_ = (ByteString, ByteString)
tup