disk-bytes (empty) → 0.1.0.0

raw patch · 11 files changed

+666/−0 lines, 11 filesdep +basedep +bytestringdep +containers

Dependencies added: base, bytestring, containers, direct-sqlite, directory, disk-bytes, stm, text

Files

• CHANGELOG.md +19/−0
• LICENSE +30/−0
• README.md +52/−0
• disk-bytes.cabal +58/−0
• src-bench/bench-memory.hs +67/−0
• src/System/Mem/Disk.hs +43/−0
• src/System/Mem/Disk/Bytes.hs +78/−0
• src/System/Mem/Disk/BytesPlain.hs +64/−0
• src/System/Mem/Disk/DiskApi.hs +21/−0
• src/System/Mem/Disk/Memory.hs +67/−0
• src/System/Mem/Disk/Sqlite.hs +167/−0

@@ -0,0 +1,19 @@+# Revision history for disk-bytes++All notable changes to this project will (hopefully) be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org).++## Unreleased++(This section tracks upcoming changes.)++## 0.1.0.0 — 2022-09-25++Initial release.++### Added++* Module `System.Mem.Disk` which introduces the `DiskBytes` and `Disk` data types.+* Benchmark `memory` that tests whether RAM usage and garbage collection work as claimed.

@@ -0,0 +1,30 @@+Copyright (c) 2022, Heinrich Apfelmus++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 Heinrich Apfelmus nor the names of other+      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+OWNER 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.

@@ -0,0 +1,52 @@+# disk-bytes++This package provides a data type `DiskBytes` which represents a sequence of bytes that is stored on disk — but in a referentially transparent manner.++The key invariant is that a value of type `DiskBytes` that has been evaluated *to weak-head normal form* (WHNF) occupies just a few words of RAM, but many bytes of on-disk storage. (We can't guarantee anything about expressions that are not in WHNF.)++The main use case for `DiskBytes` is when you have a pure Haskell program which is storing too much data, and you want to offload some of this data in a controlled, yet transparent way to disk — without `IO` doing violence to your beautiful, pure Haskell code.++The interface for `DiskBytes` consists of two *pure* functions which convert to/from an in-memory (RAM) `ByteString`:++```hs+toDiskBytes :: Disk -> ByteString -> DiskBytes+fromDiskBytes :: DiskBytes -> ByteString+```++Here, `Disk` represents the on-disk storage, typically obtained by opening a file on the file system. One can interpret `Disk` as virtual memory.++## Implementation Details++### Disk storage++Currently, the `Disk` data type is implemented as an open sqlite database file. In other words, sqlite is used to manage on-disk memory in a file. I decided to use an existing library for on-disk storage, because managing the on-disk storage (B+ trees, trade-offs between read and write speed, …) is an interesting problem, but it's not a problem that I want to solve *here*.++However, sqlite is a bit overkill, because all that we need is a key-value store. In the future, one might consider on-disk storage libraries such as [lmdb][] or [RocksDB][] — I picked sqlite simply because it has Haskell bindings that I have used before. Pull requests (with benchmarks) are welcome.++### Sqlite++TODO: Implement batching? We may want to batch *insertions* and *deletions* until the total number of bytes to process reaches a certain threshold, e.g. 10kB? Rumor has it that sequences of database operations such as `INSERT INTO` become faster if they are batched into a single transaction, rather than run as separate queries with just a few bytes each.++### Referential transparency++Internally, the `DiskBytes` type uses `unsafePerformIO`. However, this use is referentially transparent as long as the library has exclusive access to the on-disk storage. In other words, we assume that the on-disk memory is as exclusive to the Haskell run-time as we assume that RAM is exclusive to the Haskell run-time. ++TODO: Make an honest attempt to ensure that no other process can read or write to the file, e.g. by setting file permissions.++### Testing++Currently, the benchmark `memory` serves as a basic test that everything is working as intended. You can run the benchmark and look at its heap profile by executing the commands++```shell+$ cabal bench+$ hp2pretty memory.hp+```++This tests the following properties:++* `DiskBytes` that are alive do not use much RAM. (Currently, ~`100` bytes per WHNF of `DiskBytes`.)+* `DiskBytes` that are not alive are garbage collected and disk memory is freed. (This works as the value returned by `getDiskSize` stops growing.)+* The bytes of 'DiskBytes' that are alive can be loaded back into RAM. (`fromDiskBytes` does not throw an error.)++  [lmdb]: https://en.wikipedia.org/wiki/Lightning_Memory-Mapped_Database+  [rocksdb]: https://en.wikipedia.org/wiki/RocksDB

