gdritter repos tansu-sqlite3 / master Database / Tansu / Backend / SQLite3.hs
master

Tree @master (Download .tar.gz)

SQLite3.hs @masterraw · history · blame

{-# LANGUAGE OverloadedStrings #-}

module Database.Tansu.Backend.SQLite3 where

import           Control.Monad (when, void)
import           Data.ByteString (ByteString)
import           Data.Text (Text)
import qualified Data.Text as T
import           Database.SQLite3
import           Database.Tansu.Internal
import           System.Directory (doesFileExist)

schema :: Text
schema = "CREATE TABLE tansu ( k blob primary key not null \
                           \ , v blob not null );"

sqlset :: Database -> ByteString -> ByteString -> IO (Either TansuError ())
sqlset db k v = do
  stmt <- prepare db "INSERT INTO tansu (k, v) VALUES (:k, :v);"
  bindNamed stmt [ (":k", SQLBlob k)
                 , (":v", SQLBlob v)
                 ]
  void (step stmt)
  finalize stmt
  return (return ())

sqlget :: Database -> ByteString -> IO (Either TansuError ByteString)
sqlget db k = do
  stmt <- prepare db "SELECT v FROM tansu WHERE k = :k;"
  bindNamed stmt [ (":k", SQLBlob k) ]
  void (step stmt)
  cs <- columns stmt
  finalize stmt
  case cs of
    [SQLBlob v] -> return (Right v)
    [SQLNull]   -> return (Left (KeyNotFound k))
    rs          -> return (Left (OtherError (show rs)))

sqldel :: Database -> ByteString -> IO (Either TansuError ())
sqldel db k = do
  stmt <- prepare db "DELETE FROM tansu WHERE k = :k;"
  bindNamed stmt [ (":k", SQLBlob k) ]
  void (step stmt)
  finalize stmt
  return (Right ())

sqltransact :: Database -> IO a -> IO a
sqltransact db mote = do
  exec db "BEGIN TRANSACTION;"
  result <- mote
  exec db "END TRANSACTION;"
  return result

withSQLiteDb :: FilePath -> (TansuDb -> IO a) -> IO a
withSQLiteDb path mote = do
  exists <- doesFileExist path
  conn <- open (T.pack path)
  when (not exists) $ do
    exec conn schema
  result <- mote $ TansuDb { dbGet = sqlget conn
                           , dbSet = sqlset conn
                           , dbDel = sqldel conn
                           , dbRunTransaction = id
                           }
  close conn
  return result