diff --git a/Database/Groundhog/Sqlite.hs b/Database/Groundhog/Sqlite.hs --- a/Database/Groundhog/Sqlite.hs +++ b/Database/Groundhog/Sqlite.hs @@ -32,6 +32,7 @@ import qualified Data.HashMap.Strict as Map import Data.Maybe (maybeToList) import Data.Conduit.Pool +import qualified Data.Text as T import GHC.Exts (inline) @@ -308,7 +309,6 @@ ] {-# SPECIALIZE insert' :: PersistEntity v => v -> DbPersist Sqlite IO (AutoKey v) #-} -{-# INLINE insert' #-} insert' :: (PersistEntity v, MonadBaseControl IO m, MonadIO m) => v -> DbPersist Sqlite m (AutoKey v) insert' v = do -- constructor number and the rest of the field values @@ -386,15 +386,15 @@ go i (x:xs) = do case x of PersistInt64 int64 -> S.bindInt64 stmt i int64 - PersistString text -> S.bindText stmt i text + PersistString text -> S.bindText stmt i $ T.pack text PersistDouble double -> S.bindDouble stmt i double PersistBool b -> S.bindInt64 stmt i $ if b then 1 else 0 PersistByteString blob -> S.bindBlob stmt i blob PersistNull -> S.bindNull stmt i - PersistDay d -> S.bindText stmt i $ show d - PersistTimeOfDay d -> S.bindText stmt i $ show d - PersistUTCTime d -> S.bindText stmt i $ show d - PersistZonedTime (ZT d)-> S.bindText stmt i $ show d + PersistDay d -> S.bindText stmt i $ T.pack $ show d + PersistTimeOfDay d -> S.bindText stmt i $ T.pack $ show d + PersistUTCTime d -> S.bindText stmt i $ T.pack $ show d + PersistZonedTime (ZT d)-> S.bindText stmt i $ T.pack $ show d go (i + 1) xs executeRaw' :: (MonadBaseControl IO m, MonadIO m) => Utf8 -> [PersistValue] -> DbPersist Sqlite m () @@ -473,7 +473,7 @@ pFromSql :: S.SQLData -> PersistValue pFromSql (S.SQLInteger i) = PersistInt64 i pFromSql (S.SQLFloat i) = PersistDouble i -pFromSql (S.SQLText s) = PersistString s +pFromSql (S.SQLText s) = PersistString (T.unpack s) pFromSql (S.SQLBlob bs) = PersistByteString bs pFromSql (S.SQLNull) = PersistNull diff --git a/Database/Sqlite.hs b/Database/Sqlite.hs --- a/Database/Sqlite.hs +++ b/Database/Sqlite.hs @@ -21,6 +21,8 @@ step, reset, finalize, + bindParameterCount, + bindParameterName, bindBlob, bindDouble, bindInt, @@ -36,7 +38,8 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Internal as BSI -import qualified Data.ByteString.UTF8 as UTF8 +import qualified Data.Text as T +import qualified Data.Text.Encoding as T import Data.Typeable import Foreign import Foreign.C @@ -65,7 +68,7 @@ data SQLData = SQLInteger Int64 | SQLFloat Double - | SQLText String + | SQLText T.Text | SQLBlob BS.ByteString | SQLNull deriving (Eq, Show, Typeable) @@ -117,7 +120,7 @@ errmsg (Database database) = do message <- errmsgC database byteString <- BS.packCString message - return $ UTF8.toString byteString + return $ T.unpack $ T.decodeUtf8 byteString sqlError :: Maybe Database -> String -> Error -> IO a sqlError maybeDatabase functionName err = do @@ -134,7 +137,7 @@ openC :: CString -> Ptr (Ptr ()) -> IO Int openError :: String -> IO (Either Database Error) openError path = do - BS.useAsCString (UTF8.fromString path) + BS.useAsCString (T.encodeUtf8 $ T.pack path) (\pathC -> do alloca (\databaseC -> do err <- openC pathC databaseC @@ -213,6 +216,33 @@ then return () else sqlError (Just database) "finalize" err +foreign import ccall "sqlite3_bind_parameter_count" + bindParameterCountC :: Ptr () -> IO Int + +-- | Find the number SQL parameters in a prepared statement. +bindParameterCount :: Statement -> IO Int +bindParameterCount (Statement stmt _) = do + bindParameterCountC stmt + +maybeNullCString :: CString -> IO (Maybe BS.ByteString) +maybeNullCString s = + if s == nullPtr then return Nothing else fmap Just (BS.packCString s) + +foreign import ccall "sqlite3_bind_parameter_name" + bindParameterNameC :: Ptr () -> Int -> IO CString + +-- | Return the N-th SQL parameter name. +-- +-- Named parameters are returned as-is. E.g. \":v\" is returned as +-- @Just \":v\"@. Unnamed parameters, however, are converted to +-- @Nothing@. +-- +-- Note that the column index starts at 1, not 0. +bindParameterName :: Statement -> Int -> IO (Maybe String) +bindParameterName (Statement stmt _) colNdx = do + mn <- bindParameterNameC stmt colNdx >>= maybeNullCString + return (mn >>= return . T.unpack . T.decodeUtf8) + foreign import ccall "sqlite3_bind_blob" bindBlobC :: Ptr () -> Int -> Ptr () -> Int -> Ptr () -> IO Int bindBlob :: Statement -> Int -> BS.ByteString -> IO () @@ -265,9 +295,9 @@ foreign import ccall "sqlite3_bind_text" bindTextC :: Ptr () -> Int -> CString -> Int -> Ptr () -> IO Int -bindText :: Statement -> Int -> String -> IO () +bindText :: Statement -> Int -> T.Text -> IO () bindText (Statement statement database) parameterIndex text = do - byteString <- return $ UTF8.fromString text + byteString <- return $ T.encodeUtf8 text size <- return $ BS.length byteString err <- BS.useAsCString byteString (\dataC -> do @@ -325,11 +355,11 @@ foreign import ccall "sqlite3_column_text" columnTextC :: Ptr () -> Int -> IO CString -columnText :: Statement -> Int -> IO String +columnText :: Statement -> Int -> IO T.Text columnText (Statement statement _) columnIndex = do text <- columnTextC statement columnIndex byteString <- BS.packCString text - return $ UTF8.toString byteString + return $ T.decodeUtf8 byteString foreign import ccall "sqlite3_column_count" columnCountC :: Ptr () -> IO Int diff --git a/groundhog-sqlite.cabal b/groundhog-sqlite.cabal --- a/groundhog-sqlite.cabal +++ b/groundhog-sqlite.cabal @@ -1,5 +1,5 @@ name: groundhog-sqlite -version: 0.1.0.1 +version: 0.1.0.2 license: BSD3 license-file: LICENSE author: Boris Lykah @@ -17,12 +17,12 @@ library build-depends: base >= 4 && < 5 - , bytestring >= 0.9.1 && < 0.10 + , bytestring >= 0.9 , transformers >= 0.2.1 && < 0.4 , groundhog >= 0.1.0 && < 0.2.0 , monad-control >= 0.3 && < 0.4 , containers >= 0.2 - , utf8-string >= 0.3.4 && < 0.4 + , text >= 0.8 && < 0.12 , blaze-builder >= 0.3.0.0 && < 0.4 , pool-conduit >= 0.1 && < 0.2 , unordered-containers