Main.chs

module Main where

import Control.Exception
import Foreign.Ptr
import Foreign.Storable
import Foreign.C.String
import Foreign.Marshal.Alloc

#include "rocksdb/c.h"
#include "rocksdb_helpers.h"

{#enum rocksdb_no_compression as RocksDBCompression {underscoreToCase} deriving (Eq)#}

{#pointer *rocksdb_t as RocksDB foreign finalizer rocksdb_close_ifnotnull as rocksDBClose newtype#}

{#pointer *rocksdb_options_t as RocksDBOptions foreign finalizer rocksdb_options_destroy as rocksDBOptionsDestroy newtype#}

{#fun rocksdb_options_create as ^ {} -> `RocksDBOptions'#}

data RocksDBError = RocksDBError String deriving Show

instance Exception RocksDBError

throwIfPeek :: Ptr CString -> IO CString
throwIfPeek ptr | nullPtr /= ptr = do
                      err <- peek ptr >>= peekCString
                      throwIO $ RocksDBError err
                | otherwise = return nullPtr


-- {#fun rocksdb_open as ^ {`RocksDBOptions', `String', alloca- `CString' peek*} -> `RocksDB'#}
{#fun rocksdb_open as ^ {`RocksDBOptions', `String', alloca- `CString' throwIfPeek*-} -> `RocksDB'#}

type R = {#type rocksdb_t#}

main :: IO ()
main = do
  ropts <- rocksdbOptionsCreate
  rdb <- rocksdbOpen ropts "caca"
  -- XXX:  error empty if no error?
  -- TODO: enable "if missing"
  putStrLn "Done"
  return ()

Main.hs

-- GENERATED by C->Haskell Compiler, version 0.28.6 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Main.chs" #-}
module Main where
import qualified Foreign.C.String as C2HSImp
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.ForeignPtr as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Control.Exception
import Foreign.Ptr
import Foreign.Storable
import Foreign.C.String
import Foreign.Marshal.Alloc




data RocksDBCompression = RocksdbNoCompression
                        | RocksdbSnappyCompression
                        | RocksdbZlibCompression
                        | RocksdbBz2Compression
                        | RocksdbLz4Compression
                        | RocksdbLz4hcCompression
                        | RocksdbXpressCompression
                        | RocksdbZstdCompression
  deriving (Eq)
instance Enum RocksDBCompression where
  succ RocksdbNoCompression = RocksdbSnappyCompression
  succ RocksdbSnappyCompression = RocksdbZlibCompression
  succ RocksdbZlibCompression = RocksdbBz2Compression
  succ RocksdbBz2Compression = RocksdbLz4Compression
  succ RocksdbLz4Compression = RocksdbLz4hcCompression
  succ RocksdbLz4hcCompression = RocksdbXpressCompression
  succ RocksdbXpressCompression = RocksdbZstdCompression
  succ RocksdbZstdCompression = error "RocksDBCompression.succ: RocksdbZstdCompression has no successor"

  pred RocksdbSnappyCompression = RocksdbNoCompression
  pred RocksdbZlibCompression = RocksdbSnappyCompression
  pred RocksdbBz2Compression = RocksdbZlibCompression
  pred RocksdbLz4Compression = RocksdbBz2Compression
  pred RocksdbLz4hcCompression = RocksdbLz4Compression
  pred RocksdbXpressCompression = RocksdbLz4hcCompression
  pred RocksdbZstdCompression = RocksdbXpressCompression
  pred RocksdbNoCompression = error "RocksDBCompression.pred: RocksdbNoCompression has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from RocksdbZstdCompression

  fromEnum RocksdbNoCompression = 0
  fromEnum RocksdbSnappyCompression = 1
  fromEnum RocksdbZlibCompression = 2
  fromEnum RocksdbBz2Compression = 3
  fromEnum RocksdbLz4Compression = 4
  fromEnum RocksdbLz4hcCompression = 5
  fromEnum RocksdbXpressCompression = 6
  fromEnum RocksdbZstdCompression = 7

  toEnum 0 = RocksdbNoCompression
  toEnum 1 = RocksdbSnappyCompression
  toEnum 2 = RocksdbZlibCompression
  toEnum 3 = RocksdbBz2Compression
  toEnum 4 = RocksdbLz4Compression
  toEnum 5 = RocksdbLz4hcCompression
  toEnum 6 = RocksdbXpressCompression
  toEnum 7 = RocksdbZstdCompression
  toEnum unmatched = error ("RocksDBCompression.toEnum: Cannot match " ++ show unmatched)

{-# LINE 12 "./Main.chs" #-}


newtype RocksDB = RocksDB (C2HSImp.ForeignPtr (RocksDB))
withRocksDB :: RocksDB -> (C2HSImp.Ptr RocksDB -> IO b) -> IO b
withRocksDB (RocksDB fptr) = C2HSImp.withForeignPtr fptr
{-# LINE 14 "./Main.chs" #-}


newtype RocksDBOptions = RocksDBOptions (C2HSImp.ForeignPtr (RocksDBOptions))
withRocksDBOptions :: RocksDBOptions -> (C2HSImp.Ptr RocksDBOptions -> IO b) -> IO b
withRocksDBOptions (RocksDBOptions fptr) = C2HSImp.withForeignPtr fptr
{-# LINE 16 "./Main.chs" #-}


rocksdbOptionsCreate :: IO ((RocksDBOptions))
rocksdbOptionsCreate =
  rocksdbOptionsCreate'_ >>= \res ->
  (\x -> C2HSImp.newForeignPtr rocksDBOptionsDestroy x >>= (return . RocksDBOptions)) res >>= \res' ->
  return (res')

{-# LINE 18 "./Main.chs" #-}


data RocksDBError = RocksDBError String deriving Show

instance Exception RocksDBError

throwIfPeek :: Ptr CString -> IO CString
throwIfPeek ptr | nullPtr /= ptr = do
                      err <- peek ptr >>= peekCString
                      throwIO $ RocksDBError err
                | otherwise = return nullPtr


-- {#fun rocksdb_open as ^ {`RocksDBOptions', `String', alloca- `CString' peek*} -> `RocksDB'#}
rocksdbOpen :: (RocksDBOptions) -> (String) -> IO ((RocksDB))
rocksdbOpen a1 a2 =
  (withRocksDBOptions) a1 $ \a1' ->
  C2HSImp.withCString a2 $ \a2' ->
  alloca $ \a3' ->
  rocksdbOpen'_ a1' a2' a3' >>= \res ->
  (\x -> C2HSImp.newForeignPtr rocksDBClose x >>= (return . RocksDB)) res >>= \res' ->
  throwIfPeek  a3'>>
  return (res')

{-# LINE 32 "./Main.chs" #-}


type R = ((C2HSImp.Ptr ()))
{-# LINE 34 "./Main.chs" #-}


main :: IO ()
main = do
  ropts <- rocksdbOptionsCreate
  rdb <- rocksdbOpen ropts "caca"
  -- XXX:  error empty if no error?
  -- TODO: enable "if missing"
  putStrLn "Done"
  return ()

foreign import ccall "Main.chs.h &rocksdb_close_ifnotnull"
  rocksDBClose :: C2HSImp.FinalizerPtr RocksDB

foreign import ccall "Main.chs.h &rocksdb_options_destroy"
  rocksDBOptionsDestroy :: C2HSImp.FinalizerPtr RocksDBOptions

foreign import ccall safe "Main.chs.h rocksdb_options_create"
  rocksdbOptionsCreate'_ :: (IO (C2HSImp.Ptr (RocksDBOptions)))

foreign import ccall safe "Main.chs.h rocksdb_open"
  rocksdbOpen'_ :: ((C2HSImp.Ptr (RocksDBOptions)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (RocksDB))))))