@@ -0,0 +1,58 @@+cabal-version:      2.4+name:               disk-bytes+version:            0.1.0.0+synopsis:           On-disk storage, but referentially transparent+description:+    This package provides a data type 'DiskBytes' which represents a sequence of bytes that is stored on disk — but in a referentially transparent manner.+category:           Memory++license:            BSD-3-Clause+license-file:       LICENSE+copyright:          Copyright (c) 2022 Heinrich Apfelmus+author:             Heinrich Apfelmus+maintainer:         apfelmus@quantentunnel.de+homepage:           https://github.com/HeinrichApfelmus/disk-bytes+bug-reports:        https://github.com/HeinrichApfelmus/disk-bytes/issues++extra-source-files:+    CHANGELOG.md+    README.md++library+    exposed-modules:+        System.Mem.Disk+    other-modules:+        System.Mem.Disk.Bytes+        System.Mem.Disk.BytesPlain+        System.Mem.Disk.DiskApi+        System.Mem.Disk.Memory+        System.Mem.Disk.Sqlite+    default-extensions:+        NamedFieldPuns+    other-extensions:+        MagicHash+        OverloadedStrings+        UnboxedTuples+    build-depends:+          base >= 4.14.3.0 && < 4.18+        , bytestring >= 0.10.12.0 && < 0.12 +        , containers ^>= 0.6.5.1+        , directory ^>= 1.3.6.0+        , direct-sqlite ^>=2.3.27+        , stm ^>= 2.5.0.1+        , text >= 1.2.4.1 && < 2.1+    hs-source-dirs:   src+    default-language: Haskell2010++benchmark memory+    type:             exitcode-stdio-1.0+    main-is:          bench-memory.hs+    hs-source-dirs:   src-bench+    build-depends:+          base+        , disk-bytes+        , bytestring+        , text+    ghc-options:+        "-with-rtsopts=-p -s -h -i0.05"+    default-language: Haskell2010

@@ -0,0 +1,67 @@+module Main where++import Control.Concurrent+    ( threadDelay )+import Control.Exception+    ( evaluate )+import Control.Monad+    ( forM )+import Data.ByteString+    ( ByteString )+import System.Mem.Disk+import System.Mem+    ( performGC )+import Data.IORef++import qualified Data.ByteString as BS++{-----------------------------------------------------------------------------+    Benchmark parameters ------------------------------------------------------------------------------}+chunkSize, totalSize, maxSize :: Int+chunkSize = 2000 -- bytes+maxSize   = 1000 * chunkSize -- bytes+totalSize = 3 * maxSize -- bytes++{-----------------------------------------------------------------------------+    Benchmark execution ------------------------------------------------------------------------------}+main :: IO ()+main = withDiskSqlite "bench-mem.db" $ \disk -> do+    let batches = totalSize `div` maxSize+        batchSize = maxSize `div` chunkSize++    xss <- forM [1 .. batches] $ \i -> do+        say $ "Batch number " <> show i+        say $ ".. create `DiskBytes` and garbage collect `ByteString`"+        say $ "   invariant: `DiskBytes` in WHNF does not use RAM"+        xs <- forM [1 .. batchSize] $ \j -> do+            let x = toDiskBytes disk (mkBytes chunkSize j) :: DiskBytes+            x `seq` performGC+            pure x++        say $ ".. evaluate and discard `fromDiskBytes`"+        say $ "   invariant: `DiskBytes` store valid data"+        mapM_ (evaluate . fromDiskBytes) xs++        say $ ".. [pause]"+        threadDelaySeconds 2++        say $ ".. garbage collect on-disk `DiskBytes`"+        say $ "   invariant: disk memory is released for `DiskBytes`"+              <> " that are not alive"+        performGC++        say . (\x -> "Disk size: " <> show x <> " bytes") =<< getDiskSize disk+        pure []++    evaluate $ concat xss++    pure ()++mkBytes :: Int -> Int -> ByteString+mkBytes n seed = BS.pack $ map (\x -> toEnum $ (x+seed) `mod` 2^8) [1..n]++say :: String -> IO ()+say = putStrLn++threadDelaySeconds :: Int -> IO ()+threadDelaySeconds s = threadDelay (s * 1000 * 1000)

