diff --git a/Database/HDBI/PostgreSQL.hs b/Database/HDBI/PostgreSQL.hs
new file mode 100644
--- /dev/null
+++ b/Database/HDBI/PostgreSQL.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE
+  TypeFamilies
+, DeriveDataTypeable
+, OverloadedStrings
+  #-}
+
+{- |
+   Module     : Database.HDBI.PostgreSQL
+   Copyright  : Copyright (C) 2005-2011 John Goerzen
+   License    : BSD3
+
+   Maintainer : Aleksey Uymanov <s9gf4ult@gmail.com>
+   Stability  : experimental
+   Portability: portable
+
+HDBI driver interface for PostgreSQL 8.x and above
+
+Written by John Goerzen, jgoerzen\@complete.org
+
+-}
+
+module Database.HDBI.PostgreSQL
+       (
+         PostgreConnection(..)
+       , PostgreStatement(..)
+       , PGStatementState(..)
+       , connectPostgreSQL
+       ) where
+
+import Database.HDBI.PostgreSQL.Implementation
diff --git a/Database/HDBI/PostgreSQL/Implementation.hs b/Database/HDBI/PostgreSQL/Implementation.hs
new file mode 100644
--- /dev/null
+++ b/Database/HDBI/PostgreSQL/Implementation.hs
@@ -0,0 +1,581 @@
+{-# LANGUAGE
+  TypeFamilies
+, DeriveDataTypeable
+, OverloadedStrings
+  #-}
+
+{- |
+   Module     : Database.HDBI.PostgreSQL.Implementation
+   Copyright  : Copyright (C) 2005-2013 John Goerzen
+   License    : BSD3
+
+   Maintainer : Aleksey Uymanov <s9gf4ult@gmail.com>
+   Stability  : experimental
+   Portability: portable
+-}
+
+
+module Database.HDBI.PostgreSQL.Implementation
+       (
+         -- * Types
+         PostgreConnection(..)
+       , PGStatementState(..)
+       , PostgreStatement(..)
+         -- * Connection functions
+       , connectPostgreSQL
+       , withPGConnection
+         -- * Data manipulating functions
+       , sqlValueToNative
+       , formatUTC
+       , formatDay
+       , formatT
+       , formatDT
+       , formatBits
+       , o2b
+       , nativeToSqlValue
+       , parseT
+       , parseDT
+       , parseD
+       , parseUTC
+       , parseBit
+         -- * Miscellaneous functions
+       , throwErrorMessage
+       , getPGResult
+       , throwResultError
+       , pgRun
+       , pgRunRaw
+       , pgRunMany
+       , pgstGetResult
+       ) where
+
+import Blaze.ByteString.Builder (toByteString)
+import Blaze.ByteString.Builder.ByteString (fromByteString)
+import Blaze.ByteString.Builder.Char.Utf8 (fromLazyText, fromString)
+import Control.Applicative
+import Control.Concurrent.MVar
+import Control.Exception
+import Control.Monad
+import Data.Bits
+import Data.List (intercalate)
+import Data.Monoid
+import Data.Time
+import Data.Typeable
+import Data.Word
+import Database.HDBI
+import Database.HDBI.DriverUtils
+import Database.HDBI.Parsers
+import Database.HDBI.PostgreSQL.Parser (buildSqlQuery)
+import Safe
+import System.IO
+import System.Locale (defaultTimeLocale)
+import qualified Data.Attoparsec.Text.Lazy as P
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TL
+import qualified Data.UUID as U
+import qualified Database.PostgreSQL.LibPQ as PQ
+import qualified Database.PostgreSQL.Simple.BuiltinTypes as PS
+
+data PostgreConnection = PostgreConnection
+                         { postNative     :: MVar (Maybe PQ.Connection) -- ^ LibPQ connection if established
+                         , postStatements :: ChildList PostgreStatement -- ^ List of weak refs to statements to finalize on disconnect
+                         , postConnString :: TL.Text                    -- ^ Original connection string
+                         }
+                         deriving (Typeable)
+
+data PGStatementState =
+  -- | Newly created or reseted statement
+  STNew
+  -- | Just executed statement
+  | STExecuted
+    { pgstResult :: ! PQ.Result
+    }
+    -- | Fetching rows is in progress
+  | STFetching
+    { pgstResult  :: ! PQ.Result -- ^ The result to fetch data from
+    , pgstColumns :: ! PQ.Column -- ^ Columns count
+    , pgstFormats :: ! [PQ.Format]
+    , pgstTypes   :: ! [PQ.Oid]
+    , pgstTuples  :: ! PQ.Row    -- ^ Tuples in result
+    , pgstCurrent :: ! PQ.Row    -- ^ Row number waiting to fetch
+    }
+    -- | Statement is finished, can still be reseted
+  | STFinished
+
+
+data PostgreStatement = PostgreStatement
+                        { stQuery :: Query                  -- ^ Initial query
+                        , stConnection :: PostgreConnection -- ^ Connection this statement working with
+                        , stState :: MVar PGStatementState  -- ^ State of statement
+                        }
+                        deriving (Typeable)
+
+
+instance Connection PostgreConnection where
+  type ConnStatement PostgreConnection = PostgreStatement
+
+  disconnect conn = modifyMVar_ (postNative conn) $ \con -> do
+    case con of
+      Nothing -> return Nothing
+      Just c -> do
+        closeAllChildren $ postStatements conn
+        PQ.finish c
+        return Nothing
+
+  begin conn = runRaw conn "BEGIN"
+  commit conn = runRaw conn "COMMIT"
+  rollback conn = runRaw conn "ROLLBACK"
+  inTransaction conn = withPGConnection conn $ \con -> do
+    st <- PQ.transactionStatus con
+    case st of
+      PQ.TransInTrans -> return True
+      PQ.TransInError -> do
+        hPutStrLn stderr "Transaction is in error status"
+        return True
+      PQ.TransUnknown -> throwIO $ SqlDriverError "Could not determine the transaction status (TransUnknown)"
+      _ -> return False
+  connStatus conn = withMVar (postNative conn) $ \con -> case con of
+    Nothing -> return ConnDisconnected
+    Just c -> do
+      st <- PQ.status c
+      case st of
+        PQ.ConnectionOk -> return ConnOK
+
+        PQ.ConnectionBad -> return ConnBad
+        x -> throwIO $ SqlDriverError $ pgMsg $ "unexpected status code (" ++ show x ++ ")"
+
+  prepare conn query = do
+    st <- PostgreStatement
+          <$> return query
+          <*> return conn
+          <*> newMVar STNew
+    addChild (postStatements conn) st
+    return st
+
+  run conn query values = do
+    res <- pgRun conn query values
+    PQ.unsafeFreeResult res
+    return ()
+
+  runRaw conn query = do
+    res <- pgRunRaw conn query
+    PQ.unsafeFreeResult res
+    return ()
+
+  runMany = pgRunMany
+
+  clone conn = connectPostgreSQL $ postConnString conn
+
+  hdbiDriverName = const "postgresql"
+
+  dbTransactionSupport = const True
+
+
+instance Statement PostgreStatement where
+
+  execute stmt values = modifyMVar_ (stState stmt)
+                        $ \st -> withPGSTNew st $ do
+    res <- pgRun (stConnection stmt) (stQuery stmt) values
+    return $ STExecuted res
+
+  executeMany stmt vals = withMVar (stState stmt)
+                          $ \st -> withPGSTNew st
+                          $ pgRunMany (stConnection stmt) (stQuery stmt) vals
+
+  statementStatus stmt = withMVar (stState stmt)
+                         $ \st -> case st of
+    STNew         -> return StatementNew
+    STExecuted {} -> return StatementExecuted
+    STFetching { pgstCurrent = c
+               , pgstTuples  = t} -> if c >= t
+                                     then return StatementFetched
+                                     else return StatementExecuted
+    STFinished    -> return StatementFinished
+
+  affectedRows stmt = withMVar (stState stmt)
+                      $ \st -> do
+    let res = pgstGetResult "Statement is not executed or already finished" st
+    tpls <- PQ.cmdTuples res
+    case tpls of
+      Nothing -> withPGConnection (stConnection stmt) throwErrorMessage
+      Just "" -> return 0        -- when query was SELECT libPQ return empty string
+      Just r  -> let rx = TL.unpack $ decodeUTF8 r
+                 in case readMay rx of
+                   Just x -> return x
+                   Nothing -> throwIO $ SqlDriverError $ pgMsg $ "Could not read binding output as integer \"" ++ rx ++ "\""
+
+  finish stmt = modifyMVar_ (stState stmt) doFinishStatement
+
+  reset stmt = modifyMVar_ (stState stmt) $ \st -> do
+    _ <- doFinishStatement st
+    return STNew
+
+  fetchRow stmt = modifyMVar (stState stmt) _fetchRow
+    where
+      _fetchRow STExecuted {pgstResult = result} = do
+        fields <- PQ.nfields result
+        s <- STFetching
+             <$> return result
+             <*> return fields
+             <*> forM [0..fields-1] (PQ.fformat result)
+             <*> forM [0..fields-1] (PQ.ftype result)
+             <*> PQ.ntuples result
+             <*> (return $ PQ.toRow (0 :: Int))
+        _fetchRow s
+
+      _fetchRow x@(STFetching result cols formats oids tpls current) =
+        if current >= tpls
+        then return (x, Nothing)
+        else do
+          ret <- forM (zip3 [0..cols-1] formats oids) $ \(col, fmt, oid) -> do
+            mval <- PQ.getvalue' result current col
+            case mval of
+              Nothing -> return SqlNull
+              Just val -> nativeToSqlValue val fmt oid
+          return (x {pgstCurrent = current + 1}, Just ret)
+
+      _fetchRow x = throwIO
+                    $ SqlDriverError
+                    $ pgMsg $ "Statement is in wrong state (" ++ pgstName x ++ ") to fetch row"
+
+  getColumnNames stmt = withMVar (stState stmt) $ \st -> do
+    let res = pgstGetResult "Statement is in wrong state to get column names" st
+    cols <- PQ.nfields res
+    forM [0 .. cols-1] $ \col -> do
+      mname <- PQ.fname res col
+      case mname of
+        Nothing   -> withPGConnection (stConnection stmt) throwErrorMessage
+        Just name -> return $ decodeUTF8 name
+
+  getColumnsCount stmt = withMVar (stState stmt) $ \st -> do
+    let res = pgstGetResult "Statement is in wrong state to get columns count" st
+    ret <- PQ.nfields res
+    return $ toEnum $ fromEnum ret
+
+  originalQuery = stQuery
+
+
+-- | Throw `SqlDriverError` that connection is closed
+throwConnectionClosed :: IO a
+throwConnectionClosed = throwIO $ SqlDriverError $ pgMsg "The connection is closed, can not operate"
+
+-- | If connection is opened then execute an action, else throw an error.
+withPGConnection :: PostgreConnection
+                    -> (PQ.Connection -> IO a) -- ^ action to execute with native LibPQ connection
+                    -> IO a
+withPGConnection conn action = withMVar (postNative conn) $ \c -> case c of
+  Nothing -> throwConnectionClosed
+  Just con -> action con
+
+-- | Convert SqlValue to native libPQ data representation
+sqlValueToNative :: SqlValue -> Maybe (PQ.Oid, B.ByteString, PQ.Format)
+sqlValueToNative SqlNull = Nothing
+sqlValueToNative x = Just $ tonative x
+  where
+    bshow :: (Show a) => a -> B.ByteString
+    bshow = toByteString . fromString . show
+
+    asText :: (Show a) => PS.BuiltinType -> a -> (PQ.Oid, B.ByteString, PQ.Format)
+    asText t v = (PS.builtin2oid t, bshow v, PQ.Text)
+
+    tonative :: SqlValue -> (PQ.Oid, B.ByteString, PQ.Format)
+    tonative (SqlDecimal d)          = asText PS.Numeric d
+    tonative (SqlInteger i)          = asText PS.Numeric i
+    tonative (SqlDouble d)           = asText PS.Float8 d
+    tonative (SqlText t)             = (PS.builtin2oid PS.Text, encodeUTF8 t, PQ.Text)
+    tonative (SqlBlob b)             = (PS.builtin2oid PS.ByteA, b, PQ.Binary)
+    tonative (SqlBool b)             = (PS.builtin2oid PS.Bool, if b then "t" else "f", PQ.Text)
+    tonative (SqlBitField b)         = (PS.builtin2oid PS.VarBit, formatBits $ unBitField b, PQ.Text)
+    tonative (SqlUUID u)             = (PS.builtin2oid PS.UUID, toByteString $ fromString $ U.toString u, PQ.Text)
+    tonative (SqlUTCTime ut)         = (PS.builtin2oid PS.TimestampTZ, formatUTC ut, PQ.Text)
+    tonative (SqlLocalDate d)        = (PS.builtin2oid PS.Date, formatDay d, PQ.Text)
+    tonative (SqlLocalTimeOfDay tod) = (PS.builtin2oid PS.Time, formatT tod, PQ.Text)
+    tonative (SqlLocalTime t)        = (PS.builtin2oid PS.Timestamp, formatDT t, PQ.Text)
+    tonative SqlNull                 = error "SqlNull is passed to 'tonative' internal function, this is a bug"
+
+
+-- | format any formatable data
+formatToBS :: (FormatTime a) => String -> a -> B.ByteString
+formatToBS s d = toByteString $ fromString $ formatTime defaultTimeLocale s d
+
+-- | Format UTCTime as ByteString
+formatUTC :: UTCTime -> B.ByteString
+formatUTC x = formatToBS "%Y-%m-%d %H:%M:%S%Q%z" x
+
+-- | Format Day as ByteString
+formatDay :: Day -> B.ByteString
+formatDay = formatToBS  "%Y-%m-%d"
+
+-- | format TimeOfDay to ByteString
+formatT :: TimeOfDay -> B.ByteString
+formatT = formatToBS "%H:%M:%S%Q"
+
+-- | format LocalTime as ByteString
+formatDT :: LocalTime -> B.ByteString
+formatDT = formatToBS "%Y-%m-%d %H:%M:%S%Q"
+
+-- | format Word64 as bit field (001010111)
+formatBits :: Word64 -> B.ByteString
+formatBits 0 = "0"
+formatBits w = toByteString $ bits
+  where
+    bits = mconcat $ map toBS $ truncFalse $ wbits
+
+    wbits = map (testBit w) [bsz-1, bsz-2 .. 0]
+    bsz = bitSize w
+
+    truncFalse [] = []
+    truncFalse (False:r) = truncFalse r
+    truncFalse x@(True:_) = x
+
+    toBS True = fromByteString "1"
+    toBS False = fromByteString "0"
+
+-- | convert `PQ.Oid` to `PS.BuiltinType` if not converted then throw an error
+o2b :: PQ.Oid -> PS.BuiltinType
+o2b fmt = case PS.oid2builtin fmt of
+  Nothing -> throw $ SqlDriverError $ pgMsg $ "Could not understand returned type, OID=" ++ show fmt
+  Just r  -> r
+
+-- | Try parse text with given parser. If parsing failed throw SqlError
+parseFromNative :: String -> P.Parser a -> TL.Text -> a
+parseFromNative m p t = case P.parse p t of
+  P.Done _ r        -> r
+  P.Fail _ cont msg -> throw $ SqlDriverError
+                     $ "Could not parse "
+                     ++ show t
+                     ++ " as " ++ m
+                     ++ " parser context is: " ++ (intercalate ", " cont)
+                     ++ " message: " ++ msg
+
+-- | convert native LibPQ data representation to `SqlValue`. Now support just
+-- `PQ.Text` format completely. Maybe binary protocol will be added in future
+-- versions.
+nativeToSqlValue :: B.ByteString -> PQ.Format -> PQ.Oid -> IO SqlValue
+nativeToSqlValue b PQ.Text f = fromNative (o2b f) b
+  where
+    ftext x = SqlText $ decodeUTF8 x
+
+    fromNative PS.Bool x = case x of
+      "t" -> return $ SqlBool True
+      "f" -> return $ SqlBool False
+      _ -> throwIO $ SqlDriverError $ pgMsg $ "could not parse " ++ (TL.unpack $ decodeUTF8 x) ++ " as Boolean"
+    fromNative PS.ByteA x = do
+      r <- PQ.unescapeBytea x
+      case r of
+        Nothing -> throwIO $ SqlDriverError $ pgMsg "Could not unescape binary data, maybe format is wrong"
+        Just ret -> return $ SqlBlob ret
+    fromNative PS.Char x        = return $ ftext x
+    fromNative PS.Int8 x        = return
+                                  $ SqlInteger
+                                  $ parseFromNative "Integer" (P.signed P.decimal)
+                                  $ decodeUTF8 x
+    fromNative PS.Int4 x        = return
+                                  $ SqlInteger
+                                  $ parseFromNative "Integer" (P.signed P.decimal)
+                                  $ decodeUTF8 x
+    fromNative PS.Int2 x        = return
+                                  $ SqlInteger
+                                  $ parseFromNative "Integer" (P.signed P.decimal)
+                                  $ decodeUTF8 x
+    fromNative PS.Text x        = return $ ftext x
+    fromNative PS.Xml  x        = return $ ftext x
+    fromNative PS.Float4 x      = return
+                                  $ SqlDouble
+                                  $ parseFromNative "Double" (P.signed P.double)
+                                  $ decodeUTF8 x
+    fromNative PS.Float8 x      = return
+                                  $ SqlDouble
+                                  $ parseFromNative "Double" (P.signed P.double)
+                                  $ decodeUTF8 x
+    fromNative PS.BpChar x      = return $ ftext x
+    fromNative PS.VarChar x     = return $ ftext x
+    fromNative PS.Date x        = return
+                                  $ SqlLocalDate
+                                  $ parseFromNative "Date" parseIsoDay
+                                  $ decodeUTF8 x
+    fromNative PS.Time x        = return
+                                  $ SqlLocalTimeOfDay
+                                  $ parseFromNative "TimeOfDay" parseIsoTimeOfDay
+                                  $ decodeUTF8 x
+    fromNative PS.Timestamp x   = return
+                                  $ SqlLocalTime
+                                  $ parseFromNative "LocalTime" parseIsoLocalTime
+                                  $ decodeUTF8 x
+    fromNative PS.TimestampTZ x = return
+                                  $ SqlUTCTime
+                                  $ zonedTimeToUTC
+                                  $ parseFromNative "UTCTime" parseIsoZonedTime
+                                  $ decodeUTF8 x
+    fromNative PS.Bit x         = return $ SqlBitField $ BitField $ parseBit x
+    fromNative PS.VarBit x      = return $ SqlBitField $ BitField $ parseBit x
+    fromNative PS.Numeric x     = return
+                                  $ SqlDecimal
+                                  $ parseFromNative "Decimal" (P.signed P.rational)
+                                  $ decodeUTF8 x
+    fromNative PS.Void _        = return $ SqlNull
+    fromNative PS.UUID x        = SqlUUID <$> case U.fromString uval of
+      Nothing -> throwIO $ SqlDriverError $ pgMsg $ "could not read " ++ uval ++ " as UUID"
+      Just  r -> return r
+      where
+        uval = TL.unpack $ decodeUTF8 x
+    fromNative _ x = return $ ftext x
+
+nativeToSqlValue b PQ.Binary f = binFromNative (o2b f) b
+  where
+    binFromNative PS.ByteA x = return $ SqlBlob x
+    binFromNative x _ = throwIO $ SqlDriverError $ pgMsg $ "Can not parse bytes (Binary result format) as " ++ show x
+
+parseDTBytes :: (ParseTime a) => String -> B.ByteString -> a
+parseDTBytes fmt dt = parseDTString fmt val
+  where
+    val = TL.unpack $ decodeUTF8 dt
+
+parseDTString :: (ParseTime a) => String -> String -> a
+parseDTString fmt val = case parseTime defaultTimeLocale fmt val of
+  Nothing -> throw $ SqlDriverError $ pgMsg $ "Could not parse " ++ val ++ " as Date/Time in format \"" ++ fmt ++ "\""
+  Just r  -> r
+
+
+-- | parse ByteString as `TimeOfDay`
+parseT :: B.ByteString -> TimeOfDay
+parseT = parseDTBytes "%H:%M:%S%Q"
+
+-- | parse ByteString as `LocalTime`
+parseDT :: B.ByteString -> LocalTime
+parseDT = parseDTBytes "%Y-%m-%d %H:%M:%S%Q"
+
+-- | parse ByteString as `Day`
+parseD :: B.ByteString -> Day
+parseD = parseDTBytes "%Y-%m-%d"
+
+-- | parse ByteString as `UTCTime`
+parseUTC :: B.ByteString -> UTCTime
+parseUTC u = parseDTString "%Y-%m-%d %H:%M:%S%Q%z" val
+  where
+    val = (TL.unpack $ decodeUTF8 u) ++ "00" -- strange Postgre behaviour
+
+-- | parse ByteString as 64 bit field (00101110) and convert to Word64
+parseBit :: B.ByteString -> Word64
+parseBit bt = foldl makeBit 0 $ zip [0..] $ take (bitSize (undefined :: Word64)) $ reverse val
+  where
+    makeBit l (n, '1') = setBit l n
+    makeBit l (_, '0') = l
+    makeBit _ _ = throw $ SqlDriverError $ pgMsg $ "Could not parse string \"" ++ val ++ "\" as bit field"
+    val = TL.unpack $ decodeUTF8 bt
+
+-- | get last error code and error message from connection and throw proper
+-- `SqlError`
+throwErrorMessage :: PQ.Connection -> IO a
+throwErrorMessage con = do
+  errm <- throwNoMessage =<< PQ.errorMessage con
+  throwIO $ SqlError "" $ TL.unpack $ decodeUTF8 errm
+
+
+-- | Throws appropriate SqlError when no `PQ.Result` is not given, or it is in
+-- wrong status
+getPGResult :: PQ.Connection -> Maybe PQ.Result -> IO PQ.Result
+getPGResult _ (Just x) = do
+  st <- PQ.resultStatus x
+  case st of
+    PQ.FatalError -> throwResultError x
+    PQ.EmptyQuery -> throwResultError x
+    PQ.BadResponse -> throwResultError x
+    _ -> return x
+getPGResult con Nothing = throwErrorMessage con
+
+-- | if Nothing throws error about no message
+throwNoMessage :: Maybe e -> IO e
+throwNoMessage Nothing = throwIO $ SqlDriverError $ pgMsg "Error has occured, but no error message received"
+throwNoMessage (Just e) = return e
+
+-- | Get error message from the result and throw it as 'SqlError'
+throwResultError :: PQ.Result -> IO a
+throwResultError res = do
+  errm <- throwNoMessage =<< PQ.resultErrorMessage res
+  ef <- throwNoMessage =<< PQ.resultErrorField res PQ.DiagSqlstate
+  throwIO $ SqlError (TL.unpack $ decodeUTF8 ef) (TL.unpack $ decodeUTF8 errm)
+
+
+-- | Establish new PostgreSQL connection
+connectPostgreSQL :: TL.Text -- ^ Connection string according to the documentation
+                  -> IO PostgreConnection
+connectPostgreSQL constr = do
+  con <- PQ.connectdb $ encodeUTF8 constr
+  st <- PQ.status con
+  case st of
+    PQ.ConnectionOk -> do
+      done <- PQ.setClientEncoding con "UTF8"
+      when (not done) $ throwErrorMessage con
+      ret <- PostgreConnection
+             <$> (newMVar $ Just con)
+             <*> newChildList
+             <*> (return constr)
+      runRaw ret "set timezone='utc'"
+      return ret
+    _ -> throwErrorMessage con
+
+-- | encode `TL.Text` in UTF8 encoding
+encodeUTF8 :: TL.Text -> B.ByteString
+encodeUTF8 = toByteString . fromLazyText
+
+
+decodeUTF8 :: B.ByteString -> TL.Text
+decodeUTF8 x = TL.decodeUtf8 $ BL.fromChunks [x]
+
+pgRun :: PostgreConnection -> Query -> [SqlValue] -> IO PQ.Result
+pgRun conn query values = withPGConnection conn $ \con -> do
+  r <- PQ.execParams con (buildSqlQuery query) binvals PQ.Text
+  getPGResult con r     -- Throwing error if failed
+  where
+    binvals = map sqlValueToNative values
+
+pgRunRaw :: PostgreConnection -> Query -> IO PQ.Result
+pgRunRaw conn query = withPGConnection conn $ \con -> do
+    r <- PQ.exec con $ buildSqlQuery query
+    getPGResult con r
+
+pgRunMany :: PostgreConnection -> Query -> [[SqlValue]] -> IO ()
+pgRunMany conn query values = withPGConnection conn $ \con -> do
+  forM_ values $ \val -> do
+    r <- PQ.execParams con binq (binv val) PQ.Text
+    res <- getPGResult con r
+    PQ.unsafeFreeResult res
+    return ()
+  where
+    binq = buildSqlQuery query
+    binv = map sqlValueToNative
+
+-- | add "hdbi-postgresql: " before an argument
+pgMsg :: String -> String
+pgMsg = ("hdbi-postgresql: " ++)
+
+-- | return the name of `PGStatementState` constructor
+pgstName :: PGStatementState -> String
+pgstName STNew = "New"
+pgstName (STExecuted {}) = "Executed"
+pgstName (STFetching {}) = "Fetching state"
+pgstName STFinished = "Finished"
+
+withPGSTNew :: PGStatementState -> IO a -> IO a
+withPGSTNew st action = case st of
+  STNew -> action
+  x -> throwIO $ SqlDriverError $ pgMsg $ "Statement is not in new state (" ++ (pgstName x) ++ ")"
+
+-- | get Result from `PGStatementState` if can. If can not throw an error with specified message
+pgstGetResult :: String -> PGStatementState -> PQ.Result
+pgstGetResult _ STExecuted { pgstResult = result } = result
+pgstGetResult _ STFetching { pgstResult = result } = result
+pgstGetResult msg st = throw $ SqlDriverError $ pgMsg $ msg ++ " (" ++ pgstName st ++ ")"
+
+-- | Perform result finishing and return `STFinished`
+doFinishStatement :: PGStatementState -> IO PGStatementState
+doFinishStatement st = case st of
+  STExecuted {pgstResult = r} -> _finish r
+  STFetching {pgstResult = r} -> _finish r
+  _ -> return STFinished
+  where
+    _finish res = do
+      PQ.unsafeFreeResult res
+      return STFinished
diff --git a/Database/HDBI/PostgreSQL/Parser.hs b/Database/HDBI/PostgreSQL/Parser.hs
new file mode 100644
--- /dev/null
+++ b/Database/HDBI/PostgreSQL/Parser.hs
@@ -0,0 +1,157 @@
+{-# LANGUAGE
+  OverloadedStrings
+  #-}
+
+{- |
+   Module     : Database.HDBI.PostgreSQL.Parser
+   Copyright  : Copyright (C) 2005-2013 John Goerzen
+   License    : BSD3
+
+   Maintainer : Aleksey Uymanov <s9gf4ult@gmail.com>
+   Stability  : experimental
+   Portability: portable
+-}
+
+module Database.HDBI.PostgreSQL.Parser
+       (
+         buildSqlQuery
+         -- * partial parsers
+       , qidentifier
+       , quoteLiteral
+       , dollarLiteral
+       , ccomment
+       , linecomment
+       , literal
+       ) where
+
+import Blaze.ByteString.Builder (toByteString)
+import Blaze.ByteString.Builder.Char.Utf8 (fromText, fromString)
+import Control.Applicative ((<$>), Alternative(..))
+import Control.Exception (throw)
+import Data.Attoparsec.Text.Lazy
+import Data.Monoid ((<>), mempty)
+import Database.HDBI.Types (Query(..), SqlError(..))
+import Prelude hiding (take)
+import qualified Data.ByteString as B
+import qualified Data.Text as T
+
+data ParseResult =
+  -- | copy Text to the result
+  PQuoteText T.Text
+  -- | copy String to the result
+  | PQuoteString String
+  -- | replace with series of $1 $2 $3 and so on
+  | PReplace
+  deriving (Show, Eq)
+
+normalText :: Parser [ParseResult]
+normalText = (:[]) . PQuoteText <$> takeWhile1 (not . (flip elem) ['\\', '?', '-', '/', '"', '\'', '$'])
+
+qmark :: Parser [ParseResult]
+qmark = (:[]) <$> ((char '?') >> (return PReplace))
+
+comment :: Parser [ParseResult]
+comment = linecomment <|> ccomment
+
+ccomment :: Parser [ParseResult]
+ccomment = (map PQuoteText) <$> (ccomment' <?> "Inline comment")
+  where
+    ccomment' :: Parser [T.Text]
+    ccomment' = do
+      _ <- string "/*"
+      c <- manyTill
+           (ccomment' <|> ((:[]) <$> take 1))
+           $ string "*/"
+      return $ ["/*"] ++ concat c ++ ["*/"]
+
+linecomment :: Parser [ParseResult]
+linecomment = linecomment' <?> "Line comment"
+  where
+    linecomment' = do
+      _ <- string "--"
+      c <- (manyTill anyChar (endOfLine <|> endOfInput)) <?> "Body of line comment"
+      return [PQuoteString "--", PQuoteString c, PQuoteString "\n"]
+
+qidentifier :: Parser [ParseResult]
+qidentifier = qidentifier' <?> "Quoted identifier parser"
+  where
+    qidentifier' = do
+      _ <- (char '"') <?> "First double quote"
+      res <- (scan False scanner) <?> "qidentifier body"
+      let quotes = T.count "\"" res
+      if quotes `mod` 2 == 0
+        then fail "the number of quotes must be even"
+        else return [PQuoteString "\"", PQuoteText res]
+
+    scanner False '"' = Just True
+    scanner False _ = Just False
+    scanner True '"' = Just False
+    scanner True _ = Nothing
+    
+literal :: Parser [ParseResult]
+literal = quoteLiteral <|> dollarLiteral
+
+data QLChar = BackQ
+            | Quote
+            | Other 
+
+quoteLiteral :: Parser [ParseResult]
+quoteLiteral = literal' <?> "Literal string parser"
+  where
+    literal' = do
+      _ <- char '\'' <?> "First quote"
+      res <- scan Other scanner
+      let quotes = T.count "'" res
+          bquotes = T.count "\\'" res
+      if (quotes - bquotes) `mod` 2 == 0
+        then fail "the number of quotes must be even"
+        else return [PQuoteString "'", PQuoteText res]
+
+    scanner Quote '\'' = Just Other
+    scanner Quote _ = Nothing
+    scanner BackQ _ = Just Other
+    scanner Other '\'' = Just Quote
+    scanner Other '\\' = Just BackQ
+    scanner Other _ = Just Other
+
+dollarLiteral :: Parser [ParseResult]
+dollarLiteral = dollarLiteral' <?> "Dollar quoted literal string parser"
+  where
+    dollarLiteral' = do
+      _ <- char '$'
+      tag <- tagParser <?> "Tag name parser"
+      _ <- char '$'
+      body <- (manyTill anyChar $ (char '$' >> string tag >> char '$')) <?> "Dollar quoted string body"
+      let prepost = [PQuoteString "$", PQuoteText tag, PQuoteString "$"]
+      return $ prepost ++ [PQuoteString body] ++ prepost
+
+    tagParser = do
+      ret <- takeTill (== '$')
+      case T.length ret of
+        0 -> return ret
+        _ -> if inClass ['0'..'9'] $ T.head ret
+             then fail "First character must not be digit"
+             else return ret
+      
+
+sqlParser :: Parser [ParseResult]
+sqlParser = concat <$> (many' $ choice [ normalText
+                                       , qmark
+                                       , comment
+                                       , qidentifier
+                                       , literal
+                                       , (:[]) . PQuoteString . (:[]) <$> anyChar
+                                       ])
+
+
+buildSqlQuery :: Query -> B.ByteString
+buildSqlQuery (Query q) = case eitherResult $ parse sqlParser q of
+  Left e -> throw $ SqlDriverError $ "postgresql query parser: " ++ e
+  Right r -> buildBS r
+
+buildBS :: [ParseResult] -> B.ByteString
+buildBS r = toByteString $ fst $ foldl bsr (mempty, 1 :: Integer) r
+  where
+    bsr (res, n) (PQuoteText t)   = (res <> fromText t, n)
+    bsr (res, n) (PQuoteString s) = (res <> fromString s, n)
+    bsr (res, n)  PReplace        = (res <> fromString ('$':show n), n+1)
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,27 @@
+Copyright (c) 2005-2011 John Goerzen
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice, this
+  list of conditions and the following disclaimer.
+
+* Redistributions in binary form must reproduce the above copyright notice, this
+  list of conditions and the following disclaimer in the documentation and/or
+  other materials provided with the distribution.
+
+* Neither the name of John Goerzen nor the names of its
+  contributors may be used to endorse or promote products derived from this
+  software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/hdbi-postgresql.cabal b/hdbi-postgresql.cabal
new file mode 100644
--- /dev/null
+++ b/hdbi-postgresql.cabal
@@ -0,0 +1,105 @@
+Name: hdbi-postgresql
+Version: 1.0.0
+License: BSD3
+Maintainer: Aleksey Uymanov <s9gf4ult@gmail.com>
+Author: John Goerzen
+Copyright: Copyright (c) 2005-2013 John Goerzen
+license-file: LICENSE
+homepage: https://github.com/s9gf4ult/hdbi-postgresql
+Category: Database
+synopsis: PostgreSQL driver for hdbi
+Description: This package provides a PostgreSQL driver for hdbi
+Stability: experimental
+
+Build-Type: Simple
+Cabal-Version: >=1.8
+
+source-repository head
+  type:     git
+  location: https://github.com/s9gf4ult/hdbi-postgresql.git
+
+Library
+  Exposed-Modules: Database.HDBI.PostgreSQL
+                 , Database.HDBI.PostgreSQL.Implementation
+                 , Database.HDBI.PostgreSQL.Parser
+  Build-Depends: base >= 3 && < 5
+               , attoparsec
+               , blaze-builder
+               , bytestring
+               , hdbi >= 1.0.0
+               , mtl
+               , old-locale
+               , postgresql-libpq
+               , postgresql-simple
+               , safe
+               , text
+               , time
+               , uuid
+
+  if impl(ghc >= 6.9)
+    Build-Depends: base >= 4
+  Ghc-Options: -Wall
+  ghc-prof-options: -auto-all
+
+
+test-suite runtests
+   type: exitcode-stdio-1.0
+   main-is: testsrc/runtests.hs
+   other-modules: Database.HDBI.PostgreSQL.Implementation
+                , Database.HDBI.PostgreSQL.Parser
+
+   ghc-options:   -Wall -fno-warn-orphans -main-is Runtests
+   build-depends:  base >= 3 && < 5
+                 , Decimal
+                 , HUnit
+                 , QuickCheck
+                 , attoparsec
+                 , blaze-builder
+                 , bytestring
+                 , containers
+                 , hdbi >= 1.0.0
+                 , ieee754
+                 , mtl
+                 , old-locale
+                 , postgresql-libpq
+                 , postgresql-simple
+                 , quickcheck-assertions
+                 , quickcheck-instances
+                 , safe
+                 , test-framework <= 0.7
+                 , test-framework-hunit
+                 , test-framework-quickcheck2
+                 , text
+                 , time
+                 , uuid
+
+
+test-suite puretests
+   type: exitcode-stdio-1.0
+   main-is: testsrc/puretests.hs
+   other-modules: Database.HDBI.PostgreSQL.Implementation
+                , Database.HDBI.PostgreSQL.Parser
+
+   ghc-options:   -Wall -fno-warn-orphans -main-is Puretests
+   build-depends:  base >= 3 && < 5
+                 , Decimal
+                 , HUnit
+                 , QuickCheck
+                 , attoparsec
+                 , blaze-builder
+                 , bytestring
+                 , derive
+                 , hdbi >= 1.0.0
+                 , mtl
+                 , old-locale
+                 , postgresql-libpq
+                 , postgresql-simple
+                 , quickcheck-assertions
+                 , quickcheck-instances
+                 , safe
+                 , test-framework <= 0.7
+                 , test-framework-hunit
+                 , test-framework-quickcheck2
+                 , text
+                 , time
+                 , uuid
diff --git a/testsrc/puretests.hs b/testsrc/puretests.hs
new file mode 100644
--- /dev/null
+++ b/testsrc/puretests.hs
@@ -0,0 +1,256 @@
+{-# LANGUAGE
+  OverloadedStrings
+, ScopedTypeVariables
+, FlexibleInstances
+, FlexibleContexts
+, TemplateHaskell
+  #-}
+
+module Puretests where
+
+import Blaze.ByteString.Builder (toByteString)
+import Blaze.ByteString.Builder.Char.Utf8 (fromString)
+import Control.Applicative
+import Data.Attoparsec.Text.Lazy
+import Data.Decimal
+import Data.Derive.Arbitrary
+import Data.DeriveTH
+import Data.List (intercalate, isInfixOf, mapAccumL, intersperse)
+import Data.Monoid (mconcat)
+import Data.UUID (UUID, fromWords)
+import Database.HDBI
+import Database.HDBI.PostgreSQL.Implementation
+import Database.HDBI.PostgreSQL.Parser
+import Test.Framework
+import Test.Framework.Providers.HUnit
+import Test.Framework.Providers.QuickCheck2
+import Test.HUnit (assertFailure, Assertion, (@?=))
+import Test.QuickCheck
+import Test.QuickCheck.Assertions
+import Test.QuickCheck.Instances ()
+import qualified Data.ByteString as B
+import qualified Data.Text.Lazy as TL
+import qualified Test.QuickCheck.Monadic as QM
+import qualified Test.QuickCheck.Property as QP
+
+instance Arbitrary (DecimalRaw Integer) where
+  arbitrary = Decimal <$> arbitrary <*> arbitrary
+
+instance Arbitrary UUID where
+  arbitrary = fromWords
+              <$> arbitrary
+              <*> arbitrary
+              <*> arbitrary
+              <*> arbitrary
+
+instance Arbitrary BitField where
+  arbitrary = BitField <$> arbitrary
+
+$( derive makeArbitrary ''SqlValue )
+
+isID :: (Eq a, Show a) => (a -> b) -> (b -> a) -> a -> QP.Result
+isID to from a = a ==? (from $ to a)
+
+sqlToNativeAndBack :: SqlValue -> Property
+sqlToNativeAndBack val = QM.monadicIO $ do
+  res <- QM.run $ do
+    let nat = sqlValueToNative val
+    case nat of
+      Nothing -> return SqlNull
+      Just (o, b, f) -> nativeToSqlValue b f o
+  QM.stop $ res ?== val
+
+convertionTests :: Test
+convertionTests = testGroup "Can convert to and back"
+                  [testProperty "SqlValue" sqlToNativeAndBack]
+
+parseToLeft :: (Show a) => Parser a -> TL.Text -> Assertion
+parseToLeft p t = case eitherResult $ parse p t of
+  Left _ -> return ()
+  Right r -> assertFailure $ "string " ++ (show t) ++ " parsed to " ++ show r
+
+formatParseFail :: String        -- ^ Initial string
+                   -> [String]   -- ^ context
+                   -> String     -- ^ error message
+                   -> String
+formatParseFail s cts err = "string " ++ (show s)
+                            ++ "\ncontext: " ++ (intercalate ", " cts)
+                            ++ "\nerror: " ++ err
+
+parseToRight :: Parser a -> TL.Text -> Assertion
+parseToRight p t = case parse p t of
+  Fail _ cts err -> assertFailure $ formatParseFail (TL.unpack t) cts err
+  Done _ _ -> return ()
+
+testParseQidentifier :: Assertion
+testParseQidentifier = do
+  parseToRight qidentifier "\"hello\""
+  parseToRight qidentifier "\" efs a \""
+  parseToRight qidentifier "\"\""
+  parseToRight qidentifier "\"jas\"\"jas\"\"\""
+  parseToRight qidentifier "\"\"\"\""
+  parseToLeft qidentifier " asdf \""
+  parseToLeft qidentifier "\" ijasdf "
+  parseToLeft qidentifier "\"ja\"\""
+
+testQuoteLiteral :: Assertion
+testQuoteLiteral = do
+  parseToRight quoteLiteral "''"
+  parseToRight quoteLiteral "'aije'"
+  parseToRight quoteLiteral "' asdf '''"
+  parseToRight quoteLiteral "' asdfij \\''"
+  parseToRight quoteLiteral "'\\'''''\\'\\''''"
+  parseToRight quoteLiteral "''' asidfj '''"
+  parseToRight quoteLiteral "'afe\\\\s''fa'"
+  parseToLeft quoteLiteral "adf'"    -- started not from quote
+  parseToLeft quoteLiteral "'aijfa\\'" -- no end quote
+  parseToLeft quoteLiteral "'ssd''"
+
+testDollarLiteral :: Assertion
+testDollarLiteral = do
+  parseToRight dollarLiteral "$$$$"
+  parseToRight dollarLiteral "$tag$$tag$"
+  parseToRight dollarLiteral "$asdf$\"jiasd$$f 'j ija\"$asdf$"
+  parseToRight dollarLiteral "$tag$$$$$$ajs$$$tag$"
+  parseToLeft dollarLiteral "$a$jaisdj$$" -- tag mismatch
+  parseToLeft dollarLiteral "$a$ aisj\\$a $"
+  parseToLeft dollarLiteral "$4sf$hello$4sf$" -- tag started with digit
+
+testInlineComment :: Assertion
+testInlineComment = do
+  parseToRight ccomment "/**/"
+  parseToRight ccomment "/* asdf */"
+  parseToRight ccomment "/*ja e /* jasd */*/" -- inlined comment
+  parseToRight ccomment "/* ij/ * iajef */"
+  parseToRight ccomment "/*/*/**/*/*/"
+  parseToLeft ccomment " jae */" -- no start /*
+  parseToLeft ccomment "/* asdf " -- no end */
+
+testLineComment :: Assertion
+testLineComment = do
+  parseToRight linecomment "--"
+  parseToRight linecomment "-- jijasdf "
+  parseToRight linecomment "-- jasdf sj\n"
+  parseToLeft linecomment "a-- jasd" -- not started from --
+
+buildsTo :: Query -> B.ByteString -> Assertion
+buildsTo q res = (buildSqlQuery q) @?= res
+
+testQueryBuilder :: Assertion
+testQueryBuilder = do
+  buildsTo "\"hello?\" ?"
+    "\"hello?\" $1"
+  buildsTo "'?', ?" "'?', $1"
+  buildsTo "select \"a?\\?\"\"?\" from \"?\"\" \" where fld = ? and ff = 'con?t''' ?"
+    "select \"a?\\?\"\"?\" from \"?\"\" \" where fld = $1 and ff = 'con?t''' $2"
+
+parserTests :: Test
+parserTests = testGroup "Parser tests"
+              [ testCase "qidentifier parser" testParseQidentifier
+              , testCase "quote literal string parser" testQuoteLiteral
+              , testCase "dollar literal string parser" testDollarLiteral
+              , testCase "inline comment parser" testInlineComment
+              , testCase "line comment parser" testLineComment
+              , testCase "complex query builder test" testQueryBuilder
+              ]
+
+alphabet :: [String]
+alphabet = (map (:[]) "qwertyuiop[]asdfghjklzxcvbnm,. ?") ++ ["- "]
+
+parseRightProperty :: Parser a -> String -> QP.Result
+parseRightProperty p s = case parse p $ TL.pack s of
+  Done _ _        -> QP.succeeded
+  Fail _ cont err -> QP.failed {QP.reason = formatParseFail s cont err}
+
+quoteLiteralGen :: Gen String
+quoteLiteralGen = do
+  r <- listOf $ elements $ ["''", "\\'"] ++ alphabet
+  return $ "'" ++ concat r ++ "'"
+
+dollarLiteralGen :: Gen String
+dollarLiteralGen = do
+  tag <- concat <$> (listOf $ elements $ alphabet ++ ["''", "\\'", "\"", "\\\"", "\"\""])
+  let quotes = "$" ++ tag ++ "$"
+  body <- suchThat (concat <$> (listOf
+                                $ elements
+                                $ alphabet ++ ["$", "''", "\\'", "\"", "\\\"", "\"\""]))
+          $ not . (isInfixOf quotes) . (++ "$")
+  return $ quotes ++ body ++ quotes
+
+
+qidentifierGen :: Gen String
+qidentifierGen = do
+  body <- concat <$> (listOf $ elements $ alphabet ++ ["'", "\\'", "\"\"", "$"])
+  return $ "\"" ++ body ++ "\""
+
+inlineCommentGen :: Gen String
+inlineCommentGen = do
+  body <- oneof
+          [ inlineCommentGen
+          , concat <$> (listOf $ elements $ alphabet)
+          ]
+  return $ "/*" ++ body ++ "*/"
+
+lineCommentGen :: Gen String
+lineCommentGen = do
+  body <- concat <$> (listOf $ elements alphabet)
+  end <- elements ["", "\n"]
+  return $ "--" ++ body ++ end
+
+parameterPlaceholderGen :: Gen String
+parameterPlaceholderGen = do
+  (v :: Int) <- getPositive <$> arbitrary
+  return $ "$" ++ (show v)
+
+data GenS = GenQ String         -- ^ Generate string as is
+          | GenR                -- ^ Generate $1, $2 sequence in this place
+
+generateQueryPiece :: Gen (String, GenS) -- initial string and the result
+generateQueryPiece = oneof
+                     [ quote quoteLiteralGen
+                     , quote dollarLiteralGen
+                     , quote qidentifierGen
+                     , quote inlineCommentGen
+                     , quote parameterPlaceholderGen
+                     , quote ((++ "\n") <$> lineCommentGen)
+                     -- , quote $ return "\\?"
+                     , return ("?", GenR)
+                     ]
+  where
+    quote p = do
+      r <- p
+      return (r, GenQ r)
+
+pieceToResult :: [(String, GenS)] -> [(String, String)]
+pieceToResult p = snd $ mapAccumL accl 1 p
+  where
+    accl acc (x, GenQ y) = (acc, (x, y))
+    accl acc (x, GenR)   = (acc+1, (x, "$" ++ show acc))
+
+fullQueryGen :: Gen (Query, B.ByteString)
+fullQueryGen = do
+  (q, res) <- unzip . (intersperse (" ", " ")) . pieceToResult <$> (listOf generateQueryPiece)
+  return $ (Query $ TL.pack $ concat q, toByteString $ mconcat $ map fromString res)
+
+checkFullQueryGen :: (Query, B.ByteString) -> QP.Result
+checkFullQueryGen (q, res) = (buildSqlQuery q) ?== res
+    
+
+parserProperties :: Test
+parserProperties = testGroup "Parser properties"
+                   [ testProperty "literal" $ forAll quoteLiteralGen $ parseRightProperty literal
+                   , testProperty "dollar literal" $ forAll dollarLiteralGen $ parseRightProperty dollarLiteral
+                   , testProperty "qidentifier" $ forAll qidentifierGen $ parseRightProperty qidentifier
+                   , testProperty "inline comment" $ forAll inlineCommentGen $ parseRightProperty ccomment
+                   , testProperty "line comment" $ forAll lineCommentGen $ parseRightProperty linecomment
+                   , testProperty "whole parser" $ forAll fullQueryGen checkFullQueryGen
+                   ]
+
+
+
+
+main :: IO ()
+main = defaultMain [ convertionTests
+                   , parserTests
+                   , parserProperties
+                   ]
diff --git a/testsrc/runtests.hs b/testsrc/runtests.hs
new file mode 100644
--- /dev/null
+++ b/testsrc/runtests.hs
@@ -0,0 +1,236 @@
+{-# LANGUAGE
+  OverloadedStrings
+, ScopedTypeVariables
+, FlexibleInstances
+, FlexibleContexts
+  #-}
+
+module Runtests where
+
+import Control.Applicative
+import Data.AEq
+import Data.Decimal
+import Data.Fixed
+import Data.Int
+import Data.List
+import Data.Monoid
+import Data.Time
+import Data.UUID
+import Data.Word
+import Database.HDBI
+import Database.HDBI.PostgreSQL
+import System.Environment
+import System.Exit
+import Test.Framework
+import Test.Framework.Providers.HUnit
+import Test.Framework.Providers.QuickCheck2
+import Test.HUnit ((@?=), Assertion)
+import Test.QuickCheck
+import Test.QuickCheck.Assertions
+import Test.QuickCheck.Instances ()
+import qualified Data.ByteString as B
+import qualified Data.Set as S
+import qualified Data.Text.Lazy as TL
+import qualified Test.QuickCheck.Monadic as QM
+
+
+instance Arbitrary (DecimalRaw Integer) where
+  arbitrary = Decimal <$> arbitrary <*> arbitrary
+
+instance Arbitrary UUID where
+  arbitrary = fromWords
+              <$> arbitrary
+              <*> arbitrary
+              <*> arbitrary
+              <*> arbitrary
+
+runInsertSelect :: (FromSql a, ToSql a) => PostgreConnection -> Query -> a -> IO a
+runInsertSelect conn tname val = withTransaction conn $ do
+      runRaw conn "drop table if exists table1"
+      runRaw conn $ "create table table1 (val " <> tname <> ")"
+      run conn "insert into table1 (val) values (?)" [toSql val]
+      s <- prepare conn "select val from table1"
+      executeRaw s
+      (Just [res])<- fetchRow s
+      finish s
+      return $ fromSql res
+
+runInsertMany :: PostgreConnection -> [String] -> [[SqlValue]] -> IO [[SqlValue]]
+runInsertMany conn types values = withTransaction conn $ do
+  runRaw conn "drop table if exists table1"
+  runRaw conn $ pk $ "create table table1 (" ++ valnames ++ ")"
+  s <- prepare conn $ pk $ "insert into table1(" ++ colnames ++ ") values (" ++ (intersperse ',' $ replicate (length names) '?') ++")"
+  executeMany s values
+  finish s
+  s2 <- prepare conn $ pk $ "select " ++ colnames ++ " from table1"
+  executeRaw s2
+  fetchAllRows s2
+  
+  where
+    pk = Query . TL.pack
+    names = map (("val"++) . show) [1..length types]
+    colnames = intercalate "," names
+    valnames = intercalate "," $ map (\(a, b) -> a ++ " " ++ b) $ zip names types
+
+setsEqual :: PostgreConnection -> [String] -> [[SqlValue]] -> Property
+setsEqual conn types values = QM.monadicIO $ do
+  ret <- QM.run $ runInsertMany conn types values
+  QM.stop $ (S.fromList values) ==? (S.fromList ret)
+  
+preciseEqual :: (Eq a, Show a, FromSql a, ToSql a) => PostgreConnection -> Query -> a -> Property
+preciseEqual conn tname val = QM.monadicIO $ do
+  res <- QM.run $ runInsertSelect conn tname val
+  QM.stop $ res ?== val
+
+
+approxEqual :: (Show a, AEq a, FromSql a, ToSql a) => PostgreConnection -> Query -> a -> Property
+approxEqual conn tname val = QM.monadicIO $ do
+  res <- QM.run $ runInsertSelect conn tname val
+  QM.stop $ res ?~== val
+
+genTOD :: Gen TimeOfDay
+genTOD = roundTod <$> arbitrary
+
+genLT :: Gen LocalTime
+genLT = rnd <$> arbitrary
+  where
+    rnd x@(LocalTime {localTimeOfDay = t}) = x {localTimeOfDay = roundTod t}
+
+-- | Generate Text without 'NUL' symbols
+genText :: Gen TL.Text
+genText = TL.filter fltr <$> arbitrary
+  where
+    fltr '\NUL' = False         -- NULL truncates C string when pass to libpq binding.
+    fltr _ = True
+
+genUTC :: Gen UTCTime
+genUTC = rnd <$> arbitrary
+  where
+    rnd x@(UTCTime {utctDayTime = d}) = x {utctDayTime = anyToMicro d}
+
+
+-- | Strip TimeOfDay to microsecond precision
+roundTod :: TimeOfDay -> TimeOfDay
+roundTod x@(TimeOfDay {todSec = s}) = x {todSec = anyToMicro s}
+
+anyToMicro :: (Fractional b, Real a) => a -> b
+anyToMicro a = fromRational $ toRational ((fromRational $ toRational a) :: Micro)
+
+testG1 :: PostgreConnection -> Test
+testG1 c = testGroup "Can insert and select"
+           [ testProperty "Decimal" $ \(d :: Decimal) -> preciseEqual c "decimal(400,255)" d
+           , testProperty "Int32" $ \(i :: Int32) -> preciseEqual c "integer" i
+           , testProperty "Int64" $ \(i :: Int64) -> preciseEqual c "bigint"  i
+           , testProperty "Integer" $ \(i :: Integer) -> preciseEqual c "decimal(100,0)" i
+           , testProperty "Double" $ \(d :: Double) -> approxEqual c "double precision" d
+           , testProperty "Text" $ forAll genText $ \(t :: TL.Text) -> preciseEqual c "text" t
+           , testProperty "ByteString" $ \(b :: B.ByteString) -> preciseEqual c "bytea" b
+           , testProperty "Bool" $ \(b :: Bool) -> preciseEqual c "boolean" b
+           , testProperty "UUID" $ \(u :: UUID) -> preciseEqual c "uuid" u
+           , testProperty "BitField" $ \(w :: Word64) -> preciseEqual c "varbit" (BitField w)
+           , testProperty "UTCTime" $ forAll genUTC $ \(u :: UTCTime) -> preciseEqual c "timestamp with time zone" u
+           , testProperty "Day" $ \(d :: Day) -> preciseEqual c "date" d
+           , testProperty "TimeOfDay" $ forAll genTOD $ \(tod :: TimeOfDay) -> preciseEqual c "time" tod
+           , testProperty "LocalTime" $ forAll genLT $ \(lt :: LocalTime) -> preciseEqual c "timestamp without time zone" lt
+           , testProperty "Null" $ preciseEqual c "integer" SqlNull
+           , testProperty "Maybe Integer" $ \(val :: Maybe Integer) -> preciseEqual c "decimal(100,0)" val
+           , testProperty "Maybe ByteString" $ \(val :: Maybe B.ByteString) -> preciseEqual c "bytea" val
+           , testProperty "Insert many numbers" $ \(x :: [(Integer, Decimal)]) -> setsEqual c
+                                                                          ["decimal(100,0)", "decimal(400,255)"]
+                                                                          $ map (\(i, d) ->  [toSql i, toSql d]) x
+           , testProperty "Insert many text" $ \(x :: [(Maybe Integer, UUID, Maybe B.ByteString)]) -> setsEqual c
+                                                                                                      ["decimal(100,0)", "text", "bytea"]
+                                                                                                      $ map (\(i, u, b) ->  [toSql i, toSql u, toSql b]) x
+           ]
+
+testAffectedRows :: PostgreConnection -> [Int32] -> Property
+testAffectedRows c is = QM.monadicIO $ do
+  res <- QM.run $ withTransaction c $ do
+    runRaw c "drop table if exists table1"
+    runRaw c "create table table1 (val bigint)"
+    runMany c "insert into table1(val) values (?)" $ map ((:[]) . toSql) is
+
+    s2 <- prepare c "update table1 set val=10"
+    executeRaw s2
+    res <- affectedRows s2
+    finish s2
+  
+    return res
+  QM.stop $ res ?== (genericLength is)
+           
+testG2 :: PostgreConnection -> Test
+testG2 c = testGroup "Auxiliary functions"
+           [ testProperty "affectedRows" $ testAffectedRows c ]
+
+
+stmtStatus :: PostgreConnection -> Assertion
+stmtStatus c = do
+  runRaw c "drop table table1"
+  runRaw c "create table table1 (val bigint)" -- Just for postgre 9
+  s <- prepare c "select * from table1"
+  statementStatus s >>= (@?= StatementNew)
+  executeRaw s
+  statementStatus s >>= (@?= StatementExecuted)
+  _ <- fetchRow s
+  statementStatus s >>= (@?= StatementFetched)
+  finish s
+  statementStatus s >>= (@?= StatementFinished)
+  reset s
+  statementStatus s >>= (@?= StatementNew)
+
+inTransactionStatus :: PostgreConnection -> Assertion
+inTransactionStatus c = do
+  inTransaction c >>= (@?= False)
+  withTransaction c $ do
+    inTransaction c >>= (@?= True)
+
+connStatusGood :: PostgreConnection -> Assertion
+connStatusGood c = connStatus c >>= (@?= ConnOK)
+
+connClone :: PostgreConnection -> Assertion
+connClone c = do
+  newc <- clone c
+  connStatus newc >>= (@?= ConnOK)
+  withTransaction newc $ inTransaction c >>= (@?= False)
+  withTransaction c $ inTransaction newc >>= (@?= False)
+  disconnect newc
+  connStatus newc >>= (@?= ConnDisconnected)
+
+checkColumnNames :: PostgreConnection -> Assertion
+checkColumnNames c = do
+  withTransaction c $ do
+    runRaw c "drop table if exists table1"
+    runRaw c "create table table1 (val1 bigint, val2 bigint, val3 bigint)"
+    s <- prepare c "select val1, val2, val3 from table1"
+    executeRaw s
+    getColumnNames s >>= (@?= ["val1", "val2", "val3"])
+    getColumnsCount s >>= (@?= 3)
+    finish s
+  
+testG3 :: PostgreConnection -> Test
+testG3 c = testGroup "Fixed tests"
+           [ testCase "Statement status" $ stmtStatus c
+           , testCase "inTransaction return right value" $ inTransactionStatus c
+           , testCase "Connection status is good" $ connStatusGood c
+           , testCase "Connection clone works" $ connClone c
+           , testCase "Check driver name" $ hdbiDriverName c @?= "postgresql"
+           , testCase "Check transaction support" $ dbTransactionSupport c @?= True
+           , testCase "Check right column names" $ checkColumnNames c
+           ]
+
+main :: IO ()
+main = do
+  a <- getArgs
+  case a of
+    (conn:args) -> do
+      c <- connectPostgreSQL $ TL.pack conn
+      (flip defaultMainWithArgs) args [ testG1 c
+                                      , testG2 c
+                                      , testG3 c
+                                      ]
+      disconnect c
+
+    _ -> do
+      mapM_ putStrLn [ "Need at least one argument as connection string"
+                     , "the rest will be passed as arguments to test-framework"]
+      exitWith $ ExitFailure 1