selda-postgresql 0.1.2.2 → 0.1.3.0
raw patch · 3 files changed
+88/−43 lines, 3 filesdep ~selda
Dependency ranges changed: selda
Files
- selda-postgresql.cabal +4/−2
- src/Database/Selda/PostgreSQL.hs +3/−41
- src/Database/Selda/PostgreSQL/Encoding.hs +81/−0
selda-postgresql.cabal view
@@ -1,5 +1,5 @@ name: selda-postgresql-version: 0.1.2.2+version: 0.1.3.0 synopsis: PostgreSQL backend for the Selda database EDSL. description: PostgreSQL backend for the Selda database EDSL. Requires the PostgreSQL @libpq@ development libraries to be@@ -20,6 +20,8 @@ library exposed-modules: Database.Selda.PostgreSQL+ other-modules:+ Database.Selda.PostgreSQL.Encoding other-extensions: GADTs RecordWildCards@@ -28,7 +30,7 @@ build-depends: base >=4.8 && <5 , exceptions >=0.8 && <0.9- , selda >=0.1.4.1 && <0.2+ , selda >=0.1.5.0 && <0.2 , text >=1.0 && <1.3 if !flag(haste) build-depends:
src/Database/Selda/PostgreSQL.hs view
@@ -13,6 +13,7 @@ import Control.Monad.Catch #ifndef __HASTE__+import Database.Selda.PostgreSQL.Encoding import Database.PostgreSQL.LibPQ hiding (user, pass, db, host) import qualified Data.ByteString.Char8 as BS #endif@@ -136,7 +137,7 @@ q' | return_lastid = q <> " RETURNING LASTVAL();" | otherwise = q - getLastId res = (read . BS.unpack . maybe "" id) <$> getvalue res 0 0+ getLastId res = (readInt . maybe "0" id) <$> getvalue res 0 0 getRows res = do rows <- ntuples res@@ -146,7 +147,7 @@ result <- mapM (getRow res types cols) [0..rows-1] pure $ case affected of Just "" -> (0, result)- Just s -> (read $ BS.unpack s, result)+ Just s -> (readInt s, result) _ -> (0, result) getRow res types cols row = do@@ -158,35 +159,6 @@ Just val -> pure $ toSqlValue t val _ -> pure SqlNull --- | Convert the given postgres return value and type to an @SqlValue@.--- TODO: use binary format instead of text.-toSqlValue :: Oid -> BS.ByteString -> SqlValue-toSqlValue t val- | t == boolType = SqlBool $ readBool val- | t == intType = SqlInt $ read (BS.unpack val)- | t == doubleType = SqlFloat $ read (BS.unpack val)- | t `elem` textish = SqlString (decodeUtf8 val)- | otherwise = error $ "BUG: result with unknown type oid: " ++ show t- where- textish = [textType, timestampType, timeType, dateType]- readBool "f" = False- readBool "0" = False- readBool "0.0" = False- readBool "F" = False- readBool _ = True---- | Convert a parameter into an postgres parameter triple.-fromSqlValue :: Lit a -> Maybe (Oid, BS.ByteString, Format)-fromSqlValue (LitB b) = Just (boolType, if b then "true" else "false", Text)-fromSqlValue (LitI n) = Just (intType, BS.pack $ show n, Text)-fromSqlValue (LitD f) = Just (doubleType, BS.pack $ show f, Text)-fromSqlValue (LitS s) = Just (textType, encodeUtf8 s, Text)-fromSqlValue (LitTS s) = Just (timestampType, encodeUtf8 s, Text)-fromSqlValue (LitTime s) = Just (timeType, encodeUtf8 s, Text)-fromSqlValue (LitDate s) = Just (dateType, encodeUtf8 s, Text)-fromSqlValue (LitNull) = Nothing-fromSqlValue (LitJust x) = fromSqlValue x- -- | Custom column types for postgres: auto-incrementing primary keys need to -- be @BIGSERIAL@, and ints need to be @INT8@. pgColType :: T.Text -> [ColAttr] -> Maybe T.Text@@ -201,14 +173,4 @@ Just $ T.unwords ("TIMESTAMP" : map compileColAttr attrs) pgColType _ _ = Nothing---- | OIDs for all types used by Selda.-boolType, intType, textType, doubleType, dateType, timeType, timestampType :: Oid-boolType = Oid 16-intType = Oid 20-textType = Oid 25-doubleType = Oid 701-dateType = Oid 1082-timeType = Oid 1083-timestampType = Oid 1114 #endif
+ src/Database/Selda/PostgreSQL/Encoding.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE GADTs, BangPatterns, OverloadedStrings #-}+-- | Encoding/decoding for PostgreSQL.+module Database.Selda.PostgreSQL.Encoding+ ( toSqlValue, fromSqlValue+ , readInt+ ) where+import qualified Data.ByteString as BS+import Data.ByteString.Builder+import Data.ByteString.Char8 (unpack)+import qualified Data.ByteString.Lazy as LBS+import Data.Text.Encoding+import Database.PostgreSQL.LibPQ (Oid (..), Format (..))+import Database.Selda.Backend (Lit (..), SqlValue (..))+import Unsafe.Coerce++-- | OIDs for all types used by Selda.+boolType, intType, textType, doubleType, dateType, timeType, timestampType :: Oid+boolType = Oid 16+intType = Oid 20+textType = Oid 25+doubleType = Oid 701+dateType = Oid 1082+timeType = Oid 1083+timestampType = Oid 1114++-- | Convert a parameter into an postgres parameter triple.+fromSqlValue :: Lit a -> Maybe (Oid, BS.ByteString, Format)+fromSqlValue (LBool b) = Just (boolType, toBS $ if b then word8 1 else word8 0, Binary)+fromSqlValue (LInt n) = Just (intType, toBS $ int64BE (fromIntegral n), Binary)+fromSqlValue (LDouble f) = Just (doubleType, toBS $ int64BE (unsafeCoerce f), Binary)+fromSqlValue (LText s) = Just (textType, encodeUtf8 s, Text)+fromSqlValue (LDateTime s) = Just (timestampType, encodeUtf8 s, Text)+fromSqlValue (LTime s) = Just (timeType, encodeUtf8 s, Text)+fromSqlValue (LDate s) = Just (dateType, encodeUtf8 s, Text)+fromSqlValue (LNull) = Nothing+fromSqlValue (LJust x) = fromSqlValue x++-- | Convert the given postgres return value and type to an @SqlValue@.+toSqlValue :: Oid -> BS.ByteString -> SqlValue+toSqlValue t val+ | t == boolType = SqlBool $ readBool val+ | t == intType = SqlInt $ readInt val+ | t == doubleType = SqlFloat $ read (unpack val)+ | t `elem` textish = SqlString (decodeUtf8 val)+ | otherwise = error $ "BUG: result with unknown type oid: " ++ show t+ where+ textish = [textType, timestampType, timeType, dateType]+ readBool "f" = False+ readBool "0" = False+ readBool "false" = False+ readBool "n" = False+ readBool "no" = False+ readBool "off" = False+ readBool _ = True++-- | Read an integer from a strict bytestring.+-- Assumes that the bytestring does, in fact, contain an integer.+readInt :: BS.ByteString -> Int+readInt s+ | BS.head s == asciiDash = negate $! go 1 0+ | otherwise = go 0 0+ where+ !len = BS.length s+ !asciiZero = 48+ !asciiDash = 45+ go !i !acc+ | len > i = go (i+1) (acc * 10 + fromIntegral (BS.index s i - asciiZero))+ | otherwise = acc++-- | Reify a builder to a strict bytestring.+toBS :: Builder -> BS.ByteString+toBS = unChunk . toLazyByteString++-- | Convert a lazy bytestring to a strict one.+-- Avoids the copying overhead of 'LBS.toStrict' when there's only a single+-- chunk, which should always be the case when serializing single parameters.+unChunk :: LBS.ByteString -> BS.ByteString+unChunk bs =+ case LBS.toChunks bs of+ [bs'] -> bs'+ bss -> BS.concat bss