@@ -0,0 +1,43 @@+module System.Mem.Disk+    ( -- * Synopsis+      -- $synopsis++      -- * DiskBytes +      DiskBytes+    , toDiskBytes+    , fromDiskBytes+      -- * Disk storage space+    , Disk+    , getDiskSize+    , withDiskSqlite+    , withDiskMemory+    ) where++import Data.ByteString+    ( ByteString )+import System.Mem.Disk.Bytes+import System.Mem.Disk.DiskApi+    ( Disk, getDiskSize )+import System.Mem.Disk.Memory+    ( withDiskMemory )+import System.Mem.Disk.Sqlite+    ( withDiskSqlite )++{- $synopsis++This module introduces a data type 'DiskBytes' which represents a sequence+of bytes.+However, unlike most Haskell data types, values of this type+are not stored in volatile RAM, but on the hard disk (e.g. magnetic or SSD).+But just like ordinary Haskell data types,+this type is referentially transparent — no 'IO' is needed to access the disk!++The purpose of this data type is to allow you to make+trade-offs between RAM (scarce but fast) and disk (plenty but slow)+simply by switching between the 'ByteString' and 'DiskBytes' types —+while keeping the Haskell code pure. In order to test whether this worked out in your favor, you can use the 'withDiskMemory' function.++The on-disk storage space is represented by the 'Disk' type.+Typically, this storage is managed through a file on the file system,+e.g. using 'withDiskSqlite'.+-}

