Renamed Database->TansuDB
Getty Ritter
8 years ago
| 5 | 5 |
import Data.ByteString (ByteString)
|
| 6 | 6 |
import Data.IORef
|
| 7 | 7 |
import qualified Data.Map.Strict as M
|
| 8 | |
import Database.Tansu.Internal (Database(..))
|
| 8 |
import Database.Tansu.Internal (TansuDb(..))
|
| 9 | 9 |
|
| 10 | 10 |
type Table = M.Map ByteString ByteString
|
| 11 | 11 |
|
|
| 18 | 18 |
ephemeralGet :: IORef Table -> ByteString -> IO (Maybe ByteString)
|
| 19 | 19 |
ephemeralGet table key = M.lookup key `fmap` readIORef table
|
| 20 | 20 |
|
| 21 | |
withEphemeralDb :: (Database -> IO a) -> IO a
|
| 21 |
withEphemeralDb :: (TansuDb -> IO a) -> IO a
|
| 22 | 22 |
withEphemeralDb comp = do
|
| 23 | 23 |
lock <- newMVar ()
|
| 24 | 24 |
table <- newIORef M.empty
|
| 25 | |
comp $ Database
|
| 25 |
comp $ TansuDb
|
| 26 | 26 |
{ dbRunTransaction = ephemeralRunTransaction lock
|
| 27 | 27 |
, dbSet = ephemeralSet table
|
| 28 | 28 |
, dbGet = ephemeralGet table
|
| 3 | 3 |
import Data.ByteString (ByteString)
|
| 4 | 4 |
import Data.ByteString.Base64
|
| 5 | 5 |
import qualified Data.ByteString.Char8 as BS
|
| 6 | |
import Database.Tansu.Internal (Database(..))
|
| 6 |
import Database.Tansu.Internal (TansuDb(..))
|
| 7 | 7 |
import System.Directory (createDirectoryIfMissing, doesFileExist)
|
| 8 | 8 |
import System.FileLock (SharedExclusive(Exclusive), withFileLock)
|
| 9 | 9 |
import System.FilePath.Posix ((</>))
|
|
| 25 | 25 |
filePathLock path comp = do
|
| 26 | 26 |
withFileLock (path </> ".lock") Exclusive (const comp)
|
| 27 | 27 |
|
| 28 | |
withFilesystemDb :: FilePath -> (Database -> IO a) -> IO a
|
| 28 |
withFilesystemDb :: FilePath -> (TansuDb -> IO a) -> IO a
|
| 29 | 29 |
withFilesystemDb path comp = do
|
| 30 | 30 |
createDirectoryIfMissing True path
|
| 31 | |
comp $ Database { dbSet = filePathSet path
|
| 32 | |
, dbGet = filePathGet path
|
| 33 | |
, dbRunTransaction = filePathLock path
|
| 34 | |
}
|
| 31 |
comp $ TansuDb { dbSet = filePathSet path
|
| 32 |
, dbGet = filePathGet path
|
| 33 |
, dbRunTransaction = filePathLock path
|
| 34 |
}
|
| 1 | 1 |
{-# LANGUAGE Rank2Types #-}
|
| 2 | 2 |
|
| 3 | |
module Database.Tansu.Internal ( Database(..)
|
| 3 |
module Database.Tansu.Internal ( TansuDb(..)
|
| 4 | 4 |
, TansuError(..)
|
| 5 | 5 |
) where
|
| 6 | 6 |
|
|
| 11 | 11 |
| DecodeError String
|
| 12 | 12 |
deriving (Eq, Show)
|
| 13 | 13 |
|
| 14 | |
data Database = Database
|
| 14 |
data TansuDb = TansuDb
|
| 15 | 15 |
{ dbSet :: ByteString -> ByteString -> IO ()
|
| 16 | 16 |
, dbGet :: ByteString -> IO (Maybe ByteString)
|
| 17 | 17 |
, dbRunTransaction :: forall a. IO a -> IO a
|
| 1 | 1 |
module Database.Tansu ( Tansu
|
| 2 | |
, Database
|
| 2 |
, TansuDb
|
| 3 | 3 |
, TansuError(..)
|
| 4 | 4 |
, get
|
| 5 | 5 |
, getMb
|
|
| 20 | 20 |
)
|
| 21 | 21 |
import Database.Tansu.Internal
|
| 22 | 22 |
|
| 23 | |
type TansuM a = ReaderT Database (ExceptionT TansuError IO) a
|
| 23 |
type TansuM a = ReaderT TansuDb (ExceptionT TansuError IO) a
|
| 24 | 24 |
|
| 25 | 25 |
newtype Tansu a = Tansu { runTansu :: TansuM a }
|
| 26 | 26 |
|
|
| 59 | 59 |
Right val' -> return (Just val')
|
| 60 | 60 |
Left err -> Tansu (raise (DecodeError err))
|
| 61 | 61 |
|
| 62 | |
run :: Database -> Tansu a -> IO (Either TansuError a)
|
| 62 |
run :: TansuDb -> Tansu a -> IO (Either TansuError a)
|
| 63 | 63 |
run db (Tansu comp) =
|
| 64 | 64 |
dbRunTransaction db (runExceptionT (runReaderT db comp))
|
| 13 | 13 |
putStrLn "Testing ephemeral db"
|
| 14 | 14 |
withEphemeralDb sample
|
| 15 | 15 |
|
| 16 | |
sample :: Database -> IO ()
|
| 16 |
sample :: TansuDb -> IO ()
|
| 17 | 17 |
sample db = do
|
| 18 | 18 |
putStrLn "Populating test database"
|
| 19 | 19 |
run db $ do
|