1{-# LANGUAGE DeriveDataTypeable #-} 2{-# LANGUAGE ForeignFunctionInterface #-} 3{-# LANGUAGE OverloadedStrings #-} 4-- | A port of the direct-sqlite package for dealing directly with 5-- 'PersistValue's. 6module Database.Sqlite ( 7 Connection, 8 Statement, 9 Error(..), 10 SqliteException(..), 11 StepResult(Row, Done), 12 Config(ConfigLogFn), 13 LogFunction, 14 SqliteStatus (..), 15 SqliteStatusVerb (..), 16 -- * Basic usage guide 17 -- | 18 -- 19 -- Note that the example code shown here is a low level interface 20 -- usage. Let's create a small demo sqlite3 database which we will 21 -- use in our program: 22 -- 23 -- > $ sqlite3 ~/test.db 24 -- > sqlite> create table t1(a,b); 25 -- > sqlite> insert into t1(a,b) values (1,1); 26 -- > sqlite> insert into t1(a,b) values (2,2); 27 -- > sqlite> select * from t1; 28 -- > 1|1 29 -- > 2|2 30 -- 31 -- Now let's write code using the functions in this module to 32 -- fetch the rows from the table: 33 -- 34 -- > {-#LANGUAGE OverloadedStrings#-} 35 -- > 36 -- > import Database.Sqlite 37 -- > import Data.Text 38 -- > 39 -- > main :: IO () 40 -- > main = do 41 -- > conn <- open "/home/sibi/test.db" 42 -- > smt <- prepare conn "select * from t1;" 43 -- > row1 <- step smt >> columns smt 44 -- > row2 <- step smt >> columns smt 45 -- > print (row1, row2) 46 -- > finalize smt 47 -- > close conn 48 -- 49 -- On executing the above code: 50 -- 51 -- > $ ./demo-program 52 -- > $ ([PersistInt64 1,PersistInt64 1],[PersistInt64 2,PersistInt64 2]) 53 54 open, 55 close, 56 prepare, 57 step, 58 stepConn, 59 reset, 60 finalize, 61 bindBlob, 62 bindDouble, 63 bindInt, 64 bindInt64, 65 bindNull, 66 bindText, 67 bind, 68 column, 69 columns, 70 changes, 71 mkLogFunction, 72 freeLogFunction, 73 config, 74 status, 75 softHeapLimit, 76 enableExtendedResultCodes, 77 disableExtendedResultCodes 78 ) 79 where 80 81import Prelude hiding (error) 82import qualified Prelude as P 83 84import Control.Exception (Exception, throwIO) 85import qualified Data.ByteString as BS 86import qualified Data.ByteString.Unsafe as BSU 87import qualified Data.ByteString.Internal as BSI 88import Data.Fixed (Pico) 89import Data.IORef (newIORef, readIORef, writeIORef) 90import Data.Monoid (mappend, mconcat) 91import Data.Text (Text, pack, unpack) 92import Data.Text.Encoding (encodeUtf8, decodeUtf8With) 93import Data.Text.Encoding.Error (lenientDecode) 94import Data.Time (defaultTimeLocale, formatTime, UTCTime) 95import Data.Typeable (Typeable) 96import Database.Sqlite.Internal (Connection(..), Connection'(..), Statement(..)) 97import Foreign 98import Foreign.C 99 100import Database.Persist (PersistValue (..), listToJSON, mapToJSON) 101 102-- | A custom exception type to make it easier to catch exceptions. 103-- 104-- @since 2.1.3 105data SqliteException = SqliteException 106 { seError :: !Error 107 , seFunctionName :: !Text 108 , seDetails :: !Text 109 } 110 deriving (Typeable) 111instance Show SqliteException where 112 show (SqliteException error functionName details) = unpack $ Data.Monoid.mconcat 113 ["SQLite3 returned " 114 , pack $ show error 115 , " while attempting to perform " 116 , functionName 117 , details 118 ] 119instance Exception SqliteException 120 121data Error = ErrorOK 122 | ErrorError 123 | ErrorInternal 124 | ErrorPermission 125 | ErrorAbort 126 | ErrorBusy 127 | ErrorLocked 128 | ErrorNoMemory 129 | ErrorReadOnly 130 | ErrorInterrupt 131 | ErrorIO 132 | ErrorNotFound 133 | ErrorCorrupt 134 | ErrorFull 135 | ErrorCan'tOpen 136 | ErrorProtocol 137 | ErrorEmpty 138 | ErrorSchema 139 | ErrorTooBig 140 | ErrorConstraint 141 | ErrorMismatch 142 | ErrorMisuse 143 | ErrorNoLargeFileSupport 144 | ErrorAuthorization 145 | ErrorFormat 146 | ErrorRange 147 | ErrorNotAConnection 148 | ErrorRow 149 | ErrorDone 150 deriving (Eq, Show) 151 152data StepResult = Row | Done deriving (Eq, Show) 153 154data ColumnType = IntegerColumn 155 | FloatColumn 156 | TextColumn 157 | BlobColumn 158 | NullColumn 159 deriving (Eq, Show) 160 161decodeError :: Int -> Error 162decodeError 0 = ErrorOK 163decodeError 1 = ErrorError 164decodeError 2 = ErrorInternal 165decodeError 3 = ErrorPermission 166decodeError 4 = ErrorAbort 167decodeError 5 = ErrorBusy 168decodeError 6 = ErrorLocked 169decodeError 7 = ErrorNoMemory 170decodeError 8 = ErrorReadOnly 171decodeError 9 = ErrorInterrupt 172decodeError 10 = ErrorIO 173decodeError 11 = ErrorNotFound 174decodeError 12 = ErrorCorrupt 175decodeError 13 = ErrorFull 176decodeError 14 = ErrorCan'tOpen 177decodeError 15 = ErrorProtocol 178decodeError 16 = ErrorEmpty 179decodeError 17 = ErrorSchema 180decodeError 18 = ErrorTooBig 181decodeError 19 = ErrorConstraint 182decodeError 20 = ErrorMismatch 183decodeError 21 = ErrorMisuse 184decodeError 22 = ErrorNoLargeFileSupport 185decodeError 23 = ErrorAuthorization 186decodeError 24 = ErrorFormat 187decodeError 25 = ErrorRange 188decodeError 26 = ErrorNotAConnection 189decodeError 100 = ErrorRow 190decodeError 101 = ErrorDone 191decodeError i = P.error $ "decodeError " ++ show i 192 193decodeColumnType :: Int -> ColumnType 194decodeColumnType 1 = IntegerColumn 195decodeColumnType 2 = FloatColumn 196decodeColumnType 3 = TextColumn 197decodeColumnType 4 = BlobColumn 198decodeColumnType 5 = NullColumn 199decodeColumnType i = P.error $ "decodeColumnType " ++ show i 200 201foreign import ccall "sqlite3_errmsg" 202 errmsgC :: Ptr () -> IO CString 203errmsg :: Connection -> IO Text 204errmsg (Connection _ (Connection' database)) = do 205 message <- errmsgC database 206 byteString <- BS.packCString message 207 return $ decodeUtf8With lenientDecode byteString 208 209sqlError :: Maybe Connection -> Text -> Error -> IO a 210sqlError maybeConnection functionName error = do 211 details <- case maybeConnection of 212 Just database -> do 213 details <- errmsg database 214 return $ ": " `Data.Monoid.mappend` details 215 Nothing -> return "." 216 throwIO SqliteException 217 { seError = error 218 , seFunctionName = functionName 219 , seDetails = details 220 } 221 222foreign import ccall "sqlite3_open_v2" 223 openC :: CString -> Ptr (Ptr ()) -> Int -> CString -> IO Int 224 225openError :: Text -> IO (Either Connection Error) 226openError path' = do 227 let flag = sqliteFlagReadWrite .|. sqliteFlagCreate .|. sqliteFlagUri 228 BS.useAsCString (encodeUtf8 path') $ \path -> alloca $ \database -> do 229 err <- decodeError <$> openC path database flag nullPtr 230 case err of 231 ErrorOK -> do database' <- peek database 232 active <- newIORef True 233 return $ Left $ Connection active $ Connection' database' 234 _ -> return $ Right err 235 where 236 -- for all sqlite flags, check out https://www.sqlite.org/c3ref/open.html 237 sqliteFlagReadWrite = 0x2 238 sqliteFlagCreate = 0x4 239 sqliteFlagUri = 0x40 240 241open :: Text -> IO Connection 242open path = do 243 databaseOrError <- openError path 244 case databaseOrError of 245 Left database -> return database 246 Right error -> sqlError Nothing ("open " `mappend` (pack $ show path)) error 247 248foreign import ccall "sqlite3_close" 249 closeC :: Ptr () -> IO Int 250closeError :: Connection -> IO Error 251closeError (Connection iactive (Connection' database)) = do 252 writeIORef iactive False 253 error <- closeC database 254 return $ decodeError error 255close :: Connection -> IO () 256close database = do 257 error <- closeError database 258 case error of 259 ErrorOK -> return () 260 _ -> sqlError (Just database) "close" error 261 262foreign import ccall "sqlite3_extended_result_codes" 263 sqlite3_extended_result_codesC :: Ptr () -> Int -> IO Int 264 265 266-- @since 2.9.2 267enableExtendedResultCodes :: Connection -> IO () 268enableExtendedResultCodes con@(Connection _ (Connection' database)) = do 269 error <- sqlite3_extended_result_codesC database 1 270 let err = decodeError error 271 case err of 272 ErrorOK -> return () 273 _ -> sqlError (Just con) "enableExtendedResultCodes" err 274 275-- @since 2.9.2 276disableExtendedResultCodes :: Connection -> IO () 277disableExtendedResultCodes con@(Connection _ (Connection' database)) = do 278 error <- sqlite3_extended_result_codesC database 0 279 let err = decodeError error 280 case err of 281 ErrorOK -> return () 282 _ -> sqlError (Just con) "disableExtendedResultCodes" err 283 284foreign import ccall "sqlite3_prepare_v2" 285 prepareC :: Ptr () -> CString -> Int -> Ptr (Ptr ()) -> Ptr (Ptr ()) -> IO Int 286prepareError :: Connection -> Text -> IO (Either Statement Error) 287prepareError (Connection _ (Connection' database)) text' = do 288 BS.useAsCString (encodeUtf8 text') 289 (\text -> do 290 alloca (\statement -> do 291 error' <- prepareC database text (-1) statement nullPtr 292 error <- return $ decodeError error' 293 case error of 294 ErrorOK -> do 295 statement' <- peek statement 296 return $ Left $ Statement statement' 297 _ -> return $ Right error)) 298prepare :: Connection -> Text -> IO Statement 299prepare database text = do 300 statementOrError <- prepareError database text 301 case statementOrError of 302 Left statement -> return statement 303 Right error -> sqlError (Just database) ("prepare " `mappend` (pack $ show text)) error 304 305foreign import ccall "sqlite3_step" 306 stepC :: Ptr () -> IO Int 307stepError :: Statement -> IO Error 308stepError (Statement statement) = do 309 error <- stepC statement 310 return $ decodeError error 311 312-- | Execute a database statement. It's recommended to use 'stepConn' instead, because it gives better error messages. 313step :: Statement -> IO StepResult 314step statement = do 315 error <- stepError statement 316 case error of 317 ErrorRow -> return Row 318 ErrorDone -> return Done 319 _ -> sqlError Nothing "step" error 320 321-- | Execute a database statement. This function uses the 'Connection' passed to it to give better error messages than 'step'. 322-- 323-- @since 2.6.4 324stepConn :: Connection -> Statement -> IO StepResult 325stepConn database statement = do 326 error <- stepError statement 327 case error of 328 ErrorRow -> return Row 329 ErrorDone -> return Done 330 _ -> sqlError (Just database) "step" error 331 332foreign import ccall "sqlite3_reset" 333 resetC :: Ptr () -> IO Int 334resetError :: Statement -> IO Error 335resetError (Statement statement) = do 336 error <- resetC statement 337 return $ decodeError error 338reset :: Connection -> Statement -> IO () 339reset (Connection iactive _) statement = do 340 active <- readIORef iactive 341 if active 342 then do 343 error <- resetError statement 344 case error of 345 ErrorOK -> return () 346 _ -> return () -- FIXME confirm this is correct sqlError Nothing "reset" error 347 else return () 348 349foreign import ccall "sqlite3_finalize" 350 finalizeC :: Ptr () -> IO Int 351finalizeError :: Statement -> IO Error 352finalizeError (Statement statement) = do 353 error <- finalizeC statement 354 return $ decodeError error 355finalize :: Statement -> IO () 356finalize statement = do 357 error <- finalizeError statement 358 case error of 359 ErrorOK -> return () 360 _ -> return () -- sqlError Nothing "finalize" error 361 362-- Taken from: https://github.com/IreneKnapp/direct-sqlite/blob/master/Database/SQLite3/Direct.hs 363-- | Like 'unsafeUseAsCStringLen', but if the string is empty, 364-- never pass the callback a null pointer. 365unsafeUseAsCStringLenNoNull 366 :: BS.ByteString 367 -> (CString -> Int -> IO a) 368 -> IO a 369unsafeUseAsCStringLenNoNull bs cb 370 | BS.null bs = cb (intPtrToPtr 1) 0 371 | otherwise = BSU.unsafeUseAsCStringLen bs $ \(ptr, len) -> 372 cb ptr (fromIntegral len) 373 374foreign import ccall "sqlite3_bind_blob" 375 bindBlobC :: Ptr () -> Int -> Ptr () -> Int -> Ptr () -> IO Int 376bindBlobError :: Statement -> Int -> BS.ByteString -> IO Error 377bindBlobError (Statement statement) parameterIndex byteString = 378 unsafeUseAsCStringLenNoNull byteString $ \dataC size -> do 379 error <- bindBlobC statement parameterIndex (castPtr dataC) size 380 (intPtrToPtr (-1)) 381 return $ decodeError error 382bindBlob :: Statement -> Int -> BS.ByteString -> IO () 383bindBlob statement parameterIndex byteString = do 384 error <- bindBlobError statement parameterIndex byteString 385 case error of 386 ErrorOK -> return () 387 _ -> sqlError Nothing "bind blob" error 388 389foreign import ccall "sqlite3_bind_double" 390 bindDoubleC :: Ptr () -> Int -> Double -> IO Int 391bindDoubleError :: Statement -> Int -> Double -> IO Error 392bindDoubleError (Statement statement) parameterIndex datum = do 393 error <- bindDoubleC statement parameterIndex datum 394 return $ decodeError error 395bindDouble :: Statement -> Int -> Double -> IO () 396bindDouble statement parameterIndex datum = do 397 error <- bindDoubleError statement parameterIndex datum 398 case error of 399 ErrorOK -> return () 400 _ -> sqlError Nothing "bind double" error 401 402foreign import ccall "sqlite3_bind_int" 403 bindIntC :: Ptr () -> Int -> Int -> IO Int 404bindIntError :: Statement -> Int -> Int -> IO Error 405bindIntError (Statement statement) parameterIndex datum = do 406 error <- bindIntC statement parameterIndex datum 407 return $ decodeError error 408bindInt :: Statement -> Int -> Int -> IO () 409bindInt statement parameterIndex datum = do 410 error <- bindIntError statement parameterIndex datum 411 case error of 412 ErrorOK -> return () 413 _ -> sqlError Nothing "bind int" error 414 415foreign import ccall "sqlite3_bind_int64" 416 bindInt64C :: Ptr () -> Int -> Int64 -> IO Int 417bindInt64Error :: Statement -> Int -> Int64 -> IO Error 418bindInt64Error (Statement statement) parameterIndex datum = do 419 error <- bindInt64C statement parameterIndex datum 420 return $ decodeError error 421bindInt64 :: Statement -> Int -> Int64 -> IO () 422bindInt64 statement parameterIndex datum = do 423 error <- bindInt64Error statement parameterIndex datum 424 case error of 425 ErrorOK -> return () 426 _ -> sqlError Nothing "bind int64" error 427 428foreign import ccall "sqlite3_bind_null" 429 bindNullC :: Ptr () -> Int -> IO Int 430bindNullError :: Statement -> Int -> IO Error 431bindNullError (Statement statement) parameterIndex = do 432 error <- bindNullC statement parameterIndex 433 return $ decodeError error 434bindNull :: Statement -> Int -> IO () 435bindNull statement parameterIndex = do 436 error <- bindNullError statement parameterIndex 437 case error of 438 ErrorOK -> return () 439 _ -> sqlError Nothing "bind null" error 440 441foreign import ccall "sqlite3_bind_text" 442 bindTextC :: Ptr () -> Int -> CString -> Int -> Ptr () -> IO Int 443bindTextError :: Statement -> Int -> Text -> IO Error 444bindTextError (Statement statement) parameterIndex text = 445 unsafeUseAsCStringLenNoNull (encodeUtf8 text) $ \dataC size -> do 446 error <- bindTextC statement parameterIndex dataC size (intPtrToPtr (-1)) 447 return $ decodeError error 448bindText :: Statement -> Int -> Text -> IO () 449bindText statement parameterIndex text = do 450 error <- bindTextError statement parameterIndex text 451 case error of 452 ErrorOK -> return () 453 _ -> sqlError Nothing "bind text" error 454 455bind :: Statement -> [PersistValue] -> IO () 456bind statement sqlData = do 457 mapM_ (\(parameterIndex, datum) -> do 458 case datum of 459 PersistInt64 int64 -> bindInt64 statement parameterIndex int64 460 PersistDouble double -> bindDouble statement parameterIndex double 461 PersistRational rational -> bindText statement parameterIndex $ pack $ show (fromRational rational :: Pico) 462 PersistBool b -> bindInt64 statement parameterIndex $ 463 if b then 1 else 0 464 PersistText text -> bindText statement parameterIndex text 465 PersistByteString blob -> bindBlob statement parameterIndex blob 466 PersistNull -> bindNull statement parameterIndex 467 PersistDay d -> bindText statement parameterIndex $ pack $ show d 468 PersistTimeOfDay d -> bindText statement parameterIndex $ pack $ show d 469 PersistUTCTime d -> bindText statement parameterIndex $ pack $ format8601 d 470 PersistList l -> bindText statement parameterIndex $ listToJSON l 471 PersistMap m -> bindText statement parameterIndex $ mapToJSON m 472 PersistDbSpecific s -> bindText statement parameterIndex $ decodeUtf8With lenientDecode s 473 PersistArray a -> bindText statement parameterIndex $ listToJSON a -- copy of PersistList's definition 474 PersistObjectId _ -> P.error "Refusing to serialize a PersistObjectId to a SQLite value" 475 ) 476 $ zip [1..] sqlData 477 return () 478 479format8601 :: UTCTime -> String 480format8601 = formatTime defaultTimeLocale "%FT%T%Q" 481 482foreign import ccall "sqlite3_column_type" 483 columnTypeC :: Ptr () -> Int -> IO Int 484columnType :: Statement -> Int -> IO ColumnType 485columnType (Statement statement) columnIndex = do 486 result <- columnTypeC statement columnIndex 487 return $ decodeColumnType result 488 489foreign import ccall "sqlite3_column_bytes" 490 columnBytesC :: Ptr () -> Int -> IO Int 491 492foreign import ccall "sqlite3_column_blob" 493 columnBlobC :: Ptr () -> Int -> IO (Ptr ()) 494columnBlob :: Statement -> Int -> IO BS.ByteString 495columnBlob (Statement statement) columnIndex = do 496 size <- columnBytesC statement columnIndex 497 BSI.create size (\resultPtr -> do 498 dataPtr <- columnBlobC statement columnIndex 499 if dataPtr /= nullPtr 500 then BSI.memcpy resultPtr (castPtr dataPtr) (fromIntegral size) 501 else return ()) 502 503foreign import ccall "sqlite3_column_int64" 504 columnInt64C :: Ptr () -> Int -> IO Int64 505columnInt64 :: Statement -> Int -> IO Int64 506columnInt64 (Statement statement) columnIndex = do 507 columnInt64C statement columnIndex 508 509foreign import ccall "sqlite3_column_double" 510 columnDoubleC :: Ptr () -> Int -> IO Double 511columnDouble :: Statement -> Int -> IO Double 512columnDouble (Statement statement) columnIndex = do 513 columnDoubleC statement columnIndex 514 515foreign import ccall "sqlite3_column_text" 516 columnTextC :: Ptr () -> Int -> IO CString 517columnText :: Statement -> Int -> IO Text 518columnText (Statement statement) columnIndex = do 519 text <- columnTextC statement columnIndex 520 len <- columnBytesC statement columnIndex 521 byteString <- BS.packCStringLen (text, len) 522 return $ decodeUtf8With lenientDecode byteString 523 524foreign import ccall "sqlite3_column_count" 525 columnCountC :: Ptr () -> IO Int 526columnCount :: Statement -> IO Int 527columnCount (Statement statement) = do 528 columnCountC statement 529 530column :: Statement -> Int -> IO PersistValue 531column statement columnIndex = do 532 theType <- columnType statement columnIndex 533 case theType of 534 IntegerColumn -> do 535 int64 <- columnInt64 statement columnIndex 536 return $ PersistInt64 int64 537 FloatColumn -> do 538 double <- columnDouble statement columnIndex 539 return $ PersistDouble double 540 TextColumn -> do 541 text <- columnText statement columnIndex 542 return $ PersistText text 543 BlobColumn -> do 544 byteString <- columnBlob statement columnIndex 545 return $ PersistByteString byteString 546 NullColumn -> return PersistNull 547 548columns :: Statement -> IO [PersistValue] 549columns statement = do 550 count <- columnCount statement 551 mapM (\i -> column statement i) [0..count-1] 552 553foreign import ccall "sqlite3_changes" 554 changesC :: Connection' -> IO Int 555 556changes :: Connection -> IO Int64 557changes (Connection _ c) = fmap fromIntegral $ changesC c 558 559-- | Log function callback. Arguments are error code and log message. 560-- 561-- @since 2.1.4 562type RawLogFunction = Ptr () -> Int -> CString -> IO () 563 564foreign import ccall "wrapper" 565 mkRawLogFunction :: RawLogFunction -> IO (FunPtr RawLogFunction) 566 567-- | 568-- @since 2.1.4 569newtype LogFunction = LogFunction (FunPtr RawLogFunction) 570 571-- | Wraps a given function to a 'LogFunction' to be further used with 'ConfigLogFn'. 572-- First argument of given function will take error code, second - log message. 573-- Returned value should be released with 'freeLogFunction' when no longer required. 574mkLogFunction :: (Int -> String -> IO ()) -> IO LogFunction 575mkLogFunction fn = fmap LogFunction . mkRawLogFunction $ \_ errCode cmsg -> do 576 msg <- peekCString cmsg 577 fn errCode msg 578 579-- | Releases a native FunPtr for the 'LogFunction'. 580-- 581-- @since 2.1.4 582freeLogFunction :: LogFunction -> IO () 583freeLogFunction (LogFunction fn) = freeHaskellFunPtr fn 584 585-- | Configuration option for SQLite to be used together with the 'config' function. 586-- 587-- @since 2.1.4 588data Config 589 -- | A function to be used for logging 590 = ConfigLogFn LogFunction 591 592foreign import ccall "persistent_sqlite_set_log" 593 set_logC :: FunPtr RawLogFunction -> Ptr () -> IO Int 594 595-- | Sets SQLite global configuration parameter. See SQLite documentation for the <https://www.sqlite.org/c3ref/config.html sqlite3_config> function. 596-- In short, this must be called prior to any other SQLite function if you want the call to succeed. 597-- 598-- @since 2.1.4 599config :: Config -> IO () 600config c = case c of 601 ConfigLogFn (LogFunction rawLogFn) -> do 602 e <- fmap decodeError $ set_logC rawLogFn nullPtr 603 case e of 604 ErrorOK -> return () 605 _ -> sqlError Nothing "sqlite3_config" e 606 607-- | Return type of the 'status' function 608-- 609-- @since 2.6.1 610data SqliteStatus = SqliteStatus 611 { sqliteStatusCurrent :: Maybe Int 612 -- ^ The current value of the parameter. Some parameters do not record current value. 613 , sqliteStatusHighwater :: Maybe Int 614 -- ^ The highest recorded value. Some parameters do not record the highest value. 615 } deriving (Eq, Show) 616 617-- | Run-time status parameter that can be returned by 'status' function. 618-- 619-- @since 2.6.1 620data SqliteStatusVerb 621 -- | This parameter is the current amount of memory checked out using sqlite3_malloc(), 622 -- either directly or indirectly. The figure includes calls made to sqlite3_malloc() 623 -- by the application and internal memory usage by the SQLite library. Scratch memory 624 -- controlled by SQLITE_CONFIG_SCRATCH and auxiliary page-cache memory controlled by 625 -- SQLITE_CONFIG_PAGECACHE is not included in this parameter. The amount returned is 626 -- the sum of the allocation sizes as reported by the xSize method in sqlite3_mem_methods. 627 = SqliteStatusMemoryUsed 628 -- | This parameter returns the number of pages used out of the pagecache memory 629 -- allocator that was configured using SQLITE_CONFIG_PAGECACHE. The value returned 630 -- is in pages, not in bytes. 631 | SqliteStatusPagecacheUsed 632 -- | This parameter returns the number of bytes of page cache allocation which 633 -- could not be satisfied by the SQLITE_CONFIG_PAGECACHE buffer and where forced 634 -- to overflow to sqlite3_malloc(). The returned value includes allocations that 635 -- overflowed because they where too large (they were larger than the "sz" 636 -- parameter to SQLITE_CONFIG_PAGECACHE) and allocations that overflowed because 637 -- no space was left in the page cache. 638 | SqliteStatusPagecacheOverflow 639 -- | This parameter returns the number of allocations used out of the scratch 640 -- memory allocator configured using SQLITE_CONFIG_SCRATCH. The value returned 641 -- is in allocations, not in bytes. Since a single thread may only have one 642 -- scratch allocation outstanding at time, this parameter also reports the 643 -- number of threads using scratch memory at the same time. 644 | SqliteStatusScratchUsed 645 -- | This parameter returns the number of bytes of scratch memory allocation 646 -- which could not be satisfied by the SQLITE_CONFIG_SCRATCH buffer and where 647 -- forced to overflow to sqlite3_malloc(). The values returned include overflows 648 -- because the requested allocation was too larger (that is, because the requested 649 -- allocation was larger than the "sz" parameter to SQLITE_CONFIG_SCRATCH) and 650 -- because no scratch buffer slots were available. 651 | SqliteStatusScratchOverflow 652 -- | This parameter records the largest memory allocation request handed to 653 -- sqlite3_malloc() or sqlite3_realloc() (or their internal equivalents). Only 654 -- the value returned in 'sqliteStatusHighwater' field of 'SqliteStatus' record 655 -- is of interest. The value written into the 'sqliteStatusCurrent' field is Nothing. 656 | SqliteStatusMallocSize 657 -- | This parameter records the largest memory allocation request handed to 658 -- pagecache memory allocator. Only the value returned in the 'sqliteStatusHighwater' 659 -- field of 'SqliteStatus' record is of interest. The value written into the 660 -- 'sqliteStatusCurrent' field is Nothing. 661 | SqliteStatusPagecacheSize 662 -- | This parameter records the largest memory allocation request handed to 663 -- scratch memory allocator. Only the value returned in the 'sqliteStatusHighwater' 664 -- field of 'SqliteStatus' record is of interest. The value written into the 665 -- 'sqliteStatusCurrent' field is Nothing. 666 | SqliteStatusScratchSize 667 -- | This parameter records the number of separate memory allocations currently 668 -- checked out. 669 | SqliteStatusMallocCount 670 671-- Internal function to convert status parameter to a triple of its integral 672-- constant and two bools indicating if native sqlite3_status function actually 673-- modifies values at pCurrent and pHighwater pointers. 674statusVerbInfo :: SqliteStatusVerb -> (CInt, Bool, Bool) 675statusVerbInfo v = case v of 676 SqliteStatusMemoryUsed -> (0, True, True) 677 SqliteStatusPagecacheUsed -> (1, True, True) 678 SqliteStatusPagecacheOverflow -> (2, True, True) 679 SqliteStatusScratchUsed -> (3, True, True) 680 SqliteStatusScratchOverflow -> (4, True, True) 681 SqliteStatusMallocSize -> (5, False, True) 682 SqliteStatusPagecacheSize -> (7, False, True) 683 SqliteStatusScratchSize -> (8, False, True) 684 SqliteStatusMallocCount -> (9, True, True) 685 686foreign import ccall "sqlite3_status" 687 statusC :: CInt -> Ptr CInt -> Ptr CInt -> CInt -> IO Int 688 689-- | Retrieves runtime status information about the performance of SQLite, 690-- and optionally resets various highwater marks. The first argument is a 691-- status parameter to measure, the second is reset flag. If reset flag is 692-- True then the highest recorded value is reset after being returned from 693-- this function. 694-- 695-- @since 2.6.1 696status :: SqliteStatusVerb -> Bool -> IO SqliteStatus 697status verb reset' = alloca $ \pCurrent -> alloca $ \pHighwater -> do 698 let (code, hasCurrent, hasHighwater) = statusVerbInfo verb 699 e <- decodeError <$> statusC code pCurrent pHighwater (if reset' then 1 else 0) 700 case e of 701 ErrorOK -> do 702 current <- if hasCurrent then Just . fromIntegral <$> peek pCurrent else return Nothing 703 highwater <- if hasHighwater then Just . fromIntegral <$> peek pHighwater else return Nothing 704 return $ SqliteStatus current highwater 705 _ -> sqlError Nothing "sqlite3_status" e 706 707foreign import ccall "sqlite3_soft_heap_limit64" 708 softHeapLimit64C :: CLLong -> IO CLLong 709 710-- | Sets and/or queries the soft limit on the amount of heap memory that may be 711-- allocated by SQLite. If the argument is zero then the soft heap limit is disabled. 712-- If the argument is negative then no change is made to the soft heap limit. Hence, 713-- the current size of the soft heap limit can be determined by invoking 714-- this function with a negative argument. 715-- 716-- @since 2.6.1 717softHeapLimit :: Int64 -> IO Int64 718softHeapLimit x = fromIntegral <$> softHeapLimit64C (CLLong x) 719