@@ -0,0 +1,78 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}++-- | Implementation of 'DiskBytes' using GHC-specific primitives+-- like 'mkWeak#'. Unfortunately,+-- I have not been able to bring down the RAM size of 'DiskByte'+-- significantly below 100 bytes yet.+module System.Mem.Disk.Bytes+    ( DiskBytes+    , toDiskBytes+    , fromDiskBytes+    ) where++import Data.ByteString+    ( ByteString )+import Data.Int+    ( Int64 )+import System.IO.Unsafe+    ( unsafePerformIO )+import System.Mem.Disk.DiskApi+    ( Disk (..) )++import GHC.Exts (Int#, Int(I#))+import GHC.Base+import GHC.Weak++{-----------------------------------------------------------------------------+    DiskBytes+------------------------------------------------------------------------------}+-- | A sequence of bytes that is stored on disk+-- — if and only if the value is evaluated to WHNF.+--+-- The value is subject to normal garbage collection:+-- When the value is no longer referenced,+-- the disk memory will be freed (eventually).+--+-- For estimating the memory cost:+-- Even though the bulk of the data is kept on disk,+-- each WHNF of 'DiskBytes' occupies roughly @~100@ bytes of RAM;+-- this is due to administrative overhead like weak pointers and finalizers.+data DiskBytes = DiskBytes+    { index :: Int#+    , disk  :: Disk+    }++-- | Make a weak pointer for our purposes.+addFinalizerBytes :: DiskBytes -> IO () -> IO ()+addFinalizerBytes v@(DiskBytes{}) (IO finalizer) = IO $ \s ->+    case mkWeak# v v finalizer s of (# s1, w #) -> (# s1, () #)++-- | Offload a sequence of bytes onto a 'Disk'.+-- +-- NOTE: The result must be evaluated to WHNF before the data is actually+-- on disk!+-- Also, the original 'ByteString' needs to be garbage collected+-- in for its RAM to become free.+toDiskBytes :: Disk -> ByteString -> DiskBytes+toDiskBytes disk = unsafePerformIO . mkDiskBytes disk++mkDiskBytes :: Disk -> ByteString -> IO DiskBytes+mkDiskBytes disk bytes = do+    I# index <- fromEnum <$> put disk bytes+    let diskbytes = DiskBytes{index,disk}+    diskbytes `seq` (addFinalizerBytes diskbytes $ finalizerBytes diskbytes)+    pure diskbytes++{-# NOINLINE finalizerBytes #-}+finalizerBytes :: DiskBytes -> IO ()+finalizerBytes DiskBytes{index,disk} =+    delete disk $ toEnum $ I# index++-- | Read the sequence of bytes back into RAM.+fromDiskBytes :: DiskBytes -> ByteString+fromDiskBytes = unsafePerformIO . unpackM++unpackM :: DiskBytes -> IO ByteString+unpackM DiskBytes{index,disk} =+    get disk $ toEnum $ I# index

@@ -0,0 +1,64 @@+-- | Simpler implementation of 'DiskBytes' using 'mkWeakIORef'.+-- It looks like this implementation is not significantly worse than the+-- one trying to use GHC-specific primitives.+module System.Mem.Disk.BytesPlain+    ( DiskBytes+    , toDiskBytes+    , fromDiskBytes+    ) where++import Data.ByteString+    ( ByteString )+import Data.Int+    ( Int64 )+import Data.IORef+    ( IORef, newIORef, readIORef, mkWeakIORef )+import System.IO.Unsafe+    ( unsafePerformIO )+import System.Mem.Disk.DiskApi+    ( Disk (..) )++{-----------------------------------------------------------------------------+    DiskBytes+------------------------------------------------------------------------------}+-- | A sequence of bytes that is stored on disk+-- -- if and only if the value is evaluated to WHNF.+--+-- The value is subject to normal garbage collection:+-- When the value is no longer referenced,+-- the disk memory will be freed (eventually).+newtype DiskBytes = DiskBytes { unDiskBytes :: IORef DiskBytesData }++data DiskBytesData = DiskBytesData+    { index :: !Int64+    , disk  :: Disk+    }++-- | Offload a sequence of bytes onto a 'Disk'.+-- +-- NOTE: The result must be evaluated to WHNF before the data actually+-- on disk! Also keep in mind that the original 'ByteString' needs+-- to be garbage collected.+toDiskBytes :: Disk -> ByteString -> DiskBytes+toDiskBytes disk = unsafePerformIO . mkDiskBytes disk++mkDiskBytes :: Disk -> ByteString -> IO DiskBytes+mkDiskBytes disk bytes = do+    index <- put disk bytes+    ptr <- newIORef DiskBytesData{index, disk}+    _ <- mkWeakIORef ptr (finalizer ptr)+    pure $ DiskBytes ptr++finalizer :: IORef DiskBytesData -> IO ()+finalizer ptr = do+    DiskBytesData{index,disk} <- readIORef ptr+    delete disk index++-- | Read the sequence of bytes back into RAM.+fromDiskBytes :: DiskBytes -> ByteString+fromDiskBytes = unsafePerformIO . unpackM++unpackM :: DiskBytes -> IO ByteString+unpackM (DiskBytes ptr) = do+    DiskBytesData{index,disk} <- readIORef ptr+    get disk index

@@ -0,0 +1,21 @@+-- | Representation of 'Disk' as an object-like record —+-- this allows multiple storage space implementations.+module System.Mem.Disk.DiskApi where++import Data.ByteString+    ( ByteString )+import Data.Int+    ( Int64 )++{-----------------------------------------------------------------------------+    Disk+------------------------------------------------------------------------------}+-- | Represents the on-disk storage where+-- t'System.Mem.Disk.DiskBytes' are stored.+data Disk = Disk+    { put :: ByteString -> IO Int64+    , get :: Int64 -> IO ByteString+    , delete :: Int64 -> IO ()+    , getDiskSize :: IO Integer+        -- ^ Rough estimate of the current size of the 'Disk', in bytes.+    }

@@ -0,0 +1,67 @@+-- | Simple, stupid implementation of a RAM-based 'Disk' for testing.+module System.Mem.Disk.Memory where++import Data.ByteString+    ( ByteString )+import Data.Foldable+    ( foldl' )+import Data.Int+    ( Int64 )+import Data.IORef++import qualified Control.Concurrent.STM as STM+import qualified Data.ByteString as BS+import qualified Data.Map.Strict as Map+import qualified System.Mem.Disk.DiskApi as DiskApi++{-----------------------------------------------------------------------------+    Disk+------------------------------------------------------------------------------}+data Disk = Disk+    { db :: IORef (Map.Map Int64 ByteString)+    , counter :: IORef Int64+    }++-- | Create a 'Disk' in memory for the purpose of testing and profiling+-- — by swapping v'System.Mem.Disk.withDiskMemory'+-- for  v'System.Mem.Disk.withDiskSqlite' and looking at the+-- heap profile of your program, you can quickly find out whether the+-- use of t'System.Mem.Disk.DiskBytes' really helps.+--+-- Ignores the 'FilePath' argument.+withDiskMemory :: FilePath -> (DiskApi.Disk -> IO a) -> IO a+withDiskMemory _ action = do+    db <- newIORef Map.empty+    counter <- newIORef 0+    action $ mkDiskApi $ Disk{db,counter}++getDiskSize_ :: Disk -> IO Integer+getDiskSize_ Disk{db} = sumBytes <$> readIORef db+  where+    sumBytes = foldl' (\n bs -> n + fromIntegral (BS.length bs)) 0++mkDiskApi :: Disk -> DiskApi.Disk+mkDiskApi disk = DiskApi.Disk+    { DiskApi.put = put_ disk+    , DiskApi.get = get_ disk+    , DiskApi.delete = delete_ disk+    , DiskApi.getDiskSize = getDiskSize_ disk+    }++{-----------------------------------------------------------------------------+    Disk operations+------------------------------------------------------------------------------}+put_ :: Disk -> ByteString -> IO Int64+put_ Disk{db,counter} bytes = do+    index <- atomicModifyIORef' counter $ \x -> (x+1,x)+    atomicModifyIORef' db $ \db_ -> (Map.insert index bytes db_, ())+    pure index++get_ :: Disk -> Int64 -> IO ByteString+get_ Disk{db} index = do+    Just bytes <- Map.lookup index <$> readIORef db+    pure bytes++delete_ :: Disk -> Int64 -> IO ()+delete_ Disk{db} index =+    atomicModifyIORef' db $ \db_ -> (Map.delete index db_, ())

@@ -0,0 +1,167 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Implementation of an Sqlite-based 'Disk'.+module System.Mem.Disk.Sqlite where++import Control.Concurrent+    ( forkIO, killThread, ThreadId )+import Control.Exception+    ( bracket )+import Control.Monad+    ( forever, when )+import Data.ByteString+    ( ByteString )+import Data.Int+    ( Int64 )+import Data.IORef++import qualified Control.Concurrent.STM as STM+import qualified Data.Text as T+import qualified Database.SQLite3 as Sql+import qualified System.IO.Error as Sys+import qualified System.Directory as Sys++import qualified System.Mem.Disk.DiskApi as DiskApi++{-----------------------------------------------------------------------------+    File system helpers+------------------------------------------------------------------------------}+withFile :: FilePath -> IO a -> IO a+withFile path action = bracket+    (throwIfAlreadyExists path)+    (\_ -> Sys.removeFile path)+    (\_ -> action)++-- | Throw an 'IOError' that indicates that the file already exists.+throwIfAlreadyExists :: FilePath -> IO ()+throwIfAlreadyExists path = do+    b <- Sys.doesFileExist path+    when b $ Sys.ioError $ Sys.mkIOError+        Sys.alreadyExistsErrorType "Creating 'Disk'" Nothing (Just path)++{-----------------------------------------------------------------------------+    Disk+------------------------------------------------------------------------------}+data Disk = Disk+    { path :: FilePath+    , chan :: STM.TChan (Cmd STM.TMVar)+    , counter :: IORef Int64+    }++-- | Obtain the size of the 'Disk' in bytes.+-- Here, this is the file size.+getDiskSize_ :: Disk -> IO Integer+getDiskSize_ = Sys.getFileSize . path++-- | Create a new file and use it for storing+-- t'System.Mem.Disk.DiskBytes'.+--+-- Throw an error if the file already exists,+-- delete the file after use.+withDiskSqlite :: FilePath -> (DiskApi.Disk -> IO a) -> IO a+withDiskSqlite path action =+    withFile path $+    withDatabase path $ \db ->+    withSql db $ \sql ->+    withThread sql $ \chan -> do+        counter <- newIORef 0+        action $ mkDiskApi $ Disk{path,chan,counter}+  where+    withDatabase path = bracket (Sql.open $ T.pack path) Sql.close++mkDiskApi :: Disk -> DiskApi.Disk+mkDiskApi disk = DiskApi.Disk+    { DiskApi.put = put_ disk+    , DiskApi.get = get_ disk+    , DiskApi.delete = delete_ disk+    , DiskApi.getDiskSize = getDiskSize_ disk+    }++{-----------------------------------------------------------------------------+    Disk operations+------------------------------------------------------------------------------}+-- | Operations to be performed on the database+data Cmd cont+    = Put !Int64 ByteString+    | Get !Int64 (cont ByteString)+    | Delete !Int64++put_ :: Disk -> ByteString -> IO Int64+put_ Disk{chan,counter} bytes = do+    index <- atomicModifyIORef' counter (\x -> (x+1,x))+    STM.atomically $ STM.writeTChan chan $ Put index bytes+    pure index++get_ :: Disk -> Int64 -> IO ByteString+get_ Disk{chan} index = do+    k <- STM.newEmptyTMVarIO+    STM.atomically $ STM.writeTChan chan $ Get index k+    STM.atomically $ STM.takeTMVar k++delete_ :: Disk -> Int64 -> IO ()+delete_ Disk{chan} index =+    STM.atomically $ STM.writeTChan chan $ Delete index++{-----------------------------------------------------------------------------+    Worker Thread+------------------------------------------------------------------------------}+-- | Worker thread for sequencing SQL commands.+withThread :: SqlCmds -> (STM.TChan (Cmd STM.TMVar) -> IO a) -> IO a+withThread sql action =+    bracket (mkDatabaseThread sql) (killThread . fst) (\(_,c) -> action c)++mkDatabaseThread :: SqlCmds -> IO (ThreadId, STM.TChan (Cmd STM.TMVar))+mkDatabaseThread sql = do+    chan <- STM.newTChanIO+    threadId <- forkIO $ forever $+        cmdSql sql =<< STM.atomically (STM.readTChan chan)+    pure (threadId, chan)++{-----------------------------------------------------------------------------+    Sql+------------------------------------------------------------------------------}+data SqlCmds = SqlCmds+    { sput_ :: Sql.Statement+    , sget_ :: Sql.Statement+    , sdelete_ :: Sql.Statement+    }++withSql :: Sql.Database -> (SqlCmds -> IO a) -> IO a+withSql db = bracket (initSql db) finalizeSql++initSql :: Sql.Database -> IO SqlCmds+initSql db = do+    Sql.exec db "CREATE TABLE db ( ix INTEGER PRIMARY KEY, bytes BLOB );"+    sput_ <- Sql.prepare db "INSERT INTO db VALUES (?1,?2);"+    sget_ <- Sql.prepare db "SELECT bytes FROM db WHERE ix = ?1;"+    sdelete_ <- Sql.prepare db "DELETE FROM db WHERE ix = ?1;"+    pure $ SqlCmds{sput_,sget_,sdelete_}++finalizeSql :: SqlCmds -> IO ()+finalizeSql SqlCmds{sput_,sget_,sdelete_} = do+    mapM_ Sql.finalize [sput_, sget_, sdelete_]++cmdSql :: SqlCmds -> Cmd STM.TMVar -> IO ()+cmdSql SqlCmds{sput_,sget_,sdelete_} cmd = case cmd of+    Put index bytes -> do+        let s = sput_+        Sql.bind s [Sql.SQLInteger index, Sql.SQLBlob bytes]+        _ <- Sql.stepNoCB s+        reset s++    Get index k -> do+        let s = sget_+        Sql.bind s [Sql.SQLInteger index]+        Sql.Row <- Sql.stepNoCB s+        bytes <- Sql.columnBlob s 0+        reset s+        STM.atomically $ STM.putTMVar k bytes++    Delete index -> do+        let s = sdelete_+        Sql.bind s [Sql.SQLInteger index]+        Sql.Done <- Sql.stepNoCB s+        reset s++  where+    reset s = Sql.reset s >> Sql.clearBindings s