module Database.KyotoCabinet.Internal
(
DB (..)
, WithDB (..)
, makeVolatile
, makePersistent
, openPersistent
, LoggingOptions (..)
, LogFile (..)
, LogKind (..)
, defaultLoggingOptions
, TuningOption (..)
, Options (..)
, Compressor (..)
, Comparator (..)
, getKeyValue
, formatName
) where
import Data.Int (Int64, Int8)
import Data.List (intercalate)
import Data.Maybe (maybeToList)
import Foreign.ForeignPtr (ForeignPtr, newForeignPtr)
import Foreign.Ptr (Ptr)
import Prelude hiding (log)
import Database.KyotoCabinet.Foreign
newtype DB = DB {unDB :: ForeignPtr KCDB}
class WithDB db where
getDB :: db -> DB
newDB :: Ptr KCDB -> IO DB
newDB kcdb = fmap DB (newForeignPtr kcdbdel kcdb)
makeVolatile :: (DB -> a) -> (opts -> [TuningOption]) -> String
-> LoggingOptions -> opts -> Mode -> IO a
makeVolatile constr optsconv class' log opts mode =
do kcdb <- kcdbnew
kcdbopen kcdb (formatName Nothing class' log (optsconv opts)) mode
fmap constr $ newDB kcdb
makePersistent :: (DB -> a) -> (opts -> [TuningOption]) -> String
-> FilePath -> LoggingOptions -> opts -> Mode -> IO a
makePersistent constr optsconv class' fn log opts mode =
do kcdb <- kcdbnew
kcdbopen kcdb (formatName (Just fn) class' log (optsconv opts)) mode
fmap constr $ newDB kcdb
openPersistent :: (DB -> a) -> String
-> FilePath -> LoggingOptions -> Mode -> IO a
openPersistent constr class' fn log mode =
do kcdb <- kcdbnew
kcdbopen kcdb (formatName (Just fn) class' log []) mode
fmap constr $ newDB kcdb
data LoggingOptions = LoggingOptions { logFile :: LogFile
, logKind :: [LogKind]
, logPrefix :: String
}
data LogFile = File FilePath | StdOut | StdErr
data LogKind = Debug | Info | Warn | Error
defaultLoggingOptions :: LoggingOptions
defaultLoggingOptions = LoggingOptions { logFile = StdOut
, logKind = [Debug, Info, Warn, Error]
, logPrefix = ""
}
data TuningOption = Options Options
| Buckets Int64
| Compressor Compressor
| CipherKey String
| MaxRecords Int64
| MaxSize Int64
| PageSize Int64
| Comparator Comparator
| PageCacheSize Int64
| AlignmentPow Int8
| FreePoolPow Int8
| MMapSize Int64
| DefragInterval Int64
deriving (Show, Read, Eq, Ord)
data Options = Compress
deriving (Show, Read, Eq, Ord)
data Compressor = Zlib
| DEFLATE
| Gz
| LZO
| LZMA
| Arc
deriving (Show, Read, Eq, Ord)
data Comparator = Lexical | Decimal
deriving (Show, Read, Eq, Ord)
getKeyValue :: TuningOption -> (String, String)
getKeyValue (Options Compress) = ("opts", "c")
getKeyValue (Buckets i) = ("bnum", show i)
getKeyValue (Compressor compr) = case compr of
Zlib -> (k, "zlib")
DEFLATE -> (k, "def")
Gz -> (k, "gz")
LZO -> (k, "lzo")
LZMA -> (k, "lzma")
Arc -> (k, "arc")
where k = "zcomp"
getKeyValue (CipherKey s) = ("zkey", s)
getKeyValue (MaxRecords i) = ("capcount", show i)
getKeyValue (MaxSize i) = ("capsize", show i)
getKeyValue (PageSize i) = ("psize", show i)
getKeyValue (Comparator comp) = case comp of
Lexical -> ("lex", k)
Decimal -> ("dec", k)
where k = "rcomp"
getKeyValue (PageCacheSize i) = ("pccap", show i)
getKeyValue (AlignmentPow i) = ("apow", show i)
getKeyValue (FreePoolPow i) = ("fpow", show i)
getKeyValue (MMapSize i) = ("msiz", show i)
getKeyValue (DefragInterval i) = ("dfunit", show i)
formatName :: Maybe FilePath
-> String
-> LoggingOptions
-> [TuningOption]
-> String
formatName fn class' log opts = hashify $ maybeToList fn ++ [type'] ++ optss ++ logs
where
hashify = intercalate "#"
eq k v = k ++ "=" ++ v
type' = "type" `eq` class'
optss = map (uncurry eq . getKeyValue) opts
logs = case log of
LoggingOptions lfile lks lpx -> [ "log" `eq` (logFileStr lfile)
, hashify (map (eq "logkinds" . logKindStr) lks)
, "logpx" `eq` lpx
]
logFileStr (File fp) = fp
logFileStr StdOut = "-"
logFileStr StdErr = "+"
logKindStr Debug = "debug"
logKindStr Info = "info"
logKindStr Warn = "warn"
logKindStr Error = "error"