diff --git a/Control/Exception/Extensible.hs b/Control/Exception/Extensible.hs new file mode 100644 --- /dev/null +++ b/Control/Exception/Extensible.hs @@ -0,0 +1,718 @@ +------------------------- +-- | +-- Module : Control.Exception +-- Copyright : (c) The University of Glasgow 2001 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (uses ExistentialQuantification and DeriveDataTypeable) +-- +-- This module provides the extensible exceptions API for raising and catching both +-- built-in and user-defined exceptions. +-- +-- For newer versions of GHC (>=6.9), this package re-exports 'Control.Exception'. +-- Otherwise, it provides a compatibility layer around the previous version of the +-- extensions API. + +{-# LANGUAGE CPP #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE DeriveDataTypeable #-} + +#ifdef USE_NEW_EXCEPTIONS +module Control.Exception.Extensible (module Control.Exception) where + +import Control.Exception hiding (blocked) + +#else +module Control.Exception.Extensible ( + -- * The Exception type + SomeException(..), + Exception(..), + E.IOException, + E.ArithException(..), + E.ArrayException(..), + AssertionFailed(..), + E.AsyncException(..), + NonTermination(..), + NestedAtomically(..), + ExitCode(..), + BlockedOnDeadMVar(..), + BlockedIndefinitely(..), + Deadlock(..), + NoMethodError(..), + PatternMatchFail(..), + RecConError(..), + RecSelError(..), + RecUpdError(..), + ErrorCall(..), + + -- * Throwing exceptions + throwIO, + throw, + ioError, + throwTo, + -- * Catching Exceptions + + -- |There are several functions for catching and examining + -- exceptions; all of them may only be used from within the + -- 'IO' monad. + + -- ** The @catch@ functions + catch, -- :: IO a -> (Exception -> IO a) -> IO a + catches, Handler(..), + catchJust, -- :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a + + -- ** The @handle@ functions + handle, -- :: (Exception -> IO a) -> IO a -> IO a + handleJust,-- :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a + + -- ** The @try@ functions + try, -- :: IO a -> IO (Either Exception a) + tryJust, -- :: (Exception -> Maybe b) -> a -> IO (Either b a) + onException, + + -- ** The @evaluate@ function + E.evaluate, -- :: a -> IO a + + -- ** The @mapException@ function + mapException, -- :: (Exception -> Exception) -> a -> a + + -- * Asynchronous Exceptions + + -- $async + + -- ** Asynchronous exception control + + -- |The following two functions allow a thread to control delivery of + -- asynchronous exceptions during a critical region. + + E.block, + E.unblock, + + -- *** Applying @block@ to an exception handler + + -- $block_handler + + -- *** Interruptible operations + + -- $interruptible + + -- * Assertions + + assert, + + -- * Utilities + bracket, + bracket_, + bracketOnError, + finally + ) where + +import Prelude hiding (catch) +import Control.Concurrent hiding (throwTo) +import qualified Control.Exception as E +import Data.Dynamic +import Data.Typeable +import System.Exit +import System.IO.Unsafe(unsafePerformIO) + +class (Typeable e, Show e) => Exception e where + toException :: e -> SomeException + fromException :: SomeException -> Maybe e + + toException = SomeException + fromException (SomeException e) = cast e + +data SomeException = forall e . Exception e => SomeException e + deriving Typeable + +instance Show SomeException where + showsPrec p (SomeException e) = showsPrec p e + +instance Exception SomeException where + toException se = se + fromException = Just + +mkOldException :: Exception e => e -> E.Exception +mkOldException e = let e' = toException e + in case fromException e' of + Just e'' -> -- If the exception is actually a legacy exception + -- then throw it directly so the legacy functions + -- catch it as they expect + e'' + Nothing -> -- Otherwise, throw it as a dynamic + E.DynException (toDyn e') + +throw :: Exception e => e -> a +throw e = E.throw (mkOldException e) + +throwIO :: Exception e => e -> IO a +throwIO e = E.throwIO (mkOldException e) + +throwTo :: Exception e => ThreadId -> e -> IO () +throwTo tid e = E.throwTo tid (mkOldException e) + +----------------------------------------------------------------------------- +-- Catching exceptions + +-- |This is the simplest of the exception-catching functions. It +-- takes a single argument, runs it, and if an exception is raised +-- the \"handler\" is executed, with the value of the exception passed as an +-- argument. Otherwise, the result is returned as normal. For example: +-- +-- > catch (openFile f ReadMode) +-- > (\e -> hPutStr stderr ("Couldn't open "++f++": " ++ show e)) +-- +-- For catching exceptions in pure (non-'IO') expressions, see the +-- function 'evaluate'. +-- +-- Note that due to Haskell\'s unspecified evaluation order, an +-- expression may return one of several possible exceptions: consider +-- the expression @error \"urk\" + 1 \`div\` 0@. Does +-- 'catch' execute the handler passing +-- @ErrorCall \"urk\"@, or @ArithError DivideByZero@? +-- +-- The answer is \"either\": 'catch' makes a +-- non-deterministic choice about which exception to catch. If you +-- call it again, you might get a different exception back. This is +-- ok, because 'catch' is an 'IO' computation. +-- +-- Note that 'catch' catches all types of exceptions, and is generally +-- used for \"cleaning up\" before passing on the exception using +-- 'throwIO'. It is not good practice to discard the exception and +-- continue, without first checking the type of the exception (it +-- might be a 'ThreadKilled', for example). In this case it is usually better +-- to use 'catchJust' and select the kinds of exceptions to catch. +-- +-- Also note that the "Prelude" also exports a function called +-- 'Prelude.catch' with a similar type to 'Control.Exception.catch', +-- except that the "Prelude" version only catches the IO and user +-- families of exceptions (as required by Haskell 98). +-- +-- We recommend either hiding the "Prelude" version of 'Prelude.catch' +-- when importing "Control.Exception": +-- +-- > import Prelude hiding (catch) +-- +-- or importing "Control.Exception" qualified, to avoid name-clashes: +-- +-- > import qualified Control.Exception as C +-- +-- and then using @C.catch@ +-- +catch :: Exception e + => IO a -- ^ The computation to run + -> (e -> IO a) -- ^ Handler to invoke if an exception is raised + -> IO a +catch io handler = io `E.catch` handler' + where handler' e = case fromException (toException e) of + Just e' -> + -- Handle the case where e == E.Exception, + -- or one of the types that make up E.Exception + handler e' + Nothing -> + case e of + E.DynException dyn -> + case fromDynamic dyn of + Just (SomeException exc) -> + case cast exc of + Just e' -> + -- Handle the case where we have + -- a new exception type encoded + -- as a Dynamic + handler e' + Nothing -> E.throw e + Nothing -> E.throw e + _ -> E.throw e + +-- | When you want to acquire a resource, do some work with it, and +-- then release the resource, it is a good idea to use 'bracket', +-- because 'bracket' will install the necessary exception handler to +-- release the resource in the event that an exception is raised +-- during the computation. If an exception is raised, then 'bracket' will +-- re-raise the exception (after performing the release). +-- +-- A common example is opening a file: +-- +-- > bracket +-- > (openFile "filename" ReadMode) +-- > (hClose) +-- > (\handle -> do { ... }) +-- +-- The arguments to 'bracket' are in this order so that we can partially apply +-- it, e.g.: +-- +-- > withFile name mode = bracket (openFile name mode) hClose +-- +bracket + :: IO a -- ^ computation to run first (\"acquire resource\") + -> (a -> IO b) -- ^ computation to run last (\"release resource\") + -> (a -> IO c) -- ^ computation to run in-between + -> IO c -- returns the value from the in-between computation +bracket before after thing = + E.block (do + a <- before + r <- E.unblock (thing a) `onException` after a + after a + return r + ) + +onException :: IO a -> IO b -> IO a +onException io what = io `catch` \e -> do what + throw (e :: SomeException) + +block, unblock :: IO a -> IO a +block = E.block +unblock = E.unblock + +-- | A specialised variant of 'bracket' with just a computation to run +-- afterward. +-- +finally :: IO a -- ^ computation to run first + -> IO b -- ^ computation to run afterward (even if an exception + -- was raised) + -> IO a -- returns the value from the first computation +a `finally` sequel = + E.block (do + r <- E.unblock a `onException` sequel + sequel + return r + ) + +-- | A variant of 'bracket' where the return value from the first computation +-- is not required. +bracket_ :: IO a -> IO b -> IO c -> IO c +bracket_ before after thing = bracket before (const after) (const thing) + +-- | Like bracket, but only performs the final action if there was an +-- exception raised by the in-between computation. +bracketOnError + :: IO a -- ^ computation to run first (\"acquire resource\") + -> (a -> IO b) -- ^ computation to run last (\"release resource\") + -> (a -> IO c) -- ^ computation to run in-between + -> IO c -- returns the value from the in-between computation +bracketOnError before after thing = + block (do + a <- before + unblock (thing a) `onException` after a + ) + +assert :: Bool -> a -> a +assert True x = x +assert False _ = throw (AssertionFailed "") + +-- | The function 'catchJust' is like 'catch', but it takes an extra +-- argument which is an /exception predicate/, a function which +-- selects which type of exceptions we\'re interested in. +-- +-- > result <- catchJust errorCalls thing_to_try handler +-- +-- Any other exceptions which are not matched by the predicate +-- are re-raised, and may be caught by an enclosing +-- 'catch' or 'catchJust'. +catchJust + :: Exception e + => (e -> Maybe b) -- ^ Predicate to select exceptions + -> IO a -- ^ Computation to run + -> (b -> IO a) -- ^ Handler + -> IO a +catchJust p a handler = catch a handler' + where handler' e = case p e of + Nothing -> throw e + Just b -> handler b + +-- | A version of 'catch' with the arguments swapped around; useful in +-- situations where the code for the handler is shorter. For example: +-- +-- > do handle (\e -> exitWith (ExitFailure 1)) $ +-- > ... +handle :: Exception e => (e -> IO a) -> IO a -> IO a +handle = flip catch + +-- | A version of 'catchJust' with the arguments swapped around (see +-- 'handle'). +handleJust :: Exception e => (e -> Maybe b) -> (b -> IO a) -> IO a -> IO a +handleJust p = flip (catchJust p) + +----------------------------------------------------------------------------- +-- 'mapException' + +-- | This function maps one exception into another as proposed in the +-- paper \"A semantics for imprecise exceptions\". + +-- Notice that the usage of 'unsafePerformIO' is safe here. + +mapException :: (Exception e1, Exception e2) => (e1 -> e2) -> a -> a +mapException f v = unsafePerformIO (catch (E.evaluate v) + (\x -> throw (f x))) + +----------------------------------------------------------------------------- +-- 'try' and variations. + +-- | Similar to 'catch', but returns an 'Either' result which is +-- @('Right' a)@ if no exception was raised, or @('Left' e)@ if an +-- exception was raised and its value is @e@. +-- +-- > try a = catch (Right `liftM` a) (return . Left) +-- +-- Note: as with 'catch', it is only polite to use this variant if you intend +-- to re-throw the exception after performing whatever cleanup is needed. +-- Otherwise, 'tryJust' is generally considered to be better. +-- +-- Also note that "System.IO.Error" also exports a function called +-- 'System.IO.Error.try' with a similar type to 'Control.Exception.try', +-- except that it catches only the IO and user families of exceptions +-- (as required by the Haskell 98 @IO@ module). + +try :: Exception e => IO a -> IO (Either e a) +try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e)) + +-- | A variant of 'try' that takes an exception predicate to select +-- which exceptions are caught (c.f. 'catchJust'). If the exception +-- does not match the predicate, it is re-thrown. +tryJust :: Exception e => (e -> Maybe b) -> IO a -> IO (Either b a) +tryJust p a = do + r <- try a + case r of + Right v -> return (Right v) + Left e -> case p e of + Nothing -> throw e + Just b -> return (Left b) + + +------------- + + + +data Handler a = forall e . Exception e => Handler (e -> IO a) + +catches :: IO a -> [Handler a] -> IO a +catches io handlers = io `catch` catchesHandler handlers + +catchesHandler :: [Handler a] -> SomeException -> IO a +catchesHandler handlers e = foldr tryHandler (throw e) handlers + where tryHandler (Handler handler) res + = case fromException e of + Just e' -> handler e' + Nothing -> res + + +-- ----------------------------------------------------------------------------- +-- Asynchronous exceptions + +{- $async + + #AsynchronousExceptions# Asynchronous exceptions are so-called because they arise due to +external influences, and can be raised at any point during execution. +'StackOverflow' and 'HeapOverflow' are two examples of +system-generated asynchronous exceptions. + +The primary source of asynchronous exceptions, however, is +'throwTo': + +> throwTo :: ThreadId -> Exception -> IO () + +'throwTo' (also 'throwDynTo' and 'Control.Concurrent.killThread') allows one +running thread to raise an arbitrary exception in another thread. The +exception is therefore asynchronous with respect to the target thread, +which could be doing anything at the time it receives the exception. +Great care should be taken with asynchronous exceptions; it is all too +easy to introduce race conditions by the over zealous use of +'throwTo'. +-} + +{- $block_handler +There\'s an implied 'block' around every exception handler in a call +to one of the 'catch' family of functions. This is because that is +what you want most of the time - it eliminates a common race condition +in starting an exception handler, because there may be no exception +handler on the stack to handle another exception if one arrives +immediately. If asynchronous exceptions are blocked on entering the +handler, though, we have time to install a new exception handler +before being interrupted. If this weren\'t the default, one would have +to write something like + +> block ( +> catch (unblock (...)) +> (\e -> handler) +> ) + +If you need to unblock asynchronous exceptions again in the exception +handler, just use 'unblock' as normal. + +Note that 'try' and friends /do not/ have a similar default, because +there is no exception handler in this case. If you want to use 'try' +in an asynchronous-exception-safe way, you will need to use +'block'. +-} + +{- $interruptible + +Some operations are /interruptible/, which means that they can receive +asynchronous exceptions even in the scope of a 'block'. Any function +which may itself block is defined as interruptible; this includes +'Control.Concurrent.MVar.takeMVar' +(but not 'Control.Concurrent.MVar.tryTakeMVar'), +and most operations which perform +some I\/O with the outside world. The reason for having +interruptible operations is so that we can write things like + +> block ( +> a <- takeMVar m +> catch (unblock (...)) +> (\e -> ...) +> ) + +if the 'Control.Concurrent.MVar.takeMVar' was not interruptible, +then this particular +combination could lead to deadlock, because the thread itself would be +blocked in a state where it can\'t receive any asynchronous exceptions. +With 'Control.Concurrent.MVar.takeMVar' interruptible, however, we can be +safe in the knowledge that the thread can receive exceptions right up +until the point when the 'Control.Concurrent.MVar.takeMVar' succeeds. +Similar arguments apply for other interruptible operations like +'System.IO.openFile'. +-} + + +---------------------------------------------------------------------- +-- Exception instance for the legacy Exception type + +instance Exception E.Exception + +---------------------------------------------------------------------- +-- The new Exception types. These need to map to/from E.Exception so +-- that uses of legacy catch/throw functions work. + +---- + +instance Exception E.ArithException where + toException ae = toException (E.ArithException ae) + fromException (SomeException e) = case cast e of + Just (E.ArithException ae) -> + Just ae + _ -> Nothing +---- + +instance Exception E.ArrayException where + toException ae = toException (E.ArrayException ae) + fromException (SomeException e) = case cast e of + Just (E.ArrayException ae) -> + Just ae + _ -> Nothing + +---- + +data AssertionFailed = AssertionFailed String + deriving Typeable + +instance Exception AssertionFailed where + toException (AssertionFailed str) = toException (E.AssertionFailed str) + fromException (SomeException e) = case cast e of + Just (E.AssertionFailed str) -> + Just (AssertionFailed str) + _ -> Nothing + +instance Show AssertionFailed where + showsPrec _ (AssertionFailed err) = showString err + +----- + +instance Exception E.AsyncException where + toException ae = toException (E.AsyncException ae) + fromException (SomeException e) = case cast e of + Just (E.AsyncException ae) -> + Just ae + _ -> Nothing + +---- + +data BlockedOnDeadMVar = BlockedOnDeadMVar + deriving Typeable + +instance Exception BlockedOnDeadMVar where + toException BlockedOnDeadMVar = toException (E.BlockedOnDeadMVar) + fromException (SomeException e) = case cast e of + Just E.BlockedOnDeadMVar -> + Just BlockedOnDeadMVar + _ -> Nothing +instance Show BlockedOnDeadMVar where + showsPrec n BlockedOnDeadMVar = showsPrec n E.BlockedOnDeadMVar + +---- + +data BlockedIndefinitely = BlockedIndefinitely + deriving Typeable + +instance Exception BlockedIndefinitely where + toException BlockedIndefinitely = toException E.BlockedIndefinitely + fromException (SomeException e) = case cast e of + Just E.BlockedIndefinitely -> + Just BlockedIndefinitely + _ -> Nothing + +instance Show BlockedIndefinitely where + showsPrec n BlockedIndefinitely = showsPrec n E.BlockedIndefinitely + +---- + +data NestedAtomically = NestedAtomically + deriving Typeable + +instance Exception NestedAtomically where + toException NestedAtomically = toException E.NestedAtomically + fromException (SomeException e) = case cast e of + Just E.NestedAtomically -> + Just NestedAtomically + _ -> Nothing + +instance Show NestedAtomically where + showsPrec n NestedAtomically = showsPrec n E.NestedAtomically + +---- + +data Deadlock = Deadlock + deriving Typeable + +instance Exception Deadlock where + toException Deadlock = toException E.Deadlock + fromException (SomeException e) = case cast e of + Just E.Deadlock -> + Just Deadlock + _ -> Nothing + +instance Show Deadlock where + showsPrec n Deadlock = showsPrec n E.Deadlock + +----- + +data ErrorCall = ErrorCall String + deriving Typeable + +instance Exception ErrorCall where + toException (ErrorCall str) = toException (E.ErrorCall str) + fromException (SomeException e) = case cast e of + Just (E.ErrorCall str) -> + Just (ErrorCall str) + _ -> Nothing + +instance Show ErrorCall where + showsPrec _ (ErrorCall err) = showString err + +----- + +instance Typeable ExitCode where + typeOf _ = mkTyConApp (mkTyCon "ExitCode") [] + +instance Exception ExitCode where + toException ee = toException (E.ExitException ee) + fromException (SomeException e) = case cast e of + Just (E.ExitException ee) -> + Just ee + _ -> Nothing +----- + +instance Exception E.IOException where + toException ioe = toException (E.IOException ioe) + fromException (SomeException e) = case cast e of + Just (E.IOException ioe) -> + Just ioe + _ -> Nothing + +---- + +data NoMethodError = NoMethodError String + deriving Typeable + +instance Exception NoMethodError where + toException (NoMethodError str) = toException (E.NoMethodError str) + fromException (SomeException e) = case cast e of + Just (E.NoMethodError str) -> + Just (NoMethodError str) + _ -> Nothing + +instance Show NoMethodError where + showsPrec _ (NoMethodError str) = showString str + +---- + +data NonTermination = NonTermination + deriving Typeable + +instance Exception NonTermination where + toException NonTermination = toException E.NonTermination + fromException (SomeException e) = case cast e of + Just E.NonTermination -> + Just NonTermination + _ -> Nothing + +instance Show NonTermination where + showsPrec n NonTermination = showsPrec n E.NonTermination + +---- + +data PatternMatchFail = PatternMatchFail String + deriving Typeable + +instance Exception PatternMatchFail where + toException (PatternMatchFail str) = toException (E.PatternMatchFail str) + fromException (SomeException e) = case cast e of + Just (E.PatternMatchFail str) -> + Just (PatternMatchFail str) + _ -> Nothing + +instance Show PatternMatchFail where + showsPrec _ (PatternMatchFail str) = showString str + + +---- + +data RecConError = RecConError String + deriving Typeable + +instance Exception RecConError where + toException (RecConError str) = toException (E.RecConError str) + fromException (SomeException e) = case cast e of + Just (E.RecConError str) -> + Just (RecConError str) + _ -> Nothing + +instance Show RecConError where + showsPrec _ (RecConError str) = showString str + + + +---- + +data RecSelError = RecSelError String + deriving Typeable + +instance Exception RecSelError where + toException (RecSelError str) = toException (E.RecSelError str) + fromException (SomeException e) = case cast e of + Just (E.RecSelError str) -> + Just (RecSelError str) + _ -> Nothing + +instance Show RecSelError where + showsPrec _ (RecSelError str) = showString str + +---- + +data RecUpdError = RecUpdError String + deriving Typeable + +instance Exception RecUpdError where + toException (RecUpdError str) = toException (E.RecUpdError str) + fromException (SomeException e) = case cast e of + Just (E.RecUpdError str) -> + Just (RecUpdError str) + _ -> Nothing + +instance Show RecUpdError where + showsPrec _ (RecUpdError str) = showString str + + +#endif + diff --git a/Control/Exception/MonadIO.hs b/Control/Exception/MonadIO.hs --- a/Control/Exception/MonadIO.hs +++ b/Control/Exception/MonadIO.hs @@ -6,36 +6,21 @@ ) where import Control.Monad.Trans -import Control.Exception +import Control.Exception.Extensible import Control.Monad.Reader -gtry :: (CaughtMonadIO m) => m b -> m (Either Exception b) -gtry a = gcatch (liftM Right a) (return . Left) -gtryJust :: (CaughtMonadIO m) => - (Exception -> Maybe b) -> m b1 -> m (Either b b1) -gtryJust p a = gcatchJust p (liftM Right a) (return . Left) - -gbracket :: (CaughtMonadIO m) => - m t -> (t -> m a) -> (t -> m b) -> m b -gbracket acq rel act = do - r <- acq - gcatch (do - v <- act r - rel r - return v - ) - (\e -> rel r >> throw e) - -gfinally :: (CaughtMonadIO m) => m t -> m a -> m t -gfinally a f = gbracket (return ()) (const f) (const a) - +gtry :: (Exception e, CaughtMonadIO m) => m b -> m (Either e b) +gtryJust :: (Exception e, CaughtMonadIO m) => (e -> Maybe b) -> m b1 -> m (Either b b1) class MonadIO m => CaughtMonadIO m where - gcatch :: m a -> (Exception -> m a) -> m a - gcatchJust :: (Exception -> Maybe b) -> m a -> (b -> m a) -> m a + gcatch :: (Exception e) => m a -> (e -> m a) -> m a + gcatchJust :: (Exception e) => (e -> Maybe b) -> m a -> (b -> m a) -> m a +gtry a = gcatch (liftM Right a) (return . Left) +gtryJust p a = gcatchJust p (liftM Right a) (return . Left) + instance CaughtMonadIO IO where - gcatch = Control.Exception.catch + gcatch = Control.Exception.Extensible.catch gcatchJust = catchJust instance CaughtMonadIO m => CaughtMonadIO (ReaderT a m) where @@ -48,3 +33,16 @@ Just e' -> runReaderT (h e') r ) +gbracket :: (CaughtMonadIO m) => + m t -> (t -> m a) -> (t -> m b) -> m b +gbracket acq rel act = do + r <- acq + gcatch (do + v <- act r + rel r + return v + ) + (\e@(SomeException _) -> rel r >> throw e) + +gfinally :: (CaughtMonadIO m) => m t -> m a -> m t +gfinally a f = gbracket (return ()) (const f) (const a) diff --git a/Database/Enumerator.lhs b/Database/Enumerator.lhs --- a/Database/Enumerator.lhs +++ b/Database/Enumerator.lhs @@ -36,21 +36,20 @@ but their specific types and usage may differ between DBMS. -Had better keep the old style, for older versions of GHC. - -> {-# OPTIONS -cpp #-} > {-# OPTIONS -fglasgow-exts #-} -> {-# OPTIONS -fallow-overlapping-instances #-} -> {-# OPTIONS -fallow-undecidable-instances #-} - -New style extension declarations. - > {-# LANGUAGE CPP #-} > {-# LANGUAGE GeneralizedNewtypeDeriving #-} > {-# LANGUAGE OverlappingInstances #-} > {-# LANGUAGE UndecidableInstances #-} +> {- LANGUAGE MultiParamTypeClasses #-} +> {- LANGUAGE RankNTypes #-} +> {- LANGUAGE FunctionalDependencies #-} +> {- LANGUAGE FlexibleInstances #-} +> {- LANGUAGE FlexibleContexts #-} + + > module Database.Enumerator > ( > -- * Usage @@ -120,9 +119,7 @@ > import Data.IORef > import Data.Time > import Control.Monad.Trans (liftIO) -> import Control.Exception (throw, -> dynExceptions, throwDyn, bracket, Exception, finally) -> import qualified Control.Exception (catch) +> import Control.Exception.Extensible > import Control.Monad.Fix > import Control.Monad.Reader > import Control.Exception.MonadIO @@ -146,10 +143,10 @@ monad. > catchDB :: CaughtMonadIO m => m a -> (IE.DBException -> m a) -> m a -> catchDB action handler = gcatch action $ \e -> -> maybe (throw e) handler (dynExceptions e >>= fromDynamic) +> catchDB action handler = gcatch action $ handler + |This simple handler reports the error to @stdout@ and swallows it i.e. it doesn't propagate. @@ -288,8 +285,12 @@ > -> IO (a, IE.ConnectA sess) > withContinuedSession (IE.ConnectA connecta) m = > do conn <- connecta -- this invalidates connecta +> -- Note: if there was an error, then disconnect, +> -- but don't disconnect in the success case +> -- (the connecta action will raise an error if the +> -- connection is re-used). > r <- runReaderT (unDBM m) conn -> `Control.Exception.catch` (\e -> IE.disconnect conn >> throw e) +> `catch` (\e@(SomeException _) -> IE.disconnect conn >> throw e) > -- make a new, one-shot connecta > hasbeenused <- newIORef False > let connecta = do @@ -380,7 +381,7 @@ > v <- action ps > destroyStmt ps > return v -> ) (\e -> gcatch (destroyStmt ps >> throw e) (\_ -> throw e)) +> ) (\e@(SomeException _) -> gcatch (destroyStmt ps >> throw e) (\e2@(SomeException _) -> throw e)) Not exported. @@ -493,7 +494,7 @@ > doQuery stmt iteratee seed = do > (lFoldLeft, finalizer) <- doQueryMaker stmt iteratee > gcatch (fix lFoldLeft iteratee seed) -> (\e -> do +> (\e@(SomeException _) -> do > finalizer > liftIO (throw e) > ) @@ -503,18 +504,14 @@ > doQueryMaker stmt iteratee = do > sess <- ask -> query <- liftIO $ IE.makeQuery sess stmt > -- if buffer allocation raises an exception > -- (which it might) then we need to clean up the query object. +> query <- liftIO (IE.makeQuery sess stmt) > buffers <- gcatch (allocBuffers query iteratee 1) -> (\e -> do -> liftIO (IE.destroyQuery query) -> liftIO (throw e) -> ) +> (\e@(SomeException _) -> liftIO (IE.destroyQuery query >> throw e) ) > let > finaliser = -> liftIO (mapM_ (IE.freeBuffer query) buffers) -> >> liftIO (IE.destroyQuery query) +> liftIO (mapM_ (IE.freeBuffer query) buffers >> IE.destroyQuery query) > hFoldLeft self iteratee initialSeed = do > let > handle seed True = iterApply query buffers seed iteratee @@ -642,7 +639,7 @@ > v <- action > commit > return v -> ) (\e -> rollback >> throw e ) +> ) (\e@(SomeException _) -> rollback >> throw e ) -------------------------------------------------------------------- diff --git a/Database/InternalEnumerator.lhs b/Database/InternalEnumerator.lhs --- a/Database/InternalEnumerator.lhs +++ b/Database/InternalEnumerator.lhs @@ -12,8 +12,10 @@ Only the programmer for a new back-end needs to consult this file. -> {-# OPTIONS -fglasgow-exts #-} +> {-# LANGUAGE MultiParamTypeClasses #-} +> {-# LANGUAGE FunctionalDependencies #-} + > module Database.InternalEnumerator > ( > -- * Session object. @@ -35,8 +37,7 @@ > ) where > import Data.Typeable -> import Control.Exception (throw, catchDyn, -> dynExceptions, throwDyn, throwIO, bracket, Exception) +> import Control.Exception.Extensible (throw, Exception) > import qualified Control.Exception (catch) > data IsolationLevel = @@ -87,10 +88,12 @@ > | DBNoData > deriving (Typeable, Show) +> instance Exception DBException + | Throw a DBException. It's just a type-specific 'Control.Exception.throwDyn'. > throwDB :: DBException -> a -> throwDB = throwDyn +> throwDB = throw -------------------------------------------------------------------- diff --git a/Database/MSSqlServer/MSSqlFunctions.lhs b/Database/MSSqlServer/MSSqlFunctions.lhs new file mode 100644 --- /dev/null +++ b/Database/MSSqlServer/MSSqlFunctions.lhs @@ -0,0 +1,93 @@ + +| +Module : Database.MSSqlServer.MSSqlFunctions +Copyright : (c) 2004 Oleg Kiselyov, Alistair Bayley +License : BSD-style +Maintainer : oleg@pobox.com, alistair@abayley.org +Stability : experimental +Portability : non-portable + +Simple wrappers for MS Sql Server functions (FFI). + + > -L"C:\Program Files\Common Files\System\Ole DB" -lsqloledb + +Don't forget to specify the header file location +(or wherever your Sql Server installation resides): + + > "-IC:\Program Files\Microsoft SQL Server\80\Tools\DevTools\Include" + + +> {-# OPTIONS -ffi #-} +> {-# OPTIONS -fglasgow-exts #-} + +From C:\WINDOWS\hh.exe "C:\Program Files\Microsoft SQL Server\80\Tools\Books\SQL80.col" + -- Compiling OLE DB Applications -- +"Most applications use wide character strings to make OLE DB function calls. +If applications are using TCHAR variables, the application must include +#define UNICODE in the application. It converts the TCHAR variables to +wide character strings." + +> {-# OPTIONS -optc-DUNICODE #-} + +Do we need this? + {-# OPTIONS -#include "windows.h" #-} + +> {-# OPTIONS -#include "sqloledb.h" #-} +> {-# OPTIONS -#include "oledberr.h" #-} + +Don't need to explcitly include sqldb.h, as it's implied by the +FFI foreign import declarations e.g. + > foreign import ccall "oledb.h dbinit" dbInit :: IO CString +implies + {- # OPTIONS -#include "oledb.h" #-} + + +> module Database.MSSqlServer.MSSqlFunctions where + +> import Foreign +> import Foreign.C +> import Control.Monad +> import Control.Exception +> import Data.Dynamic +> import Data.Int +> import Data.IORef + + + +> data MSSqlException = MSSqlException Int String +> deriving (Typeable, Eq) + +> instance Show MSSqlException where +> show (MSSqlException i s) = "MSSqlException " ++ (show i) ++ " " ++ s + +> makeEx :: CInt -> String -> MSSqlException +> makeEx e msg = MSSqlException (fromIntegral e) msg + +> catchMSSql :: IO a -> (MSSqlException -> IO a) -> IO a +> catchMSSql = catchDyn + +> throwMSSql :: MSSqlException -> a +> throwMSSql = throwDyn + +> throwEx :: CInt -> String -> IO a +> throwEx e msg = throwMSSql (makeEx e msg) + +> testForError :: CInt -> String -> a -> IO a +> testForError rc msg retval = do +> case () of +> _ | rc == dbSUCCEED -> return retval +> | otherwise -> throwEx rc msg + +> errorOnNull :: Ptr b -> String -> a -> IO a +> errorOnNull ptr msg retval = do +> if ptr == nullPtr +> then throwEx (-1 ) msg +> else return retval + +> cStr :: CStringLen -> CString +> cStr = fst +> cStrLen :: CStringLen -> CInt +> cStrLen = fromIntegral . snd + + + foreign import ccall "sqldb.h dbinit" dbInit :: IO CString diff --git a/Database/MSSqlServer/Test/Enumerator.lhs b/Database/MSSqlServer/Test/Enumerator.lhs new file mode 100644 --- /dev/null +++ b/Database/MSSqlServer/Test/Enumerator.lhs @@ -0,0 +1,32 @@ + +| +Module : Database.MSSqlServer.Test.Enumerator +Copyright : (c) 2004 Oleg Kiselyov, Alistair Bayley +License : BSD-style +Maintainer : oleg@pobox.com, alistair@abayley.org +Stability : experimental +Portability : non-portable + +> {-# OPTIONS -fglasgow-exts -fallow-overlapping-instances #-} + +> module Database.MSSqlServer.Test.Enumerator (runTest) where + +> --import qualified Database.MSSqlServer.Enumerator as MSSql (connect, disconnect) +> import qualified Database.MSSqlServer.Test.MSSqlFunctions as Low +> import Database.Test.Enumerator as Enum +> import Database.Test.Performance as Perf +> import Database.Enumerator +> import Control.Monad (when) + + +> runTest :: Perf.ShouldRunTests -> [String] -> IO () +> runTest runPerf args = catchDB ( do +> let [user, pswd, dbname ] = args +> Low.runTest args +> {- +> sess <- MSSql.connect user pswd dbname +> Enum.runTests dateMSSql sess +> when (runPerf == Perf.RunTests) (Perf.runTests sess) +> MSSql.disconnect sess +> -} +> ) basicDBExceptionReporter diff --git a/Database/MSSqlServer/Test/MSSqlFunctions.lhs b/Database/MSSqlServer/Test/MSSqlFunctions.lhs new file mode 100644 --- /dev/null +++ b/Database/MSSqlServer/Test/MSSqlFunctions.lhs @@ -0,0 +1,79 @@ + +| +Module : Database.MSSqlServer.Test.MSSqlFunctions +Copyright : (c) 2004 Oleg Kiselyov, Alistair Bayley +License : BSD-style +Maintainer : oleg@pobox.com, alistair@abayley.org +Stability : experimental +Portability : non-portable + + +> {-# OPTIONS -fglasgow-exts #-} + + +> module Database.MSSqlServer.Test.MSSqlFunctions (runTest) where + +> import Prelude hiding (catch) +> import Foreign +> import Foreign.C +> import Control.Monad +> import Control.Exception +> import Data.Dynamic +> import Database.MSSqlServer.MSSqlFunctions +> import System.Environment (getArgs) +> import Test.HUnit +> import Data.IORef + + +> nullException = MSSqlException 0 "" + +> runTest :: [String] -> IO () +> runTest args = do +> ex <- newIORef nullException +> printIgnoreError ex $ do +> let [ usr, pwd, dbase, svr ] = args +> putStrLn "init" +> dbInit +> putStrLn "install error handler" +> enableErrorHandler ex +> putStrLn "open" +> sess <- open usr pwd dbase svr +> putStrLn "exec" +> execQuery sess "select 'hello'" +> putStrLn "fetch" +> rc <- fetchRow sess +> putStrLn "value" +> s <- colValString sess 1 +> putStrLn s +> putStrLn "cancel" +> dbCancel sess +> putStrLn "close" +> dbClose sess +> putStrLn "exit" +> dbExit +> return () + + +> testlist db = TestList $ map (\t -> TestCase (t db)) +> [ ] + +> ignoreError :: IO () -> IO () +> ignoreError action = +> catchMSSql action (\e -> return ()) + +> printIgnoreError :: IORef MSSqlException -> IO () -> IO () +> printIgnoreError refex action = catchMSSql action +> (\e -> do +> realEx <- readIORef refex +> let ex = if realEx == nullException then e else realEx +> putStrLn (show ex) +> ) + +> printPropagateError :: IORef MSSqlException -> IO a -> IO a +> printPropagateError refex action = catchMSSql action +> (\e -> do +> realEx <- readIORef refex +> let ex = if realEx == nullException then e else realEx +> putStrLn (show ex) +> throwMSSql ex +> ) diff --git a/Database/ODBC/Enumerator.lhs b/Database/ODBC/Enumerator.lhs --- a/Database/ODBC/Enumerator.lhs +++ b/Database/ODBC/Enumerator.lhs @@ -10,16 +10,40 @@ ODBC implementation of Database.Enumerator. +Notes on ODBC query processing: +Query rebinding (i.e. prepared-stmt reuse) is awkward +(at least for MS SQL Server): + + * For a normal "select", when you are done fetching, + you must call closeCursor before you attempt to rebind. + + * For a procedure call returning result-sets, + again (I think) you must call closeCursor before rebinding. + Don't call it until you've processed all result-sets, + because it will close all of them, including any unprocessed. + + * For a procedure call that does not return a result-set, + closeCursor will raise an error. + + * If you call closeCursor after preparing the stmt, + but before binding and executing, this will cause an error. + This means we can't simply call closeCursor before every bind. + +So when do we call closeCursor? +Before binding, but only if the prepared-stmt object +indicates that some rows have already been fetched. + + > {-# OPTIONS -fglasgow-exts #-} -> {-# OPTIONS -fallow-undecidable-instances #-} -> {-# OPTIONS -fallow-overlapping-instances #-} +> {-# LANGUAGE OverlappingInstances #-} +> {-# LANGUAGE UndecidableInstances #-} > module Database.ODBC.Enumerator > ( Session, connect -> , prepareStmt, preparePrefetch +> , prepareStmt > , prepareQuery, prepareLargeQuery, prepareCommand > , sql, sqlbind, prefetch, cmdbind -> , Out(..) +> , Out(..), InfoDbmsName(..) > , module Database.Enumerator > ) > where @@ -31,7 +55,7 @@ > import Foreign.C > import Foreign.Storable (sizeOf) > import Control.Monad -> import Control.Exception +> import Control.Exception.Extensible (bracket) > import Database.ODBC.OdbcFunctions > (EnvHandle, ConnHandle, StmtHandle, OdbcException(..), catchOdbc, throwOdbc) > import qualified Database.ODBC.OdbcFunctions as DBAPI @@ -41,10 +65,13 @@ > import Data.Dynamic > import Data.IORef > import Data.Int +> import Data.List (isPrefixOf) > import System.Time > import Data.Time +> --debugStmt s = putStrLn s +> debugStmt s = return () -------------------------------------------------------------------- -- ** API Wrappers @@ -86,7 +113,7 @@ > stmtExecute stmt = convertEx (DBAPI.executeStmt stmt) > closeCursor :: StmtHandle -> IO () -> closeCursor stmt = convertEx (DBAPI.closeCursor stmt) +> closeCursor stmt = debugStmt "closeCursor" >> convertEx (DBAPI.closeCursor stmt) > fetchRow :: StmtHandle -> IO Bool > fetchRow stmt = convertEx (DBAPI.fetch stmt) @@ -94,7 +121,7 @@ > rowCount :: StmtHandle -> IO Int > rowCount stmt = convertEx (DBAPI.rowCount stmt) -> freeStmt stmt = convertEx (DBAPI.freeStmt stmt) +> freeStmt stmt = debugStmt "freeStmt" >> convertEx (DBAPI.freeStmt stmt) > freeConn conn = convertEx (DBAPI.freeConn conn) > freeEnv env = convertEx (DBAPI.freeEnv env) @@ -131,6 +158,32 @@ > (env, conn) <- connectDb connstr > return (Session env conn) + +Note: the PostgreSQL ODBC driver only supports ReadCommitted +and Serializable. It throws an error on other values. +It'd be nicer if it just silently upgraded, but c'est la vie... + +Apparently MS SQL Server upgrades RepeatableRead to Serializable. +Presumably the other modes are still supported. + +> isolationLevel ReadUncommitted = DBAPI.sqlTxnReadUncommitted +> isolationLevel ReadCommitted = DBAPI.sqlTxnReadCommitted +> isolationLevel RepeatableRead = DBAPI.sqlTxnRepeatableRead +> isolationLevel Serialisable = DBAPI.sqlTxnSerializable +> isolationLevel Serializable = DBAPI.sqlTxnSerializable + +> instance ISession Session where +> disconnect sess = do +> disconnectDb (connHandle sess) +> freeConn (connHandle sess) +> freeEnv (envHandle sess) +> -- With ODBC, transactions are implicitly started. +> beginTransaction sess isolation = do +> commitTrans (connHandle sess) +> setTransLevel (connHandle sess) (isolationLevel isolation) +> commit sess = commitTrans (connHandle sess) +> rollback sess = rollbackTrans (connHandle sess) + -------------------------------------------------------------------- -- Statements and Commands -------------------------------------------------------------------- @@ -153,10 +206,6 @@ > liftM fromIntegral (rowCount stmt) > ) -> instance Command BoundStmt Session where -> executeCommand sess (BoundStmt pstmt) = -> rowCount (stmtHandle pstmt) - > instance Command StmtBind Session where > executeCommand sess (StmtBind sqltext bas) = do > let (PreparationA action) = prepareStmt' sqltext FreeManually @@ -169,31 +218,18 @@ > rowCount (stmtHandle pstmt) > ) -Note: the PostgreSQL ODBC driver only supports ReadCommitted -and Serializable. It throws an error on other values. -It'd be nicer if it just silently upgraded, but c'est la vie... +> instance Command BoundStmt Session where +> executeCommand sess (BoundStmt pstmt) = +> rowCount (stmtHandle pstmt) -Apparently MS SQL Server upgrades RepeatableRead to Serializable. -Presumably the other modes are still supported. -> isolationLevel ReadUncommitted = DBAPI.sqlTxnReadUncommitted -> isolationLevel ReadCommitted = DBAPI.sqlTxnReadCommitted -> isolationLevel RepeatableRead = DBAPI.sqlTxnRepeatableRead -> isolationLevel Serialisable = DBAPI.sqlTxnSerializable -> isolationLevel Serializable = DBAPI.sqlTxnSerializable +> data InfoDbmsName = InfoDbmsName -> instance ISession Session where -> disconnect sess = do -> disconnectDb (connHandle sess) -> freeConn (connHandle sess) -> freeEnv (envHandle sess) -> -- With ODBC, transactions are implicitly started. -> beginTransaction sess isolation = do -> commitTrans (connHandle sess) -> setTransLevel (connHandle sess) (isolationLevel isolation) -> commit sess = commitTrans (connHandle sess) -> rollback sess = rollbackTrans (connHandle sess) +> instance EnvInquiry InfoDbmsName Session String where +> inquire InfoDbmsName sess = +> liftM (map toLower) (DBAPI.getInfoDbmsName (connHandle sess)) + About stmtFreeWithQuery: We need to keep track of the scope of the PreparedStmtObj @@ -211,37 +247,42 @@ separate types for the two types of prepared statement... > data StmtLifetime = FreeWithQuery | FreeManually +> deriving (Eq) > data PreparedStmtObj = PreparedStmtObj > { stmtHandle :: StmtHandle > , stmtLifetime :: StmtLifetime +> -- stmtBuffers are actually output bind buffers. +> -- we package them to look like ColumnBuffers +> -- (as created by allocBuffer) so that we can use them +> -- like ColumnBuffers. +> , stmtBuffers :: IORef [ColumnBuffer] +> , stmtFetched :: IORef Bool > } > prepareStmt :: QueryString -> PreparationA Session PreparedStmtObj > prepareStmt (QueryString sqltext) = prepareStmt' sqltext FreeManually > prepareQuery :: QueryString -> PreparationA Session PreparedStmtObj -> prepareQuery (QueryString sqltext) = prepareStmt' sqltext FreeManually +> prepareQuery q = prepareStmt q > prepareLargeQuery :: Int -> QueryString -> PreparationA Session PreparedStmtObj -> prepareLargeQuery _ (QueryString sqltext) = prepareStmt' sqltext FreeManually +> prepareLargeQuery _ q = prepareStmt q > prepareCommand :: QueryString -> PreparationA Session PreparedStmtObj -> prepareCommand (QueryString sqltext) = prepareStmt' sqltext FreeManually - - -preparePrefetch is just here for interface consistency -with Oracle and PostgreSQL. - -> preparePrefetch :: Int -> QueryString -> PreparationA Session PreparedStmtObj -> preparePrefetch count (QueryString sqltext) = -> prepareStmt' sqltext FreeManually +> prepareCommand q = prepareStmt q -> prepareStmt' sqltext free = +> prepareStmt' sqltext lifetime = > PreparationA (\sess -> do > stmt <- stmtPrepare (connHandle sess) sqltext -> return (PreparedStmtObj stmt free)) +> newPreparedStmt stmt lifetime +> ) +> newPreparedStmt stmt lifetime = do +> b <- newIORef [] +> f <- newIORef False +> return (PreparedStmtObj stmt lifetime b f) + -------------------------------------------------------------------- -- ** Binding -------------------------------------------------------------------- @@ -252,38 +293,46 @@ > instance IPrepared PreparedStmtObj Session BoundStmt BindObj where > bindRun sess pstmt bas action = do +> fetched <- readIORef (stmtFetched pstmt) +> when (fetched) +> (closeCursor (stmtHandle pstmt) >> writeIORef (stmtFetched pstmt) False) > sequence_ (zipWith (\i (BindA ba) -> ba sess pstmt i) [1..] bas) -> let stmt = stmtHandle pstmt -> stmtExecute stmt +> stmtExecute (stmtHandle pstmt) > action (BoundStmt pstmt) -> destroyStmt sess pstmt = freeStmt (stmtHandle pstmt) +> destroyStmt sess pstmt = do +> -- Could free output bind buffers here, but for now we don't bother. +> -- They are ForeignPtrs, so we expect them to be GC'd. +> --buffers <- readIORef (stmtBuffers pstmt) +> --sequence_ (map (freeBindBuffer . colBuffer) buffers) +> freeStmt (stmtHandle pstmt) + > instance DBBind (Maybe String) Session PreparedStmtObj BindObj where > bindP val = makeBindAction val DBAPI.bindParamBuffer 0 > instance DBBind (Out (Maybe String)) Session PreparedStmtObj BindObj where -> bindP (Out val) = makeBindAction (DBAPI.InOutParam val) DBAPI.bindParamBuffer 16000 +> bindP (Out val) = makeOutputBindAction (DBAPI.InOutParam val) DBAPI.bindParamBuffer 16000 > instance DBBind (Maybe Int) Session PreparedStmtObj BindObj where > bindP val = makeBindAction val DBAPI.bindParamBuffer 0 > instance DBBind (Out (Maybe Int)) Session PreparedStmtObj BindObj where -> bindP (Out val) = makeBindAction (DBAPI.InOutParam val) DBAPI.bindParamBuffer 0 +> bindP (Out val) = makeOutputBindAction (DBAPI.InOutParam val) DBAPI.bindParamBuffer 0 > instance DBBind (Maybe Double) Session PreparedStmtObj BindObj where > bindP val = makeBindAction val DBAPI.bindParamBuffer 0 > instance DBBind (Out (Maybe Double)) Session PreparedStmtObj BindObj where -> bindP (Out val) = makeBindAction (DBAPI.InOutParam val) DBAPI.bindParamBuffer 0 +> bindP (Out val) = makeOutputBindAction (DBAPI.InOutParam val) DBAPI.bindParamBuffer 0 > instance DBBind (Maybe UTCTime) Session PreparedStmtObj BindObj where > bindP val = makeBindAction val DBAPI.bindParamBuffer 0 > instance DBBind (Out (Maybe UTCTime)) Session PreparedStmtObj BindObj where -> bindP (Out val) = makeBindAction (DBAPI.InOutParam val) DBAPI.bindParamBuffer 0 +> bindP (Out val) = makeOutputBindAction (DBAPI.InOutParam val) DBAPI.bindParamBuffer 0 > instance DBBind (Maybe a) Session PreparedStmtObj BindObj @@ -308,6 +357,15 @@ > makeBindAction val binder size = BindA (\ses st pos -> do > convertEx (binder (stmtHandle st) pos val size >> return ())) +> makeOutputBindAction val binder size = BindA (\ses st pos -> do +> convertEx (binder (stmtHandle st) pos val size >>= appendOutputBindBuffer st)) + +> appendOutputBindBuffer stmt buffer = do +> buffers <- readIORef (stmtBuffers stmt) +> let colbuf = ColumnBuffer (1 + length buffers) buffer +> modifyIORef (stmtBuffers stmt) (++ [colbuf]) + + -------------------------------------------------------------------- -- ** Queries -------------------------------------------------------------------- @@ -354,43 +412,74 @@ > makeQuery sess (QueryString sqltext) = makeQuery sess sqltext > instance Statement String Session Query where -> makeQuery sess sqltext = do -> let (PreparationA action) = prepareStmt' sqltext FreeWithQuery -> pstmt <- action sess -> stmtExecute (stmtHandle pstmt) -> n <- newIORef 0 -> return (Query pstmt sess n) +> makeQuery sess sqltext = makeQuery sess (StmtBind sqltext []) +> instance Statement (NextResultSet mark PreparedStmtObj) Session Query where +> makeQuery sess (NextResultSet (PreparedStmt pstmt)) = do +> -- If stmt buffers are present, then the first doQuery +> -- will have processed its results from there. +> -- So for tne next query, we want to clear the buffer list +> -- and start fetching from the stmt handle. +> -- This allows us to call stored procedures that return +> -- both output parameters and (multiple) result-sets. +> buffers <- readIORef (stmtBuffers pstmt) +> if null buffers +> then do +> more <- DBAPI.moreResults (stmtHandle pstmt) +> when (not more) (throwDB (DBError ("02", "000") (-1) +> "NextResultSet was used, but there are no more result-sets to process")) +> n <- newIORef 0 +> return (Query pstmt sess n) +> else do +> writeIORef (stmtBuffers pstmt) [] +> n <- newIORef 0 +> return (Query pstmt sess n) > instance IQuery Query Session ColumnBuffer where > destroyQuery query = do -> closeCursor (stmtHandle (queryStmt query)) -> case stmtLifetime (queryStmt query) of -> FreeWithQuery -> freeStmt (stmtHandle (queryStmt query)) -> FreeManually -> return () +> let pstmt = queryStmt query +> when (stmtLifetime pstmt == FreeWithQuery) +> (freeStmt (stmtHandle pstmt)) > fetchOneRow query = do -> moreRows <- fetchRow (stmtHandle (queryStmt query)) -> modifyIORef (queryCount query) (+1) -> return moreRows +> let pstmt = queryStmt query +> -- Only call fetchRow if there are no bind output buffers +> -- If there are bind output buffers then assume this was a +> -- procedure call. +> -- In this case you will always get the same row over and over, +> -- so you'd better be careful with your iteratees +> buffers <- readIORef (stmtBuffers pstmt) +> if not (null buffers) then return True +> else do +> moreRows <- fetchRow (stmtHandle pstmt) +> writeIORef (stmtFetched pstmt) True +> modifyIORef (queryCount query) (+1) +> return moreRows > currentRowNum q = readIORef (queryCount q) > freeBuffer q buffer = return () -> nullIf :: Bool -> a -> Maybe a -> nullIf test v = if test then Nothing else Just v - -> --bufferToString buffer = -> -- convertEx (DBAPI.getUTF8StringFromBuffer (colBuffer buffer)) - - > data ColumnBuffer = ColumnBuffer > { colPos :: Int > , colBuffer :: DBAPI.BindBuffer > } +In allocBuffer we decide to either + - create a new buffer - this is a real column buffer for a query - , or + - return an already-allocated output bind-buffer. + > allocBuffer q pos size val = do -> bindbuffer <- convertEx (DBAPI.bindColBuffer (stmtHandle (queryStmt q)) pos size val) -> return (ColumnBuffer pos bindbuffer) +> let stmt = queryStmt q +> buffers <- readIORef (stmtBuffers stmt) +> if null buffers +> then do +> bindbuffer <- convertEx (DBAPI.bindColBuffer (stmtHandle stmt) pos size val) +> return (ColumnBuffer pos bindbuffer) +> else do +> if length buffers >= pos +> then return (buffers !! (pos - 1)) +> else +> throwDB (DBError ("02", "000") (-1) ( "There are " ++ show (length buffers) +> ++ " output buffers, but you have asked for buffer " ++ show pos )) > buffer_pos q buffer = do > row <- currentRowNum q diff --git a/Database/ODBC/OdbcFunctions.hsc b/Database/ODBC/OdbcFunctions.hsc --- a/Database/ODBC/OdbcFunctions.hsc +++ b/Database/ODBC/OdbcFunctions.hsc @@ -1,6 +1,6 @@ -{-# OPTIONS -ffi #-} {-# OPTIONS -fglasgow-exts #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -34,7 +34,8 @@ module Database.ODBC.OdbcFunctions where -import Control.Exception +import Prelude hiding (catch) +import Control.Exception.Extensible import Control.Monad import Data.Dynamic import Data.Time @@ -43,6 +44,9 @@ import Foreign.C import Foreign.C.UTF8 +--debugStmt s = putStrLn s +debugStmt s = return () + data HandleObj = HandleObj type Handle = Ptr HandleObj data EnvObj = EnvObj @@ -320,16 +324,18 @@ instance Show OdbcException where show (OdbcException i st s more) = "OdbcException " - ++ (show i) ++ " " ++ st ++ " " ++ s -- ++ (concat (map showOdbcExMsg more)) - --- showOdbcExMsg (OdbcException i st s more) = s + ++ (show i) ++ " " ++ st ++ " " ++ s + -- Could print the entire chain of diag recs... is this a good idea? + -- ++ (concat (map showOdbcExMsg more)) + -- where showOdbcExMsg (OdbcException i st s more) = s catchOdbc :: IO a -> (OdbcException -> IO a) -> IO a -catchOdbc = catchDyn - throwOdbc :: OdbcException -> a -throwOdbc = throwDyn +instance Exception OdbcException +catchOdbc = catch +throwOdbc = throw + -- define SQL_SUCCEEDED(rc) (((rc)&(~1))==0) sqlSucceeded rc = rc == sqlRcSuccess || rc == sqlRcSuccessWithInfo @@ -340,15 +346,15 @@ allocaBytes 1025 $ \cstrMsg -> do alloca $ \msgLenPtr -> do rc <- sqlGetDiagRec htype handle row cstrState errorNumPtr cstrMsg 1024 msgLenPtr - --putStrLn ("getDiagRec: rc=" ++ show rc) + --debugStmt ("getDiagRec: rc=" ++ show rc) case () of _ | rc == sqlRcSuccess -> do errnum <- peek errorNumPtr state <- myPeekCStringLen (cstrState, 5) msglen <- peek msgLenPtr - --putStrLn ("getDiagRec: msglen=" ++ show msglen) + --debugStmt ("getDiagRec: msglen=" ++ show msglen) msg <- myPeekCStringLen (cstrMsg, fromIntegral msglen) - --putStrLn ("getDiagRec: msg=" ++ msg) + --debugStmt ("getDiagRec: msg=" ++ msg) more <- getDiagRec retcode htype handle (row+1) return ((OdbcException (fromIntegral errnum) state msg []) : more) | rc == sqlRcNoData -> return [] @@ -540,6 +546,9 @@ -- The OdbcBindBuffer class has a getData function which uses these, -- if you'd rather. +-- This function tests the null indicator first. +-- If the value is null, then there's no need to do the actual marshaling, +-- which is performed by the action passed in. getMaybeFromBuffer :: Storable a => Ptr SqlLen -> Ptr a -> (Ptr a -> SqlLen -> IO b) -> IO (Maybe b) getMaybeFromBuffer szptr bptr action = do len <- peek szptr @@ -677,6 +686,7 @@ getCAStringFromBuffer :: BindBuffer -> IO (Maybe String) getCAStringFromBuffer buffer = + -- FIXME also assume null-termed string? testForNull buffer (\ptr len -> peekCAStringLen (castPtr ptr, fromIntegral len)) getCWStringFromBuffer :: BindBuffer -> IO (Maybe String) @@ -685,7 +695,11 @@ getUTF8StringFromBuffer :: BindBuffer -> IO (Maybe String) getUTF8StringFromBuffer buffer = - testForNull buffer (\ptr len -> peekUTF8StringLen (castPtr ptr, fromIntegral len)) + testForNull buffer (\ptr len -> + debugStmt ("getUTF8StringFromBuffer: size " ++ show len) >> + --peekUTF8StringLen (castPtr ptr, fromIntegral len)) + -- assume null-termed string + peekUTF8String (castPtr ptr)) getUtcTimeFromBuffer :: BindBuffer -> IO (Maybe UTCTime) getUtcTimeFromBuffer bindbuffer = do @@ -755,7 +769,8 @@ mem <- mallocBytes bufsz copyBytes mem cstr (fromIntegral clen) pokeByteOff mem (fromIntegral clen) (0 :: Word8) - buffer <- wrapSizedBuffer mem (fromIntegral clen) bufsz + --buffer <- wrapSizedBuffer mem (fromIntegral clen) bufsz + buffer <- wrapSizedBuffer mem sqlNullTermedString bufsz bindParam stmt pos direction sqlCTypeString sqlDTypeString (fromIntegral clen) 0 buffer return buffer @@ -768,6 +783,7 @@ bindParamUTF8String :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> Int -> IO BindBuffer bindParamUTF8String stmt pos direction val sz = + debugStmt ("bindParamUTF8String: " ++ show val ++ ", size " ++ show sz) >> bindEncodedString stmt pos direction val withUTF8StringLen sz bindParamCAString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> Int -> IO BindBuffer @@ -858,6 +874,7 @@ -- Binding with class... sizeOfMaybe :: forall a. Storable a => Maybe a -> Int +--sizeOfMaybe :: Storable a => Maybe a -> Int sizeOfMaybe _ = sizeOf ( undefined :: a ) -- H98 stylee... --sizeOfMaybe v@Nothing = sizeOfMaybe (asTypeOf (Just undefined) v) @@ -1059,7 +1076,7 @@ -> SqlSmallInt -- ^ decimal digits (scale) -> Ptr Buffer -- ^ input+output buffer -> SqlLen -- ^ buffer size - -> Ptr SqlLen -- ^ input+output data size, or -1 (SQL_NULL_DATA) for null + -> Ptr SqlLen -- ^ input+output data size, SQL_NTS (-3), SQL_NULL_DATA (-1), or SQL_NO_TOTAL (-4) -> IO SqlReturn -- SQLRETURN SQL_API SQLExecute(SQLHSTMT); diff --git a/Database/ODBC/Test/Enumerator.lhs b/Database/ODBC/Test/Enumerator.lhs new file mode 100644 --- /dev/null +++ b/Database/ODBC/Test/Enumerator.lhs @@ -0,0 +1,262 @@ + +| +Module : Database.ODBC.Test.Enumerator +Copyright : (c) 2007 Oleg Kiselyov, Alistair Bayley +License : BSD-style +Maintainer : oleg@pobox.com, alistair@abayley.org +Stability : experimental +Portability : non-portable + + +> module Database.ODBC.Test.Enumerator (runTest) where + +> import qualified Database.ODBC.Test.OdbcFunctions as Low +> import Database.ODBC.Enumerator +> import Database.Test.Performance as Perf +> import Database.Test.Enumerator +> import Database.Util +> import Control.Monad (liftM, when) +> import Control.Monad.Trans (liftIO) +> import Data.Char +> import Test.MiniUnit + + +> runTest :: Perf.ShouldRunTests -> [String] -> IO () +> runTest runPerf args = do +> let (dsn:_) = args +> Low.runTest args +> flip catchDB basicDBExceptionReporter $ do +> (r, conn1) <- withContinuedSession (connect dsn) (testBody runPerf) +> withSession conn1 testPartTwo + +> testBody :: Perf.ShouldRunTests -> DBM mark Session () +> testBody runPerf = do +> runFixture ODBCFunctions +> when (runPerf == Perf.RunTests) runPerformanceTests + +> testPartTwo :: DBM mark Session () +> testPartTwo = do +> makeFixture execDrop execDDL_ +> destroyFixture execDDL_ + +> runFixture :: DBLiteralValue a => a -> DBM mark Session () +> runFixture fns = do +> makeFixture execDrop execDDL_ +> runTestTT "ODBC tests" (map (runOneTest fns) testList) +> destroyFixture execDDL_ + +> runOneTest fns t = catchDB (t fns) (reportRethrowMsg "runOneTest ") + +> runPerformanceTests :: DBM mark Session () +> runPerformanceTests = do +> makeFixture execDrop execDDL_ +> beginTransaction ReadCommitted +> runTestTT "ODBC performance tests" (map (flip catchDB reportRethrow) +> -- The PostgreSQL ODBC driver has genetric query optimisation disabled +> -- by default. This makes it really struggle with the query we use +> -- for performance testing - the memory used by the server process +> -- goes through the roof. +> [ timedSelect (prefetch 1 sqlRows2Power17 []) 4 (2^17) +> , timedSelect (prefetch 1000 sqlRows2Power17 []) 4 (2^17) +> , timedCursor (prefetch 1 sqlRows2Power17 []) 4 (2^17) +> , timedCursor (prefetch 1000 sqlRows2Power17 []) 4 (2^17) +> , timedSelect (prefetch 1000 sqlRows2Power20 []) 35 (2^20) +> ] +> ) +> commit +> destroyFixture execDDL_ + + +----------------------------------------------------------- + +> selectNoRows _ = selectTest sqlNoRows iterNoRows expectNoRows + +> selectTerminatesEarly _ = selectTest sqlTermEarly iterTermEarly expectTermEarly + +> selectFloatsAndInts fns = selectTest (sqlFloatsAndInts fns) iterFloatsAndInts expectFloatsAndInts + +> selectNullString _ = selectTest sqlNullString iterNullString expectNullString + +> selectEmptyString _ = selectTest sqlEmptyString iterEmptyString expectEmptyString + +> selectUnhandledNull _ = catchDB ( do +> selectTest sqlUnhandledNull iterUnhandledNull expectUnhandledNull +> assertFailure sqlUnhandledNull +> ) (\e -> return () ) + + + +> selectNullDate dateFn = selectTest (sqlNullDate dateFn) iterNullDate expectNullDate + +> selectCursor fns = actionCursor (sqlCursor fns) +> selectExhaustCursor fns = actionExhaustCursor (sqlCursor fns) + +> selectBindString _ = actionBindString +> (prepareQuery (sql sqlBindString)) +> [bindP "a2", bindP "b1"] + +> selectBindInt _ = actionBindInt +> (prepareQuery (sql sqlBindInt)) +> [bindP (1::Int), bindP (2::Int)] + + +> selectBindIntDoubleString _ = actionBindIntDoubleString +> (prefetch 1 sqlBindIntDoubleString [bindP (1::Int), bindP (2.2::Double), bindP "row 1", bindP (3::Int), bindP (4.4::Double), bindP "row 2"]) + +> selectBindDate _ = actionBindDate +> (prefetch 1 sqlBindDate (map bindP expectBindDate)) + +> selectBindBoundaryDates _ = actionBindBoundaryDatesLocal +> (prefetch 1 sqlBindBoundaryDates (map bindP expectBoundaryDatesLocal)) + +> expectBoundaryDatesLocal = +> -- 1753 seems to be about the earliest year MS SQL Server supports. +> [ int64ToUTCTime 17530101000000 +> , int64ToUTCTime 20010102000000 +> , int64ToUTCTime 20010103000000 +> , int64ToUTCTime 99991231000000 +> ] +> actionBindBoundaryDatesLocal stmt = do +> withTransaction Serialisable $ do +> actual <- doQuery stmt iterBindDate [] +> assertEqual sqlBindBoundaryDates expectBoundaryDatesLocal actual + + +> selectRebindStmt _ = actionRebind (prepareQuery (sql sqlRebind)) +> [bindP (1::Int)] [bindP (2::Int)] + +> boundStmtDML _ = actionBoundStmtDML (prepareCommand (sql sqlBoundStmtDML)) +> boundStmtDML2 _ = do +> -- With MS SQL Server cannot use withTransaction with rollback/commit; +> -- if you explicitly end the transaction, then when withTransaction +> -- attempts to end it (with a commit, in the success case) then we +> -- get a "logic error". +> -- This differs from PostgreSQL and Oracle, who don't seem to care if +> -- you commit or rollback too many times. +> beginTransaction ReadCommitted +> count <- execDML (cmdbind sqlBoundStmtDML [bindP (100::Int), bindP "100"]) +> rollback +> assertEqual sqlBoundStmtDML 1 count + +> polymorphicFetchTest _ = actionPolymorphicFetch +> (prefetch 1 sqlPolymorphicFetch [bindP expectPolymorphicFetch]) + +> polymorphicFetchTestNull _ = actionPolymorphicFetchNull +> (prefetch 1 sqlPolymorphicFetchNull []) + +> exceptionRollback _ = actionExceptionRollback sqlInsertTest4 sqlExceptionRollback + +> iterateeMatchesResultSet _ = actionIterateeMatchesResultSet +> (prefetch 0 sqlIterateeMatchesResultSet [bindP (1::Int), bindP (2.2::Double), bindP "row 1", bindP (3::Int)]) + + +> dropFixtureMultiResultSet1 = "DROP VIEW t_whole" +> makeFixtureMultiResultSet1 = "CREATE VIEW t_whole as" +> ++ " select 0 as n union select 1" +> ++ " union select 2 union select 3" +> ++ " union select 4 union select 5" +> ++ " union select 6 union select 7" +> ++ " union select 8 union select 9" + +> dropFixtureMultiResultSet2 = "DROP VIEW t_natural" +> makeFixtureMultiResultSet2 = "CREATE VIEW t_natural as" +> ++ " select n from" +> ++ " ( select t1.n + 10 * t10.n + 100 * t100.n as n" +> ++ " from t_whole t1, t_whole t10, t_whole t100" +> ++ " ) t where n > 0" + +> dropFixtureMultiResultSet3 = "DROP PROCEDURE takusenTestProc" +> makeFixtureMultiResultSet3 = "CREATE PROCEDURE takusenTestProc" +> ++ " AS BEGIN" +> ++ " SELECT n*n from t_natural where n < 10 order by 1 \n\n" +> ++ " SELECT n, n*n, n*n*n from t_natural where n < 10 order by 1 \n\n" +> ++ " END;" + + +> selectMultiResultSet _ = do +> dbmsname <- liftM (map toLower) (inquire InfoDbmsName) +> when (dbmsname == "microsoft sql server") $ do +> execDrop dropFixtureMultiResultSet3 +> execDrop dropFixtureMultiResultSet2 +> execDrop dropFixtureMultiResultSet1 +> execDDL_ makeFixtureMultiResultSet1 +> execDDL_ makeFixtureMultiResultSet2 +> execDDL_ makeFixtureMultiResultSet3 +> withPreparedStatement (prepareCommand (sql "{call takusenTestProc}")) $ \pstmt -> do +> withBoundStatement pstmt [] $ \bstmt -> do +> result1 <- doQuery bstmt iterRS1 [] +> assertEqual "selectMultiResultSet: RS1" [1,4,9,16,25,36,49,64,81] result1 +> result2 <- doQuery (NextResultSet pstmt) iterRS2 [] +> let expect = [(1,1,1),(2,4,8),(3,9,27),(4,16,64),(5,25,125),(6,36,216) +> ,(7,49,343),(8,64,512),(9,81,729)] +> assertEqual "selectMultiResultSet: RS2" expect result2 +> return () +> execDDL_ dropFixtureMultiResultSet3 +> execDDL_ dropFixtureMultiResultSet2 +> execDDL_ dropFixtureMultiResultSet1 +> where +> iterRS1 :: (Monad m) => Int -> IterAct m [Int] +> iterRS1 i acc = result (acc ++ [i]) +> iterRS2 :: (Monad m) => Int -> Int -> Int -> IterAct m [(Int, Int, Int)] +> iterRS2 i i2 i3 acc = result (acc ++ [(i, i2, i3)]) + + +> dropFixtureBindOutput = "DROP PROCEDURE takusenTestProc" +> makeFixtureBindOutputSqlServer = "CREATE PROCEDURE takusenTestProc @x int output, @y varchar(200) output" +> ++ " AS BEGIN" +> ++ " declare @z varchar(200) \n\n" +> ++ " select @x = 2 * @x \n\n" +> ++ " select @z = 'output ' + @y + ' xxx' \n\n" +> ++ " select @y = @z \n\n" +> ++ " END;" + +> makeFixtureBindOutputOracle = "CREATE or replace PROCEDURE takusenTestProc(x in out number, y in out varchar)" +> ++ " AS BEGIN" +> ++ " x := x * 2;" +> ++ " y := 'output ' || y || ' xxx';" +> ++ " END;" + +> bindOutput _ = do +> dbmsname <- liftM (map toLower) (inquire InfoDbmsName) +> case dbmsname of +> "microsoft sql server" -> k makeFixtureBindOutputSqlServer +> "oracle" -> k makeFixtureBindOutputOracle +> _ -> return () +> where +> k makeFixture = do +> execDrop dropFixtureBindOutput +> execDDL_ makeFixture +> let qry = sqlbind "{call takusenTestProc(?,?)}" [bindP (Out (1234::Int)), bindP (Out (Just "message"))] +> (x, s) <- doQuery qry iter undefined +> execDrop dropFixtureBindOutput +> assertEqual "bindOutput: int " 2468 x +> assertEqual "bindOutput: string " "output message" s +> iter :: (Monad m) => Int -> String -> IterAct m (Int, String) +> iter i s _ = return (Left (i, s)) + + +> testList :: DBLiteralValue a => [a -> DBM mark Session ()] +> testList = +> selectNoRows : +> selectTerminatesEarly : +> selectFloatsAndInts : +> selectNullString : +> selectEmptyString : +> selectUnhandledNull : +> selectCursor : +> selectExhaustCursor : +> selectBindString : +> selectBindInt : +> selectBindIntDoubleString : +> selectBindDate : +> selectBindBoundaryDates : +> selectRebindStmt : +> boundStmtDML : +> boundStmtDML2 : +> polymorphicFetchTest : +> polymorphicFetchTestNull : +> exceptionRollback : +> iterateeMatchesResultSet : +> selectMultiResultSet : +> bindOutput : +> [] diff --git a/Database/ODBC/Test/OdbcFunctions.lhs b/Database/ODBC/Test/OdbcFunctions.lhs new file mode 100644 --- /dev/null +++ b/Database/ODBC/Test/OdbcFunctions.lhs @@ -0,0 +1,522 @@ + +| +Module : Database.ODBC.Test.OdbcFunctions +Copyright : (c) 2007 Oleg Kiselyov, Alistair Bayley +License : BSD-style +Maintainer : oleg@pobox.com, alistair@abayley.org +Stability : experimental +Portability : non-portable + + +-- FIXME add tests for moreResults + +> module Database.ODBC.Test.OdbcFunctions where + +> import Database.ODBC.OdbcFunctions +> import Control.Exception.Extensible (finally) +> import Control.Monad (liftM, when) +> import Data.Char +> import Data.List +> import Data.Time +> import Data.Word (Word8) +> import Database.Util +> import Test.MiniUnit +> import Foreign.ForeignPtr (withForeignPtr) +> import Foreign.Ptr (castPtr) +> import Foreign.Storable (peek) +> import Foreign.Marshal.Array (peekArray0, peekArray) +> import Numeric (showHex) + + +> ignoreError action = +> catchOdbc action (\e -> return undefined) + +> printIgnoreError action = catchOdbc action +> (\e -> do +> putStrLn (show e) +> return undefined +> ) + +> printPropagateError action = catchOdbc action +> (\e -> do +> putStrLn (show e) +> throwOdbc e +> return undefined +> ) + +> testCreateEnv = do +> env <- allocEnv +> freeEnv env + +> testCreateConn = do +> env <- allocEnv +> setOdbcVer env +> conn <- allocConn env +> freeConn conn +> freeEnv env + +> testConnect connstr = do +> env <- allocEnv +> setOdbcVer env +> conn <- allocConn env +> connstr <- connect conn connstr +> disconnect conn +> freeConn conn +> freeEnv env + +> createConn connstr = do +> env <- allocEnv +> setOdbcVer env +> conn <- allocConn env +> connstr <- connect conn connstr +> dbms <- getInfoDbmsName conn +> return (env, conn { connDbms = map toLower dbms } ) + +> closeConn (env, conn) = do +> disconnect conn +> freeConn conn +> freeEnv env + + +> createDual conn = do +> stmt <- allocStmt conn +> prepareStmt stmt "create table tdual (dummy varchar(1) primary key)" +> executeStmt stmt +> prepareStmt stmt "insert into tdual values ('X')" +> executeStmt stmt +> freeStmt stmt + +> dropDual conn = do +> stmt <- allocStmt conn +> prepareStmt stmt "drop table tdual" +> executeStmt stmt +> freeStmt stmt + + +> testCreateStmt conn = do +> stmt <- allocStmt conn +> prepareStmt stmt "select 'x' from tdual" +> executeStmt stmt +> freeStmt stmt + + +> testIsolationLevel conn = do +> -- For PostgreSQL this fails with: +> -- 206 HY009 Illegal parameter value for SQL_TXN_ISOLATION +> --setTxnIsolation conn sqlTxnReadUncommitted +> setTxnIsolation conn sqlTxnReadCommitted -- This is OK +> -- For PostgreSQL this fails with: +> -- 206 HY009 Illegal parameter value for SQL_TXN_ISOLATION +> --setTxnIsolation conn sqlTxnRepeatableRead +> setTxnIsolation conn sqlTxnSerializable -- This is OK + + +Uses getData, rather than a buffer. + +> testFetchString conn = do +> stmt <- allocStmt conn +> let string1 = "abc" ++ map chr [0x000080, 0x0007FF, 0x00FFFF, 0x10FFFF] +> let string2 = "xyz" ++ map chr [0x000080, 0x0007FF, 0x00FFFF, 0x10FFFF] +> prepareStmt stmt ("select '" ++ string1 +> ++ "' from tdual union select '" ++ string2 ++ "' from tdual order by 1") +> executeStmt stmt +> more <- fetch stmt +> s <- getDataUTF8String stmt 1 +> assertEqual "testFetchString" (Just string1) s +> more <- fetch stmt +> s <- getDataUTF8String stmt 1 +> assertEqual "testFetchString" (Just string2) s +> more <- fetch stmt +> assertBool "testFetchString: EOD" (not more) +> freeStmt stmt + +> testFetchStringWithBuffer conn = do +> stmt <- allocStmt conn +> let string1 = "abc" ++ map chr [0x000080, 0x0007FF, 0x00FFFF, 0x10FFFF] +> let string2 = "xyz" ++ map chr [0x000080, 0x0007FF, 0x00FFFF, 0x10FFFF] +> prepareStmt stmt ("select '" ++ string1 +> ++ "' from tdual union select '" ++ string2 ++ "' from tdual order by 1") +> executeStmt stmt +> buffer <- bindColBuffer stmt 1 100 (Just "") +> more <- fetch stmt +> s <- getUTF8StringFromBuffer buffer +> assertEqual "testFetchStringWithBuffer" (Just string1) s +> more <- fetch stmt +> s <- getUTF8StringFromBuffer buffer +> assertEqual "testFetchStringWithBuffer" (Just string2) s +> more <- fetch stmt +> assertBool "testFetchStringWithBuffer: EOD" (not more) +> freeStmt stmt + +> testFetchInt conn = do +> stmt <- allocStmt conn +> prepareStmt stmt "select 101 from tdual" +> executeStmt stmt +> more <- fetch stmt +> s <- getData stmt 1 +> let expect :: Int; expect = 101 +> assertEqual "testFetchInt" (Just expect) s +> more <- fetch stmt +> assertBool "testFetchInt: EOD" (not more) +> freeStmt stmt + +> testFetchIntWithBuffer conn = do +> stmt <- allocStmt conn +> prepareStmt stmt "select 101 from tdual" +> executeStmt stmt +> buffer <- bindColBuffer stmt 1 0 (Just (0::Int)) +> more <- fetch stmt +> s <- getFromBuffer buffer +> let expect :: Int; expect = 101 +> assertEqual "testFetchInt" (Just expect) s +> more <- fetch stmt +> assertBool "testFetchInt: EOD" (not more) +> freeStmt stmt + +> testFetchDouble conn = do +> stmt <- allocStmt conn +> prepareStmt stmt "select 123.456789 from tdual" +> executeStmt stmt +> --buffer <- bindColBuffer stmt 1 sqlDTypeDouble 16 +> more <- fetch stmt +> --s <- getFromBuffer buffer +> s <- getData stmt 1 +> let expect :: Double; expect = 123.456789 +> assertEqual "testFetchDouble" (Just expect) s +> more <- fetch stmt +> assertBool "testFetchDouble: EOD" (not more) +> freeStmt stmt + +> testFetchDatetime conn = do +> stmt <- allocStmt conn +> dbmsname <- liftM (map toLower) (getInfoDbmsName conn) +> flip finally (freeStmt stmt) ( do +> -- There is no common SQL standard for datetime literal text. +> -- Well, there is (timestamp), but MS SQL Server doesn't support it. Pah. +> -- And Oracle seems to also require a sane NLS setting e.g. +> -- alter session set NLS_TIMESTAMP_FORMAT = 'yyyy-mm-dd hh24:mi:ss' +> when (dbmsname == "oracle") ( do +> prepareStmt stmt "alter session set NLS_TIMESTAMP_FORMAT = 'yyyy-mm-dd hh24:mi:ss'" +> executeStmt stmt +> ) +> -- +> -- PostgreSQL doesn't appear to support the {fn ...} escape sequences; +> -- the text seems to be passed through unchanged (according to SQLNativeSql, anyway). +> -- THe MS SQL Server ODBC driver's SQLNativeSql also returns the text unchanged, +> -- but it doesn't seem to cause any grief on the server. +> --getNativeSql conn "select {fn CONVERT('1916-10-01 02:25:21', SQL_TIMESTAMP)}, {fn CONVERT('2005-10-01 00:00:00', SQL_TIMESTAMP)} from tdual" >>= putStrLn +> case dbmsname of +> "postgresql" -> +> prepareStmt stmt "select cast ('1916-10-01 02:25:21' as timestamp), cast ('2005-10-01 00:00:00' as timestamp) from tdual" +> otherwise -> +> prepareStmt stmt "select {fn CONVERT('1916-10-01 02:25:21', SQL_TIMESTAMP)}, {fn CONVERT('2005-10-01 00:00:00', SQL_TIMESTAMP)} from tdual" +> executeStmt stmt +> let expect1 = mkUTCTime 1916 10 1 2 25 21 +> let expect2 = mkUTCTime 2005 10 1 0 0 0 +> buffer1 <- bindColBuffer stmt 1 0 (Just expect1) +> buffer2 <- bindColBuffer stmt 2 0 (Just expect2) +> more <- fetch stmt +> t1 <- getFromBuffer buffer1 +> t2 <- getFromBuffer buffer2 +> assertEqual "testFetchDatetime1" (Just expect1) t1 +> assertEqual "testFetchDatetime2" (Just expect2) t2 +> more <- fetch stmt +> assertBool "testFetchDatetime: EOD" (not more) +> ) + + +> testBindInt conn = do +> stmt <- allocStmt conn +> prepareStmt stmt "select ? from tdual" +> bindParamBuffer stmt 1 (Just (101::Int)) 0 +> executeStmt stmt +> buffer <- bindColBuffer stmt 1 0 (Just (0::Int)) +> more <- fetch stmt +> s <- getFromBuffer buffer +> let expect :: Int; expect = 101 +> assertEqual "testFetchInt" (Just expect) s +> more <- fetch stmt +> assertBool "testFetchInt: EOD" (not more) +> freeStmt stmt + +> testBindString conn = do +> stmt <- allocStmt conn +> prepareStmt stmt "select ? from tdual" +> let expect = "abcdefghijklmnopqrstuvwxyz" +> bindParamBuffer stmt 1 (Just expect) 0 +> executeStmt stmt +> buffer <- bindColBuffer stmt 1 1000 (Just expect) +> more <- fetch stmt +> s <- getUTF8StringFromBuffer buffer +> assertEqual "testBindString" (Just expect) s +> more <- fetch stmt +> assertBool "testBindString: EOD" (not more) +> -- test closeCursor can be called if we want to +> closeCursor stmt -- not necessary when done just before freeStmt +> freeStmt stmt + +> testBindStringUTF8 conn = do +> stmt <- allocStmt conn +> prepareStmt stmt "select ? from tdual" +> let expect = "abc" ++ map chr [0x000080, 0x0007FF, 0x00FFFF, 0x10FFFF] +> bindParamBuffer stmt 1 (Just expect) 0 +> executeStmt stmt +> buffer <- bindColBuffer stmt 1 1000 (Just expect) +> more <- fetch stmt +> s <- getUTF8StringFromBuffer buffer +> assertEqual "testBindStringUTF8 (PostgreSQL fails with Unicode driver, succeeds with ANSI)" (Just expect) s +> more <- fetch stmt +> assertBool "testBindStringUTF8: EOD" (not more) +> freeStmt stmt + +> testBindUTCTime conn = do +> stmt <- allocStmt conn +> flip finally (freeStmt stmt) ( do +> prepareStmt stmt "select ? from tdual" +> let expect :: UTCTime; expect = mkUTCTime 1971 10 1 2 25 21 +> bindbuf <- bindParamBuffer stmt 1 (Just expect) 0 +> executeStmt stmt +> buffer <- bindColBuffer stmt 1 undefined (Just expect) +> more <- fetch stmt +> t <- getUtcTimeFromBuffer buffer +> assertEqual "testBindUTCTime" (Just expect) t +> more <- fetch stmt +> assertBool "testBindUTCTime: EOD" (not more) +> ) + + +> testBindUTCTimeBoundary conn = do +> stmt <- allocStmt conn +> prepareStmt stmt "select ?, ? from tdual" +> -- 1753 seems to be about the earliest year MS SQL Server supports. +> let expect1 = mkUTCTime 1753 1 1 0 0 0 +> let expect2 = mkUTCTime 9999 10 1 2 25 21 +> let input1 = expect1 +> let input2 = expect2 +> inbuf1 <- bindParamBuffer stmt 1 (Just input1) 0 +> inbuf2 <- bindParamBuffer stmt 2 (Just input2) 0 +> executeStmt stmt +> buffer1 <- bindColBuffer stmt 1 100 (Just expect1) +> buffer2 <- bindColBuffer stmt 2 100 (Just expect2) +> more <- fetch stmt +> t1 <- getFromBuffer buffer1 +> t2 <- getFromBuffer buffer2 +> assertEqual "testBindUTCTimeBoundary1" (Just expect1) t1 +> assertEqual "testBindUTCTimeBoundary2" (Just expect2) t2 +> more <- fetch stmt +> assertBool "testBindUTCTimeBoundary: EOD" (not more) +> freeStmt stmt + +> testRebind conn = do +> stmt <- allocStmt conn +> prepareStmt stmt "select ? from tdual" +> -- +> --closeCursor stmt -- can't do this - function sequence error +> -- +> let expect = "abc" +> bindParamBuffer stmt 1 (Just expect) 0 +> executeStmt stmt +> buffer <- bindColBuffer stmt 1 100 (Just "") +> more <- fetch stmt +> s <- getUTF8StringFromBuffer buffer +> assertEqual "testRebind1" (Just expect) s +> more <- fetch stmt +> assertBool "testRebind1: EOD" (not more) +> -- +> closeCursor stmt -- reset stmt for rebinding, but do not dealloc +> -- +> let expect = "xyz" +> bindParamBuffer stmt 1 (Just expect) 0 +> executeStmt stmt +> buffer <- bindColBuffer stmt 1 100 (Just "") +> more <- fetch stmt +> s <- getUTF8StringFromBuffer buffer +> assertEqual "testRebind2" (Just expect) s +> more <- fetch stmt +> assertBool "testRebind2: EOD" (not more) +> -- +> closeCursor stmt +> bindParamBuffer stmt 1 (Just expect) 0 +> executeStmt stmt +> closeCursor stmt +> -- +> freeStmt stmt + + +> testUTF8 conn = do +> stmt <- allocStmt conn +> prepareStmt stmt "drop table t_utf8" +> ignoreError (executeStmt stmt) +> prepareStmt stmt "create table t_utf8(s varchar(50))" +> executeStmt stmt +> let expect = "abc" ++ map chr [0x000080, 0x0007FF, 0x00FFFF, 0x10FFFF] +> prepareStmt stmt ("insert into t_utf8 values ( '" ++ expect ++ "' )") +> executeStmt stmt +> prepareStmt stmt "select s from t_utf8" +> executeStmt stmt +> buffer <- bindColBuffer stmt 1 100 (Just expect) +> more <- fetch stmt +> s <- getUTF8StringFromBuffer buffer +> assertEqual "testUTF8" (Just expect) s +> freeStmt stmt + +> testDbmsName conn = do +> (liftM ("dbms-name: " ++) (getInfoDbmsName conn)) >>= putStrLn +> (liftM ("dbms-ver: " ++) (getInfoDbmsVer conn)) >>= putStrLn +> (liftM ("db-name: " ++) (getInfoDatabaseName conn)) >>= putStrLn +> (liftM ("driver-name: " ++) (getInfoDriverName conn)) >>= putStrLn +> (liftM ("driver-ver: " ++) (getInfoDriverVer conn)) >>= putStrLn + + +> dropFixtureMultiResultSet = "DROP PROCEDURE takusenTestProc" +> makeFixtureMultiResultSet = "CREATE PROCEDURE takusenTestProc" +> ++ " AS BEGIN" +> ++ " SELECT '1', '2' \n\n" +> ++ " SELECT '3', '4' \n\n" +> ++ " END;" + +> testMultiResultSet conn = do +> name <- liftM (map toLower) (getInfoDbmsName conn) +> when (name == "microsoft sql server") $ do +> stmt <- allocStmt conn +> printIgnoreError (prepareStmt stmt dropFixtureMultiResultSet) +> ignoreError (executeStmt stmt) +> printIgnoreError (prepareStmt stmt makeFixtureMultiResultSet) +> printIgnoreError (executeStmt stmt) +> prepareStmt stmt "{call takusenTestProc}" +> executeStmt stmt +> -- +> buffer1 <- bindColBuffer stmt 1 100 (Just "") +> buffer2 <- bindColBuffer stmt 2 100 (Just "") +> more <- fetch stmt +> s1 <- getUTF8StringFromBuffer buffer1 +> assertEqual "testMultiResultSet1" (Just "1") s1 +> s2 <- getUTF8StringFromBuffer buffer2 +> assertEqual "testMultiResultSet2" (Just "2") s2 +> more <- fetch stmt +> assertBool "testMultiResultSet1: EOD" (not more) +> -- +> more <- moreResults stmt +> assertBool "testMultiResultSet: more result-sets" more +> -- +> buffer1 <- bindColBuffer stmt 1 100 (Just "") +> buffer2 <- bindColBuffer stmt 2 100 (Just "") +> more <- fetch stmt +> s1 <- getUTF8StringFromBuffer buffer1 +> assertEqual "testMultiResultSet3" (Just "3") s1 +> s2 <- getUTF8StringFromBuffer buffer2 +> assertEqual "testMultiResultSet4" (Just "4") s2 +> more <- fetch stmt +> assertBool "testMultiResultSet3: EOD" (not more) +> -- +> more <- moreResults stmt +> assertBool "testMultiResultSet: no more result-sets" (not more) +> -- +> prepareStmt stmt dropFixtureMultiResultSet +> executeStmt stmt +> freeStmt stmt + + +> dropFixtureBindOutput = "DROP PROCEDURE takusenTestProc" +> makeFixtureBindOutputSqlServer = "CREATE PROCEDURE takusenTestProc @x int output, @y varchar(200) output" +> ++ " AS BEGIN" +> ++ " declare @z varchar(200) \n\n" +> ++ " select @x = 2 * @x \n\n" +> ++ " select @z = 'output ' + @y + ' xxx' \n\n" +> ++ " select @y = @z \n\n" +> ++ " END;" + +> makeFixtureBindOutputOracle = "CREATE or replace PROCEDURE takusenTestProc(x in out number, y in out varchar)" +> ++ " AS BEGIN" +> ++ " x := x * 2;" +> ++ " y := 'output ' || y || ' xxx';" +> ++ " END;" + +> testBindOutput conn = do +> dbmsname <- liftM (map toLower) (getInfoDbmsName conn) +> case dbmsname of +> "microsoft sql server" -> k makeFixtureBindOutputSqlServer +> "oracle" -> k makeFixtureBindOutputOracle +> _ -> return () +> where +> k makeFixture = do +> stmt <- allocStmt conn +> prepareStmt stmt dropFixtureBindOutput +> ignoreError (executeStmt stmt) +> prepareStmt stmt makeFixture +> executeStmt stmt +> -- +> prepareStmt stmt "{call takusenTestProc(?,?)}" +> let input1 :: Int; input1 = 1234 +> let input2 = "message" +> buffer1 <- bindParamBuffer stmt 1 (InOutParam (Just input1)) 0 +> buffer2 <- bindParamBuffer stmt 2 (InOutParam (Just input2)) 200 +> executeStmt stmt +> -- +> i <- getFromBuffer buffer1 +> assertEqual "testBindOutput" (Just (2*input1)) i +> s <- getUTF8StringFromBuffer buffer2 +> assertEqual "testBindOutput" (Just "output message xxx") s +> --more <- fetch stmt -- This will cause error: +> -- +> --more <- moreResults stmt +> --assertBool "testBindOutput: more result-sets" (not more) +> -- +> prepareStmt stmt dropFixtureMultiResultSet +> executeStmt stmt +> freeStmt stmt + + + +> printBufferContents buffer = do +> withForeignPtr (bindBufPtr buffer) $ \bptr -> do +> withForeignPtr (bindBufSzPtr buffer) $ \szptr -> do +> sz <- peek szptr +> printArrayContents (fromIntegral sz) (castPtr bptr) + + +> testlist = +> testCreateStmt : +> testIsolationLevel : +> testFetchString : +> testFetchStringWithBuffer : +> testFetchInt : +> testFetchIntWithBuffer : +> testFetchDouble : +> testFetchDatetime : +> testBindInt : +> testBindString : +> testBindStringUTF8 : +> testBindUTCTime : +> testBindUTCTimeBoundary : +> testUTF8 : +> testRebind : +> --testDbmsName : +> testMultiResultSet : +> testBindOutput : +> [] + +> testlist2 = +> testBindOutput : +> [] + +> mkTestlist conn testlist = map (\testcase -> printIgnoreError (testcase conn)) testlist + +> parseArgs :: [String] -> IO String +> parseArgs args = do +> let (dsn:_) = args +> return dsn + +> runTest :: [String] -> IO () +> runTest as = do +> connstr <- parseArgs as +> printPropagateError testCreateEnv +> printPropagateError testCreateConn +> printPropagateError (testConnect connstr) +> (env, conn) <- printPropagateError (createConn connstr) +> ignoreError (dropDual conn) +> printPropagateError (createDual conn) +> counts <- runTestTT "ODBC low-level tests" (mkTestlist conn testlist) +> printPropagateError (dropDual conn) +> closeConn (env, conn) +> return () diff --git a/Database/Oracle/Enumerator.lhs b/Database/Oracle/Enumerator.lhs --- a/Database/Oracle/Enumerator.lhs +++ b/Database/Oracle/Enumerator.lhs @@ -11,12 +11,11 @@ > {-# OPTIONS -fglasgow-exts #-} -> {-# OPTIONS -fallow-undecidable-instances #-} -> {-# OPTIONS -fallow-overlapping-instances #-} +> {-# LANGUAGE OverlappingInstances #-} +> {-# LANGUAGE UndecidableInstances #-} > module Database.Oracle.Enumerator > ( Session, connect -> , prepareStmt, preparePrefetch > , prepareQuery, prepareLargeQuery, prepareCommand, prepareLargeCommand > , sql, sqlbind, prefetch, cmdbind > , StmtHandle, Out(..) @@ -35,7 +34,7 @@ > import Foreign > import Foreign.C > import Control.Monad -> import Control.Exception +> import Control.Exception.Extensible > import Control.Monad.Trans > import Control.Monad.Reader > import Data.Char (toLower) @@ -47,8 +46,6 @@ > import System.Time > import System.IO (hPutStrLn, stderr) -> {-# DEPRECATED prepareStmt "Use prepareQuery or prepareCommand instead" #-} -> {-# DEPRECATED preparePrefetch "Use prepareLargeQuery instead" #-} -------------------------------------------------------------------- -- ** Error handling @@ -346,6 +343,10 @@ > closeStmt _ stmt = dispose stmt +FIXME stmt should not be closed by these functions, +because they don't create it. +stmt should be closed in function that creates it. + > setPrefetchCount :: Session -> StmtHandle -> Int -> IO () > setPrefetchCount session stmt count = inSession session > (\_ err _ -> with count $ \countPtr -> @@ -353,7 +354,6 @@ > ) (closeStmt session stmt) - > stmtPrepare :: Session -> StmtHandle -> String -> IO () > stmtPrepare session stmt sql = inSession session > (\_ err _ -> OCI.stmtPrepare err stmt sql @@ -440,11 +440,14 @@ > doCommand sess str = do > stmt <- getStmt sess +> -- stmtPrepare and execute both close the stmt if an exception is thrown, +> -- so there should be no need for bracket here. > stmtPrepare sess stmt str -> n <- execute sess stmt 1 +> rc <- execute sess stmt 1 > closeStmt sess stmt -> return (fromIntegral n) +> return rc + > instance Command String Session where > executeCommand sess str = executeCommand sess (sql str) @@ -512,14 +515,6 @@ > beginsWithSelect text = isPrefixOf "select" . map toLower $ text > inferStmtType text = if beginsWithSelect text then SelectType else CommandType -> prepareStmt :: QueryString -> PreparationA Session PreparedStmtObj -> prepareStmt (QueryString sqltext) = -> prepareStmt' (prefetchRowCount defaultResourceUsage) sqltext FreeManually (inferStmtType sqltext) - -> preparePrefetch :: Int -> QueryString -> PreparationA Session PreparedStmtObj -> preparePrefetch count (QueryString sqltext) = -> prepareStmt' count sqltext FreeManually (inferStmtType sqltext) - > prepareQuery :: QueryString -> PreparationA Session PreparedStmtObj > prepareQuery (QueryString sqltext) = > prepareStmt' (prefetchRowCount defaultResourceUsage) sqltext FreeManually SelectType @@ -555,6 +550,7 @@ > newPreparedStmt lifetime iteration sess stmt = do > c <- newIORef [] > b <- newIORef [] + > return (PreparedStmtObj lifetime iteration stmt sess c b) -------------------------------------------------------------------- @@ -575,15 +571,11 @@ > execute sess (stmtHandle stmt) iteration > writeIORef (stmtCursors stmt) [] > action (BoundStmt stmt) -> destroyStmt sess pstmt = do -> -- FIXME should also destroy all stmtCursors and stmtBuffers -> closeStmt sess (stmtHandle pstmt) +> destroyStmt sess pstmt = closeStmt sess (stmtHandle pstmt) > instance DBBind (Maybe String) Session PreparedStmtObj BindObj where > bindP = makeBindAction -Disable this for now, as Strings have charset conversion issues for me... - > instance DBBind (Out (Maybe String)) Session PreparedStmtObj BindObj where > bindP (Out v) = makeOutputBindAction v @@ -653,7 +645,7 @@ > => Session -> PreparedStmtObj -> Maybe a -> Int -> IO () > bindMaybe sess stmt v pos = > bindWithValue v $ \ptrv -> do -> bindByPos sess stmt pos (bindNullInd v) (castPtr ptrv) (bindSize v) (bindType v) +> bindByPos sess stmt pos (bindNullInd v) (castPtr ptrv) (bindDataSize v) (bindType v) Note currying... we don't provide the column-position; it's provided when bindRun is invoked. @@ -670,9 +662,9 @@ > withForeignPtr nullind $ \indptr -> do > withForeignPtr sizeind $ \szeptr -> do > poke (castPtr indptr) (bindNullInd v) -> poke (castPtr szeptr) (bindSize v) +> poke (castPtr szeptr) (bindDataSize v) -- input size > bindWriteBuffer (castPtr bufptr) v -> bindOutputByPos sess stmt pos (nullind, buffer, sizeind) (bindSize v) (bindType v) +> bindOutputByPos sess stmt pos (nullind, buffer, sizeind) (bindBufferSize v) (bindType v) > let > colbuf = ColumnBuffer > { colBufBufferFPtr = buffer @@ -700,10 +692,13 @@ > class OracleBind a where > bindWithValue :: a -> (Ptr Word8 -> IO ()) -> IO () > bindWriteBuffer :: Ptr Word8 -> a -> IO () -> bindSize :: a -> Int +> bindDataSize :: a -> Int > bindBufferSize :: a -> Int -> bindBufferSize v = bindSize v +> bindBufferSize v = bindDataSize v > bindNullInd :: a -> CShort +> -- non-Maybe types aren't nullable, so null-ind is always 0 +> -- for values in these types. +> bindNullInd _ = 0 > bindType :: a -> CInt > instance OracleBind a => OracleBind (Maybe a) where @@ -711,54 +706,53 @@ > bindWithValue Nothing a = return () > bindWriteBuffer b (Just v) = bindWriteBuffer b v > bindWriteBuffer b Nothing = return () -> bindSize (Just v) = bindSize v -> bindSize Nothing = 0 +> bindDataSize (Just v) = bindDataSize v +> bindDataSize Nothing = 0 +> bindBufferSize (Just v) = bindBufferSize v +> bindBufferSize x@Nothing = +> let (Just v) = (Just undefined) `asTypeOf` x in bindBufferSize v > bindNullInd (Just v) = 0 > bindNullInd Nothing = -1 > bindType (Just v) = bindType v > bindType Nothing = bindType (undefined :: a) > instance OracleBind String where +> -- FIXME should these be withUTF8String{Len} ? > bindWithValue v a = withCString v (\p -> a (castPtr p)) -> bindWriteBuffer b s = withCStringLen s (\(p,l) -> copyBytes p (castPtr b) l) -> bindSize s = fromIntegral (length s) -> bindBufferSize s = 16000 -> bindNullInd _ = 0 +> bindWriteBuffer b s = withCStringLen s (\(p,l) -> +> copyBytes (castPtr b) p (1+l)) +> bindDataSize s = fromIntegral (length s) +> bindBufferSize _ = 32000 > bindType _ = oci_SQLT_CHR > instance OracleBind Int where > bindWithValue v a = withBinaryValue toCInt v (\p v -> poke (castPtr p) v) a > bindWriteBuffer b v = poke (castPtr b) v -> bindSize _ = (sizeOf (toCInt 0)) -> bindNullInd _ = 0 +> bindDataSize _ = (sizeOf (toCInt 0)) > bindType _ = oci_SQLT_INT > instance OracleBind Double where > bindWithValue v a = withBinaryValue toCDouble v (\p v -> poke (castPtr p) v) a > bindWriteBuffer b v = poke (castPtr b) v -> bindSize _ = (sizeOf (toCDouble 0.0)) -> bindNullInd _ = 0 +> bindDataSize _ = (sizeOf (toCDouble 0.0)) > bindType _ = oci_SQLT_FLT > instance OracleBind CalendarTime where > bindWithValue v a = withBinaryValue id v (\p dt -> calTimeToBuffer (castPtr p) dt) a > bindWriteBuffer b v = calTimeToBuffer (castPtr b) v -> bindSize _ = 7 -> bindNullInd _ = 0 +> bindDataSize _ = 7 > bindType _ = oci_SQLT_DAT > instance OracleBind UTCTime where > bindWithValue v a = withBinaryValue id v (\p dt -> utcTimeToBuffer (castPtr p) dt) a > bindWriteBuffer b v = utcTimeToBuffer (castPtr b) v -> bindSize _ = 7 -> bindNullInd _ = 0 +> bindDataSize _ = 7 > bindType _ = oci_SQLT_DAT > instance OracleBind StmtHandle where > bindWithValue v a = alloca (\p -> poke p v >> a (castPtr p)) > bindWriteBuffer b v = poke (castPtr b) v -> bindSize _ = sizeOf nullPtr -> bindNullInd _ = 0 +> bindDataSize _ = sizeOf nullPtr > bindType _ = oci_SQLT_RSET > withBinaryValue :: (OracleBind b) => @@ -768,7 +762,9 @@ > -> (Ptr Word8 -> IO ()) -- ^ action to run over buffer; buffer will be freed on completion > -> IO () > withBinaryValue fn v pok action = -> allocaBytes (bindSize v) $ \p -> do +> -- FIXME is bindBufferSize better here? +> --allocaBytes (bindBufferSize v) $ \p -> do +> allocaBytes (bindDataSize v) $ \p -> do > pok p (fn v) > action (castPtr p) @@ -868,7 +864,17 @@ > execute sess (stmtHandle pstmt) 0 > return (Query pstmt sess (Just pstmt)) +> instance Statement CommandBind Session Query where +> makeQuery sess (CommandBind sqltext bas) = do +> let +> (PreparationA action) = +> prepareStmt' 1 sqltext FreeWithQuery CommandType +> pstmt <- action sess +> sequence_ (zipWith (\i (BindA ba) -> ba sess pstmt i) [1..] bas) +> execute sess (stmtHandle pstmt) 1 +> return (Query pstmt sess (Just pstmt)) + > data ColumnBuffer = ColumnBuffer > { colBufBufferFPtr :: OCI.ColumnResultBuffer > , colBufNullFPtr :: ForeignPtr CShort @@ -885,24 +891,19 @@ > _ -> return () > fetchOneRow query = do > let pstmt = queryStmt query -> case stmtType pstmt of -> SelectType -> do -> rc <- fetchRow (querySess query) (queryStmt query) +> -- Only call fetchRow if there are no bind output buffers +> -- If there are bind output buffers then assume this was a +> -- procedure call. +> -- In this case you will always get the same row over and over, +> -- so you'd better be careful with your iteratees +> buffers <- readIORef (stmtBuffers pstmt) +> if not (null buffers) then return True +> else do +> rc <- fetchRow (querySess query) pstmt > return (rc /= oci_NO_DATA) -> -- This is the CommandType case, where we have a command -> -- (function/procedure call, or update-returning) -> -- that will populate output bind buffers. -> -- We don't need to do anything except return True to -> -- indicate that data is available. -> -- True also means the fetch will never terminate; -> -- it will always give the same row over and over, -> -- so you'd better be careful with your iteratees. -> _ -> return True > currentRowNum query = > getRowCount (querySess query) (stmtHandle (queryStmt query)) -> freeBuffer q buffer = do -> -- FIXME we need to free StmtHandles -> return () +> freeBuffer q buffer = return () This is where we differ the behaviour depending on the diff --git a/Database/Oracle/OCIFunctions.lhs b/Database/Oracle/OCIFunctions.lhs --- a/Database/Oracle/OCIFunctions.lhs +++ b/Database/Oracle/OCIFunctions.lhs @@ -22,19 +22,20 @@ the OCI call, and some text identifying the wrapper function. See 'formatErrorCodeDesc' for the set of possible values for the OCI error numbers. -> {-# OPTIONS -ffi #-} -> {-# OPTIONS -fglasgow-exts #-} +> {-# LANGUAGE ForeignFunctionInterface #-} +> {-# LANGUAGE CPP #-} > module Database.Oracle.OCIFunctions where +> import Prelude hiding (catch) > import Database.Oracle.OCIConstants > import Database.Util > import Foreign > import Foreign.C > import Control.Monad -> import Control.Exception +> import Control.Exception.Extensible > import Data.Dynamic > import System.Time > import Data.Time @@ -98,11 +99,10 @@ > catchOCI :: IO a -> (OCIException -> IO a) -> IO a -> catchOCI = catchDyn - > throwOCI :: OCIException -> a -> throwOCI = throwDyn - +> instance Exception OCIException +> catchOCI = catch +> throwOCI = throw > mkCInt :: Int -> CInt @@ -164,9 +164,20 @@ plsqlArrayMaxLen, plsqlCurrEltPtr, mode > foreign import ccall "oci.h OCIBindByPos" ociBindByPos :: -> StmtHandle -> Ptr BindHandle -> ErrorHandle -> CUInt -> BufferPtr -> CInt -> -> CUShort -> Ptr CShort -> Ptr CUShort -> Ptr CUShort -> -> CUInt -> Ptr CUInt -> CUInt -> IO CInt +> StmtHandle +> -> Ptr BindHandle +> -> ErrorHandle +> -> CUInt -- ^ position +> -> BufferPtr -- ^ buffer containing data +> -> CInt -- ^ max size of buffer +> -> CUShort -- ^ SQL data type +> -> Ptr CShort -- ^ null indicator ptr +> -> Ptr CUShort -- ^ input + output size, or array of sizes +> -> Ptr CUShort -- ^ array of return codes +> -> CUInt -- ^ max array elements +> -> Ptr CUInt -- ^ number of array elements +> -> CUInt -- ^ mode +> -> IO CInt > foreign import ccall "oci.h OCIBindDynamic" ociBindDynamic :: > BindHandle -> ErrorHandle -> ContextPtr -> FunPtr OCICallbackInBind @@ -516,7 +527,7 @@ so we have this function to substitute ? with :n, where n starts at one and increases with each ?. -We don't use this function into this library though; +We don't use this function in this library though; it's used in the higher-level implementation of Enumerator. We prefer to retain flexibility at this lower-level, and not force arbitrary implementation choices too soon. @@ -563,8 +574,8 @@ > ErrorHandle > -> StmtHandle > -> Int -- ^ Position -> -> BindBuffer -- ^ triple of (null-ind, payload, output-size) -> -> Int -- ^ payload input size in bytes +> -> BindBuffer -- ^ triple of (null-ind, payload, input-size) +> -> Int -- ^ buffer max size in bytes > -> CInt -- ^ SQL Datatype (from "Database.Oracle.OCIConstants") > -> IO BindHandle > bindOutputByPos err stmt pos (nullIndFPtr, bufFPtr, sizeFPtr) sze sqltype = @@ -669,6 +680,7 @@ > withForeignPtr bufFPtr $ \bufferPtr -> > withForeignPtr sizeFPtr $ \retSizePtr -> do > retsize <- liftM cUShort2Int (peek retSizePtr) +> --putStrLn ("bufferToString: size = " ++ show retsize) > pokeByteOff (castPtr bufferPtr) retsize nullByte > val <- peekCString (castPtr bufferPtr) > return (Just val) diff --git a/Database/Oracle/Test/Enumerator.lhs b/Database/Oracle/Test/Enumerator.lhs new file mode 100644 --- /dev/null +++ b/Database/Oracle/Test/Enumerator.lhs @@ -0,0 +1,378 @@ + +| +Module : Database.Oracle.Test.Enumerator +Copyright : (c) 2004 Oleg Kiselyov, Alistair Bayley +License : BSD-style +Maintainer : oleg@pobox.com, alistair@abayley.org +Stability : experimental +Portability : non-portable + + +The Oracle multi-result-set tests require these database objects: + +CREATE OR REPLACE VIEW t_whole as +select 0 as n from dual union select 1 from dual +union select 2 from dual union select 3 from dual +union select 4 from dual union select 5 from dual +union select 6 from dual union select 7 from dual +union select 8 from dual union select 9 from dual +; + +CREATE OR REPLACE VIEW t_natural as +select n from +( select t1.n + 10 * t10.n + 100 * t100.n as n +from t_whole t1, t_whole t10, t_whole t100 +) t where n > 0 order by 1 +; + +create or replace package Takusen as type RefCursor is ref cursor; end; + +CREATE OR REPLACE PROCEDURE takusenTestProc +(refc1 out Takusen.RefCursor, refc2 out Takusen.RefCursor) AS BEGIN +OPEN refc1 FOR SELECT n*n from t_natural where n < 10 order by 1; +OPEN refc2 FOR SELECT n, n*n, n*n*n from t_natural where n < 10 order by 1; +END; + +select n, cursor( + SELECT nat2.n + , cursor(SELECT nat3.n from t_natural nat3 where nat3.n < nat2.n order by n) + from t_natural nat2 where nat2.n < nat.n order by n +) +from t_natural nat where n < 10 order by n; + + +> {-# LANGUAGE OverlappingInstances #-} + +> module Database.Oracle.Test.Enumerator (runTest) where + +> import qualified Database.Oracle.Test.OCIFunctions as Low +> import Database.Oracle.Enumerator +> import Database.Util (print_) +> import Database.Test.Performance as Perf +> import Database.Test.Enumerator +> import Control.Monad (when) +> import Control.Monad.Trans (liftIO) +> import Test.MiniUnit +> import Data.Int +> import System.Time + + +> runTest :: Perf.ShouldRunTests -> [String] -> IO () +> runTest runPerf args = do +> let (user:pswd:dbname:_) = args +> Low.runTest args +> flip catchDB basicDBExceptionReporter $ +> withSession (connect user pswd dbname) (testBody runPerf) + +> testBody runPerf = do +> runFixture OracleFunctions +> when (runPerf == Perf.RunTests) runPerformanceTests + +> runPerformanceTests = do +> makeFixture execDrop execDDL_ +> beginTransaction RepeatableRead +> runTestTT "Oracle performance tests" (map (flip catchDB reportRethrow) +> [ timedSelect (prefetch 1000 sqlRows2Power20 []) 30 (2^20) +> , timedSelect (prefetch 1 sqlRows2Power17 []) 60 (2^17) +> , timedSelect (prefetch 1000 sqlRows2Power17 []) 6 (2^17) +> , timedCursor (prefetch 1 sqlRows2Power17 []) 60 (2^17) +> , timedCursor (prefetch 1000 sqlRows2Power17 []) 6 (2^17) +> ] +> ) +> commit +> destroyFixture execDDL_ + + +> runFixture :: OracleFunctions -> DBM mark Session () +> runFixture fns = do +> makeFixture execDrop execDDL_ +> execDDL_ makeFixtureMultiResultSet1 +> execDDL_ makeFixtureMultiResultSet2 +> execDDL_ makeFixtureMultiResultSet3 +> execDDL_ makeFixtureMultiResultSet4 +> execDDL_ makeFixtureBindOutput +> runTestTT "Oracle tests" (map (runOneTest fns) testList) +> execDDL_ dropFixtureBindOutput +> execDDL_ dropFixtureMultiResultSet4 +> execDDL_ dropFixtureMultiResultSet3 +> execDDL_ dropFixtureMultiResultSet2 +> execDDL_ dropFixtureMultiResultSet1 +> destroyFixture execDDL_ + +> runOneTest fns t = catchDB (t fns) reportRethrow + +----------------------------------------------------------- + +> selectNoRows _ = selectTest sqlNoRows iterNoRows expectNoRows + +> selectTerminatesEarly _ = selectTest sqlTermEarly iterTermEarly expectTermEarly + +> selectFloatsAndInts fns = selectTest (sqlFloatsAndInts fns) iterFloatsAndInts expectFloatsAndInts + +> selectNullString _ = selectTest sqlNullString iterNullString expectNullString + +> selectEmptyString _ = selectTest sqlEmptyString iterEmptyString expectEmptyString + +> selectUnhandledNull _ = catchDB ( do +> selectTest sqlUnhandledNull iterUnhandledNull expectUnhandledNull +> assertFailure sqlUnhandledNull +> ) (\e -> return () ) + + + +> selectNullDate dateFn = selectTest (sqlNullDate dateFn) iterNullDate expectNullDate + +> selectDate dateFn = selectTest (sqlDate dateFn) iterDate expectDate + +> selectCalDate dateFn = selectTest (sqlDate dateFn) iterCalDate expectCalDate + +> selectBoundaryDates dateFn = selectTest (sqlBoundaryDates dateFn) iterBoundaryDates expectBoundaryDates + +> selectCursor fns = actionCursor (sqlCursor fns) + +> selectExhaustCursor fns = actionExhaustCursor (sqlCursor fns) + +> selectBindString _ = actionBindString +> (prepareQuery (sql sqlBindString)) +> [bindP "a2", bindP "b1"] + + +> selectBindInt _ = actionBindInt +> (prepareQuery (sql sqlBindInt)) +> [bindP (1::Int), bindP (2::Int)] + + +> selectBindIntDoubleString _ = actionBindIntDoubleString +> (prefetch 0 sqlBindIntDoubleString [bindP (1::Int), bindP (2.2::Double), bindP "row 1", bindP (3::Int), bindP (4.4::Double), bindP "row 2"]) + +> selectBindDate _ = actionBindDate +> (prefetch 1 sqlBindDate (map bindP expectBindDate)) + +> selectBindBoundaryDates _ = actionBindBoundaryDates +> (prefetch 1 sqlBindBoundaryDates (map bindP expectBoundaryDates)) + +> selectRebindStmt _ = actionRebind (prepareQuery (sql sqlRebind)) +> [bindP (1::Int)] [bindP (2::Int)] + +> boundStmtDML _ = actionBoundStmtDML (prepareCommand (sql sqlBoundStmtDML)) +> boundStmtDML2 _ = withTransaction RepeatableRead $ do +> count <- execDML (cmdbind sqlBoundStmtDML [bindP (100::Int), bindP "100"]) +> assertEqual sqlBoundStmtDML 1 count +> rollback + + +> polymorphicFetchTest _ = actionPolymorphicFetch +> (prefetch 0 sqlPolymorphicFetch [bindP expectPolymorphicFetch]) + +> polymorphicFetchTestNull _ = actionPolymorphicFetchNull +> (prefetch 1 sqlPolymorphicFetchNull []) + +> exceptionRollback _ = actionExceptionRollback sqlInsertTest4 sqlExceptionRollback + + +FIXME check definitions of whole and natural numbers + +> dropFixtureMultiResultSet1 = "DROP VIEW t_whole" +> makeFixtureMultiResultSet1 = "CREATE OR REPLACE VIEW t_whole as" +> ++ " select 0 as n from dual union select 1 from dual" +> ++ " union select 2 from dual union select 3 from dual" +> ++ " union select 4 from dual union select 5 from dual" +> ++ " union select 6 from dual union select 7 from dual" +> ++ " union select 8 from dual union select 9 from dual" + +> dropFixtureMultiResultSet2 = "DROP VIEW t_natural" +> makeFixtureMultiResultSet2 = "CREATE OR REPLACE VIEW t_natural as" +> ++ " select n from" +> ++ " ( select t1.n + 10 * t10.n + 100 * t100.n as n" +> ++ " from t_whole t1, t_whole t10, t_whole t100" +> ++ " ) t where n > 0 order by 1" + + +> dropFixtureMultiResultSet3 = "DROP package Takusen" +> makeFixtureMultiResultSet3 = +> "create or replace package Takusen as type RefCursor is ref cursor; end;" + +> dropFixtureMultiResultSet4 = "DROP PROCEDURE takusenTestProc" +> makeFixtureMultiResultSet4 = "CREATE OR REPLACE PROCEDURE takusenTestProc" +> ++ " (refc1 out Takusen.RefCursor, refc2 out Takusen.RefCursor) AS BEGIN" +> ++ " OPEN refc1 FOR SELECT n*n from t_natural where n < 10 order by 1;" +> ++ " OPEN refc2 FOR SELECT n, n*n, n*n*n from t_natural where n < 10 order by 1;" +> ++ " END;" + +What would you need to do to make database functions and procedures +callable from Haskell as if they were local functions (IO actions)? + +wrapPLSQLFunc funcname parms = + let + sqltext = "begin " ++ (head args) ++ " := " ++ funcname ++ "(" ++ placeholders ++ "); end;" + placeholders = concat (intersperse "," (tail args)) + args = take (length parms) (map (\n -> ":x" ++ show n) [1..]) + in cmdbind sqltext parms + +wrapPLSQLProc procname parms = + let + sqltext = "begin " ++ procname ++ "(" ++ placeholders ++ "); end;" + placeholders = concat (intersperse "," args) + args = take (length parms) (map (\n -> ":x" ++ show n) [1..]) + in cmdbind sqltext parms + +convertCcy :: String -> Double -> String -> UTCTime -> DBM mark Session (String, Double) +convertCcy ccyFrom valFrom ccyTo onDate = do + sqlcmd = wrapPLSQLFunc "pk_fx.convert_ccy" + [ bindP (Out (0 :: Double)) + , bindP ccyFrom + , bindP valFrom + , bindP ccyTo + , bindP onDate + ] + let + iter :: Monad m => Double -> IterAct m Double + iter val seed = return (Left val) + result = doQuery sqlcmd iter undefined + return result + +> selectMultiResultSet _ = do +> let refcursor :: Maybe StmtHandle; refcursor = Just undefined +> withTransaction RepeatableRead $ do +> withPreparedStatement (prepareCommand (sql "begin takusenTestProc(:1,:2); end;")) $ \pstmt -> do +> withBoundStatement pstmt [bindP (Out refcursor), bindP (Out refcursor)] $ \bstmt -> do +> dummy <- doQuery bstmt iterMain () +> result1 <- doQuery (NextResultSet pstmt) iterRS1 [] +> assertEqual "selectMultiResultSet: RS1" [1,4,9,16,25,36,49,64,81] result1 +> result2 <- doQuery (NextResultSet pstmt) iterRS2 [] +> let expect = [(1,1,1),(2,4,8),(3,9,27),(4,16,64),(5,25,125),(6,36,216) +> ,(7,49,343),(8,64,512),(9,81,729)] +> assertEqual "selectMultiResultSet: RS2" expect result2 +> return () +> where +> iterMain :: (Monad m) => RefCursor StmtHandle -> RefCursor StmtHandle -> IterAct m () +> iterMain c1 c2 acc = return (Left acc) +> iterRS1 :: (Monad m) => Int -> IterAct m [Int] +> iterRS1 i acc = result (acc ++ [i]) +> iterRS2 :: (Monad m) => Int -> Int -> Int -> IterAct m [(Int, Int, Int)] +> iterRS2 i i2 i3 acc = result (acc ++ [(i, i2, i3)]) + + +> selectNestedMultiResultSet :: OracleFunctions -> DBM mark Session () +> selectNestedMultiResultSet _ = do +> let +> -- This returns two rows, each of which contains one cursor. +> -- The first cursor returns 101, the second 102. +> q = "select cursor(select n from dual) from" +> ++ " (select 101 as n from dual union select 102 from dual)" +> iterMain (c::RefCursor StmtHandle) acc = do +> rs <- doQuery c iterInner [] +> result' (c:acc) +> iterInner (i::Int) acc = do +> if (i /= 101 && i /= 102) +> then assertFailure "selectNestedMultiResultSet: inner value not 101 or 102" +> else return () +> result' (i:acc) +> withTransaction RepeatableRead $ do +> withPreparedStatement (prepareQuery (sql q)) $ \pstmt -> do +> withBoundStatement pstmt [] $ \bstmt -> do +> rs <- doQuery bstmt iterMain [] +> return () + + +> selectNestedMultiResultSet2 :: OracleFunctions -> DBM mark Session () +> selectNestedMultiResultSet2 _ = do +> let +> q = "select n, cursor(SELECT nat2.n, cursor" +> ++ " (SELECT nat3.n from t_natural nat3 where nat3.n < nat2.n order by n)" +> ++ " from t_natural nat2 where nat2.n < nat.n order by n)" +> ++ " from t_natural nat where n < 10 order by n" +> iterMain (outer::Int) (c::RefCursor StmtHandle) acc = do +> rs <- doQuery c (iterInner outer) [] +> let expect = drop (9-outer) [8,7,6,5,4,3,2,1] +> assertEqual "processOuter" expect (map fst rs) +> result' ((outer,c):acc) +> iterInner outer (inner::Int) (c::RefCursor StmtHandle) acc = do +> rs <- doQuery c (iterInner2 outer inner) [] +> let expect = drop (9-inner) [8,7,6,5,4,3,2,1] +> assertEqual "processInner" expect rs +> result' ((inner,c):acc) +> iterInner2 outer inner (i::Int) acc = do +> --print_ (show outer ++ " " ++ show inner ++ " " ++ show i) +> assertBool "processInner2" (i < inner) +> result' (i:acc) +> withTransaction RepeatableRead $ do +> withPreparedStatement (prepareQuery (sql q)) $ \pstmt -> do +> withBoundStatement pstmt [] $ \bstmt -> do +> rs <- doQuery bstmt iterMain [] +> assertEqual "selectNestedMultiResultSet" [9,8,7,6,5,4,3,2,1] (map fst rs) +> --print_ "" + +> selectNestedMultiResultSet3 :: OracleFunctions -> DBM mark Session () +> selectNestedMultiResultSet3 _ = do +> let +> q = "select n, cursor(SELECT nat2.n, cursor" +> ++ " (SELECT nat3.n from t_natural nat3 where nat3.n < nat2.n order by n)" +> ++ " from t_natural nat2 where nat2.n < nat.n order by n)" +> ++ " from t_natural nat where n < 10 order by n" +> iterMain (outer::Int) (c::RefCursor StmtHandle) acc = do +> rs <- doQuery c (iterInner outer) [] +> let expect = drop (9-outer) [8,7,6,5,4,3,2,1] +> assertEqual "processOuter" expect (map fst rs) +> result' ((outer,c):acc) +> iterInner outer (inner::Int) (c::RefCursor StmtHandle) acc = do +> rs <- doQuery c (iterInner2 outer inner) [] +> let expect = drop (9-inner) [8,7,6,5,4,3,2,1] +> assertEqual "processInner" expect rs +> result' ((inner,c):acc) +> iterInner2 outer inner (i::Int) acc = do +> --print_ (show outer ++ " " ++ show inner ++ " " ++ show i) +> assertBool "processInner2" (i < inner) +> result' (i:acc) +> withTransaction RepeatableRead $ do +> rs <- doQuery (sql q) iterMain [] +> assertEqual "selectNestedMultiResultSet" [9,8,7,6,5,4,3,2,1] (map fst rs) +> --print_ "" + +> dropFixtureBindOutput = "DROP PROCEDURE takusenTestBindProc" + +> makeFixtureBindOutput = "CREATE or replace PROCEDURE takusenTestBindProc(x in out number, y in out varchar2)" +> ++ " AS BEGIN\n" +> ++ " y := 'output ' || y;\n" +> ++ " x := x * 2;\n" +> ++ " END;" + +> bindOutputString _ = do +> let sqltext = "begin takusenTestBindProc(:1,:2); end;" +> let qry = cmdbind sqltext [bindP (Out (1234::Int)), bindP (Out (Just "message"))] +> (x, s) <- doQuery qry iter undefined +> assertEqual "bindOutputString: int " 2468 x +> assertEqual "bindOutputString: string " "output message" s +> where +> iter :: (Monad m) => Int -> String -> IterAct m (Int, String) +> iter i s _ = return (Left (i, s)) + + +> bindOutput _ = do +> let sqltext = +> "begin :1 := :1 + 1;\n " +> ++ ":2 := :2 * 2;\n" +> ++ "end;" +> let qry = cmdbind sqltext [bindP (Out (44.4 :: Double)), bindP (Out (1234::Int))] +> (d, i) <- doQuery qry iter undefined +> assertEqual "bindOutput: double " 45.4 d +> assertEqual "bindOutput: int " 2468 i +> where +> iter :: (Monad m) => Double -> Int -> IterAct m (Double, Int) +> iter d i _ = return (Left (d, i)) + + +> testList :: [OracleFunctions -> DBM mark Session ()] +> testList = +> [ selectNoRows, selectTerminatesEarly, selectFloatsAndInts +> , selectNullString, selectEmptyString, selectUnhandledNull +> , selectNullDate, selectDate, selectCalDate, selectBoundaryDates +> , selectCursor, selectExhaustCursor +> , selectBindString, selectBindInt, selectBindIntDoubleString +> , selectBindDate, selectBindBoundaryDates, selectRebindStmt +> , boundStmtDML, boundStmtDML2 +> , polymorphicFetchTest, polymorphicFetchTestNull, exceptionRollback +> , selectMultiResultSet, selectNestedMultiResultSet +> , selectNestedMultiResultSet2, selectNestedMultiResultSet3 +> , bindOutput, bindOutputString +> ] diff --git a/Database/Oracle/Test/OCIFunctions.lhs b/Database/Oracle/Test/OCIFunctions.lhs new file mode 100644 --- /dev/null +++ b/Database/Oracle/Test/OCIFunctions.lhs @@ -0,0 +1,448 @@ + +| +Module : Database.Oracle.Test.OCIFunctions +Copyright : (c) 2004 Oleg Kiselyov, Alistair Bayley +License : BSD-style +Maintainer : oleg@pobox.com, alistair@abayley.org +Stability : experimental +Portability : non-portable + +Test harness for "Database.Oracle.OCIFunctions". +This module depends on on "Database.Oracle.OCIFunctions". +so it should only use functions from there (and "Database.Oracle.OCIConstants"). + + +> module Database.Oracle.Test.OCIFunctions (runTest) where + +> import qualified Database.Oracle.OCIFunctions as OCI +> import Database.Oracle.OCIFunctions (EnvHandle, ErrorHandle, ConnHandle, StmtHandle) +> import Database.Oracle.OCIConstants +> import Foreign.Ptr +> import Foreign.C.String +> import Foreign.C.Types +> import Foreign +> import System.IO +> import System.Environment (getArgs) +> import Control.Monad +> import Test.MiniUnit +> import Data.Char + + +> nullAction :: IO () +> nullAction = return () + +> printError :: String -> IO () +> printError s = hPutStrLn stderr s + +> reportAndIgnore :: ErrorHandle -> OCI.OCIException -> IO () -> IO () +> reportAndIgnore err ociexc cleanupAction = do +> (e, m) <- OCI.formatErrorMsg ociexc err +> printError $ (show e) ++ ": " ++ m +> cleanupAction + +> reportAndRethrow :: ErrorHandle -> OCI.OCIException -> IO () -> IO () +> reportAndRethrow err ociexc cleanupAction = do +> (_, m) <- OCI.formatErrorMsg ociexc err +> printError m +> cleanupAction +> OCI.throwOCI ociexc + + +> logon :: (String, String, String) -> IO (EnvHandle, ErrorHandle, ConnHandle) +> logon (testUser, testPswd, testDb) = do +> env <- OCI.envCreate +> err <- OCI.handleAlloc oci_HTYPE_ERROR (castPtr env) +> OCI.catchOCI ( do +> server <- OCI.handleAlloc oci_HTYPE_SERVER (castPtr env) +> OCI.serverAttach (castPtr err) (castPtr server) testDb +> conn <- OCI.handleAlloc oci_HTYPE_SVCCTX (castPtr env) +> -- the connection holds a reference to the server in one of its attributes +> OCI.setHandleAttr (castPtr err) (castPtr conn) oci_HTYPE_SVCCTX (castPtr server) oci_ATTR_SERVER +> session <- OCI.handleAlloc oci_HTYPE_SESSION (castPtr env) +> if (testUser == "") +> then do +> OCI.sessionBegin (castPtr err) (castPtr conn) (castPtr session) oci_CRED_EXT +> else do +> OCI.setHandleAttrString (castPtr err) (castPtr session) oci_HTYPE_SESSION testUser oci_ATTR_USERNAME +> OCI.setHandleAttrString (castPtr err) (castPtr session) oci_HTYPE_SESSION testPswd oci_ATTR_PASSWORD +> OCI.sessionBegin (castPtr err) (castPtr conn) (castPtr session) oci_CRED_RDBMS +> -- the connection also holds a reference to the session in one of its attributes +> OCI.setHandleAttr (castPtr err) (castPtr conn) oci_HTYPE_SVCCTX (castPtr session) oci_ATTR_SESSION +> -- and we need to create a valid transaction handle for the connection, too. +> trans <- OCI.handleAlloc oci_HTYPE_TRANS (castPtr env) +> OCI.setHandleAttr (castPtr err) (castPtr conn) oci_HTYPE_SVCCTX (castPtr trans) oci_ATTR_TRANS +> return (env, castPtr err, castPtr conn) +> ) (\ociexc -> do +> reportAndIgnore (castPtr err) ociexc nullAction +> return (nullPtr, nullPtr, nullPtr) +> ) + +> logoff :: (EnvHandle, ErrorHandle, ConnHandle) -> IO () +> logoff (env, err, conn) = OCI.catchOCI ( do +> session <- OCI.getHandleAttr err (castPtr conn) oci_HTYPE_SVCCTX oci_ATTR_SESSION +> server <- OCI.getHandleAttr err (castPtr conn) oci_HTYPE_SVCCTX oci_ATTR_SERVER +> OCI.sessionEnd err conn session +> OCI.serverDetach err server +> OCI.handleFree oci_HTYPE_SESSION (castPtr session) +> OCI.handleFree oci_HTYPE_SERVER (castPtr server) +> OCI.handleFree oci_HTYPE_SVCCTX (castPtr conn) +> OCI.handleFree oci_HTYPE_ERROR (castPtr err) +> OCI.handleFree oci_HTYPE_ENV (castPtr env) +> OCI.terminate +> ) (\ociexc -> reportAndIgnore (castPtr err) ociexc nullAction) + + +> testCreateEnv :: IO () +> testCreateEnv = do +> env <- OCI.envCreate +> OCI.handleFree oci_HTYPE_ENV (castPtr env) + + +> testConnect :: (String, String, String) -> IO () +> testConnect args = do +> x <- logon args +> logoff x + + +> getStmt :: EnvHandle -> ErrorHandle -> ConnHandle -> String -> IO StmtHandle +> getStmt env err conn sql = do +> stmt <- OCI.handleAlloc oci_HTYPE_STMT (castPtr env) +> OCI.stmtPrepare err (castPtr stmt) sql +> OCI.stmtExecute err conn (castPtr stmt) 0 +> return (castPtr stmt) + + +> testBeginTrans :: (String, String, String) -> IO () +> testBeginTrans args = do +> (env, err, conn) <- logon args +> OCI.catchOCI ( do +> OCI.beginTrans err conn oci_TRANS_SERIALIZABLE +> stmt <- getStmt env err conn "select dummy from dual" +> OCI.handleFree oci_HTYPE_STMT (castPtr stmt) +> ) (\ociexc -> reportAndIgnore (castPtr err) ociexc nullAction) +> logoff (env, err, conn) + + +> testExecute :: (String, String, String) -> IO () +> testExecute args = do +> (env, err, conn) <- logon args +> OCI.catchOCI ( do +> stmt <- getStmt env err conn "select dummy from dual" +> OCI.handleFree oci_HTYPE_STMT (castPtr stmt) +> ) (\ociexc -> reportAndIgnore (castPtr err) ociexc nullAction) +> logoff (env, err, conn) + + +> testFetch :: (String, String, String) -> IO () +> testFetch args = do +> (env, err, conn) <- logon args +> OCI.catchOCI ( do +> stmt <- getStmt env err conn "select dummy from dual" +> (_, buf, nullptr, sizeptr) <- OCI.defineByPos err (castPtr stmt) 1 100 oci_SQLT_CHR +> rc <- OCI.stmtFetch err (castPtr stmt) +> OCI.handleFree oci_HTYPE_STMT (castPtr stmt) +> ) (\ociexc -> reportAndIgnore (castPtr err) ociexc nullAction) +> logoff (env, err, conn) + +> testFetchStmt :: (String, String, String) -> IO () +> testFetchStmt args = do +> (env, err, conn) <- logon args +> OCI.catchOCI ( do +> stmt <- getStmt env err conn "select cursor(select 101 from dual) from dual" +> (_, buf, nullptr, sizeptr) <- OCI.defineByPos err (castPtr stmt) 1 8 oci_SQLT_RSET +> stmt2 <- OCI.handleAlloc oci_HTYPE_STMT (castPtr env) +> withForeignPtr buf $ \p -> poke (castPtr p) stmt2 +> rc <- OCI.stmtFetch err (castPtr stmt) +> -- stmt2 <- OCI.bufferToStmtHandle buf +> (_, buf, nullptr, sizeptr) <- OCI.defineByPos err (castPtr stmt2) 1 4 oci_SQLT_INT +> rc <- OCI.stmtFetch err (castPtr stmt2) +> mb_i <- OCI.bufferToInt nullptr buf +> assertEqual "testFetchStmt" (Just 101) mb_i +> OCI.handleFree oci_HTYPE_STMT (castPtr stmt2) +> OCI.handleFree oci_HTYPE_STMT (castPtr stmt) +> ) (\ociexc -> reportAndIgnore (castPtr err) ociexc nullAction) +> logoff (env, err, conn) + + +> testNestedFetchStmt :: (String, String, String) -> IO () +> testNestedFetchStmt args = do +> let +> -- This returns two rows, each of which contains one cursor. +> -- The first cursor returns 101, the second 102. +> sql = "select cursor(select n from dual) from" +> ++ " (select 101 as n from dual union select 102 from dual)" +> (env, err, conn) <- logon args +> OCI.catchOCI ( do +> stmt <- getStmt env err conn sql +> -- Create result buffer bfor row 1 StmtHandle +> (_, obuf, nullptr, sizeptr) <- OCI.defineByPos err (castPtr stmt) 1 8 oci_SQLT_RSET +> stmt101 <- OCI.handleAlloc oci_HTYPE_STMT (castPtr env) +> withForeignPtr obuf $ \p -> poke (castPtr p) stmt101 +> -- +> -- Fetch row 1 of 2 +> rc <- OCI.stmtFetch err (castPtr stmt) +> -- +> -- Fetch stmt101 value +> (_, buf, nullptr, sizeptr) <- OCI.defineByPos err (castPtr stmt101) 1 4 oci_SQLT_INT +> rc <- OCI.stmtFetch err (castPtr stmt101) +> mb_101 <- OCI.bufferToInt nullptr buf +> assertEqual "testFetchStmt" (Just 101) mb_101 +> --OCI.handleFree oci_HTYPE_STMT (castPtr stmt101) +> -- +> -- Create result buffer for row 2 StmtHandle... +> -- or re-use the StmtHandle stmt101. +> -- Both ways work. +> --(_, obuf, nullptr, sizeptr) <- OCI.defineByPos err (castPtr stmt) 1 8 oci_SQLT_RSET +> --stmt102 <- OCI.handleAlloc oci_HTYPE_STMT (castPtr env) +> --withForeignPtr obuf $ \p -> poke (castPtr p) stmt102 +> let stmt102 = stmt101 +> -- +> -- Fetch row 2 of 2 +> rc <- OCI.stmtFetch err (castPtr stmt) +> -- What happens if we free here? +> -- Will the child cursor still be valid? +> -- No - we get ORA-01001: invalid cursor +> -- So it looks like closing the parent closes the children too. +> --OCI.handleFree oci_HTYPE_STMT (castPtr stmt) +> -- +> -- Fetch stmt102 value +> (_, buf, nullptr, sizeptr) <- OCI.defineByPos err (castPtr stmt102) 1 4 oci_SQLT_INT +> rc <- OCI.stmtFetch err (castPtr stmt102) +> mb_102 <- OCI.bufferToInt nullptr buf +> assertEqual "testFetchStmt" (Just 102) mb_102 +> OCI.handleFree oci_HTYPE_STMT (castPtr stmt102) +> -- +> OCI.handleFree oci_HTYPE_STMT (castPtr stmt) +> ) (\ociexc -> reportAndIgnore (castPtr err) ociexc nullAction) +> logoff (env, err, conn) + + + +> testFetchFail :: (String, String, String) -> IO () +> testFetchFail args = do +> (env, err, conn) <- logon args +> OCI.catchOCI ( do +> stmt <- getStmt env err conn "select dummy, 1 from dual" +> (_, buf, nullptr, sizeptr) <- OCI.defineByPos err (castPtr stmt) 1 100 oci_SQLT_CHR +> rc <- OCI.stmtFetch err (castPtr stmt) +> OCI.handleFree oci_HTYPE_STMT (castPtr stmt) +> ) (\ociexc -> reportAndIgnore (castPtr err) ociexc nullAction) +> logoff (env, err, conn) + + +> testBind :: (String, String, String) -> IO () +> testBind args = do +> (env, err, conn) <- logon args +> OCI.catchOCI ( do +> stmt <- OCI.handleAlloc oci_HTYPE_STMT (castPtr env) +> -- Oracle can't cope with ? as a bind variable placeholder. +> -- We must use the :x style instead. +> -- Sqlite can cope with either. I think the ANSI/ISO standard is :n. +> OCI.stmtPrepare err (castPtr stmt) +> (OCI.substituteBindPlaceHolders "select :1 from dual union select :2 from dual") +> withCStringLen "hello" $ \(cstr, clen) -> +> OCI.bindByPos err (castPtr stmt) 1 0 (castPtr cstr) clen oci_SQLT_CHR +> withCStringLen "hello2" $ \(cstr, clen) -> +> OCI.bindByPos err (castPtr stmt) 2 0 (castPtr cstr) clen oci_SQLT_CHR +> OCI.stmtExecute err conn (castPtr stmt) 0 +> buffer@(_, buf, nullptr, sizeptr) <- OCI.defineByPos err (castPtr stmt) 1 100 oci_SQLT_CHR +> rc <- OCI.stmtFetch err (castPtr stmt) +> s <- OCI.bufferToString buffer +> rc <- OCI.stmtFetch err (castPtr stmt) +> s <- OCI.bufferToString buffer +> rc <- OCI.stmtFetch err (castPtr stmt) +> OCI.handleFree oci_HTYPE_STMT (castPtr stmt) +> ) (\ociexc -> reportAndIgnore (castPtr err) ociexc nullAction) +> logoff (env, err, conn) + +> testOutputBind :: (String, String, String) -> IO () +> testOutputBind args = do +> (env, err, conn) <- logon args +> OCI.catchOCI ( do +> stmt <- OCI.handleAlloc oci_HTYPE_STMT (castPtr env) +> -- Oracle can't cope with ? as a bind variable placeholder. +> -- We must use the :x style instead. +> -- Sqlite can cope with either. I think the ANSI/ISO standard is :n. +> OCI.stmtPrepare err (castPtr stmt) (OCI.substituteBindPlaceHolders +> ("begin if :1 <> 'hello' then " +> ++ "raise_application_error(-20001, 'xx-' || :1 || '-xx'); end if; " +> ++ ":1 := 'abcdefg' || substr(:1, 1, 1) || 'ijk'; :2 := 1026; end;")) +> nullIndFPtr1 <- mallocForeignPtr +> nullIndFPtr2 <- mallocForeignPtr +> sizeFPtr1 <- mallocForeignPtr +> sizeFPtr2 <- mallocForeignPtr +> cintFPtr <- mallocForeignPtrBytes (sizeOf (0::CInt)) +> cstrFPtr <- mallocForeignPtrBytes 16000 -- size of "hello" +> withForeignPtr cstrFPtr $ \p -> +> withCStringLen "hello" $ \(cstr, clen) -> copyBytes p (castPtr cstr) (clen+1) +> withForeignPtr sizeFPtr1 $ \p -> poke p 5 +> withForeignPtr sizeFPtr2 $ \p -> poke p (fromIntegral (sizeOf (0::CInt))) +> OCI.bindOutputByPos err (castPtr stmt) 1 (nullIndFPtr1, castForeignPtr cstrFPtr, sizeFPtr1) 16000 oci_SQLT_CHR +> OCI.bindOutputByPos err (castPtr stmt) 2 (nullIndFPtr2, castForeignPtr cintFPtr, sizeFPtr2) (sizeOf (0::CInt)) oci_SQLT_INT +> OCI.stmtExecute err conn (castPtr stmt) 1 +> s <- withForeignPtr cstrFPtr (peekCString . castPtr) +> assertEqual "testOutputBind: 1" "abcdefghijk" s +> ind <- withForeignPtr nullIndFPtr1 peek +> assertEqual "testOutputBind: 2" 0 ind +> i <- withForeignPtr cintFPtr peek +> assertEqual "testOutputBind: 3" 1026 (i :: CInt) +> size <- withForeignPtr sizeFPtr1 peek >>= return . fromIntegral +> assertEqual "testOutputBind: 4" 11 size +> size <- withForeignPtr sizeFPtr2 peek >>= return . fromIntegral +> assertEqual "testOutputBind: 5" (sizeOf (0::CInt)) size +> s <- OCI.bufferToString (undefined, castForeignPtr cstrFPtr, nullIndFPtr1, sizeFPtr1) +> assertEqual "testOutputBind: 6" (Just "abcdefghijk") s +> OCI.handleFree oci_HTYPE_STMT (castPtr stmt) +> ) (\ociexc -> reportAndIgnore (castPtr err) ociexc nullAction) +> logoff (env, err, conn) + +> testOutputBindNoStrings :: (String, String, String) -> IO () +> testOutputBindNoStrings args = do +> (env, err, conn) <- logon args +> OCI.catchOCI ( do +> stmt <- OCI.handleAlloc oci_HTYPE_STMT (castPtr env) +> OCI.stmtPrepare err (castPtr stmt) (OCI.substituteBindPlaceHolders +> ("begin if :1 <> 2 then " +> ++ "raise_application_error(-20001, 'xx-' || to_char(:1) || '-xx'); end if; " +> ++ ":1 := 130; :2 := 1026; end;")) +> let sizeOfCInt = sizeOf (0::CInt) +> nullIndFPtr1 <- mallocForeignPtr +> nullIndFPtr2 <- mallocForeignPtr +> sizeFPtr1 <- mallocForeignPtr +> sizeFPtr2 <- mallocForeignPtr +> cintFPtr1 <- mallocForeignPtrBytes sizeOfCInt +> cintFPtr2 <- mallocForeignPtrBytes sizeOfCInt +> withForeignPtr cintFPtr1 $ \p -> poke p 2 +> withForeignPtr cintFPtr2 $ \p -> poke p 3 +> withForeignPtr sizeFPtr1 $ \p -> poke p (fromIntegral sizeOfCInt) +> withForeignPtr sizeFPtr2 $ \p -> poke p (fromIntegral sizeOfCInt) +> let buffer1 = (nullIndFPtr1, castForeignPtr cintFPtr1, sizeFPtr1) +> let buffer2 = (nullIndFPtr2, castForeignPtr cintFPtr2, sizeFPtr2) +> OCI.bindOutputByPos err (castPtr stmt) 1 buffer1 sizeOfCInt oci_SQLT_INT +> OCI.bindOutputByPos err (castPtr stmt) 2 buffer2 sizeOfCInt oci_SQLT_INT +> OCI.stmtExecute err conn (castPtr stmt) 1 +> ind <- withForeignPtr nullIndFPtr1 peek +> assertEqual "testOutputBind: 0" 0 ind +> i <- withForeignPtr cintFPtr1 peek +> assertEqual "testOutputBind: 1" 130 (i :: CInt) +> ind <- withForeignPtr nullIndFPtr2 peek +> assertEqual "testOutputBind: 2" 0 ind +> i <- withForeignPtr cintFPtr2 peek +> assertEqual "testOutputBind: 3" 1026 (i :: CInt) +> size <- withForeignPtr sizeFPtr1 peek >>= return . fromIntegral +> assertEqual "testOutputBind: 4" sizeOfCInt size +> size <- withForeignPtr sizeFPtr2 peek >>= return . fromIntegral +> assertEqual "testOutputBind: 5" sizeOfCInt size +> OCI.handleFree oci_HTYPE_STMT (castPtr stmt) +> ) (\ociexc -> reportAndIgnore (castPtr err) ociexc nullAction) +> logoff (env, err, conn) + +> testOutputStmtBind :: (String, String, String) -> IO () +> testOutputStmtBind args = do +> (env, err, conn) <- logon args +> OCI.catchOCI ( do +> stmt <- OCI.handleAlloc oci_HTYPE_STMT (castPtr env) +> OCI.stmtPrepare err (castPtr stmt) (OCI.substituteBindPlaceHolders +> ("begin open :1 for select dummy from dual; end;")) +> nullIndFPtr <- mallocForeignPtr +> sizeFPtr <- mallocForeignPtr +> bufrFPtr <- mallocForeignPtrBytes (sizeOf nullPtr) +> -- you have to pass in a valid Statement Handle +> -- is it replaced or just modified? +> stmtx <- OCI.handleAlloc oci_HTYPE_STMT (castPtr env) +> withForeignPtr bufrFPtr $ \p -> poke p (castPtr stmtx) +> withForeignPtr sizeFPtr $ \p -> poke p (fromIntegral (sizeOf nullPtr)) +> OCI.bindOutputByPos err (castPtr stmt) 1 (nullIndFPtr, castForeignPtr bufrFPtr, sizeFPtr) (sizeOf nullPtr) oci_SQLT_RSET +> OCI.stmtExecute err conn (castPtr stmt) 1 +> ind <- withForeignPtr nullIndFPtr $ \p -> peek p +> assertEqual "testOutputStmtBind: ind" 0 ind +> --stmt2 <- withForeignPtr bufrFPtr (peek . castPtr) +> let stmt2 = stmtx +> buffer@(_, buf, nullptr, sizeptr) <- OCI.defineByPos err (castPtr stmt2) 1 100 oci_SQLT_CHR +> rc <- OCI.stmtFetch err (castPtr stmt2) +> s <- OCI.bufferToString buffer +> assertEqual "testOutputStmtBind: stmt2 dummy" (Just "X") s +> OCI.handleFree oci_HTYPE_STMT (castPtr stmt2) +> OCI.handleFree oci_HTYPE_STMT (castPtr stmt) +> ) (\ociexc -> reportAndIgnore (castPtr err) ociexc nullAction) +> logoff (env, err, conn) + + +This just shows that the parent StmtHandle can be safely +closed before we fetch from the child, and this doesn't +seem to matter. +This only works for PL/SQL statements that have output bind variables. +For select statements that return cursors, closing the parent +statement closes all the child cursors too. + +> testOutputStmtBindCloseEarly :: (String, String, String) -> IO () +> testOutputStmtBindCloseEarly args = do +> (env, err, conn) <- logon args +> OCI.catchOCI ( do +> stmt <- OCI.handleAlloc oci_HTYPE_STMT (castPtr env) +> OCI.stmtPrepare err (castPtr stmt) (OCI.substituteBindPlaceHolders +> ("begin open :1 for select 'A' from dual; end;")) +> nullIndFPtr <- mallocForeignPtr +> sizeFPtr <- mallocForeignPtr +> bufrFPtr <- mallocForeignPtrBytes (sizeOf nullPtr) +> -- you have to pass in a valid Statement Handle +> -- is it replaced or just modified? +> stmtx <- OCI.handleAlloc oci_HTYPE_STMT (castPtr env) +> withForeignPtr bufrFPtr $ \p -> poke p (castPtr stmtx) +> withForeignPtr sizeFPtr $ \p -> poke p (fromIntegral (sizeOf nullPtr)) +> OCI.bindOutputByPos err (castPtr stmt) 1 (nullIndFPtr, castForeignPtr bufrFPtr, sizeFPtr) (sizeOf nullPtr) oci_SQLT_RSET +> OCI.stmtExecute err conn (castPtr stmt) 1 +> ind <- withForeignPtr nullIndFPtr $ \p -> peek p +> assertEqual "testOutputStmtBindCloseEarly: ind" 0 ind +> --stmt2 <- withForeignPtr bufrFPtr (peek . castPtr) +> OCI.handleFree oci_HTYPE_STMT (castPtr stmt) +> let stmt2 = stmtx +> buffer@(_, buf, nullptr, sizeptr) <- OCI.defineByPos err (castPtr stmt2) 1 100 oci_SQLT_CHR +> rc <- OCI.stmtFetch err (castPtr stmt2) +> s <- OCI.bufferToString buffer +> assertEqual "testOutputStmtBindCloseEarly: stmt2 dummy" (Just "A") s +> OCI.handleFree oci_HTYPE_STMT (castPtr stmt2) +> ) (\ociexc -> reportAndIgnore (castPtr err) ociexc nullAction) +> logoff (env, err, conn) + +> testSubst input expect = do +> let actual = OCI.substituteBindPlaceHolders input +> when (actual /= expect) (error $ "testSubstBindPlaceHolders failed: " ++ input ++ " -> " ++ actual) + +> testSubstituteBindPlaceHolders :: IO () +> testSubstituteBindPlaceHolders = do +> testSubst "?'?'?" ":1'?':2" +> testSubst "?" ":1" +> testSubst "" "" +> testSubst "x" "x" +> testSubst "????????????" ":1:2:3:4:5:6:7:8:9:10:11:12" +> testSubst "?'''?'''''?" ":1'''?''''':2" + + +> parseArgs :: [String] -> IO (String, String, String) +> parseArgs args = do +> let [u, p, d] = args +> return (u, p, d) + +> testlist args = +> [ testCreateEnv +> , testConnect args +> , testBeginTrans args +> , testExecute args +> , testFetch args +> , testFetchFail args +> , testFetchStmt args +> , testNestedFetchStmt args +> , testBind args +> , testOutputBind args +> , testOutputBindNoStrings args +> , testOutputStmtBind args +> , testOutputStmtBindCloseEarly args +> , testSubstituteBindPlaceHolders +> ] + +> runTest :: [String] -> IO () +> runTest as = do +> args <- parseArgs as +> counts <- runTestTT "Oracle low-level tests" (testlist args) +> return () diff --git a/Database/PostgreSQL/Enumerator.lhs b/Database/PostgreSQL/Enumerator.lhs --- a/Database/PostgreSQL/Enumerator.lhs +++ b/Database/PostgreSQL/Enumerator.lhs @@ -11,8 +11,8 @@ > {-# OPTIONS -fglasgow-exts #-} -> {-# OPTIONS -fallow-undecidable-instances #-} -> {-# OPTIONS -fallow-overlapping-instances #-} +> {-# LANGUAGE OverlappingInstances #-} +> {-# LANGUAGE UndecidableInstances #-} > module Database.PostgreSQL.Enumerator > ( Session, connect, ConnectAttr(..) @@ -29,7 +29,6 @@ > import Database.InternalEnumerator > import Foreign.C > import Control.Monad -> import Control.Exception (catchDyn, throwDyn, throwIO) > import qualified Database.PostgreSQL.PGFunctions as DBAPI > import Data.Char > import Data.Dynamic diff --git a/Database/PostgreSQL/PGFunctions.lhs b/Database/PostgreSQL/PGFunctions.lhs --- a/Database/PostgreSQL/PGFunctions.lhs +++ b/Database/PostgreSQL/PGFunctions.lhs @@ -10,14 +10,17 @@ Simple wrappers for PostgreSQL functions (FFI) plus middle-level wrappers (in the second part of this file) -> {-# OPTIONS -ffi #-} + > {-# OPTIONS -fglasgow-exts #-} +> {-# LANGUAGE ForeignFunctionInterface #-} +> {-# LANGUAGE CPP #-} > module Database.PostgreSQL.PGFunctions where +> import Prelude hiding (catch) > import Database.Util > import Control.Monad -> import Control.Exception +> import Control.Exception.Extensible > import Data.Dynamic > import Data.Int > import Data.Time @@ -47,13 +50,12 @@ > show (PGException i s) = "PGException " ++ (show i) ++ " " ++ s > catchPG :: IO a -> (PGException -> IO a) -> IO a -> catchPG = catchDyn - -> throwPG :: Integral a => a -> String -> any -> throwPG rc s = throwDyn (PGException (fromIntegral rc) s) - -> rethrowPG :: PGException -> any -> rethrowPG = throwDyn +> throwPG :: Integral i => i -> String -> a +> rethrowPG :: PGException -> a +> instance Exception PGException +> catchPG = catch +> throwPG rc s = throw (PGException (fromIntegral rc) s) +> rethrowPG = throw > cStr :: CStringLen -> CString > cStr = fst diff --git a/Database/PostgreSQL/Test/Enumerator.lhs b/Database/PostgreSQL/Test/Enumerator.lhs new file mode 100644 --- /dev/null +++ b/Database/PostgreSQL/Test/Enumerator.lhs @@ -0,0 +1,352 @@ + +| +Module : Database.PostgreSQL.Test.Enumerator +Copyright : (c) 2004 Oleg Kiselyov, Alistair Bayley +License : BSD-style +Maintainer : oleg@pobox.com, alistair@abayley.org +Stability : experimental +Portability : non-portable + + + +Can we support database functions that return/create multiple result-sets? +Oracle, MS Sql Server, and Sybase have them, +and we can simulate them in Postgres with the code below. + +CREATE TRUSTED PROCEDURAL LANGUAGE 'plpgsql' HANDLER plpgsql_call_handler; + +CREATE OR REPLACE VIEW t_whole as +select 0 as n +union select 1 +union select 2 +union select 3 +union select 4 +union select 5 +union select 6 +union select 7 +union select 8 +union select 9 +; + +CREATE OR REPLACE VIEW t_natural as +select n from +( select t1.n + 10 * t10.n + 100 * t100.n as n + from t_whole t1, t_whole t10, t_whole t100 +) t +where n > 0 +order by 1 +; + +DROP FUNCTION takusenTestFunc() ; + +CREATE OR REPLACE FUNCTION takusenTestFunc() RETURNS SETOF refcursor AS \$\$ +DECLARE refc1 refcursor; refc2 refcursor; +BEGIN + OPEN refc1 FOR SELECT n*n from t_natural where n < 10 order by 1; + RETURN NEXT refc1; + OPEN refc2 FOR SELECT n, n*n, n*n*n from t_natural where n < 10 order by 1; + RETURN NEXT refc2; +END;\$\$ LANGUAGE plpgsql; + + +-- this select returns two values (rows), both strings (well, refcursors), +-- which are the cursor names. +select * from myfunc(); + +fetch all from ""; +fetch all from ""; +commit; + + +Another example: + +CREATE OR REPLACE FUNCTION takusenTestFunc(lim int4) RETURNS refcursor AS \$\$ +DECLARE + refc refcursor; +BEGIN + OPEN refc FOR SELECT n, takusenTestFunc2(n) from t_natural where n < lim order by n; + RETURN refc; +END; +\$\$ LANGUAGE plpgsql; + +CREATE OR REPLACE FUNCTION takusenTestFunc2(lim int4) RETURNS refcursor AS \$\$ +DECLARE + refc refcursor; +BEGIN + OPEN refc FOR SELECT n from t_natural where n < lim order by n; + RETURN refc; +END; +\$\$ LANGUAGE plpgsql; + +SELECT n, takusenTestFunc(n) from t_natural where n < 10 order by n; + + +> {-# LANGUAGE OverlappingInstances #-} + +> module Database.PostgreSQL.Test.Enumerator (runTest) where + +> import qualified Database.PostgreSQL.Test.PGFunctions as Low +> import Database.PostgreSQL.Enumerator +> import Database.Test.Performance as Perf +> import Database.Test.Enumerator +> import Control.Monad (when) +> import Test.MiniUnit +> import Data.Int +> import Data.List +> import System.Time + + +> runTest :: Perf.ShouldRunTests -> [String] -> IO () +> runTest runPerf args = do +> putStrLn "PostgreSQL tests" +> let (user:pswd:dbname:_) = args +> Low.runTest user +> flip catchDB basicDBExceptionReporter $ do +> (r, conn1) <- withContinuedSession (connect [CAuser user]) (testBody runPerf) +> withSession conn1 testPartTwo + +> testBody runPerf = do +> runFixture PGSqlFunctions +> when (runPerf == Perf.RunTests) runPerformanceTests + +> testPartTwo = do +> makeFixture execDrop execDDL_ +> destroyFixture execDDL_ + +> runPerformanceTests = do +> makeFixture execDrop execDDL_ +> beginTransaction RepeatableRead +> runTestTT "PostgreSQL performance tests" (map (flip catchDB reportRethrow) +> [ timedSelect (prefetch 1000 sqlRows2Power20 []) 40 (2^20) +> , timedSelect (prefetch 1 sqlRows2Power17 []) 40 (2^17) +> , timedSelect (prefetch 1000 sqlRows2Power17 []) 5 (2^17) +> , timedCursor (prefetch 1 sqlRows2Power17 []) 40 (2^17) +> , timedCursor (prefetch 1000 sqlRows2Power17 []) 5 (2^17) +> ] +> ) +> commit +> destroyFixture execDDL_ + + +> runFixture :: PGSqlFunctions -> DBM mark Session () +> runFixture fns = do +> makeFixture execDrop execDDL_ +> execDDL_ makeFixtureNestedMultiResultSet1 +> execDDL_ makeFixtureNestedMultiResultSet2 +> execDDL_ makeFixtureNestedMultiResultSet3 +> execDDL_ makeFixtureNestedMultiResultSet4 +> execDDL_ makeFixtureMultiResultSet1 +> runTestTT "Postgres tests" (map (runOneTest fns) testList) +> execDDL_ dropFixtureMultiResultSet1 +> execDDL_ dropFixtureNestedMultiResultSet4 +> execDDL_ dropFixtureNestedMultiResultSet3 +> execDDL_ dropFixtureNestedMultiResultSet2 +> execDDL_ dropFixtureNestedMultiResultSet1 +> destroyFixture execDDL_ + +> runOneTest fns t = catchDB (t fns) reportRethrow + +----------------------------------------------------------- + +> selectNoRows _ = selectTest sqlNoRows iterNoRows expectNoRows + +> selectTerminatesEarly _ = selectTest sqlTermEarly iterTermEarly expectTermEarly + +> selectFloatsAndInts fns = selectTest (sqlFloatsAndInts fns) iterFloatsAndInts expectFloatsAndInts + +> selectNullString _ = selectTest sqlNullString iterNullString expectNullString + +> selectEmptyString _ = selectTest sqlEmptyString iterEmptyString expectEmptyString + +> selectUnhandledNull _ = catchDB ( do +> selectTest sqlUnhandledNull iterUnhandledNull expectUnhandledNull +> assertFailure sqlUnhandledNull +> ) (\e -> return () ) + + + +> selectNullDate dateFn = selectTest (sqlNullDate dateFn) iterNullDate expectNullDate + +> selectDate dateFn = selectTest (sqlDate dateFn) iterDate expectDate + +> selectCalDate dateFn = selectTest (sqlDate dateFn) iterCalDate expectCalDate + +> selectBoundaryDates dateFn = selectTest (sqlBoundaryDates dateFn) iterBoundaryDates expectBoundaryDates + +> selectCursor fns = actionCursor (sqlCursor fns) + +> selectExhaustCursor fns = actionExhaustCursor (sqlCursor fns) + +Note that these two tests use the same prepared statement name. +This tests that the statement is properly deallocated, through use of +withPreparedStatement. + +> selectBindString _ = actionBindString +> (prepareQuery "1" (sql sqlBindString) [bindType "", bindType ""]) +> [bindP "a2", bindP "b1"] + +> selectBindInt _ = actionBindInt +> (prepareQuery "1" (sql sqlBindInt) (map bindType expectBindInt)) +> [bindP (1::Int), bindP (2::Int)] + + +> selectBindIntDoubleString _ = actionBindIntDoubleString +> (prefetch 0 sqlBindIntDoubleString [bindP (1::Int), bindP (2.2::Double), bindP "row 1", bindP (3::Int), bindP (4.4::Double), bindP "row 2"]) + +> selectBindDate _ = actionBindDate +> (prefetch 1 sqlBindDate (map bindP expectBindDate)) + +> selectBindBoundaryDates _ = actionBindBoundaryDates +> (prefetch 1 sqlBindBoundaryDates (map bindP expectBoundaryDates)) + +> selectRebindStmt _ = actionRebind +> (prepareQuery "1" (sql sqlRebind) [bindType (0::Int)]) +> [bindP (1::Int)] [bindP (2::Int)] + +> boundStmtDML _ = actionBoundStmtDML +> (prepareCommand "boundStmtDML" (sql sqlBoundStmtDML) [bindType (0::Int), bindType ""]) +> boundStmtDML2 _ = do +> beginTransaction RepeatableRead +> count <- execDML (cmdbind sqlBoundStmtDML [bindP (100::Int), bindP "100"]) +> rollback +> assertEqual sqlBoundStmtDML 1 count + + +> polymorphicFetchTest _ = actionPolymorphicFetch +> (prefetch 0 sqlPolymorphicFetch [bindP expectPolymorphicFetch]) + +> polymorphicFetchTestNull _ = withTransaction RepeatableRead $ +> actionPolymorphicFetchNull (prefetch 1 sqlPolymorphicFetchNull []) + +For the exceptionRollback test we have to specify the count result is int4; +if we don't specify the type then it defaults to a Postgres numeric, +which we can't yet marshal. + +> exceptionRollback _ = actionExceptionRollback sqlInsertTest4 +> ("select count(*)::int4 from " ++ testTable) + + +Ensure we get an exception if the result-set columns +don't match the output buffers (at present we only +check that there aren't too many buffers +i.e. not enough columns). + +> iterateeMatchesResultSet _ = actionIterateeMatchesResultSet +> (prefetch 0 sqlIterateeMatchesResultSet [bindP (1::Int), bindP (2.2::Double), bindP "row 1", bindP (3::Int)]) + +> selectUTF8Text _ = do +> let iter (s::String) (_::String) = result s +> -- GREEK SMALL LETTER PHI : CF86 UTF8, 03C6 UTF16, 966 decimal +> let expect = ['\966'] +> result <- doQuery (sql ("select '" ++ expect ++ "'")) iter "" +> assertEqual "selectUTF8Text" expect result + + +> dropFixtureMultiResultSet1 = "DROP FUNCTION takusenTestFunc()" +> makeFixtureMultiResultSet1 = +> "CREATE OR REPLACE FUNCTION takusenTestFunc() RETURNS SETOF refcursor AS $$" +> ++ "DECLARE refc1 refcursor; refc2 refcursor; BEGIN" +> ++ " OPEN refc1 FOR SELECT n*n from t_natural where n < 10 order by 1;" +> ++ " RETURN NEXT refc1;" +> ++ " OPEN refc2 FOR SELECT n, n*n, n*n*n from t_natural where n < 10 order by 1;" +> ++ " RETURN NEXT refc2;" +> ++ "END;$$ LANGUAGE plpgsql;\n" + +> selectMultiResultSet _ = do +> withTransaction RepeatableRead $ do +> withPreparedStatement (prepareLargeQuery 2 "stmt1" (sql "select * from takusenTestFunc()") []) $ \pstmt -> do +> withBoundStatement pstmt [] $ \bstmt -> do +> dummy <- doQuery bstmt iterMain [] +> result1 <- doQuery (NextResultSet pstmt) iterRS1 [] +> assertEqual "selectMultiResultSet: RS1" [1,4,9,16,25,36,49,64,81] result1 +> result2 <- doQuery (NextResultSet pstmt) iterRS2 [] +> let expect = [(1,1,1),(2,4,8),(3,9,27),(4,16,64),(5,25,125),(6,36,216) +> ,(7,49,343),(8,64,512),(9,81,729)] +> assertEqual "selectMultiResultSet: RS2" expect result2 +> return () +> where +> iterMain :: (Monad m) => (RefCursor String) -> IterAct m [RefCursor String] +> iterMain c acc = result (acc ++ [c]) +> iterRS1 :: (Monad m) => Int -> IterAct m [Int] +> iterRS1 i acc = result (acc ++ [i]) +> iterRS2 :: (Monad m) => Int -> Int -> Int -> IterAct m [(Int, Int, Int)] +> iterRS2 i i2 i3 acc = result (acc ++ [(i, i2, i3)]) + + + +> dropFixtureNestedMultiResultSet1 = "DROP VIEW t_whole" +> makeFixtureNestedMultiResultSet1 = "CREATE OR REPLACE VIEW t_whole as" +> ++ " select 0 as n union select 1 union select 2 union select 3 union select 4" +> ++ " union select 5 union select 6 union select 7 union select 8 union select 9" + +> dropFixtureNestedMultiResultSet2 = "DROP VIEW t_natural" +> makeFixtureNestedMultiResultSet2 = "CREATE OR REPLACE VIEW t_natural as" +> ++ " select n from" +> ++ " ( select t1.n + 10 * t10.n + 100 * t100.n as n" +> ++ " from t_whole t1, t_whole t10, t_whole t100" +> ++ " ) t where n > 0 order by 1" + +> dropFixtureNestedMultiResultSet3 = "DROP FUNCTION takusenTestFunc(int4)" +> makeFixtureNestedMultiResultSet3 = +> "CREATE OR REPLACE FUNCTION takusenTestFunc(lim int4) RETURNS refcursor AS $$" +> ++ " DECLARE refc refcursor; BEGIN" +> ++ " OPEN refc FOR SELECT n, takusenTestFunc2(n) from t_natural where n < lim order by n;" +> ++ " RETURN refc; END; $$ LANGUAGE plpgsql;" + +> dropFixtureNestedMultiResultSet4 = "DROP FUNCTION takusenTestFunc2(int4)" +> makeFixtureNestedMultiResultSet4 = +> "CREATE OR REPLACE FUNCTION takusenTestFunc2(lim int4) RETURNS refcursor AS $$" +> ++ " DECLARE refc refcursor; BEGIN" +> ++ " OPEN refc FOR SELECT n from t_natural where n < lim order by n;" +> ++ " RETURN refc; END; $$ LANGUAGE plpgsql;" + +> selectNestedMultiResultSet _ = do +> let +> q = "SELECT n, takusenTestFunc(n) from t_natural where n < 10 order by n" +> iterMain (i::Int) (c::RefCursor String) acc = result' ((i,c):acc) +> iterInner (i::Int) (c::RefCursor String) acc = result' ((i,c):acc) +> iterInner2 (i::Int) acc = result' (i:acc) +> withTransaction RepeatableRead $ do +> rs <- doQuery (sql q) iterMain [] +> assertEqual "selectNestedMultiResultSet" [9,8,7,6,5,4,3,2,1] (map fst rs) +> --print_ "" +> flip mapM_ rs $ \(outer, c) -> do +> rs <- doQuery c iterInner [] +> let expect = drop (9-outer) [8,7,6,5,4,3,2,1] +> assertEqual "processOuter" expect (map fst rs) +> flip mapM_ rs $ \(inner, c) -> do +> rs <- doQuery c iterInner2 [] +> let expect = drop (9-inner) [8,7,6,5,4,3,2,1] +> assertEqual "processInner" expect rs +> flip mapM_ rs $ \i -> do +> --print_ (show outer ++ " " ++ show inner ++ " " ++ show i) +> assertBool "processInner2" (i < inner) + + + +> generateErrorMessageTest _ = do +> catchDB ( do +> doQuery (sql "select * from nonExistantObject") iterNoRows [] +> return () +> ) (\e -> do +> let msg = formatDBException e +> -- uncomment this to view error message +> --liftIO (putStrLn msg) +> let expect = "42P01 7: ERROR: 42P01: relation" +> assertEqual "generateErrorMessageTest" expect (take (length expect) msg) +> ) + + +> testList :: [PGSqlFunctions -> DBM mark Session ()] +> testList = +> [ selectNoRows, selectTerminatesEarly, selectFloatsAndInts +> , selectNullString, selectEmptyString, selectUnhandledNull +> , selectNullDate, selectDate, selectCalDate, selectBoundaryDates +> , selectCursor, selectExhaustCursor +> , selectBindString, selectBindInt, selectBindIntDoubleString +> , selectBindDate, selectBindBoundaryDates, selectRebindStmt +> , boundStmtDML, boundStmtDML2 +> , polymorphicFetchTest, polymorphicFetchTestNull, exceptionRollback +> , selectMultiResultSet, selectNestedMultiResultSet +> , generateErrorMessageTest, selectUTF8Text, iterateeMatchesResultSet +> ] diff --git a/Database/PostgreSQL/Test/PGFunctions.lhs b/Database/PostgreSQL/Test/PGFunctions.lhs new file mode 100644 --- /dev/null +++ b/Database/PostgreSQL/Test/PGFunctions.lhs @@ -0,0 +1,383 @@ + +| +Module : Database.PostgreSQL.Test.PGFunctions +Copyright : (c) 2004 Oleg Kiselyov, Alistair Bayley +License : BSD-style +Maintainer : oleg@pobox.com, alistair@abayley.org +Stability : experimental +Portability : non-portable + + +> module Database.PostgreSQL.Test.PGFunctions (runTest) where + + +> import Database.PostgreSQL.PGFunctions +> import Database.Util +> import Foreign +> import Foreign.C +> import Control.Monad +> import Control.Exception.Extensible +> import Data.Dynamic +> import System.Environment (getArgs) +> import Test.MiniUnit +> import Data.Char +> import Data.Time + + +This low-level test assumes that the user has a database with their name. +If not, it won't work. I have a postgres user and a postgres database. + +> runTest :: String -> IO () +> runTest dbname = printPropagateError $ do +> testOpen ("user=" ++ dbname) +> db <- openDb ("user=" ++ dbname) +> disableNoticeReporting db +> createFixture db +> runTestTT "Postgres low-level tests" (testlist db) +> destroyFixture db +> closeDb db + +> testlist db = map ($ db) +> [ testSelectInts +> , testSelectDouble +> , testSelectDate +> , testSelectDate2 +> , testSelectDate3 +> , testSelectNumeric +> , testSelectStrings +> , testSelectInt64 +> , testSelectNoRows +> , testUnion +> , testSelectManyRows +> , testBindString +> , testBindInt +> , testBindDouble +> , testBindDate +> , testCreateDual +> , testSelectUTF8Text +> ] + + +> ignoreError action = catchPG action (const (return ())) + +> printIgnoreError action = catchPG action (putStrLn . show) + +> printPropagateError action = catchPG action +> (\e -> putStrLn (show e) >> rethrowPG e) + +> ddlExec db stmt = nqExec db stmt >> return () + +> testOpen connstr = openDb connstr >>= closeDb + +> createFixture db = do +> -- ignoreError $ ddlExec db "drop table tdual" +> -- ignoreError $ ddlExec db "drop table t_natural" +> -- ignoreError $ ddlExec db "drop table t_blob" +> printPropagateError $ +> ddlExec db "create temp table tdual (dummy text primary key)" +> printPropagateError $ +> ddlExec db "insert into tdual (dummy) values ('X')" +> printPropagateError $ ddlExec db +> "create temp table t_natural (n integer primary key)" +> mapM_ (insertNatural db) [1,2,64,65534,65535,65536] +> printPropagateError $ +> ddlExec db "create temp table t_blob (b bytea)" +> printPropagateError $ +> ddlExec db "insert into t_blob values ('blobtest')" + +> insertNatural db n = do +> ddlExec db $ "insert into t_natural values (" ++ (show n) ++ ")" + + + +> destroyFixture db = return () -- our tables are temporary + +> testCreateDual db = do +> ignoreError ( do +> ddlExec db "create temp table tdual (dummy integer primary key)" +> assertFailure "PGException not thrown when table already exists" +> ) +> printPropagateError $ ddlExec db "insert into tdual values (1)" + + +> testSelectStrings db = do +> sn <- printPropagateError $ +> stmtPrepare db "" "select text(n) from t_natural where n < 3 order by n;" [] +> (stmt,ntuples) <- stmtExec0t db sn +> assertEqual "testSelectInts: ntuples" 2 ntuples +> n <- colValString stmt 1 1 +> assertEqual "testSelectInts: 1" 1 (read n) +> n <- colValString stmt 2 1 +> assertEqual "testSelectInts: 2" 2 (read n) +> stmtFinalise stmt + +> testSelectInts db = do +> sn <- printPropagateError $ +> stmtPrepare db "" "select n from t_natural where n < 65536 order by n;" [] +> (rs,ntuples) <- stmtExec0t db sn +> assertEqual "testSelectInts: ntuples" 5 ntuples +> n <- colValInt rs 1 1 +> assertEqual "testSelectInts: 1" 1 n +> n <- colValInt rs 2 1 +> assertEqual "testSelectInts: 2" 2 n +> n <- colValInt rs 3 1 +> assertEqual "testSelectInts: 64" 64 n +> n <- colValInt rs 4 1 +> assertEqual "testSelectInts: 65534" 65534 n +> stmtFinalise rs + +> testSelectInt64 db = do +> sn <- printPropagateError $ +> stmtPrepare db "" "select 20041225235959" [] +> --stmtPrepare db "" "select -1 union select 1 union select 2*1000*1000*1000 order by 1" +> (stmt,ntuples) <- stmtExec0t db sn +> n <- colValInt64 stmt 1 1 +> assertEqual "testSelectInt64: 20041225235959" 20041225235959 n +> stmtFinalise stmt + + +> testSelectDouble db = do +> sn <- printPropagateError $ stmtPrepare db "" "select 1.2::float8" [] +> (stmt,ntuples) <- stmtExec0t db sn +> n <- colValDouble stmt 1 1 +> assertEqual "testSelectDouble: 1.2" 1.2 n +> stmtFinalise stmt + +> testSelectDate db = do +> sn <- printPropagateError $ stmtPrepare db "" +> ("select timestamp with time zone '2000-01-01'" +> ++ " union select timestamp with time zone '2001-01-01'" +> ++ " union select timestamp with time zone '1999-01-01' order by 1" +> ) +> [] +> let +> d1 = UTCTime (fromGregorian 1999 1 1) 0 +> d0 = UTCTime (fromGregorian 2000 1 1) 0 +> d2 = UTCTime (fromGregorian 2001 1 1) 0 +> diff1 = realToFrac (diffUTCTime d1 d0) +> diff2 = realToFrac (diffUTCTime d2 d0) +> (stmt,ntuples) <- stmtExec0t db sn +> d <- colValUTCTime stmt 1 1 +> assertEqual "testSelectDate: 1999" d1 d +> d <- colValUTCTime stmt 2 1 +> assertEqual "testSelectDate: 2000" d0 d +> d <- colValUTCTime stmt 3 1 +> assertEqual "testSelectDate: 2001" d2 d +> stmtFinalise stmt + + +Here we test some wierd date boundary cases in Postgres. +There's some funnyness around 1916-10-01 02:25:20 when we use time zones. + +testSelectDate2: 1, -2627156078 +testSelectDate2: 2, -2627156079 +testSelectDate2: 3, -2627156080 (without time zone) +testSelectDate2: 4, -2627158159 (with time zone) +diff 3-4: 2080 seconds = 00:34:40 + +-- Update: + +Turns out this is due to my default timezone, which was set to Europe/Dublin +(some odd things happened to Irish timekeeping at 1916-10-01 02:25:20). + +Setting it to GMT (rather than Europe/London or Europe/Dublin) fixed it. +Note that Europe/London also has some funnyness in 1847, +so it's also a poor choice if we want to test boundary dates. + + +> testSelectDate2 db = do +> let +> sqltext = "select timestamp without time zone '1916-10-01 02:25:22', 10" +> ++ " union select timestamp without time zone '1916-10-01 02:25:21', 20" +> ++ " union select timestamp without time zone '1916-10-01 02:25:20', 30" +> ++ " union select timestamp with time zone '1916-10-01 02:25:20' /* this one fails */, 40" +> ++ " order by 2" +> sn <- printPropagateError $ stmtPrepare db "" sqltext [] +> let +> ds = ( +> mkUTCTime 1916 10 1 2 25 22: +> mkUTCTime 1916 10 1 2 25 21: +> mkUTCTime 1916 10 1 2 25 20: +> mkUTCTime 1916 10 1 2 25 20: +> [] ) +> (stmt,ntuples) <- stmtExec0t db sn +> let +> loop n = +> if n <= ntuples +> then do +> x <- colValDouble stmt n 1 +> d <- colValUTCTime stmt n 1 +> assertEqual ("testSelectDate2: " ++ show n ++ "\n" ++ sqltext) (ds!!(n-1)) d +> loop (n+1) +> else return () +> loop 1 +> stmtFinalise stmt + + +Postgres only allows specification of -ve years by use of the AD/BC suffix. +Sadly, this differs from the astronomical year number like so: +astro: ... 3, 2, 1, 0, -1, -2, -3,... +ad/bc: ...3AD,2AD,1AD,1BC,2BC,3BC,4BC,... + +i.e. 0 astro = 1BC, -1 astro = 2BC, etc. + +ISO8601 uses astronomical years, so we ought to be able to write +-1000-12-25 (instead of 1001-01-01 BC), but Postgres won't parse this. + +> testSelectDate3 db = do +> let +> sqltext = "select timestamp without time zone '1900-01-01', 10" +> ++ " union select timestamp without time zone '1000-01-01', 20" +> ++ " union select timestamp without time zone '0001-01-01', 30" +> ++ " union select timestamp without time zone '1001-01-01 BC', 40" +> ++ " order by 2" +> sn <- printPropagateError $ stmtPrepare db "" sqltext [] +> let +> ds = +> mkUTCTime 1900 1 1 0 0 0 : +> mkUTCTime 1000 1 1 0 0 0 : +> mkUTCTime 0001 1 1 0 0 0 : +> mkUTCTime (-1000) 1 1 0 0 0 : +> [] +> (stmt,ntuples) <- stmtExec0t db sn +> let +> loop n = +> if n <= ntuples +> then do +> --x <- colValDouble stmt n 1 +> d <- colValUTCTime stmt n 1 +> assertEqual ("testSelectDate3: " ++ show n ++ "\n" ++ sqltext) (ds!!(n-1)) d +> loop (n+1) +> else return () +> loop 1 +> stmtFinalise stmt + + +If we don't specify the type, Postgres gives the number the NUMERIC type. +I don't yet know what the internal binary rep is, nor how to +convert it to an appropriate Haskell type. +Best we can do is marshal/transmist everything as text. + +> testSelectNumeric db = do +> sn <- printPropagateError $ stmtPrepare db "" "select 1.2" [] +> (rs,ntuples) <- stmtExec0t db sn +> --fmt0 <- fPQfformat rs 0 +> --ct0 <- fPQftype rs 0 +> --putStrLn $ "\ntestSelectNumeric: format " ++ (show fmt0) ++ ", type (oid) " ++ (show ct0) +> n <- colValDouble rs 1 1 +> assertEqual "testSelectNumeric: 1.2" 1.2 n +> stmtFinalise rs + + + +> testUnion db = do +> (stmt,ntuples) <- printPropagateError $ +> stmtExecImm db "select 'h1' from tdual union select 'h2' from tdual union select 'h3' from tdual" [] +> assertEqual "testUnion: ntuples" 3 ntuples +> s <- colValString stmt 1 1 +> assertEqual "testUnion: h1" "h1" s +> s <- colValString stmt 2 1 +> assertEqual "testUnion: h2" "h2" s +> s <- colValString stmt 3 1 +> assertEqual "testUnion: h3" "h3" s +> stmtFinalise stmt + + +> testSelectNoRows db = do +> (stmt,ntuples) <- printPropagateError $ +> stmtExecImm db "select 'h1' from tdual where dummy = '2'" [] +> stmtFinalise stmt +> assertEqual "testSelectNoRows: done" 0 ntuples + + +> manyRows :: String +> manyRows = +> "select 1 from" +> ++ " ( select 1 from tdual union select 0 from tdual) as t1" +> ++ ", ( select 2 from tdual union select 0 from tdual) as t2" +> ++ ", ( select 3 from tdual union select 0 from tdual) as t3" +> ++ ", ( select 4 from tdual union select 0 from tdual) as t4" +> ++ ", ( select 5 from tdual union select 0 from tdual) as t5" +> ++ ", ( select 6 from tdual union select 0 from tdual) as t6" +> ++ ", ( select 7 from tdual union select 0 from tdual) as t7" +> ++ ", ( select 8 from tdual union select 0 from tdual) as t8" +> ++ ", ( select 9 from tdual union select 0 from tdual) as t9" +> ++ ", ( select 10 from tdual union select 0 from tdual) as t10" + + +> countRows :: DBHandle -> String -> Int -> IO Int +> countRows db sn n = do +> (stmt,ntuples) <- printPropagateError $ stmtExec0t db sn +> stmtFinalise stmt +> if ntuples == 0 +> then return n +> else countRows db sn (n+ntuples) + +> cursor'name = "takusenp" + +> testSelectManyRows db = do +> let prefetch = 200 +> _ <- printPropagateError $ nqExec db "Begin work" +> let q = "DECLARE " ++ cursor'name ++ " NO SCROLL CURSOR FOR " ++ +> manyRows +> _ <- printPropagateError $ nqExec db q +> let f = "FETCH FORWARD " ++ (show prefetch) ++ " FROM " ++ cursor'name +> sn <- printPropagateError $ stmtPrepare db "" f [] +> n <- countRows db sn 0 +> _ <- printPropagateError $ nqExec db $ "CLOSE " ++ cursor'name +> _ <- printPropagateError $ nqExec db $ "commit work" +> assertEqual "testSelectManyRows: done" 1024 n + + +> testBindString db = do +> (rs, ntuples) <- printPropagateError $ +> prepare'n'exec db "" (substituteBindPlaceHolders "select ?") [newBindVal "h1"] +> n <- colValString rs 1 1 +> assertEqual "testBindString: h1" "h1" n +> stmtFinalise rs + +> testBindInt db = do +> (rs, ntuples) <- printPropagateError $ +> prepare'n'exec db "" (substituteBindPlaceHolders "select ?") [newBindVal (2001::Int)] +> n <- colValInt rs 1 1 +> assertEqual "testBindInt: 2001" 2001 n +> stmtFinalise rs + +> testBindDouble db = do +> let +> v1 :: Double; v1 = 2.3 +> v2 :: Int; v2 = 2001 +> v3 :: Int; v3 = 2001 +> bindvals = [newBindVal v1, newBindVal v2, newBindVal v3] +> (rs, ntuples) <- printPropagateError $ do +> prepare'n'exec db "" (substituteBindPlaceHolders "select ? from tdual where ? = ?") bindvals +> n <- colValDouble rs 1 1 +> assertEqual "testBindDouble: 2.3" 2.3 n +> stmtFinalise rs + +> testBindDate db = do +> let +> v1 :: UTCTime; v1 = UTCTime (fromGregorian 2000 1 1) 0 +> v2 :: UTCTime; v2 = UTCTime (fromGregorian 1980 2 29) 0 +> bindvals = [newBindVal v1, newBindVal v2] +> (rs, ntuples) <- printPropagateError $ +> prepare'n'exec db "" (substituteBindPlaceHolders "select ?, ?") bindvals +> n <- colValUTCTime rs 1 1 +> assertEqual "testBindDate: 1 " v1 n +> n <- colValUTCTime rs 1 2 +> assertEqual "testBindDate: 2 " v2 n +> stmtFinalise rs + +> testSelectUTF8Text db = do +> -- GREEK SMALL LETTER PHI +> -- unicode code-point 966 +> -- UTF8: CF86 (207,134) +> -- UTF16: 03C6 +> let expect = ['\966'] +> let sql = "select '" ++ expect ++ "'" +> sn <- printPropagateError (stmtPrepare db "" sql []) +> (stmt,ntuples) <- stmtExec0t db sn +> assertEqual "testSelectUTF8Text: ntuples" 1 ntuples +> result <- colValString stmt 1 1 +> assertEqual "testSelectUTF8Text" expect result + diff --git a/Database/PostgreSQL/Test/pgaccess.hs b/Database/PostgreSQL/Test/pgaccess.hs new file mode 100644 --- /dev/null +++ b/Database/PostgreSQL/Test/pgaccess.hs @@ -0,0 +1,188 @@ +{-# OPTIONS -fglasgow-exts #-} + +module Main where + +import System.Environment (getArgs) +import Control.Exception (try, handle, bracket, throwIO) +import System.IO +import Data.List (isPrefixOf) +import Data.Char (toLower) +import System.Posix (epochTime,ProcessID,getProcessID,EpochTime) +import Database.PostgreSQL.PGFunctions +import Prelude hiding (log) + +docstrings = [ + "A helper to access a PostgreSQL from a `scripting' language.", + "This function attempts to closely emulate `dbaccess' of Informix.", + "The goal is to have my Scheme-to-Informix interface work with", + "PostgreSQL with minimal changes.", + "", + "Synopsys:", + " dbaccess ", + "where is the string of database connection parameters.", + "", + "The program connects to the database and listens on its standard", + "input for a SQL command. A command is an ASCII sequence terminated by", + "NL-NULL-NL.", + "If the command is other than SELECT or COPY, we submit it to the database.", + "On success, no reply is generated, and we wait for a new command.", + "If the command starts with a /*simple*/ SELECT, we expect few rows.", + "We submit the query to the database and write the result to stdout.", + "If the command was SELECT, we make a query and write the result,", + "in groups, to the stdout. Each group of results has the form:", + " 0 NL", + " for the last group of results", + " NL", + " followed by the matrix of * field values in the", + " row-major order. Each field value has the form", + " NL", + " where is the length of the value proper (no NL).", + "", + "If the command was COPY, we assume ", + " COPY /* fname*/ table ... FROM STDIN...", + " where is the length of the file name. We open the file and", + " send its contents to the server", + "", + "Any error causes the termination of this program.", + "We log all the results to stderr." + ] + + +main = do + args <- getArgs + hSetBuffering stderr LineBuffering + hSetBuffering stdout LineBuffering + case args of + [connparms] -> main' connparms + _ -> mapM_ err'note ("One argument is expected" : + docstrings) + +err'note = hPutStrLn stderr + +data Log = Log { log_pid :: ProcessID, log_time :: EpochTime } + +log log_data strs = err'note (show (log_time log_data) ++ + " [" ++ show (log_pid log_data) ++ "] " ++ + concat strs) + +main' connparms = + do + pid <- getProcessID + etime <- epochTime + let logd = Log pid etime + catchPG ( + bracket (openDb connparms) closeDb $ \db -> + log logd ["Starting"] >> + -- setErrorVerbosity db ePQERRORS_VERBOSE + main'' logd stdin db stdout) + (\e -> err'note (show e) >> rethrowPG e) + + +data CommandCategory = + CmdQuery | CmdSimpleQuery String | CmdCopy FilePath String | CmdOther + +-- Main loop proper +main'' logd hin db hout = + do + cmd <- get'command hin "" + logd <- epochTime >>= (\et -> return logd{log_time=et}) + log logd ["SQL: ",cmd] + case classify cmd of + CmdQuery -> exec'complex'query logd cmd db hout + CmdSimpleQuery cmd -> + exec'simple'query logd cmd db hout + CmdOther -> exec'other logd cmd db hout + CmdCopy fname cmd -> exec'copy logd cmd db fname + hFlush hout + main'' logd hin db hout + where + get'command hin acc = do + s <- hGetLine hin + if s == "\NUL" then return acc + else get'command hin (acc ++ s ++ "\n") + psimple = "/*simple*/" + classify cmd | isPrefixOf psimple cmd = CmdSimpleQuery + (drop (length psimple) cmd) + classify cmd | isPrefixOfci "select" cmd = CmdQuery + classify cmd | isPrefixOfci "copy" cmd = + let (fname,s) = read'fname $ snd (break (== '/') cmd) + in CmdCopy fname ("copy " ++ s) + classify _ = CmdOther + + read'fname ('/':'*':str) = let [(l::Int,' ':s)] = reads str + fname = take l s + ('*':'/':s') = drop l s + in (fname,s') + + -- case-insensitive + isPrefixOfci [] _ = True + isPrefixOfci _ [] = False + isPrefixOfci (cp:rp) (cs:rs) | (toLower cp == toLower cs) = + isPrefixOfci rp rs + isPrefixOfci _ _ = False + + +-- ------------------------------------------------------------------------ +-- Executors + +nrows_in_a_group = 10 -- aka, the prefetch count +cursor_name = "pgaccessc" + +-- A general query: may return too many rows. So, we have to open +-- a cursor and query by groups +exec'complex'query logd cmd db hout = + do + nqExec db $ unwords ["DECLARE",cursor_name,"NO SCROLL CURSOR FOR",cmd] + let fetchq = unwords ["FETCH FORWARD",show nrows_in_a_group,"FROM", + cursor_name] + psname <- stmtPrepare db "" fetchq [] + let loop = do + (rs,ntuples) <- stmtExec0t db psname + log logd ["SQLtuples...: ",show ntuples] + put'tuples rs ntuples hout + stmtFinalise rs + if ntuples == 0 then return () else loop + loop + nqExec db $ unwords ["CLOSE",cursor_name] + return () + + + +-- execute a query that is expected to produce few values. +-- That is, we're justified in asking for all tuples and so can get +-- by without opening a cursor, etc. +exec'simple'query logd cmd db hout = + do + (rs,ntuples) <- stmtExecImm0 db cmd + log logd ["SQLtuples: ",show ntuples] + put'tuples rs ntuples hout + stmtFinalise rs + +put'tuples rs ntuples hout = + if ntuples == 0 then hPutStrLn hout "0" else put'tuples' + where + put'tuples' = do + ncols <- fPQnfields rs + hPutStrLn hout $ unwords [show ntuples,show ncols] + sequence_ [put'col i j | i<-[0..ntuples-1], j<-[0..ncols-1]] + put'col i j = do + len <- fPQgetlength rs (fromIntegral i) (fromIntegral j) + hPutStrLn hout $ show len + vp <- fPQgetvalue rs (fromIntegral i) (fromIntegral j) + hPutBuf hout vp (fromIntegral len) + + +-- Execute command (such as DDL or DML) that produces no resultset +exec'other logd cmd db hout = + do + res <- nqExec db cmd + log logd ["SQLDone: ", show res] + +-- Execute the COPY FROM STDIN command +exec'copy logd cmd db fname = + do + log logd ["SQLCopy: ", fname] + hin <- openBinaryFile fname ReadMode + nqCopyIn db cmd hin + hClose hin + log logd ["SQLCopyDone"] diff --git a/Database/Sqlite/Enumerator.lhs b/Database/Sqlite/Enumerator.lhs --- a/Database/Sqlite/Enumerator.lhs +++ b/Database/Sqlite/Enumerator.lhs @@ -11,9 +11,15 @@ > {-# OPTIONS -fglasgow-exts #-} -> {-# OPTIONS -fallow-undecidable-instances #-} -> {-# OPTIONS -fallow-overlapping-instances #-} +> {-# LANGUAGE OverlappingInstances #-} +> {-# LANGUAGE UndecidableInstances #-} +> {-# LANGUAGE IncoherentInstances #-} +> {-# LANGUAGE FlexibleInstances #-} +> {-# LANGUAGE MultiParamTypeClasses #-} +> {-# LANGUAGE TypeSynonymInstances #-} + + > module Database.Sqlite.Enumerator > ( Session, connect > , prepareStmt, preparePrefetch @@ -31,7 +37,7 @@ > import Database.Util > import Foreign.C > import Control.Monad -> import Control.Exception +> import Control.Exception.Extensible > import Database.Sqlite.SqliteFunctions > (DBHandle, StmtHandle, SqliteException(..), catchSqlite, throwSqlite) > import qualified Database.Sqlite.SqliteFunctions as DBAPI @@ -155,11 +161,13 @@ > instance Command String Session where > executeCommand sess str = do -> stmt <- stmtPrepare (dbHandle sess) str -> fetchRow (dbHandle sess) stmt -> n <- DBAPI.stmtChanges (dbHandle sess) -> finaliseStmt (dbHandle sess) stmt -> return (fromIntegral n) +> bracket +> (stmtPrepare (dbHandle sess) str) +> (finaliseStmt (dbHandle sess)) +> (\stmt -> do +> fetchRow (dbHandle sess) stmt +> liftM fromIntegral (DBAPI.stmtChanges (dbHandle sess)) +> ) > instance Command BoundStmt Session where > executeCommand sess (BoundStmt pstmt) = do @@ -171,13 +179,14 @@ > instance Command StmtBind Session where > executeCommand sess (StmtBind sqltext bas) = do -> let (PreparationA action) = prepareStmt' sqltext False -> pstmt <- action sess -> sequence_ (zipWith (\i (BindA ba) -> ba sess pstmt i) [1..] bas) -> fetchRow (dbHandle sess) (stmtHandle pstmt) -> n <- DBAPI.stmtChanges (dbHandle sess) -> finaliseStmt (dbHandle sess) (stmtHandle pstmt) -> return (fromIntegral n) +> bracket +> (let (PreparationA action) = prepareStmt' sqltext False in action sess) +> (finaliseStmt (dbHandle sess) . stmtHandle) +> (\pstmt -> do +> sequence_ (zipWith (\i (BindA ba) -> ba sess pstmt i) [1..] bas) +> fetchRow (dbHandle sess) (stmtHandle pstmt) +> liftM fromIntegral (DBAPI.stmtChanges (dbHandle sess)) +> ) > data LastInsertRowid = LastInsertRowid diff --git a/Database/Sqlite/SqliteFunctions.lhs b/Database/Sqlite/SqliteFunctions.lhs --- a/Database/Sqlite/SqliteFunctions.lhs +++ b/Database/Sqlite/SqliteFunctions.lhs @@ -1,6 +1,4 @@ -> {-# OPTIONS -ffi -fglasgow-exts #-} - | Module : Database.Sqlite.SqliteFunctions Copyright : (c) 2004 Oleg Kiselyov, Alistair Bayley @@ -12,14 +10,18 @@ Simple wrappers for Sqlite functions (FFI). +> {-# LANGUAGE ForeignFunctionInterface #-} +> {-# LANGUAGE CPP #-} + > module Database.Sqlite.SqliteFunctions where +> import Prelude hiding (catch) > import Foreign.C.UTF8 > import Foreign > import Foreign.C > import Foreign.Ptr > import Control.Monad -> import Control.Exception +> import Control.Exception.Extensible > import Data.Dynamic > import Data.Int @@ -40,10 +42,11 @@ > show (SqliteException i s) = "SqliteException " ++ (show i) ++ " " ++ s > catchSqlite :: IO a -> (SqliteException -> IO a) -> IO a -> catchSqlite = catchDyn - > throwSqlite :: SqliteException -> a -> throwSqlite = throwDyn +> instance Exception SqliteException +> catchSqlite = catch +> throwSqlite = throw + > sqliteOK :: CInt > sqliteOK = 0 diff --git a/Database/Sqlite/Test/Enumerator.lhs b/Database/Sqlite/Test/Enumerator.lhs new file mode 100644 --- /dev/null +++ b/Database/Sqlite/Test/Enumerator.lhs @@ -0,0 +1,158 @@ + +| +Module : Database.Sqlite.Test.Enumerator +Copyright : (c) 2004 Oleg Kiselyov, Alistair Bayley +License : BSD-style +Maintainer : oleg@pobox.com, alistair@abayley.org +Stability : experimental +Portability : non-portable + + +> {-# LANGUAGE OverlappingInstances #-} + +> module Database.Sqlite.Test.Enumerator (runTest) where + +> import qualified Database.Sqlite.Test.SqliteFunctions as Low +> import Database.Sqlite.Enumerator +> import Database.Test.Performance as Perf +> import Database.Test.Enumerator +> import Control.Monad (when) +> import Control.Monad.Trans (liftIO) +> import Test.MiniUnit +> import Data.Int +> import System.Time + + +> runTest :: Perf.ShouldRunTests -> [String] -> IO () +> runTest runPerf args = do +> let (user:pswd:dbname:_) = args +> Low.runTest dbname +> flip catchDB basicDBExceptionReporter $ do +> (r, conn1) <- withContinuedSession (connect dbname) (testBody runPerf) +> withSession conn1 testPartTwo + +> testBody runPerf = do +> runFixture SqliteFunctions +> when (runPerf == Perf.RunTests) runPerformanceTests + +> testPartTwo :: DBM mark Session () +> testPartTwo = do +> makeFixture execDrop execDDL_ +> destroyFixture execDDL_ + +> runPerformanceTests = do +> makeFixture execDrop execDDL_ +> beginTransaction RepeatableRead +> {-# SCC "runPerformanceTests:runTestTT" #-} +> runTestTT "Sqlite performance tests" (map (flip catchDB reportRethrow) +> [ timedSelect (prefetch 1000 sqlRows2Power20 []) 35 (2^20) +> , timedSelect (prefetch 1 sqlRows2Power17 []) 4 (2^17) +> , timedSelect (prefetch 1000 sqlRows2Power17 []) 4 (2^17) +> , timedCursor (prefetch 1 sqlRows2Power17 []) 4 (2^17) +> , timedCursor (prefetch 1000 sqlRows2Power17 []) 4 (2^17) +> ] +> ) +> commit +> destroyFixture execDDL_ + + +> runFixture :: DBLiteralValue a => a -> DBM mark Session () +> runFixture fns = do +> makeFixture execDrop execDDL_ +> runTestTT "Sqlite tests" (map (runOneTest fns) testList) +> destroyFixture execDDL_ + +> runOneTest fns t = catchDB (t fns) reportRethrow + +----------------------------------------------------------- + +> selectNoRows _ = selectTest sqlNoRows iterNoRows expectNoRows + +> selectTerminatesEarly _ = selectTest sqlTermEarly iterTermEarly expectTermEarly + +> selectFloatsAndInts fns = selectTest (sqlFloatsAndInts fns) iterFloatsAndInts expectFloatsAndInts + +> selectNullString _ = selectTest sqlNullString iterNullString expectNullString + +> selectEmptyString _ = selectTest sqlEmptyString iterEmptyString expectEmptyString + +> selectUnhandledNull _ = catchDB ( do +> selectTest sqlUnhandledNull iterUnhandledNull expectUnhandledNull +> assertFailure sqlUnhandledNull +> ) (\e -> return () ) + + + +> selectNullDate dateFn = selectTest (sqlNullDate dateFn) iterNullDate expectNullDate + +> selectDate dateFn = selectTest (sqlDate dateFn) iterDate expectDate + +> selectCalDate dateFn = selectTest (sqlDate dateFn) iterCalDate expectCalDate + +> selectBoundaryDates dateFn = selectTest (sqlBoundaryDates dateFn) iterBoundaryDates expectBoundaryDates + +> selectCursor fns = actionCursor (sqlCursor fns) +> selectExhaustCursor fns = actionExhaustCursor (sqlCursor fns) + +> selectBindString _ = actionBindString +> (prepareQuery (sql sqlBindString)) +> [bindP "a2", bindP "b1"] + +> selectBindInt _ = actionBindInt +> (prepareQuery (sql sqlBindInt)) +> [bindP (1::Int), bindP (2::Int)] + + +> selectBindIntDoubleString _ = actionBindIntDoubleString +> (prefetch 1 sqlBindIntDoubleString [bindP (1::Int), bindP (2.2::Double), bindP "row 1", bindP (3::Int), bindP (4.4::Double), bindP "row 2"]) + +> selectBindDate _ = actionBindDate +> (prefetch 1 sqlBindDate (map bindP expectBindDate)) + +> selectBindBoundaryDates _ = actionBindBoundaryDates +> (prefetch 1 sqlBindBoundaryDates (map bindP expectBoundaryDates)) + +> selectRebindStmt _ = actionRebind (prepareQuery (sql sqlRebind)) +> [bindP (1::Int)] [bindP (2::Int)] + +> boundStmtDML _ = actionBoundStmtDML (prepareCommand (sql sqlBoundStmtDML)) +> boundStmtDML2 _ = do +> -- cannot use withTransaction with rollback/commit; +> -- if you explicitly end the transaction, then when withTransaction +> -- attempts to end it (with a commit, in the success case) then we +> -- get a "logic error". +> -- This differs from PostgreSQL and Oracle, who don't seem to care if +> -- you commit or rollback too many times. +> beginTransaction RepeatableRead +> count <- execDML (cmdbind sqlBoundStmtDML [bindP (100::Int), bindP "100"]) +> rollback +> assertEqual sqlBoundStmtDML 1 count + +> polymorphicFetchTest _ = actionPolymorphicFetch +> (prefetch 1 sqlPolymorphicFetch [bindP expectPolymorphicFetch]) + +> polymorphicFetchTestNull _ = actionPolymorphicFetchNull +> (prefetch 1 sqlPolymorphicFetchNull []) + +> exceptionRollback _ = actionExceptionRollback sqlInsertTest4 sqlExceptionRollback + +> insertGetRowId _ = +> withTransaction RepeatableRead ( do +> execDML (sql ("insert into " ++ testTable ++ " values (100, '100')")) +> rowid <- inquire LastInsertRowid +> assertBool "insertGetRowId" (rowid > 0) +> --liftIO $ putStrLn ("last insert row id " ++ show rowid) +> ) + +> testList :: DBLiteralValue a => [a -> DBM mark Session ()] +> testList = +> [ selectNoRows, selectTerminatesEarly, selectFloatsAndInts +> , selectNullString, selectEmptyString, selectUnhandledNull +> , selectNullDate, selectDate, selectCalDate, selectBoundaryDates +> , selectCursor, selectExhaustCursor +> , selectBindString, selectBindInt, selectBindIntDoubleString +> , selectBindDate, selectBindBoundaryDates, selectRebindStmt +> , boundStmtDML, boundStmtDML2 +> , polymorphicFetchTest, polymorphicFetchTestNull, exceptionRollback +> , insertGetRowId +> ] diff --git a/Database/Sqlite/Test/SqliteFunctions.lhs b/Database/Sqlite/Test/SqliteFunctions.lhs new file mode 100644 --- /dev/null +++ b/Database/Sqlite/Test/SqliteFunctions.lhs @@ -0,0 +1,291 @@ + +| +Module : Database.Sqlite.Test.SqliteFunctions +Copyright : (c) 2004 Oleg Kiselyov, Alistair Bayley +License : BSD-style +Maintainer : oleg@pobox.com, alistair@abayley.org +Stability : experimental +Portability : non-portable + + +> module Database.Sqlite.Test.SqliteFunctions (runTest) where + + +> import Foreign +> import Foreign.C +> import Foreign.C.UTF8 +> import Control.Monad +> import Control.Exception.Extensible +> import Data.Dynamic +> import Database.Sqlite.SqliteFunctions +> import System.Environment (getArgs) +> import Test.MiniUnit + + + + +> runTest :: String -> IO () +> runTest dbname = do +> testOpen dbname +> db <- openDb dbname +> createFixture db +> runTestTT "Sqlite low-level tests" (testlist db) +> destroyFixture db +> closeDb db + + +> --testlist db = TestList $ map (\t -> TestCase (t db)) +> testlist db = map (\t -> t db) +> [ testSelectInts +> , testSelectDouble +> , testSelectInt64 +> , testSelectStringNull +> , testSelectStringEmpty +> , testSelectNoRows +> , testSelectManyRows +> , testUnion +> , testBindString +> , testBindDouble +> , testFetchAfterFinalise +> , testConstraintError +> , testSelectUTF8Text +> ] + + +> ignoreError action = +> catchSqlite action (\e -> return undefined) + +> printIgnoreError action = catchSqlite action +> (\e -> do +> putStrLn (show e) +> return undefined +> ) + +> printPropagateError action = catchSqlite action +> (\e -> do +> putStrLn (show e) +> throwSqlite e +> return undefined +> ) + +> ddlExec db stmt = do +> _ <- stmtExec db stmt +> return () + +> testOpen dbname = do +> h <- openDb dbname +> closeDb h + +> createFixture db = do +> ignoreError $ ddlExec db "drop table tdual" +> ignoreError $ ddlExec db "drop table t_natural" +> ignoreError $ ddlExec db "drop table t_blob" +> printPropagateError $ +> ddlExec db "create table tdual (dummy text)" +> printPropagateError $ +> ddlExec db "insert into tdual (dummy) values ('X')" +> printPropagateError $ ddlExec db "create table t_natural (n integer primary key)" +> mapM_ (insertNatural db) [1..10] +> printPropagateError $ +> ddlExec db "create table t_blob (b blob)" +> printPropagateError $ +> ddlExec db "insert into t_blob values ('blobtest')" + +> insertNatural db n = do +> ddlExec db $ "insert into t_natural values (" ++ (show n) ++ ")" + + + +> destroyFixture db = do +> printPropagateError $ ddlExec db "drop table tdual" +> printPropagateError $ ddlExec db "drop table t_natural" +> printPropagateError $ ddlExec db "drop table t_blob" + + +> testCreateDual db = do +> ignoreError ( do +> ddlExec db "create table tdual (dummy integer primary key)" +> assertFailure "SqliteException not thrown when table already exists" +> ) +> printPropagateError $ ddlExec db "insert into tdual values (1)" + + + + +> testSelectInts db = do +> stmt <- printPropagateError $ +> stmtPrepare db "select n from t_natural where n < 3 order by n;" +> rc <- stmtFetch db stmt +> n <- colValInt stmt 1 +> assertEqual "testSelectInts: 1" 1 n +> rc <- stmtFetch db stmt +> n <- colValInt stmt 1 +> assertEqual "testSelectInts: 2" 2 n +> rc <- stmtFetch db stmt +> stmtFinalise db stmt +> assertEqual "testSelectInts: done" sqliteDONE rc + + +> testSelectInt64 db = do +> stmt <- printPropagateError $ +> stmtPrepare db "select 20041225235959" +> --stmtPrepare db "select -1 union select 1 union select 2*1000*1000*1000 order by 1" +> rc <- stmtFetch db stmt +> n <- colValInt64 stmt 1 +> assertEqual "testSelectInt64: 20041225235959" 20041225235959 n +> rc <- stmtFetch db stmt +> stmtFinalise db stmt +> assertEqual "testSelectInt64: done" sqliteDONE rc + + +> testSelectDouble db = do +> stmt <- printPropagateError $ +> stmtPrepare db "select 1.2" +> rc <- stmtFetch db stmt +> n <- colValDouble stmt 1 +> assertEqual "testSelectDouble: 1.2" 1.2 n +> rc <- stmtFetch db stmt +> stmtFinalise db stmt +> assertEqual "testSelectDouble: done" sqliteDONE rc + + +> testSelectStringNull db = do +> stmt <- printPropagateError $ +> stmtPrepare db "select null" +> rc <- stmtFetch db stmt +> n <- colValString stmt 1 +> assertEqual "testSelectString: Nothing" Nothing n +> rc <- stmtFetch db stmt +> stmtFinalise db stmt +> assertEqual "testSelectString: done" sqliteDONE rc + + +> testSelectStringEmpty db = do +> stmt <- printPropagateError $ +> stmtPrepare db "select ''" +> rc <- stmtFetch db stmt +> -- what is rc after row fetch? sqliteOK or sqliteROW? +> assertEqual "testSelectString: row 1" sqliteROW rc +> n <- colValString stmt 1 +> assertEqual "testSelectString: ''" (Just "") n +> rc <- stmtFetch db stmt +> stmtFinalise db stmt +> assertEqual "testSelectString: done" sqliteDONE rc + + +> testUnion db = do +> stmt <- printPropagateError $ +> stmtPrepare db "select 'h1' from tdual union select 'h2' from tdual union select 'h3' from tdual" +> rc <- stmtFetch db stmt +> Just s <- colValString stmt 1 +> assertEqual "testUnion: h1" "h1" s +> rc <- stmtFetch db stmt +> Just s <- colValString stmt 1 +> assertEqual "testUnion: h2" "h2" s +> rc <- stmtFetch db stmt +> Just s <- colValString stmt 1 +> assertEqual "testUnion: h3" "h3" s +> rc <- stmtFetch db stmt +> stmtFinalise db stmt +> assertEqual "testUnion: done" sqliteDONE rc + + +> testSelectNoRows db = do +> stmt <- printPropagateError $ +> stmtPrepare db "select 'h1' from tdual where dummy = '2'" +> rc <- stmtFetch db stmt +> stmtFinalise db stmt +> assertEqual "testSelectNoRows: done" sqliteDONE rc + + +> manyRows :: String +> manyRows = +> "select 1 from" +> ++ " ( select 1 from tdual union select 0 from tdual)" +> ++ ", ( select 2 from tdual union select 0 from tdual)" +> ++ ", ( select 3 from tdual union select 0 from tdual)" +> ++ ", ( select 4 from tdual union select 0 from tdual)" +> ++ ", ( select 5 from tdual union select 0 from tdual)" +> ++ ", ( select 6 from tdual union select 0 from tdual)" +> ++ ", ( select 7 from tdual union select 0 from tdual)" +> ++ ", ( select 8 from tdual union select 0 from tdual)" +> ++ ", ( select 9 from tdual union select 0 from tdual)" +> ++ ", ( select 10 from tdual union select 0 from tdual)" + + +> countRows :: DBHandle -> StmtHandle -> Int -> IO Int +> countRows db stmt n = do +> rc <- printPropagateError $ stmtFetch db stmt +> _ <- colValInt stmt 1 +> if rc == sqliteDONE +> then return n +> else countRows db stmt (n+1) + +> testSelectManyRows db = do +> stmt <- printPropagateError $ stmtPrepare db manyRows +> n <- countRows db stmt 0 +> stmtFinalise db stmt +> assertEqual "testSelectManyRows: done" 1024 n + +> testBindString db = do +> stmt <- printPropagateError $ +> stmtPrepare db "select ? from tdual" +> bindString db stmt 1 "h1" +> rc <- stmtFetch db stmt +> Just n <- colValString stmt 1 +> assertEqual "testBindString: h1" "h1" n +> rc <- stmtFetch db stmt +> stmtFinalise db stmt + +> testBindDouble db = do +> stmt <- printPropagateError $ +> stmtPrepare db "select ? from tdual where ? = ?" +> bindDouble db stmt 1 2.3 +> bindInt db stmt 2 2001 +> bindInt64 db stmt 3 2001 +> rc <- stmtFetch db stmt +> n <- colValDouble stmt 1 +> assertEqual "testBindDouble: 2.3" 2.3 n +> rc <- stmtFetch db stmt +> stmtFinalise db stmt + + +This test reveals that library misuse (error number 21) +is reported by sqlite_errcode as error code zero. + +> testFetchAfterFinalise db = do +> stmt <- printPropagateError $ stmtPrepare db manyRows +> stmtFinalise db stmt +> rc <- sqliteStep stmt +> assertEqual "testFetchAfterFinalise: rc" 21 rc +> ex@(SqliteException e m) <- getError db +> -- Is this a bug in Sqlite?) +> assertEqual "testFetchAfterFinalise: errcode" 0 e +> assertEqual "testFetchAfterFinalise: errmsg" "not an error" m + + +This test confirms that a constraint error (19) +is correctly reported by sqlite_errcode. + +> testConstraintError db = do +> withUTF8String "insert into t_natural values (1)" $ \cstr -> do +> rc <- sqliteExec db cstr nullFunPtr nullPtr nullPtr +> assertEqual "testConstraintError: rc" 19 rc +> ex@(SqliteException e m) <- getError db +> assertEqual "testConstraintError: errcode" 19 e +> assertEqual "testConstraintError: errmsg" "PRIMARY KEY must be unique" m + + +> testSelectUTF8Text db = do +> -- GREEK SMALL LETTER PHI +> -- unicode code-point 966 +> -- UTF8: CF86 (207,134) +> -- UTF16: 03C6 +> let expect = ['\966'] +> stmt <- printPropagateError $ +> stmtPrepare db "select ?" +> bindString db stmt 1 expect +> rc <- stmtFetch db stmt +> Just n <- colValString stmt 1 +> assertEqual "testSelectUTF8Text" expect n +> stmtFinalise db stmt diff --git a/Database/Stub/Enumerator.lhs b/Database/Stub/Enumerator.lhs --- a/Database/Stub/Enumerator.lhs +++ b/Database/Stub/Enumerator.lhs @@ -16,10 +16,12 @@ See fetchIntVal. - > {-# OPTIONS -fglasgow-exts #-} -> {-# OPTIONS -fallow-undecidable-instances #-} -> {-# OPTIONS -fallow-overlapping-instances #-} +> {-# LANGUAGE OverlappingInstances #-} +> {-# LANGUAGE UndecidableInstances #-} +> {-# LANGUAGE MultiParamTypeClasses #-} +> {-# LANGUAGE FlexibleInstances #-} +> {-# LANGUAGE IncoherentInstances #-} > module Database.Stub.Enumerator > -- Only the type constructor of Session is exported @@ -35,7 +37,6 @@ > import Foreign.C > import Foreign.C.Types > import Control.Monad -> import Control.Exception (catchDyn, throwDyn, throwIO) > import System.Time > import Data.IORef > import Data.Dynamic diff --git a/Database/Stub/Test/Enumerator.lhs b/Database/Stub/Test/Enumerator.lhs new file mode 100644 --- /dev/null +++ b/Database/Stub/Test/Enumerator.lhs @@ -0,0 +1,179 @@ + +| +Module : Database.Stub.Test.Enumerator +Copyright : (c) 2004 Oleg Kiselyov, Alistair Bayley +License : BSD-style +Maintainer : oleg@pobox.com, alistair@abayley.org +Stability : experimental +Portability : non-portable + +Simple test harness for Stub. +Stub can't share the tests for \"real\" backends because it +returns a somewhat contrived result set. + + +> {-# LANGUAGE OverlappingInstances #-} + +> module Database.Stub.Test.Enumerator (runTest) where + +> import Database.Enumerator +> import Database.Stub.Enumerator +> -- import Database.Test.Performance as Perf +> import System.Time -- CalendarTime +> import Test.MiniUnit +> import Data.Int +> import Control.Monad.Trans (liftIO) + + + + +> runTest :: a -> [String] -> IO () +> runTest _ _ = +> withSession (connect (ConnParm "" "" "")) +> (runTestTT "Stub tests" (map runOneTest testList) >> return ()) + +> runOneTest t = catchDB (t ()) reportRethrow + +> testList :: [() -> DBM mark Session ()] +> testList = +> [ selectString, selectIterIO, selectFloatInt +> , selectStringNullInt, selectDatetime +> , selectCursor, selectExhaustCursor +> ] + +> selectTest iter expect = catchDB ( do +> actual <- doQuery (sql "") iter [] +> liftIO $ assertEqual "" expect actual +> ) (\e -> return () ) +> selectTest' iter expect = catchDB ( do +> actual <- doQuery (prefetch 10 "") iter [] +> liftIO $ assertEqual "" expect actual +> ) (\e -> return () ) + +> selectString () = selectTest iter expect +> where +> -- To illustrate that the full signature is not necessary as long +> -- as some type information (e.g., (c1::String)) is provided -- +> -- or enough context for the compiler to figure that out. +> -- iter :: (Monad m) => String -> IterAct m [String] +> -- iter :: String -> IterAct (DBM mark Session) [String] +> iter (c1::String) acc = result $ c1:acc +> expect = [ "boo", "boo", "boo" ] + + +The following test illustrates doing IO in the iteratee itself. + +> -- monomorphism restriction strikes... +> selectIterIO () = selectTest iter ([]::[String]) +> where +> -- Here, it's better to avoid the signature and specify +> -- types of the arguments specifically so we do not have to +> -- figure out which exactly Monad we're operating in. +> -- We let the compiler figure out the right monad from +> -- the context (that is, from the Session) +> --iter :: String -> IterAct (ReaderT Query SessionQuery) () +> iter (c1::String) seed = do +> ct <- liftIO $ getClockTime +> liftIO $ putStr "" +> result seed + + +> selectFloatInt () = selectTest' iter expect +> where +> iter :: (Monad m) => Double -> Int -> IterAct m [(Double, Int)] +> iter c1 c2 acc = result $ (c1, c2):acc +> expect = [ (1.1, 1), (1.1, 1), (1.1, 1) ] + + + +> selectStringNullInt () = selectTest' iter expect +> where +> iter :: (Monad m) => +> String -> Maybe Int -> IterAct m [(String, Int)] +> iter c1 c2 acc = result $ (c1, ifNull c2 (-(1))):acc +> expect = [ ("boo", 1), ("boo", -1), ("boo", 1) ] + + +> defDate = makeCalTime 19710701120101 + +> selectDatetime () = selectTest iter expect +> where +> iter :: (Monad m) => CalendarTime -> IterAct m [CalendarTime] +> iter c1 acc = result $ c1:acc +> expect = [ defDate, defDate, defDate ] + + + +> selectCursor () = do +> let +> iter :: (Monad m) => Maybe Int -> IterAct m [Int] +> iter i acc = result $ (ifNull i 2):acc +> withCursor (sql "") iter [] $ \c -> do +> r <- cursorCurrent c +> liftIO $ assertEqual "selectCursor" [1] r +> doneBool <- cursorIsEOF c +> liftIO $ assertEqual "selectCursor" False doneBool +> -- +> cursorNext c +> r <- cursorCurrent c +> liftIO $ assertEqual "selectCursor" [2, 1] r +> doneBool <- cursorIsEOF c +> liftIO $ assertEqual "selectCursor" False doneBool +> -- +> cursorNext c +> r <- cursorCurrent c +> liftIO $ assertEqual "selectCursor" [1, 2, 1] r +> doneBool <- cursorIsEOF c +> liftIO $ assertEqual "selectCursor" False doneBool +> -- +> cursorNext c +> r <- cursorCurrent c +> liftIO $ assertEqual "selectCursor" [1, 2, 1] r +> doneBool <- cursorIsEOF c +> liftIO $ assertEqual "selectCursor" True doneBool +> -- +> return () + + + +> selectExhaustCursor () = catchDB (do +> let +> -- Again, here we demonstrate the use of a local argument +> -- type annotation rather than the complete signature. +> -- Let the compiler figure out the monad and the seed type. +> --iter :: (Maybe m) => Maybe Int -> IterAct m [Int] +> iter (i::Maybe Int) acc = result $ (ifNull i (-(1))):acc +> withCursor (sql "") iter [] $ \c -> do +> cursorNext c +> cursorNext c +> cursorNext c +> cursorNext c +> liftIO $ assertFailure "selectExhaustCursor" +> return () +> ) (\e -> return () ) + + +> makeCalTime :: Int64 -> CalendarTime +> makeCalTime i = +> let +> year = (i `quot` 10000000000) +> month = ((abs i) `rem` 10000000000) `quot` 100000000 +> day = ((abs i) `rem` 100000000) `quot` 1000000 +> hour = ((abs i) `rem` 1000000) `quot` 10000 +> minute = ((abs i) `rem` 10000) `quot` 100 +> second = ((abs i) `rem` 100) +> in CalendarTime +> { ctYear = fromIntegral year +> , ctMonth = toEnum (fromIntegral month - 1) +> , ctDay = fromIntegral day +> , ctHour = fromIntegral hour +> , ctMin = fromIntegral minute +> , ctSec = fromIntegral second +> , ctPicosec = 0 +> , ctWDay = Sunday +> , ctYDay = -1 +> , ctTZName = "UTC" +> , ctTZ = 0 +> , ctIsDST = False +> } + diff --git a/Database/Test/Enumerator.lhs b/Database/Test/Enumerator.lhs new file mode 100644 --- /dev/null +++ b/Database/Test/Enumerator.lhs @@ -0,0 +1,470 @@ + +| +Module : Database.Test.Enumerator +Copyright : (c) 2004 Oleg Kiselyov, Alistair Bayley +License : BSD-style +Maintainer : oleg@pobox.com, alistair@abayley.org +Stability : experimental +Portability : non-portable + +Simple test harness. Demonstrates possible usage. + +Tests in this module are organised in groups of three/four functions: + sqlXXX + iterXXX + expectXXX + actionXXX + +These have to be tied together by a function which uses backend-specific +functions and types. See the various backend-specific test modules for examples. + + +> {-# LANGUAGE OverlappingInstances #-} + +> module Database.Test.Enumerator where + +> import Database.Enumerator +> import Database.Util +> import Data.Time +> import System.Time +> import Data.Int +> import Control.Exception.MonadIO +> import Control.Monad.Trans (liftIO) +> --import Test.HUnit +> import Test.MiniUnit + + +> testTable = "takusen_test" + +> sqlDropDual = "drop table tdual" +> sqlCreateDual = "create table tdual (dummy varchar(1) primary key)" +> sqlInsertDual = "insert into tdual values ('X')" +> sqlDropTest = "drop table " ++ testTable +> sqlCreateTest = "create table " ++ testTable ++ " (id integer, v varchar(1000))" + +> sqlInsertTest1 = "insert into " ++ testTable ++ " (id, v) values (1, '2')" +> sqlInsertTest2 = "insert into " ++ testTable ++ " (id, v) values (2, '2')" +> sqlInsertTest3 = "insert into " ++ testTable ++ " (id, v) values (3, '3')" +> sqlInsertTest4 = "insert into " ++ testTable ++ " (id, v) values (4, '4')" + + +> reportError sql (DBFatal (ssc, sssc) e m) = do +> putStrLn ("FATAL: " ++ ssc ++ sssc ++ " - " ++ m) +> putStrLn (" " ++ sql) +> reportError sql (DBError (ssc, sssc) e m) = do +> putStrLn ("ERROR: " ++ ssc ++ sssc ++ " - " ++ m) +> putStrLn (" " ++ sql) +> reportError sql (DBUnexpectedNull r c) = +> putStrLn $ "Unexpected null in row " ++ (show r) ++ ", column " ++ (show c) ++ "." +> reportError sql (DBNoData) = putStrLn "Fetch: no more data." + +----------------------------------------------------------- + +> class DBLiteralValue a where +> literalDate :: a -> Int64 -> String +> literalInt :: a -> Int -> String +> literalInt64 :: a -> Int64 -> String +> literalFloat :: a -> Float -> String +> literalDouble :: a -> Double -> String +> -- default methods +> literalInt _ i = show i +> literalInt64 _ i = show i +> literalFloat _ i = show i +> literalDouble _ i = show i + + +> data SqliteFunctions = SqliteFunctions +> data OracleFunctions = OracleFunctions +> data PGSqlFunctions = PGSqlFunctions +> data ODBCFunctions = ODBCFunctions + +> instance DBLiteralValue SqliteFunctions where +> literalDate _ i = dateSqlite i + +> instance DBLiteralValue OracleFunctions where +> literalDate _ i = dateOracle i + +> instance DBLiteralValue PGSqlFunctions where +> literalDate _ i = datePG i +> literalInt _ i = show i ++ "::int4" +> literalInt64 _ i = show i ++ "::int8" +> literalFloat _ i = show i ++ "::float4" +> literalDouble _ i = show i ++ "::float8" + +> instance DBLiteralValue ODBCFunctions where +> literalDate _ i = dateISO i + + + +> dateSqlite :: Int64 -> String +> dateSqlite i = if i == 0 then "99999999999999" else show i + +> dateOracle :: Int64 -> String +> dateOracle i +> | i == 0 = "to_date(null)" +> | i > 0 = "to_date('" ++ (zeroPad 14 i) ++ "', 'yyyymmddhh24miss')" +> | i < 0 = "to_date('" ++ (zeroPad 14 i) ++ "', 'syyyymmddhh24miss')" + +> dateISO :: Int64 -> String +> dateISO i = +> let +> (year, month, day, hour, minute, second) = int64ToDateParts i +> zp = zeroPad +> in +> if i == 0 then "null" +> else zp 4 year ++ "-" ++ zp 2 month ++ "-" ++ zp 2 day +> ++ "T" ++ zp 2 hour ++ ":" ++ zp 2 minute ++ ":" ++ zp 2 second + + +For postgres: +0000-01-01 AD -> 0001-01-01 BC +0000-12-31 AD -> 0001-12-31 BC +0001-01-01 AD -> 0001-01-01 AD + +Using Doubles as storage (not sure about this?) +4714-11-24 BC -> mindate +5874897-12-31 AD -> maxdate +Using 8-bytes ints: +4713 BC -> 294276 AD + +Postgres only allows specification of -ve years by use of the AD/BC suffix. +Sadly, this differs from the astronomical year number like so: +astro: ...3,2,1,0,-1,-2,-3,... +ad/bc: ...3AD,2AD,1AD,1BC,2BC,3BC,... + +i.e. 0 astro = 1BC, -1 astro = 2BC, etc. + +ISO8601 uses astronomical years, so we ought to be able to write +-1000-12-25 (instead of 1001-01-01 BC), but Postgres won't parse this. + +So in datePG we want: +int64 0000-01-01 -> 0001-01-01 AD +int64 0001-01-01 -> 0001-01-01 AD +int64 -0001-01-01 -> 0000-01-01 AD +int64 -0002-01-01 -> 0003-01-01 BC +int64 -4712-01-01 -> 4713-01-01 BC + +> datePG :: Int64 -> String +> datePG i = +> let +> (year1, month, day, hour, minute, second) = int64ToDateParts i +> year = case () of +> _ | year1 == 0 -> 1 +> | year1 < 0 -> abs (year1 - 1) +> | otherwise -> year1 +> suffix = if year1 < 1 then " BC'" else " AD'" +> zp = zeroPad +> in +> if i == 0 then "null::timestamp" +> --else "timestamp with time zone '" ++ zp 4 year ++ "-" ++ zp 2 month ++ "-" ++ zp 2 day +> else "timestamp '" ++ zp 4 year ++ "-" ++ zp 2 month ++ "-" ++ zp 2 day +> ++ " " ++ zp 2 hour ++ ":" ++ zp 2 minute ++ ":" ++ zp 2 second ++ suffix + + + + +> execDDL_ s = catchDB (execDDL s) reportRethrow +> execDML_ s = execDDL_ s + +Use execDrop when the DDL is likely to raise an error. +Note that PostgreSQL + ODBC seems to require you commit or rollback the DDL; +if you don't then the next statement will fail with a 25P02 +("in failed SQL transaction") +I guess that's a result of PostgreSQL's transactional DDL feature. + +> execDrop s = catchDB (withTransaction Serializable (execDDL s)) (\e -> return ()) + +> makeFixture doDrop doDDL = flip catchDB (reportRethrowMsg "makeFixture: ") $ do +> doDrop sqlDropDual +> doDrop sqlDropTest +> doDDL sqlCreateDual +> beginTransaction ReadCommitted +> doDDL sqlInsertDual +> commit +> doDDL sqlCreateTest +> withTransaction Serialisable $ do +> doDDL sqlInsertTest1 +> doDDL sqlInsertTest2 +> doDDL sqlInsertTest3 + +> destroyFixture execDDL_ = flip catchDB reportRethrow $ do +> execDDL_ sqlDropDual +> execDDL_ sqlDropTest +> catchDB commit (const (return ())) + +> selectTest query iter expect = do +> actual <- doQuery query iter [] +> assertEqual query expect actual + + + +----------------------------------------------------------- + +This is used in a few tests... + +> sqlSingleValue = "select ? from tdual" + +> sqlNoRows = "select dummy from tdual where dummy = 'a' or dummy = '2' " +> iterNoRows (c1::String) acc = result $ c1:acc +> expectNoRows = []::[String] + +> sqlTermEarly = "select 'hello1' from tdual union select 'hello2' from tdual union select 'hello3' from tdual" +> iterTermEarly c1 acc = if c1 == "hello2" +> then return (Left (c1:acc)) +> else result (c1:acc) +> expectTermEarly = ["hello2", "hello1"] + +> sqlFloatsAndInts fns = "select " ++ (literalDouble fns 4841.3403490431) ++ ", " +> ++ (literalInt fns (-22340234)) ++ " from tdual union select 33311.32332, 23789234 from tdual" +> --iterFloatsAndInts :: (Monad m) => Double -> Int -> IterAct m [(Double, Int)] +> iterFloatsAndInts (c1::Double) (c2::Int) acc = result $ (c1, c2):acc +> expectFloatsAndInts :: [(Double, Int)] +> expectFloatsAndInts = [ (33311.32332, 23789234) , (4841.3403490431, -22340234) ] + +> sqlNullString = "select 'hello1', 'hello2', null from tdual" +> iterNullString :: (Monad m) => String -> String -> Maybe String +> -> IterAct m [(String, String, Maybe String)] +> iterNullString c1 c2 c3 acc = result $ (c1, c2, c3):acc +> expectNullString = [ ("hello1", "hello2", Nothing) ] + +> sqlEmptyString = "select 'hello1', 'hello2', '' from tdual /* Oracle always fails this test */" +> iterEmptyString :: (Monad m) => String -> String -> Maybe String +> -> IterAct m [(String, String, Maybe String)] +> iterEmptyString c1 c2 c3 acc = result $ (c1, c2, c3):acc +> expectEmptyString = [ ("hello1", "hello2", Just "") ] + +> sqlUnhandledNull = "select 'hello1', 'hello2', null from tdual" +> iterUnhandledNull :: (Monad m) => String -> String -> UTCTime +> -> IterAct m [(String, String, UTCTime)] +> iterUnhandledNull c1 c2 c3 acc = result $ (c1, c2, c3):acc +> expectUnhandledNull = [] + +> sqlNullDate fns = "select 'hello1', 'hello2', " ++ (literalDate fns 0) ++ " from tdual" +> iterNullDate :: (Monad m) => String -> String -> Maybe UTCTime +> -> IterAct m [(String, String, UTCTime)] +> iterNullDate c1 c2 c3 acc = result $ (c1, c2, ifNull c3 (int64ToUTCTime 10101000000)):acc +> expectNullDate = [ ("hello1", "hello2", (int64ToUTCTime 10101000000)) ] + +> sqlDate fns = "select " ++ (literalDate fns 20041224235959) ++ " from tdual" +> iterDate :: (Monad m) => UTCTime -> IterAct m [UTCTime] +> iterDate c1 acc = result $ c1:acc +> expectDate = [ (int64ToUTCTime 20041224235959) ] + +> iterCalDate :: (Monad m) => CalendarTime -> IterAct m [CalendarTime] +> iterCalDate c1 acc = result $ c1:acc +> expectCalDate = [ (int64ToCalTime 20041224235959) ] + + +These are the Oracle date boundary cases. + +> sqlBoundaryDates fns = +> "select " ++ (literalDate fns 99991231000000) ++ " from tdual" +> ++ " union select " ++ (literalDate fns 10101000000) ++ " from tdual" +> ++ " union select " ++ (literalDate fns (-10101000000)) ++ " from tdual" +> ++ " union select " ++ (literalDate fns (-47120101000000)) ++ " from tdual" +> ++ " order by 1 desc" +> iterBoundaryDates :: (Monad m) => UTCTime -> IterAct m [UTCTime] +> iterBoundaryDates c1 acc = result $ c1:acc +> expectBoundaryDates = +> [ int64ToUTCTime (-47120101000000) +> , int64ToUTCTime (-10101000000) +> , int64ToUTCTime 10101000000 +> , int64ToUTCTime 99991231000000 +> ] + +|Goal: exercise the "happy path" throught cursor code +i.e. open and fetch all rows, close after last row. + +> sqlCursor fns = "select " ++ literalInt fns 1 ++ " from tdual union select " ++ literalInt fns 2 ++ " from tdual" +> iterCursor :: (Monad m) => Int -> IterAct m [Int] +> iterCursor i acc = result $ i:acc +> actionCursor query = do +> withCursor query iterCursor [] $ \c -> do +> doneBool <- cursorIsEOF c +> assertBool query (not doneBool) +> r <- cursorCurrent c +> assertEqual query [1] r +> -- +> cursorNext c +> doneBool <- cursorIsEOF c +> assertBool query (not doneBool) +> r <- cursorCurrent c +> assertEqual query [2, 1] r +> -- +> -- Now that the result-set is exhausted, cursorIsEOF returns True, +> -- and cursorCurrent returns the same value as the previous call to cursorCurrent. +> cursorNext c +> doneBool <- cursorIsEOF c +> assertBool query doneBool +> r <- cursorCurrent c +> assertEqual query [2, 1] r +> -- +> -- What happens if try to advance again? +> -- We get a DBException: the DBNoData case. +> --cursorNext c +> doneBool <- cursorIsEOF c +> assertBool query doneBool +> r <- cursorCurrent c +> assertEqual query [2, 1] r +> -- +> return () + +|Goal: ensure exception raised when too many rows +fetched from cursor. + +This test will raise an exception, as it tries to +fetch too many rows from the cursor. +The exception handler is coded as if we expect the +exception i.e. it ignores it. +The main action should never finish, so there's +a failure assertion at the bottom, just in case +the exception is not raised. + +> actionExhaustCursor query = catchDB ( +> withCursor query iterCursor [] $ \c -> do +> cursorNext c +> cursorNext c +> cursorNext c +> cursorNext c +> assertFailure "selectExhaustCursor" +> ) (\e -> return () ) + +> sqlBindString = "select ? from tdual union select ? from tdual order by 1" +> iterBindString :: (Monad m) => String -> IterAct m [String] +> iterBindString i acc = result $ i:acc +> expectBindString = ["b1", "a2"] +> actionBindString stmt bindVals = do +> withTransaction Serialisable $ do +> withPreparedStatement stmt $ \pstmt -> do +> withBoundStatement pstmt bindVals $ \bstmt -> do +> actual <- doQuery bstmt iterBindString [] +> assertEqual sqlBindString expectBindString actual + + +Each back-end has it's own idea of parameter placeholder syntax. +We currently support ?-style as a lowest-common-denominator, +and each back-end converts occurences of "?" +to the back-end-specific style where required. +If you use a back-end specific style, you can expect it to be passed +through unmolested. + ? : ODBC, MS Sql Server, Sqlite + :n : Oracle + $n : Postgres + +> sqlBindInt = "select ? from tdual union select ? from tdual order by 1" +> iterBindInt :: (Monad m) => Int -> IterAct m [Int] +> iterBindInt i acc = result $ i:acc +> expectBindInt :: [Int]; expectBindInt = [2, 1] +> actionBindInt stmt bindVals = do +> withTransaction Serialisable $ do +> withPreparedStatement stmt $ \pstmt -> do +> withBoundStatement pstmt bindVals $ \bstmt -> do +> actual <- doQuery bstmt iterBindInt [] +> assertEqual sqlBindInt expectBindInt actual + +> sqlBindIntDoubleString = "select ?,?,? from tdual union select ?,?,? from tdual order by 1" +> iterBindIntDoubleString :: (Monad m) => Int -> Double -> String -> IterAct m [(Int, Double, String)] +> iterBindIntDoubleString i d s acc = result $ (i, d, s):acc +> expectBindIntDoubleString :: [(Int, Double, String)] +> expectBindIntDoubleString = [(3, 4.4, "row 2"), (1, 2.2, "row 1")] +> actionBindIntDoubleString stmt = do +> withTransaction Serialisable $ do +> actual <- doQuery stmt iterBindIntDoubleString [] +> assertEqual sqlBindIntDoubleString expectBindIntDoubleString actual + +> sqlBindDate = sqlSingleValue +> iterBindDate :: (Monad m) => UTCTime -> IterAct m [UTCTime] +> iterBindDate c1 acc = result $ c1:acc +> expectBindDate = [ (int64ToUTCTime 20041224235959) ] +> actionBindDate stmt = do +> withTransaction Serialisable $ do +> actual <- doQuery stmt iterBindDate [] +> assertEqual sqlBindDate expectBindDate actual + +> sqlBindBoundaryDates = +> "select ? from tdual" +> ++ " union select ? from tdual" +> ++ " union select ? from tdual" +> ++ " union select ? from tdual" +> ++ " order by 1 desc" +> actionBindBoundaryDates stmt = do +> withTransaction Serialisable $ do +> actual <- doQuery stmt iterBindDate [] +> assertEqual sqlBindBoundaryDates expectBoundaryDates actual + + +> sqlBoundStmtDML = "insert into " ++ testTable ++ " (id, v) values (?, ?)" +> actionBoundStmtDML stmt = do +> withPreparedStatement stmt $ \pstmt -> do +> -- do it twice, to check that prepared stmt can be reused. +> -- Note that with bound statements, the query (or command) +> -- already been executed, so it's too late to begin the transaction. +> beginTransaction Serialisable +> withBoundStatement pstmt [bindP (100::Int), bindP "100"] $ \bstmt -> do +> count <- execDML bstmt +> rollback +> assertEqual sqlBoundStmtDML 1 count +> beginTransaction Serialisable +> withBoundStatement pstmt [bindP (100::Int), bindP "100"] $ \bstmt -> do +> count <- execDML bstmt +> rollback +> assertEqual sqlBoundStmtDML 1 count + + + +With 'MyTree' we test the ability to send and receive arbtrary Show-able +values as Strings i.e. we create our own datatype for the test. + +> data MyTree a = Leaf a | Branch [MyTree a] deriving (Eq, Show, Read) + +> sqlPolymorphicFetch = sqlSingleValue +> iterPolymorphicFetch :: (Monad m) => MyTree String -> IterAct m (MyTree String) +> iterPolymorphicFetch v _ = result' v +> expectPolymorphicFetch = Branch [Leaf "a", Leaf "b", Branch [Leaf "c", Leaf "d"], Leaf "e"] +> actionPolymorphicFetch stmt = do +> actual <- doQuery stmt iterPolymorphicFetch (Leaf "") +> assertEqual sqlPolymorphicFetch expectPolymorphicFetch actual + +> sqlPolymorphicFetchNull = "select '' from tdual" +> iterPolymorphicFetchNull :: (Monad m) => Maybe (MyTree String) -> IterAct m (Maybe (MyTree String)) +> iterPolymorphicFetchNull v _ = result' v +> expectPolymorphicFetchNull :: Maybe (MyTree String) +> expectPolymorphicFetchNull = Nothing +> actionPolymorphicFetchNull stmt = do +> actual <- doQuery stmt iterPolymorphicFetchNull Nothing +> assertEqual sqlPolymorphicFetchNull Nothing actual + +> sqlRebind = sqlSingleValue +> iterRebind (i::Int) acc = result $ i:acc +> expectRebind1 :: [Int]; expectRebind1 = [1] +> expectRebind2 :: [Int]; expectRebind2 = [2] +> actionRebind stmt bindVal1 bindVal2 = do +> withPreparedStatement stmt $ \pstmt -> do +> withBoundStatement pstmt bindVal1 $ \bstmt -> do +> actual <- doQuery bstmt iterRebind [] +> assertEqual sqlRebind expectRebind1 actual +> withBoundStatement pstmt bindVal2 $ \bstmt -> do +> actual <- doQuery bstmt iterRebind [] +> assertEqual sqlRebind expectRebind2 actual + +> sqlExceptionRollback = "select count(*) from " ++ testTable +> iterExceptionRollback (i::Int) acc = result $ i:acc +> actionExceptionRollback insertStmt selectStmt = do +> catchDB ( +> withTransaction Serialisable $ do +> execDML insertStmt +> throwDB DBNoData +> ) (\e -> return () ) +> count <- doQuery selectStmt iterExceptionRollback [] +> assertEqual sqlExceptionRollback [3] count + +> sqlIterateeMatchesResultSet = "select ?,?,? from tdual" +> --iterMatchesResultSet :: (Monad m) => Int -> Double -> String -> IterAct m [(Int, Double, String)] +> --iterMatchesResultSet i d s acc = result $ (i, d, s):acc +> iterMatchesResultSet :: (Monad m) => Int -> Double -> String -> String -> IterAct m [(Int, Double, String, String)] +> iterMatchesResultSet i d s s2 acc = result $ (i, d, s, s2):acc +> actionIterateeMatchesResultSet stmt = do +> catchDB ( do +> actual <- doQuery stmt iterMatchesResultSet [] +> assertFailure "actionIterateeMatchesResultSet" +> ) (\e -> return () ) diff --git a/Database/Test/MultiConnect.lhs b/Database/Test/MultiConnect.lhs new file mode 100644 --- /dev/null +++ b/Database/Test/MultiConnect.lhs @@ -0,0 +1,35 @@ + +| +Module : Database.Test.MultiConnect +Copyright : (c) 2004 Oleg Kiselyov, Alistair Bayley +License : BSD-style +Maintainer : oleg@pobox.com, alistair@abayley.org +Stability : experimental +Portability : non-portable + +Tests Database.Enumerator code in the context of multiple +database connections to different DBMS products. +We should add tests to shift data between databases, too. + + +> {-# LANGUAGE OverlappingInstances #-} + +> module Database.Test.MultiConnect (runTest) where + +> import qualified Database.Sqlite.Enumerator as Sqlite +> import qualified Database.PostgreSQL.Enumerator as PG +> import Database.Sqlite.Test.Enumerator as SqlTest +> import Database.PostgreSQL.Test.Enumerator as PGTest +> import Database.Test.Performance as Perf +> import Database.Enumerator +> import System.Environment (getArgs) + + +> runTest :: Perf.ShouldRunTests -> [String] -> IO () +> runTest runPerf args = catchDB ( do +> let [ user, pswd, dbname ] = args +> withSession (PG.connect user pswd dbname) $ \sessPG -> do +> withSession (Sqlite.connect user pswd dbname) $ \sessSql -> do +> SqlTest.runTest runPerf args +> PGTest.runTest runPerf args +> ) basicDBExceptionReporter diff --git a/Database/Test/Performance.lhs b/Database/Test/Performance.lhs new file mode 100644 --- /dev/null +++ b/Database/Test/Performance.lhs @@ -0,0 +1,99 @@ + +| +Module : Database.Test.Performance +Copyright : (c) 2004 Oleg Kiselyov, Alistair Bayley +License : BSD-style +Maintainer : oleg@pobox.com, alistair@abayley.org +Stability : experimental +Portability : non-portable + +Performance tests. Currently just tests large result sets. + + +> {-# LANGUAGE OverlappingInstances #-} + +> module Database.Test.Performance where + +> import Database.Enumerator +> import Database.Util +> import System.Environment (getArgs) +> import Control.Monad +> import System.Time +> import Test.MiniUnit +> import Control.Monad.Reader + +> data ShouldRunTests = RunTests | Don'tRunTests deriving (Show, Eq) + +> timedCursor stmt limit rows = do +> withCursor stmt (rowCounter rows) 0 $ \c -> do +> ct1 <- liftIO getClockTime +> replicateM_ rows (cursorNext c) +> ct2 <- liftIO getClockTime +> let diffCt = diffClockTimes ct2 ct1 +> let limitDiff = TimeDiff 0 0 0 0 0 limit 0 +> print_ $ "timedCursor: " ++ timeDiffToString diffCt +> assertBool ("timedCursor: time " ++ (timeDiffToString diffCt) ++ " (limit " ++ (timeDiffToString limitDiff) ++ ")") +> (diffCt < limitDiff) + + +> timedSelect stmt limit rows = do +> ct1 <- liftIO getClockTime +> r <- doQuery stmt (rowCounter rows) 0 +> ct2 <- liftIO getClockTime +> let diffCt = diffClockTimes ct2 ct1 +> -- assume it must complete within limit seconds +> let limitDiff = TimeDiff 0 0 0 0 0 limit 0 +> print_ $ "timedSelect: " ++ timeDiffToString diffCt +> assertBool ("timedSelect: time " ++ (timeDiffToString diffCt) ++ " (limit " ++ (timeDiffToString limitDiff) ++ ")") +> (diffCt < limitDiff) +> assertEqual ("timedSelect: rows " ++ (show r)) rows r + + +|This counter takes the maximum number of rows to fetch as its first argument, +so don't forget to curry it when using it as an iteratee function. +We also try to ensure that it is strict in the counter; +we don't want thousands or millions of unevaluated '+' thunks sitting +on the stack. + +> rowCounter :: (Monad m) => Int -> Int -> IterAct m Int +> rowCounter n _ i = result' (i+1) +> --if i >= n then return (Left $! i) else return (Right $! (1 + i)) +> --if i >= n then return (Left i) else return (Right (1 + i)) + + +2 ^ 16 = 65536 +2 ^ 20 = 1048576 + +Cartesian product. Each instance of the subquery multiplies +the total number of rows by 2, so the number of rows +is 2 ^ (count of subquery instances). +You start to notice the pause around 2^13, +and 2^16 blows out the standard 1M stack +if you use the lazy version of result. Bummer. + +> sqlRows2Power17 :: String +> sqlRows2Power17 = +> "select 1 from" +> ++ " ( select 1 x from tdual union select 0 from tdual) t1" +> ++ ", ( select 2 x from tdual union select 0 from tdual) t2" +> ++ ", ( select 3 x from tdual union select 0 from tdual) t3" +> ++ ", ( select 4 x from tdual union select 0 from tdual) t4" +> ++ ", ( select 5 x from tdual union select 0 from tdual) t5" +> ++ ", ( select 6 x from tdual union select 0 from tdual) t6" +> ++ ", ( select 7 x from tdual union select 0 from tdual) t7" +> ++ ", ( select 8 x from tdual union select 0 from tdual) t8" +> ++ ", ( select 9 x from tdual union select 0 from tdual) t9" +> ++ ", ( select 10 x from tdual union select 0 from tdual) t10" +> ++ ", ( select 11 x from tdual union select 0 from tdual) t11" +> ++ ", ( select 12 x from tdual union select 0 from tdual) t12" +> ++ ", ( select 13 x from tdual union select 0 from tdual) t13" +> ++ ", ( select 14 x from tdual union select 0 from tdual) t14" +> ++ ", ( select 15 x from tdual union select 0 from tdual) t15" +> ++ ", ( select 16 x from tdual union select 0 from tdual) t16" +> ++ ", ( select 17 x from tdual union select 0 from tdual) t17" + +> sqlRows2Power20 :: String +> sqlRows2Power20 = sqlRows2Power17 +> ++ ", ( select 18 x from tdual union select 0 from tdual) t18" +> ++ ", ( select 19 x from tdual union select 0 from tdual) t19" +> ++ ", ( select 20 x from tdual union select 0 from tdual) t20" diff --git a/Database/Test/Util.lhs b/Database/Test/Util.lhs new file mode 100644 --- /dev/null +++ b/Database/Test/Util.lhs @@ -0,0 +1,129 @@ +> {-# LANGUAGE CPP #-} + +> module Database.Test.Util where + +> import Database.Util +> import Test.MiniUnit +> import Data.Int +> import Data.Char + + +> runTest :: a -> [String] -> IO () +> runTest _ _ = do +> counts <- runTestTT "Util module tests" testlist +> return () + +> testlist = +> [ testSubstr +> , testWordsBy +> , testInt64ToDatePartsMinDate +> , testInt64ToDatePartsMaxDate +> , testUtcTimeToInt64MinDate +> , testUtcTimeToInt64MaxDate +> , testCalTimeToInt64MinDate +> , testCalTimeToInt64MaxDate +> , testInt64ToCalTimeMinDate +> , testInt64ToCalTimeMaxDate +> , testPGDatetimeToUTCTimeMinDate +> , testPGDatetimeToUTCTimeMaxDate +> , testPGDatetimeToUTCTimeBCBoundary +> , testPGDatetimeToUTCTimeBCBoundary2 +> , testUTCTimeToPGDatetimeMinDate +> , testUTCTimeToPGDatetimeMaxDate +> ] + +> testSubstr = do +> assertEqual "substr - 1" "a" (substr 1 1 "abc") +> assertEqual "substr - 2" "b" (substr 2 1 "abc") +> assertEqual "substr - 3" "c" (substr 3 1 "abc") +> assertEqual "substr - 4" "bc" (substr 2 2 "abc") +> assertEqual "substr - 5" "ab" (substr 1 2 "abc") +> assertEqual "substr - 6" "abc" (substr 1 4 "abc") +> assertEqual "substr -76" "" (substr 4 4 "abc") + +> testWordsBy = do +> assertEqual "wordsBy - 1" [] (wordsBy isDigit "") +> assertEqual "wordsBy - 2" [] (wordsBy isDigit " --,") +> assertEqual "wordsBy - 2.5" ["5"] (wordsBy isDigit "5") +> assertEqual "wordsBy - 2.75" ["5"] (wordsBy isDigit "5 ") +> assertEqual "wordsBy - 3" ["5"] (wordsBy isDigit "5 --,") +> assertEqual "wordsBy - 4" ["6"] (wordsBy isDigit " --,6") +> assertEqual "wordsBy - 5" ["7"] (wordsBy isDigit " --7, ") +> assertEqual "wordsBy - 6" ["100", "12", "67", "25"] (wordsBy isDigit "100-12,67--, 25") + + +-4712 (4713BC?) is a very common minimum date among DBMS implementations. +Maximum varies, but is often 5874897 AD. + +ghc-6.4.1 needs this, because it only has Show instances for +up to 5-tuples. + +#if __GLASGOW_HASKELL__ <= 604 +> instance (Show a, Show b, Show c, Show d, Show e, Show f) +> => Show (a,b,c,d,e,f) where +> show (a,b,c,d,e,f) = +> "(" ++ show a +> ++ "," ++ show a +> ++ "," ++ show b +> ++ "," ++ show c +> ++ "," ++ show d +> ++ "," ++ show e +> ++ "," ++ show f +> ++ ")" +#endif + +> testInt64ToDatePartsMinDate = do +> let expect :: (Int64,Int64,Int64,Int64,Int64,Int64); expect = (-4712,1,1,0,0,0) +> assertEqual "testInt64ToDatePartsMinDate" expect (int64ToDateParts (-47120101000000)) + +> testInt64ToDatePartsMaxDate = do +> let expect :: (Int64,Int64,Int64,Int64,Int64,Int64); expect = (999999,12,31,23,59,59) +> assertEqual "testInt64ToDatePartsMaxDate" expect (int64ToDateParts (9999991231235959)) + +> testUtcTimeToInt64MinDate = do +> let expect :: Int64; expect = (-47120101000000) +> assertEqual "testUtcTimeToInt64MinDate" expect (utcTimeToInt64 (mkUTCTime (-4712) 1 1 0 0 0)) + +> testUtcTimeToInt64MaxDate = do +> let expect :: Int64; expect = (9999991231235959) +> assertEqual "testUtcTimeToInt64MaxDate" expect (utcTimeToInt64 (mkUTCTime 999999 12 31 23 59 59)) + +> testCalTimeToInt64MinDate = do +> let expect :: Int64; expect = (-47120101000000) +> assertEqual "testCalTimeToInt64MinDate" expect (calTimeToInt64 (mkCalTime (-4712) 1 1 0 0 0)) + +> testCalTimeToInt64MaxDate = do +> let expect :: Int64; expect = (9999991231235959) +> assertEqual "testCalTimeToInt64MaxDate" expect (calTimeToInt64 (mkCalTime 999999 12 31 23 59 59)) + +> testInt64ToCalTimeMinDate = do +> let expect = mkCalTime (-4712) 1 1 0 0 0 +> assertEqual "testInt64ToCalTimeMinDate" expect (int64ToCalTime (-47120101000000)) + +> testInt64ToCalTimeMaxDate = do +> let expect = mkCalTime 999999 12 31 23 59 59 +> assertEqual "testInt64ToCalTimeMaxDate" expect (int64ToCalTime 9999991231235959) + +> testPGDatetimeToUTCTimeMinDate = do +> let expect = mkUTCTime (-4712) 1 1 0 0 0 +> assertEqual "testPGDatetimeToUTCTimeMinDate" expect (pgDatetimetoUTCTime "4713-01-01 00:00:00 BC") + +> testPGDatetimeToUTCTimeMaxDate = do +> let expect = mkUTCTime 999999 1 1 0 0 0 +> assertEqual "testPGDatetimeToUTCTimeMaxDate" expect (pgDatetimetoUTCTime "999999-01-01 00:00:00+00") + +> testPGDatetimeToUTCTimeBCBoundary = do +> let expect = mkUTCTime 0 1 1 0 0 0 +> assertEqual "testPGDatetimeToUTCTimeBCBoundary" expect (pgDatetimetoUTCTime "0001-01-01 00:00:00 BC") + +> testPGDatetimeToUTCTimeBCBoundary2 = do +> let expect = mkUTCTime 0 12 31 0 0 0 +> assertEqual "testPGDatetimeToUTCTimeBCBoundary2" expect (pgDatetimetoUTCTime "0001-12-31 00:00:00 BC") + +> testUTCTimeToPGDatetimeMinDate = do +> let expect = "4713-01-01T00:00:00.000000+00 BC" +> assertEqual "testUTCTimeToPGDatetimeMinDate" expect (utcTimeToPGDatetime (mkUTCTime (-4712) 1 1 0 0 0)) + +> testUTCTimeToPGDatetimeMaxDate = do +> let expect = "999999-01-01T00:00:00.300001+00 AD" +> assertEqual "testUTCTimeToPGDatetimeMaxDate" expect (utcTimeToPGDatetime (mkUTCTime 999999 1 1 0 0 0.300001)) diff --git a/Database/Util.lhs b/Database/Util.lhs --- a/Database/Util.lhs +++ b/Database/Util.lhs @@ -10,10 +10,7 @@ Utility functions. Mostly used in database back-ends, and tests. -> {-# OPTIONS -fglasgow-exts #-} -> {-# OPTIONS -fallow-overlapping-instances #-} -> {-# OPTIONS -fallow-undecidable-instances #-} - +> {-# LANGUAGE TypeSynonymInstances #-} > {-# LANGUAGE FlexibleInstances #-} > {-# LANGUAGE OverlappingInstances #-} > {-# LANGUAGE UndecidableInstances #-} @@ -27,6 +24,10 @@ > import Data.List > import Data.Char > import Data.Time +> import Data.Word (Word8) +> import Foreign.Ptr (Ptr, castPtr) +> import Foreign.Marshal.Array (peekArray) +> import Numeric (showHex) > import Text.Printf @@ -142,8 +143,8 @@ > wordsBy pred s = skipNonMatch pred s 2 states: -skipNonMatch is for when we are looking for the start of our next word -consumeMatch is for when we are currently scanning a word + - skipNonMatch is for when we are looking for the start of our next word + - scanWord is for when we are currently scanning a word > skipNonMatch :: (Char -> Bool) -> String -> [String] > skipNonMatch pred "" = [] @@ -260,3 +261,18 @@ > ++ ":" ++ zeroPad 2 minute > ++ ":" ++ secs > ++ "+00" ++ suffix + + +> printArrayContents :: Int -> Ptr Word8 -> IO () +> printArrayContents sz ptr = do +> putStrLn ("printBufferContents: sz = " ++ show sz) +> l <- peekArray sz ptr +> let +> toHex :: Word8 -> String; +> toHex i = (if i < 16 then "0" else "") ++ showHex i "" +> --let h :: [String]; h = map toHex l +> putStrLn (concat (intersperse " " (map toHex l))) +> let +> toChar :: Word8 -> String +> toChar i = if 31 < i && i < 127 then [chr (fromIntegral i)] else " " +> putStrLn (concat (intersperse " " (map toChar l))) diff --git a/Foreign/C/Test/UTF8.hs b/Foreign/C/Test/UTF8.hs new file mode 100644 --- /dev/null +++ b/Foreign/C/Test/UTF8.hs @@ -0,0 +1,138 @@ + +-- | +-- Module : Foreign.C.Test.UTF8 +-- Copyright : (c) 2004 Oleg Kiselyov, Alistair Bayley +-- License : BSD-style +-- Maintainer : alistair@abayley.org +-- Stability : experimental +-- Portability : non-portable +-- +-- UTF8 decoder and encoder tests. + + +module Foreign.C.Test.UTF8 where + +import Prelude hiding (catch) +import Control.Exception.Extensible +import Data.Char +import Foreign.C.String +import Foreign.C.UTF8 +import Foreign.Marshal.Array +import Foreign.Ptr +import Test.MiniUnit +import qualified Test.QuickCheck as QC +import Data.Word (Word8) + + +runTest :: a -> [String] -> IO () +runTest _ args = runTestTT "UTF8" mkTestList >> return () + +--mkTestList :: Test +--mkTestList = TestList (map TestCase testlist) +mkTestList = testlist + +testlist :: [IO ()] +testlist = + [ testUTF8RoundTrip + , testUTF8StringLenRoundTrip + , quickCheckUTF8RoundTrip + , testFromUTF8Failure5Bytes + , testFromUTF8Failure6Bytes + -- , testLargeFromUTF8 + -- , testLargeFromUTF8Len + ] + + +instance QC.Arbitrary Char where + arbitrary = QC.choose (chr 1, chr 0x10FFFF) + coarbitrary = undefined + +prop_roundtrip s = s == fromUTF8 (toUTF8 s) +quickCheckUTF8RoundTrip = QC.test prop_roundtrip + +testUTF8RoundTrip = do + utf8RoundTrip "1ByteLow" 0x000001 [0x01] + utf8RoundTrip "1ByteHigh" 0x00007F [0x7F] + utf8RoundTrip "2BytesLow" 0x000080 [0xC2, 0x80] + utf8RoundTrip "2BytesHigh" 0x0007FF [0xDF, 0xBF] + utf8RoundTrip "3BytesLow" 0x000800 [0xE0, 0xA0, 0x80] + utf8RoundTrip "3BytesHigh" 0x00FFFF [0xEF, 0xBF, 0xBF] + utf8RoundTrip "4BytesLow" 0x010000 [0xF0, 0x90, 0x80, 0x80] + -- chr 0x10FFFF is the largest code-point Haskell currently allows + utf8RoundTrip "4BytesHigh" 0x10FFFF [0xF4, 0x8F, 0xBF, 0xBF] + +utf8RoundTrip :: String -> Int -> [Word8] -> IO () +utf8RoundTrip msg unicode utf8 = do + assertEqual ("testToUTF8-" ++ msg) utf8 (toUTF8 [chr unicode]) + assertEqual ("testFromUTF8-" ++ msg) [chr unicode] (fromUTF8 utf8) + withUTF8String [chr unicode] $ \cstr -> do + w8 <- peekArray0 0 (castPtr cstr) + assertEqual ("testToUTF8Ptr-" ++ msg) utf8 w8 + withCString (map (chr . fromIntegral) utf8) $ \cstr -> do + s <- peekUTF8String cstr + assertEqual ("testFromUTF8Ptr-" ++ msg) [chr unicode] s + +testUTF8StringLenRoundTrip = do + utf8StringLenRoundTrip "1ByteLow" [0x000001, 0x000001] [0x01, 0x01] + utf8StringLenRoundTrip "2BytesLow" [0x000080, 0x00007F] [0xC2, 0x80, 0x7F] + utf8StringLenRoundTrip "3BytesLow" [0x000800, 0x000001] [0xE0, 0xA0, 0x80, 0x01] + utf8StringLenRoundTrip "4BytesLow" [0x010000, 0x00007F] [0xF0, 0x90, 0x80, 0x80, 0x7F] + utf8StringLenRoundTrip "4BytesHigh" [0x10FFFF, 0x00007F] [0xF4, 0x8F, 0xBF, 0xBF, 0x01] + +utf8StringLenRoundTrip :: String -> [Int] -> [Word8] -> IO () +utf8StringLenRoundTrip msg codepoints utf8 = do + let unicode = map chr codepoints + let expect = take (length unicode - 1) unicode + -- convert our unicode code-points (Haskell String) + -- into a UTF8 CStringLen. + -- Pass this back to peekUTF8StringLen to convert back into Haskell String. + -- Chop off the last char - make sure it's only one byte. + withUTF8StringLen unicode $ \(cstr, clen) -> do + assertEqual ("testUTF8StringLenRoundTrip-" ++ msg) (length utf8) clen + s <- peekUTF8StringLen (cstr, clen - 1) + assertEqual ("testUTF8StringLenRoundTrip-" ++ msg) expect s + + + +--testUTF8StringLenRoundTrip = do + +testFromUTF8Failure5Bytes = do + let utf8 = [0xF8, 0x80, 0x80, 0x80, 0x80] + let handler :: ErrorCall -> IO () + handler (ErrorCall msg) = assertEqual "testFromUTF8Failure5Bytes" "fromUTF8: illegal UTF-8 character 248" msg + catch (do + assertEqual "testFromUTF8Failure5Bytes" [chr 0x10FFFF] (fromUTF8 utf8) + assertBool "testFromUTF8Failure5Bytes: no error raised" False + ) handler + +testFromUTF8Failure6Bytes = do + let utf8 = [0xFD, 0xBF, 0xBF, 0xBF, 0xBF, 0xBF] + let handler :: ErrorCall -> IO () + handler (ErrorCall msg) = assertEqual "testFromUTF8Failure6Bytes" "fromUTF8: illegal UTF-8 character 253" msg + catch (do + assertEqual "testFromUTF8Failure6Bytes" [chr 0x10FFFF] (fromUTF8 utf8) + assertBool "testFromUTF8Failure6Bytes: no error raised" False + ) handler +{- +testLargeFromUTF8 = do + let sz = 1000000 + withCString (take sz (repeat 'a')) $ \cstr -> do + s <- peekUTF8String cstr + assertEqual "testLargeFromUTF8" sz (length s) + s <- peekUTF8StringB cstr + assertEqual "testLargeFromUTF8B" sz (length s) + s <- peekUTF8StringLen (cstr, sz) + assertEqual "testLargeFromUTF8Len" sz (length s) + s <- peekUTF8StringLenB (cstr, sz) + assertEqual "testLargeFromUTF8LenB" sz (length s) +-} + +{- +testLargeFromUTF8Len = do + let sz = 1000000 + withCStringLen (take sz (repeat 'a')) $ \(cstr, clen) -> do + putStrLn "testLargeFromUTF8Len: call peekUTF8StringLen" + s <- peekUTF8StringLen (cstr, clen) + putStrLn "testLargeFromUTF8Len: assert length" + assertEqual "testLargeFromUTF8Len" sz (length s) +-} diff --git a/Foreign/C/UTF8.hs b/Foreign/C/UTF8.hs --- a/Foreign/C/UTF8.hs +++ b/Foreign/C/UTF8.hs @@ -1,5 +1,4 @@ -{-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} -- | @@ -21,7 +20,7 @@ -- well, you have the original String, so... --- This module has been reasonablt optimised. You can check GHC's +-- This module has been reasonably optimised. You can check GHC's -- simplifier output (for unboxing, mainly) with this: -- ghc -O2 -c UTF8.hs -ddump-simpl > simpl.txt @@ -251,12 +250,12 @@ fromUTF8Ptr0 :: Ptr Word8 -> IO String fromUTF8Ptr0 p = do len <- lengthArray0 nullByte p - --fromUTF8PtrUnboxed (len-1) p "" fromUTF8Ptr (len-1) p "" -- | The bytes parameter should be len-1 --- i.e. if the CString has length 2, then you should pass --- bytes=1. +-- i.e. if the CString has length 2, then you should pass bytes=1. +-- That's because we add bytes to the Ptr p to get the offset +-- for each byte; byte 1 is at p+0, byte 2 is at p+1, etc. fromUTF8Ptr :: Int -> Ptr Word8 -> String -> IO String fromUTF8Ptr bytes p acc | bytes `seq` p `seq` acc `seq` False = undefined diff --git a/Main.lhs b/Main.lhs new file mode 100644 --- /dev/null +++ b/Main.lhs @@ -0,0 +1,70 @@ + +| +Module : Main +Copyright : (c) 2004 Oleg Kiselyov, Alistair Bayley +License : BSD-style +Maintainer : oleg@pobox.com, alistair@abayley.org +Stability : experimental +Portability : non-portable + +Simple driver module, mainly for testing. +Imports test modules and runs test suites. + +This project is now hosted at haskell.org: + +@darcs get @ + +Invoke main like this (assuming the compiled executable is called @takusen@): + + > takusen stub noperf + > takusen sqlite noperf "" "" dbname + > takusen oracle noperf "" "" dbname -- no username, so os-authenticated + > takusen mssql noperf user paswd dbname + + +> module Main (main) where + + +> import Database.Sqlite.Test.Enumerator as Sqlite +> import Database.Oracle.Test.Enumerator as Oracle +> --import Database.Test.MultiConnect as Multi +> import Database.ODBC.Test.Enumerator as ODBC +> import Database.Stub.Test.Enumerator as Stub +> --import Database.MSSqlServer.Test.Enumerator as MSSql +> import Database.PostgreSQL.Test.Enumerator as PGSql +> import System.Environment (getArgs) +> import Database.Test.Performance as Perf +> import Database.Test.Util as Util +> import Foreign.C.Test.UTF8 as UTF8 + + +> main :: IO () +> main = do +> args <- getArgs +> if (length args < 2) +> then showUsage +> else do +> let (impl:perf:as) = args +> doTests impl perf as + +> showUsage = do +> putStrLn "usage: takusen backend {no}perf user pswd database" + +> doTests impl perf args = do +> let runPerf = if perf == "perf" then Perf.RunTests else Perf.Don'tRunTests +> case lookup impl backendTests of +> Nothing -> putStrLn $ "No backend for " ++ impl ++ "." +> Just test -> test runPerf args + +> backendTests :: [(String, Perf.ShouldRunTests -> [String] -> IO ())] +> backendTests = +> [ ("sqlite", Sqlite.runTest) +> , ("pgsql", PGSql.runTest) +> , ("odbc", ODBC.runTest) +> --, ("mssql", MSSql.runTest) +> , ("oracle", Oracle.runTest) +> --, ("multi", Multi.runTest) +> , ("stub", Stub.runTest) +> , ("utf8", UTF8.runTest) +> , ("util", Util.runTest) +> ] diff --git a/README.txt b/README.txt new file mode 100644 --- /dev/null +++ b/README.txt @@ -0,0 +1,177 @@ +Installing +---------- +Prerequisites: GHC >= 6.6, Cabal >= 1.6, filepath + +Note that on Windows you will require cabal-1.6.0.2 for ghc-6.6, +as there is a bug in cabal-1.6.0.1 which breaks it on ghc-6.6 on Windows. +cabal-1.6.0.1, which is bundled with ghc-6.10, is fine for ghc-6.8 and later. + +(It was possible to use Takusen with GHC-6.4; see notes in separate section +below.) + +To run or build Setup.hs you will need filepath installed. +This is only needed by Setup.hs, and is not required by Takusen itself. +filepath comes with ghc-6.8 and later, but is a separate download and +install for ghc-6.6. + +Ensure that the database libraries for any particular database you plan +to use are in your path e.g. ensure that %ORACLE_HOME%\bin is in your path. +If the library is not in your path, then the buildtools won't be found, +and the configure will fail. + +The installation uses Cabal configurations. Each of the backends is +enabled by a flag, and the flags are all False by default. If you want +to enable a particular backend, you must enable its flag with -f +e.g. Setup configure -fodbc -foracle -fpostgres -fsqlite + +Typical build, after unzipping the distribution archive (Takusen-?.?.gz): + $ ghc --make Setup + $ Setup configure -fodbc -foracle -fpostgres -fsqlite + $ Setup build + $ Setup install + +Typical build, using darcs to get latest code: + $ mkdir takusen + $ cd takusen + $ darcs get http://darcs.haskell.org/takusen + $ ghc --make Setup + $ Setup configure -fodbc -foracle -fpostgres -fsqlite + $ Setup build + $ Setup install + +It may be that you also need to specify library or include dirs in the +setup configure step. For example, the Oracle Instant Client on Linux +puts header files in a different location from normal i.e. not under +$ORACLE_HOME. In that case you will have to use --extra-include-dirs=..., +and possibly --extra-lib-dirs=..., in the configure step. + +Setup under ghc-6.6 expects the sqlite.h header file to be in the same +location as sqlite3.exe. You can get sqlite3.h from the sqlite source bundle, +and rename to sqlite.h. + + + +Using i.e. Writing data access code +----------------------------------- +There are extensive instructions and examples in the Haddock docs +for module Database.Enumerator: + http://darcs.haskell.org/takusen/doc/html/Database-Enumerator.html + +This should give you most, if not all, of the information you need to +create a program that uses Takusen. + +Here's a little hello-world test case that uses Sqlite: + +{-# OPTIONS -fglasgow-exts #-} +{-# OPTIONS -fallow-overlapping-instances #-} +module Main where +import Database.Sqlite.Enumerator +import Control.Monad.Trans (liftIO) +main = flip catchDB reportRethrow $ + withSession (connect "sqlite_db") (do + let iter (s::String) (_::String) = result s + result <- doQuery (sql "select 'Hello world.'") iter "" + liftIO (putStrLn result) + ) + +If this is Main.hs, then + $ ghc --make Main -o hello +should build a "hello" executable. + + + +Paths, GHCi & runhaskell +------------------------ +Just as with ensuring that your path is correctly set when building Takusen, +you must also ensure it is correctly set when building your programs. +If it is not correct, then you are likely to see linker errors. + +The Cabal build script (Setup.hs) looks for various executables +on your path, in order to configure, or validate the configuration. +For example: + - the Oracle configuration checks that sqlplus is available before continuing + - The PostgreSQL configuration uses the pg_config program to get the library + and include directory locations. + +If you install a new back-end, you will need to re-run the installation +process to be able to use it. + + + +PostgreSQL gotchas on Windows +----------------------------- +The PostgreSQL client library is called libpq.dll on Windows, rather than +the more typical pq.dll. This is fine when using ghc to compile, as gnu ld +is able to figure out that this is the library to use when you pass it -lpq, +but ghci is not quite so slick, and it fails to load the library. + +There is any easy workaround, which is to copy libpq.dll and rename it to +pq.dll. If you do this, then you should be able to use ghci with PostgreSQL +without problems. Don't forget to ensure that PostgreSQL's bin is in your path. + +In the past I've had problems with older versions of PostgreSQL and +ghc-6.4.1. Specifically, the call to PQprepare would segfault. +This occured with C programs (i.e. no Haskell) compiled with the gcc +and ld that came with ghc-6.4.1. If ld (version 2.15.91) was replaced +with an older one (2.13.91) from MSYS then the test program worked. + +With PostgreSQL 8.1.5.1 and ghc-6.6 (gcc 3.4.5 (mingw special) +and ld 2.15.94) this problem seems to have vanished. + + + +Oracle gotchas on Windows +------------------------- +Some users have reported linker errors because their Oracle bin contains +hsbase.dll, which is an Oracle library related to Heterogenous Services. +This DLL overrides GHC's HSbase.dll, and therefore causes linker errors. + +If you can control your Oracle client installation then either + - don't choose Heterogenous Services when you install, + or re-run the installer and remove it, or + - rename hsbase.dll in Oracle bin. + + + +GHC-6.4 and Takusen +------------------- +It was possible to use Takusen with GHC-6.4. +We no longer test this configuration, so you may need to do some work +it you want to go down this path. + +You will need to install Data.Time, which is quite a chore on Windows +because of the dependencies. You will also need MSYS installed in order +to be able to run autoreconf, so get that out of the way first. + +The summary for Windows is: + +darcs get --partial http://www-users.cs.york.ac.uk/~ndm/filepath/ +(or download and unzip the prepared distribution) +normal cabal configure, build, install + +darcs get --partial http://www.cse.unsw.edu.au/~dons/code/fps +(or download and unzip the prepared distribution) +normal cabal configure, build, install + +darcs get http://darcs.haskell.org/packages/Win32 +Edit Win32.cabal, add fps to build-depends. +normal cabal configure, build, install + +darcs get http://semantic.org/TimeLib/TimeLib +There are two packages here: time and fixed. Ignore time. +Go into fixed and do cabal configure, build, install + +darcs get http://darcs.haskell.org/packages/time +Edit time.cabal, add fixed and Win32 to build-depends. +create Setup.hs: + import Distribution.Simple + main = defaultMainWithHooks defaultUserHooks +From MSYS shell, not Windows cmd.exe: + $ autoreconf + $ ghc --make Setup + $ Setup configure + $ Setup build + $ Setup install + +And finally, build Takusen with the normal cabal configure, +build, install. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,11 +1,14 @@ #!/usr/bin/env runhaskell +-- setup configure -fodbc -foracle -fpostgres -fsqlite + import Distribution.PackageDescription ( PackageDescription(..), Library(..), BuildInfo(..), HookedBuildInfo - , emptyHookedBuildInfo, writeHookedBuildInfo, emptyBuildInfo + , emptyHookedBuildInfo, emptyBuildInfo ) -import Distribution.Package (Dependency(..)) -import Distribution.Simple.Setup ( ConfigFlags(..) ) +import Distribution.PackageDescription.Parse ( writeHookedBuildInfo ) +import Distribution.Package (Dependency(..), PackageName(..)) +import Distribution.Simple.Setup ( ConfigFlags(..), BuildFlags(.. ), fromFlag) import Distribution.Simple ( defaultMainWithHooks, autoconfUserHooks, UserHooks(..), Args ) import Distribution.Simple.Program (findProgramOnPath, simpleProgram, Program(..)) @@ -16,8 +19,9 @@ import qualified System.Info (os) import System.Directory (canonicalizePath, removeFile) import System.Environment (getEnv) -import System.FilePath (combine, dropFileName, FilePath) +import System.FilePath (combine, dropFileName, FilePath, pathSeparators) import System.IO.Error (try) +import Data.List (isInfixOf) import Data.Maybe (fromJust) import Data.Monoid (mconcat) @@ -43,6 +47,7 @@ -} + main = defaultMainWithHooks autoconfUserHooks { preConf=preConf, postConf=postConf , hookedPrograms = [pgConfigProgram, odbcConfigProgram, sqlite3Program, sqlplusProgram] @@ -54,15 +59,15 @@ return emptyHookedBuildInfo postConf :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO () postConf args flags pkgdesc localbuildinfo = do - let verbose = (configVerbose flags) + let verbose = fromFlag (configVerbosity flags) let lbi = libBuildInfo (fromJust (library pkgdesc)) let buildtools = buildTools lbi sqliteBI <- configSqlite3 verbose buildtools pgBI <- configPG verbose buildtools oraBI <- configOracle verbose buildtools odbcBI <- configOdbc verbose buildtools - let bi = mconcat [sqliteBI, pgBI, oraBI, odbcBI, Just lbi] - writeHookedBuildInfo "Takusen.buildinfo" (bi, []) + let bi = mconcat [sqliteBI, pgBI, oraBI, odbcBI, lbi] + writeHookedBuildInfo "Takusen.buildinfo" (Just bi, []) -- ODBCConf.exe - MDAC install actions - command line? @@ -76,35 +81,48 @@ isWindows = System.Info.os == "mingw32" || System.Info.os == "windows" +-- ghc-6.6.1 can't cope with a trailing slash or backslash on the end +-- of the include dir path, so we strip it off. +-- Not sure why this is; there might be something else causing it to fail +-- which has gone unnoticed. +stripTrailingSep :: String -> String +stripTrailingSep p + = reverse + . (\s -> if [head s] `isInfixOf` pathSeparators then drop 1 s else s) + . reverse + $ p + makeConfig path libDir includeDir = do libDirs <- canonicalizePath (combine path libDir) includeDirs <- canonicalizePath (combine path includeDir) return - (Just emptyBuildInfo - { extraLibDirs = [libDirs], includeDirs = [includeDirs] }) + (emptyBuildInfo + { extraLibDirs = [stripTrailingSep libDirs], includeDirs = [stripTrailingSep includeDirs] }) maybeGetEnv :: String -> IO (Maybe String) maybeGetEnv env = do catch ( getEnv env >>= return . Just ) ( const (return Nothing) ) -- Check that the program is in the buildtools. --- If it is, then run the action (which should return Maybe BuildInfo). --- If not, return Nothing. -guardProg :: Program -> [Dependency] -> IO (Maybe BuildInfo) -> IO (Maybe BuildInfo) +-- If it is, then run the action (which should return BuildInfo). +-- If not, return emptyBuildInfo. +-- Cabal populates the buildtools list depending on which flags +-- have been passed to "setup configure". +guardProg :: Program -> [Dependency] -> IO BuildInfo -> IO BuildInfo guardProg prog tools action = do - if prog `isElem` tools then action else return Nothing + if prog `isElem` tools then action else return emptyBuildInfo where isElem program buildtools = or (map (match program) buildtools) - match program (Dependency tool _) = (programName program) == tool + match program (Dependency (PackageName tool) _) = (programName program) == tool -- Run the first action to give a Maybe FilePath. -- If this is Nothing then emit a warning about library not found. -- Otherwise, run the second action over the FilePath. -guardPath :: (IO (Maybe FilePath)) -> String -> Verbosity -> (FilePath -> IO (Maybe BuildInfo)) -> IO (Maybe BuildInfo) +guardPath :: (IO (Maybe FilePath)) -> String -> Verbosity -> (FilePath -> IO BuildInfo) -> IO BuildInfo guardPath pathAction libName verbose resAction = do mb <- pathAction case mb of - Nothing -> warn verbose ("No " ++libName++ " library found") >> return Nothing + Nothing -> warn verbose ("No " ++libName++ " library found") >> return emptyBuildInfo Just path -> info verbose ("Using " ++libName++ ": " ++ path) >> resAction path -- From the Oracle 10g manual: @@ -133,15 +151,15 @@ if isWindows then guardPath (programFindLocation sqlite3Program verbose) "Sqlite3" verbose $ \path -> do makeConfig (dropFileName path) "" "" - else return Nothing + else return emptyBuildInfo configPG verbose buildtools = do - guardProg sqlplusProgram buildtools $ do + guardProg pgConfigProgram buildtools $ do guardPath (programFindLocation pgConfigProgram verbose) "PostgreSQL" verbose $ \pq_config_path -> do lib_dirs <- rawSystemStdout verbose pq_config_path ["--libdir"] inc_dirs <- rawSystemStdout verbose pq_config_path ["--includedir"] inc_dirs_server <- rawSystemStdout verbose pq_config_path ["--includedir-server"] - return ( Just emptyBuildInfo + return (emptyBuildInfo { extraLibDirs = words lib_dirs , includeDirs = words inc_dirs ++ words inc_dirs_server }) @@ -154,7 +172,7 @@ configOdbc verbose buildtools | isWindows = do info verbose "Using ODBC: lib already in PATH>" - return Nothing + return emptyBuildInfo configOdbc verbose buildtools = do --info verbose "Using odbc: assume lib already in PATH>" - return Nothing + return emptyBuildInfo diff --git a/Takusen.cabal b/Takusen.cabal --- a/Takusen.cabal +++ b/Takusen.cabal @@ -1,5 +1,12 @@ +-- setup configure -fodbc -foracle -fpostgres -fsqlite +-- setup build +-- setup install +-- +-- setup configure -fbuildtests +-- setup build +-- setup install Name: Takusen -Version: 0.8.3 +Version: 0.8.4 License: BSD3 License-file: LICENSE Author: Alistair Bayley, Oleg Kiselyov @@ -10,7 +17,7 @@ Package-url: http://darcs.haskell.org/takusen Category: Database Build-type: Custom -Cabal-Version: >= 1.4 +Cabal-Version: >= 1.6 Synopsis: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. Description: Takusen is a DBMS access library. Like HSQL and HDBC, we support @@ -48,26 +55,68 @@ Flag sqlite Description: SQLite3 backend Default: False +Flag buildtests + Description: Build test executables + Default: False + +Executable takusen_tests + If !flag(buildtests) + Buildable: False + else + -- If we want to build test exe, then it needs Takusen installed. + Build-Depends: Takusen + Main-Is: Main.lhs + Build-Depends: base, mtl, time, QuickCheck + -- ghc-6.6 has System.Time in base. + -- Later versions has it in a separate package. + if impl(ghc >= 6.8) + Build-Depends: old-time + Extensions: CPP DeriveDataTypeable ScopedTypeVariables + if impl(ghc>=6.9) + cpp-options: -DUSE_NEW_EXCEPTIONS + build-depends: base>=4&&<5 + else + build-depends: base<4 + +Executable miniunit_tests + If !flag(buildtests) + Buildable: False + Main-Is: Test/Main.hs + Build-Depends: base, mtl + Extensions: CPP DeriveDataTypeable ScopedTypeVariables + if impl(ghc>=6.9) + cpp-options: -DUSE_NEW_EXCEPTIONS + build-depends: base>=4&&<5 + else + build-depends: base<4 + + Library + If flag(buildtests) + Buildable: False + Exposed-modules: Database.Enumerator , Database.Util - , Database.Stub.Enumerator + --, Database.Stub.Enumerator , Control.Exception.MonadIO + , Control.Exception.Extensible , Foreign.C.UTF8 If flag(odbc) Exposed-modules: Database.ODBC.Enumerator , Database.ODBC.OdbcFunctions - Build-Tools: odbcconf If os(windows) extra-libraries: odbc32 ld-options: --enable-stdcall-fixup Else - extra-libraries: odbc + If os(darwin) + extra-libraries: iodbc + Else + extra-libraries: odbc If flag(oracle) Exposed-modules: @@ -98,9 +147,26 @@ Build-Tools: sqlite3 Extra-Libraries: sqlite3 - Build-Depends: base, mtl, time, old-time - -- Database.Enumerator uses CPP to make a deriving clause palatable for Haddock. - Extensions: CPP + Build-Depends: base, mtl, time + -- ghc-6.6 has System.Time in base. + -- Later versions has it in a separate package. + if impl(ghc >= 6.8) + Build-Depends: old-time + -- Many modules use CPP to switch between new and old exceptions. + -- DeriveDataTypeable is because we can't switch it on/off with #define; + -- for ghc-6.6 it is rendered as -fglasgow-exts anyway. + Extensions: CPP DeriveDataTypeable + -- We need the USE_NEW_EXCEPTIONS flag as this is used in + -- Control.Exception.Extensible is choose between defining our own + -- extensible exceptions, or re-exporting what's in base-4. + if impl(ghc>=6.9) + cpp-options: -DUSE_NEW_EXCEPTIONS + build-depends: base>=4&&<5 + else + build-depends: base<4 + if impl(ghc >= 6.10) + -- doesn't work with Data.Time on older ghcs, due to some missing header file + Ghc-Options: -O2 Other-modules: Database.InternalEnumerator -- We don't expose the Test modules; the only reason to do so would be so Haddock @@ -108,4 +174,3 @@ -- and for that they'd have to be in Exposed-modules. -- Modules in Other-modules are passed to Haddock with --hide=. Ghc-Prof-Options: -prof -auto-all - --Ghc-Options: -O2 -- doesn't work with Data.Time, due to some missing header file diff --git a/Test/Main.hs b/Test/Main.hs new file mode 100644 --- /dev/null +++ b/Test/Main.hs @@ -0,0 +1,7 @@ + +module Main where + +import Test.MiniUnitTest + +main :: IO () +main = tests diff --git a/Test/MiniUnit.hs b/Test/MiniUnit.hs new file mode 100644 --- /dev/null +++ b/Test/MiniUnit.hs @@ -0,0 +1,178 @@ + +-- | +-- Module : Test.MiniUnit +-- Copyright : (c) 2004 Oleg Kiselyov, Alistair Bayley +-- License : BSD-style +-- Maintainer : oleg@pobox.com, alistair@abayley.org +-- Stability : experimental +-- Portability : portable +-- +-- This is just a simple one-module unit test framework, with the same +-- API as "Test.HUnit" (albeit with a lot of stuff missing). +-- We use it because it works in 'Control.Exception.MonadIO.CaughtMonadIO' +-- instead of IO +-- (and also because I couldn't convert "Test.HUnit" +-- to use 'Control.Exception.MonadIO.CaughtMonadIO'). + +{-# LANGUAGE CPP #-} + +module Test.MiniUnit + ( + -- ** Primary API + runTestTT, assertFailure, assertBool, assertString, assertEqual + -- ** Exposed for self-testing only; see "Test.MiniUnitTest" + , TestResult(..), throwUserError, runSingleTest, reportResults + ) +where + +import Control.Exception.MonadIO +import Control.Exception.Extensible +import Control.Monad +import Control.Monad.Trans (liftIO) +import System.IO.Error (ioeGetErrorString) +import System.IO +import Data.List +import Data.IORef + + +data TestResult = TestSuccess | TestFailure String | TestException String + deriving (Show, Eq) + +-- We'll use HUnit's trick of throwing an IOError when an assertion fails. +-- This will terminate the test case, obviously, but we catch the exception +-- and record that it haa failed so that we can continue with other +-- test cases. + +-- Unlike HUnit, we catch all exceptions; any that are not thrown by +-- failed assertions are recorded as test errors (as opposed to test failures), +-- and the testing continues... + +-- When an assertion fails, we throw an IOException with a special +-- text prefix, which the exception handler will detect. +assertFailure :: CaughtMonadIO m => String -> m () +assertFailure msg = throwUserError (exceptionPrefix ++ msg) + +exceptionPrefix = "MiniUnit:" +hugsPrefix = "IO Error: User error\nReason: " +nhc98Prefix = "I/O error (user-defined), call to function `userError':\n " +ghcPrefix = "" -- We don't use this; it's just documentation... + +dropPrefix p s = if isPrefixOf p s then drop (length p) s else s +trimCompilerPrefixes = dropPrefix hugsPrefix . dropPrefix nhc98Prefix + +throwUserError :: CaughtMonadIO m => String -> m () +throwUserError msg = liftIO (throwIO (userError msg)) + +runSingleTest :: CaughtMonadIO m => m () -> m TestResult +runSingleTest action = do + let + iohandler :: CaughtMonadIO m =>IOException -> m TestResult + iohandler e = + let errText = trimCompilerPrefixes (ioeGetErrorString e) in + if isPrefixOf exceptionPrefix errText + then return (TestFailure (dropPrefix exceptionPrefix errText)) + else return (TestException (show e)) + errhandler :: CaughtMonadIO m => SomeException -> m TestResult + errhandler e = return (TestException (show e)) + (action >> return TestSuccess) + `gcatch` iohandler + `gcatch` errhandler + +-- Predicates for list filtering +isSuccess TestSuccess = True +isSuccess _ = False +isFailure (TestFailure _) = True +isFailure _ = False +isError (TestException _) = True +isError _ = False + +-- Make function composition look more like Unix pipes. +-- This first definition requires a Point-Free Style. +-- I prefer the PFS, as you can use it in (for example) predicate +-- functions passed as arguments (see filter example below). +infixl 9 |> +(|>) = flip (.) + +-- This second definition affords a more pointed style... +-- We can use this operator to inject an argument into a pipe +-- defined using |>; it has lower precedence, so will bind last. +-- e.g. ... = mylist |>> zip [1..] |> filter (snd |> pred) |> map show |> concat +infixl 8 |>> +(|>>) = flip ($) + +--reportFilter pred = zip [1..] |> filter (snd |> pred) |> map testReporter |> concat + +testReporter (n, TestSuccess) = "" +testReporter (n, TestException s) = "Test " ++ show n ++ " failed with exception:\n" ++ s ++ "\n" +testReporter (n, TestFailure s) = "Test " ++ show n ++ " failed with message:\n" ++ s ++ "\n" + +reportResults list = + let + s = list |>> filter isSuccess |> length + e = list |>> filter isError |> length + f = list |>> filter isFailure |> length + in "Test cases: " ++ show (length list) + ++ " Failures: " ++ show f + ++ " Errors: " ++ show e + -- ++ reportFilter isFailure list + -- ++ reportFilter isError list + +-- 2 defns for same result; which is better? +--contains pred = filter pred |> null |> not +contains p l = maybe False (const True) (find p l) + +-- | Return 0 if everything is rosy, +-- 1 if there were assertion failures (but no exceptions), +-- 2 if there were any exceptions. +-- You could use this return code as the return code from +-- your program, if you're driving from the command line. +runTestTT :: CaughtMonadIO m => String -> [m ()] -> m Int +runTestTT desc list = do + liftIO (putStrLn "") + when (desc /= "") (liftIO (putStr (desc ++ " - "))) + liftIO (putStrLn ("Test case count: " ++ show (length list))) + r <- mapM (\(n, t) -> liftIO (putStr "." >> hFlush stdout) >> runSingleTestTT n t) (zip [1..] list) + liftIO (putStrLn "") + liftIO (putStrLn (reportResults r)) + if contains isError r + then return 2 + else if contains isFailure r + then return 1 + else return 0 + +-- Could use this instead of runSingleTest - it will output +-- failures and exceptions as they occur, rather than all +-- at the end. +runSingleTestTT :: CaughtMonadIO m => Int -> m () -> m TestResult +runSingleTestTT n test = do + r <- runSingleTest test + case r of + TestSuccess -> return r + TestFailure _ -> liftIO (putStrLn ('\n':(testReporter (n ,r)))) >> return r + TestException _ -> liftIO (putStrLn ('\n':(testReporter (n, r)))) >> return r + +--------------------------------------------- +-- That's the basic framework; now for some sugar... +-- ... stolen straight from Dean Herrington's HUnit code. +-- Shall we steal his infix operators, too? + +assertBool :: CaughtMonadIO m => String -> Bool -> m () +assertBool msg b = unless b (assertFailure msg) + +assertString :: CaughtMonadIO m => String -> m () +assertString s = unless (null s) (assertFailure s) + +assertEqual :: (Eq a, Show a, CaughtMonadIO m) => + String -- ^ message preface + -> a -- ^ expected + -> a -- ^ actual + -> m () +assertEqual preface expected actual = do + let + msg = + (if null preface then "" else preface ++ "\n") + ++ "expect: " ++ show expected ++ "\nactual: " ++ show actual + unless (actual == expected) (assertFailure msg) + + +--p @? msg = assertBool msg p diff --git a/Test/MiniUnitTest.hs b/Test/MiniUnitTest.hs new file mode 100644 --- /dev/null +++ b/Test/MiniUnitTest.hs @@ -0,0 +1,64 @@ + +{-# LANGUAGE NoMonomorphismRestriction #-} + +module Test.MiniUnitTest where + +import Test.MiniUnit +import Data.IORef +import Control.Exception.MonadIO +import Control.Monad.Trans (liftIO) + + +tests = do + print_ "MiniUnit tests..." + test__assertFailure + test__runSingleTestSuccess + test__runSingleTestFailure + test__runSingleTestException + test__reportResults + print_ "Testing runTestTT; ignore following test output." + test__runTestTT + print_ "MiniUnit tests done." + +print_ s = liftIO (putStrLn s) + +test__assertFailure = catch + (assertFailure "test__assertFailure" + >> error "test__assertFailure: failed: exception not thrown.") + (\e -> print_ "test__assertFailure OK") + +reportResult name result = do + case result of + TestSuccess -> print_ (name ++ " OK") + TestFailure _ -> print_ (name ++ " failed") + TestException _ -> print_ (name ++ " exception") + +test__runSingleTestSuccess = + runSingleTest (return ()) + >>= reportResult "test__runSingleTestSuccess" + +test__runSingleTestFailure = + runSingleTest (assertFailure "test__runSingleTestFailure") + >>= reportResult "test__runSingleTestFailure" + +test__runSingleTestException = do + result <- runSingleTest (throwUserError "boo") + case result of + TestSuccess -> print_ "test__runSingleTestException failed" + TestFailure _ -> print_ "test__runSingleTestException failed!" + TestException _ -> print_ "test__runSingleTestException OK" + +test__reportResults = do + results <- mapM runSingleTest + [assertFailure "test__runSingleTest", return (), throwUserError "boo"] + let expect = "Test cases: 3 Failures: 1 Errors: 1" + if reportResults results == expect + then print_ "test__reportResults OK" + else print_ "test__reportResults failed!" + + +test__runTestTT = do + r <- runTestTT "MiniUnitTest" [assertFailure "test__runSingleTest", return (), throwUserError "boo"] + return () + +---- diff --git a/doc/html/Control-Exception-MonadIO.html b/doc/html/Control-Exception-MonadIO.html new file mode 100644 --- /dev/null +++ b/doc/html/Control-Exception-MonadIO.html @@ -0,0 +1,239 @@ + + +Control.Exception.MonadIO
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Control.Exception.MonadIO
Documentation
class MonadIO m => CaughtMonadIO m where
Methods
gcatch :: m a -> (Exception -> m a) -> m a
gcatchJust :: (Exception -> Maybe b) -> m a -> (b -> m a) -> m a
show/hide Instances
gtry :: CaughtMonadIO m => m b -> m (Either Exception b)
gtryJust :: CaughtMonadIO m => (Exception -> Maybe b) -> m b1 -> m (Either b b1)
gbracket :: CaughtMonadIO m => m t -> (t -> m a) -> (t -> m b) -> m b
gfinally :: CaughtMonadIO m => m t -> m a -> m t
Produced by Haddock version 0.7
diff --git a/doc/html/Database-Enumerator.html b/doc/html/Database-Enumerator.html new file mode 100644 --- /dev/null +++ b/doc/html/Database-Enumerator.html @@ -0,0 +1,5722 @@ + + +Database.Enumerator
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Database.Enumerator
Portabilitynon-portable
Stabilityexperimental
Maintaineroleg@pobox.com, alistair@abayley.org
Contents
Usage +
Iteratee Functions +
result and result' +
Rank-2 types, ($), and the monomorphism restriction +
Bind Parameters +
Multiple (and nested) Result Sets +
Sessions and Transactions +
Exceptions and handlers +
Preparing and Binding +
Iteratees and Cursors +
Utilities +
Description

Abstract database interface, providing a left-fold enumerator + and cursor operations. +

There is a stub: Database.Stub.Enumerator. + This lets you run the test cases without having a working DBMS installation. + This isn't so valuable now, because it's dead easy to install Sqlite, + but it's still there if you want to try it. +

Additional reading: +

Note that there are a few functions that are exported from each DBMS-specific + implementation which are exposed to the API user, and which are part of + the Takusen API, but are not (necessarily) in this module. + They include: +

  • connect (obviously DBMS specific) +
  • prepareQuery, prepareLargeQuery, prepareCommand, sql, sqlbind, prefetch, cmdbind

These functions will typically have the same names and intentions, + but their specific types and usage may differ between DBMS. +

Synopsis
data DBM mark sess a
class ISession sess
data ConnectA sess
withSession :: (Typeable a, ISession sess) => ConnectA sess -> (forall mark . DBM mark sess a) -> IO a
withContinuedSession :: (Typeable a, ISession sess) => ConnectA sess -> (forall mark . DBM mark sess a) -> IO (a, ConnectA sess)
commit :: ISession s => DBM mark s ()
rollback :: ISession s => DBM mark s ()
beginTransaction :: (MonadReader s (ReaderT s IO), ISession s) => IsolationLevel -> DBM mark s ()
withTransaction :: ISession s => IsolationLevel -> DBM mark s a -> DBM mark s a
data IsolationLevel
= ReadUncommitted
| ReadCommitted
| RepeatableRead
| Serialisable
| Serializable
execDDL :: Command stmt s => stmt -> DBM mark s ()
execDML :: Command stmt s => stmt -> DBM mark s Int
inquire :: EnvInquiry key s result => key -> DBM mark s result
data DBException
= DBError SqlState Int String
| DBFatal SqlState Int String
| DBUnexpectedNull RowNum ColNum
| DBNoData
formatDBException :: DBException -> String
basicDBExceptionReporter :: CaughtMonadIO m => DBException -> m ()
reportRethrow :: CaughtMonadIO m => DBException -> m a
reportRethrowMsg :: CaughtMonadIO m => String -> DBException -> m a
catchDB :: CaughtMonadIO m => m a -> (DBException -> m a) -> m a
catchDBError :: CaughtMonadIO m => Int -> m a -> (DBException -> m a) -> m a
ignoreDBError :: CaughtMonadIO m => Int -> m a -> m a
throwDB :: DBException -> a
type ColNum = Int
type RowNum = Int
type SqlState = (SqlStateClass, SqlStateSubClass)
type SqlStateClass = String
type SqlStateSubClass = String
data PreparedStmt mark stmt
withPreparedStatement :: (Typeable a, IPrepared stmt sess bstmt bo) => PreparationA sess stmt -> (PreparedStmt mark stmt -> DBM mark sess a) -> DBM mark sess a
withBoundStatement :: (Typeable a, IPrepared stmt s bstmt bo) => PreparedStmt mark stmt -> [BindA s stmt bo] -> (bstmt -> DBM mark s a) -> DBM mark s a
class ISession sess => Statement stmt sess q | stmt sess -> q
class ISession sess => Command stmt sess
class ISession sess => EnvInquiry inquirykey sess result | inquirykey sess -> result
data PreparationA sess stmt
class ISession sess => IPrepared stmt sess bound_stmt bo | stmt -> bound_stmt, stmt -> bo
data BindA sess stmt bo
class ISession sess => DBBind a sess stmt bo | stmt -> bo where
bindP :: a -> BindA sess stmt bo
bindP :: DBBind a sess stmt bo => a -> BindA sess stmt bo
class ISession sess => IQuery q sess b | q -> sess, q -> b where
currentRowNum :: q -> IO Int
doQuery :: (Statement stmt sess q, QueryIteratee (DBM mark sess) q i seed b, IQuery q sess b) => stmt -> i -> seed -> DBM mark sess seed
class DBType a q b | q -> b
type IterResult seedType = Either seedType seedType
type IterAct m seedType = seedType -> m (IterResult seedType)
currentRowNum :: IQuery q sess b => q -> IO Int
data NextResultSet mark stmt = NextResultSet (PreparedStmt mark stmt)
data RefCursor a = RefCursor a
cursorIsEOF :: DBCursor mark (DBM mark s) a -> DBM mark s Bool
cursorCurrent :: DBCursor mark (DBM mark s) a -> DBM mark s a
cursorNext :: DBCursor mark (DBM mark s) a -> DBM mark s (DBCursor mark (DBM mark s) a)
withCursor :: (Typeable a, Statement stmt sess q, QueryIteratee (DBM mark sess) q i seed b, IQuery q sess b) => stmt -> i -> seed -> (DBCursor mark (DBM mark sess) seed -> DBM mark sess a) -> DBM mark sess a
type Position = Int
ifNull :: Maybe a -> a -> a
result :: Monad m => IterAct m a
result' :: Monad m => IterAct m a
Usage +

Let's look at some example code: +

 -- sample code, doesn't necessarily compile
+ module MyDbExample is
+
+ import Database.Oracle.Enumerator
+ import Database.Enumerator
+ ...
+
+ query1Iteratee :: (Monad m) => Int -> String -> Double -> IterAct m [(Int, String, Double)]
+ query1Iteratee a b c accum = result' ((a, b, c):accum)
+
+ -- non-query actions.
+ otherActions session = do
+   execDDL (sql "create table blah")
+   execDML (cmdbind "insert into blah (...) values (?, ?, ?, ...)" [bindP "v1", bindP (1::Int), ...])
+   commit
+   -- Use withTransaction to delimit a transaction.
+   -- It will commit at the end, or rollback if an error occurs.
+   withTransaction Serialisable ( do
+     execDML (sql "update blah ...")
+     execDML (sql "insert into blah ...")
+     )
+
+ main :: IO ()
+ main = do
+   withSession (connect "user" "password" "server") ( do
+     -- simple query, returning reversed list of rows.
+     r <- doQuery (sql "select a, b, c from x") query1Iteratee []
+     liftIO $ putStrLn $ show r
+     otherActions session
+     )
+

Notes: +

  • connection is made by withSession, + which also disconnects when done i.e. withSession + delimits the connection. + You must pass it a connection action, which is back-end specific, + and created by calling the connect + function from the relevant back-end. +
  • inside the session, the usual transaction delimiter commands are usable + e.g. beginTransaction IsolationLevel, + commit, rollback, and + withTransaction. + We also provide execDML and execDDL. +
  • non-DML and -DDL commands - i.e. queries - are processed by + doQuery (this is the API for our left-fold). + See more explanation and examples below in Iteratee Functions and + Bind Parameters sections. +

The first argument to doQuery must be an instance of + Statement. + Each back-end will provide a useful set of Statement instances + and associated constructor functions for them. + For example, currently all back-ends have: +

  • for basic, all-text statements (no bind variables, default row-caching) + which can be used as queries or commands: +
      sql "select ..."
+
  • for a select with bind variables: +
      sqlbind "select ?, ... where col = ? and ..." [bindP ..., bindP ...]
+
  • for a select with bind variables and row caching: +
      prefetch 100 "select ?, ... where col = ? and ..." [bindP ..., bindP ...]
+
  • for a DML command with bind variables: +
      cmdbind "insert into ... values (?, ?, ...)" [bindP ..., bindP ...]
+
  • for a reusable prepared statement: we have to first create the + prepared statement, and then bind in a separate step. + This separation lets us re-use prepared statements: +
      let stmt = prepareQuery (sql "select ? ...")
+      withPreparedStatement stmt $ \pstmt ->
+        withBoundStatement pstmt [bindP ..., bindP ...] $ \bstmt -> do
+          result <- doQuery bstmt iter seed
+          ...
+

The PostgreSQL backend additionally requires that when preparing statements, + you (1) give a name to the prepared statement, + and (2) specify types for the bind parameters. + The list of bind-types is created by applying the + bindType function + to dummy values of the appropriate types. e.g. +

 let stmt = prepareQuery "stmtname" (sql "select ...") [bindType "", bindType (0::Int)]
+ withPreparedStatement stmt $ \pstmt -> ...
+

A longer explanation of prepared statements and + bind variables is in the Bind Parameters section below. +

Iteratee Functions +

doQuery takes an iteratee function, of n arguments. + Argument n is the accumulator (or seed). + For each row that is returned by the query, + the iteratee function is called with the data from that row in + arguments 1 to n-1, and the current accumulated value in the argument n. +

The iteratee function returns the next value of the accumulator, + wrapped in an Either. + If the Either value is Left, then the query will terminate, + returning the wrapped accumulator/seed value. + If the value is Right, then the query will continue, with the next row + begin fed to the iteratee function, along with the new accumulator/seed value. +

In the example above, query1Iteratee simply conses the new row (as a tuple) + to the front of the accumulator. + The initial seed passed to doQuery was an empty list. + Consing the rows to the front of the list results in a list + with the rows in reverse order. +

The types of values that can be used as arguments to the iteratee function + are back-end specific; they must be instances of the class + DBType. + Most backends directly support the usual lowest-common-denominator set + supported by most DBMS's: Int, String, + Double, UTCTime. + (Int64 is often, but not always, supported.) +

By directly support we mean there is type-specific marshalling code + implemented. + Indirect support for Read- and Show-able types + is supported by marshalling to and from Strings. + This is done automatically by the back-end; + there is no need for user-code to perform the marshalling, + as long as instances of Read and Show are defined. +

The iteratee function operates in the DBM monad, + so if you want to do IO in it you must use liftIO + (e.g. liftIO $ putStrLn "boo" ) to lift the IO action into DBM. +

The iteratee function is not restricted to just constructing lists. + For example, a simple counter function would ignore its arguments, + and the accumulator would simply be the count e.g. +

 counterIteratee :: (Monad m) => Int -> IterAct m Int
+ counterIteratee _ i = result' $ (1 + i)
+

The iteratee function that you pass to doQuery + needs type information, + at least for the arguments if not the return type (which is typically + determined by the type of the seed). + The type synonyms IterAct and IterResult give some convenience + in writing type signatures for iteratee functions: +

 type IterResult seedType = Either seedType seedType
+ type IterAct m seedType = seedType -> m (IterResult seedType)
+

Without them, the type for counterIteratee would be: +

 counterIteratee :: (Monad m) => Int -> Int -> m (Either Int Int)
+

which doesn't seem so onerous, but for more elaborate seed types + (think large tuples) it certainly helps e.g. +

 iter :: Monad m =>
+      String -> Double -> UTCTime -> [(String, Double, UTCTime)]
+   -> m (Either [(String, Double, UTCTime)] [(String, Double, UTCTime)] )
+

reduces to (by using IterAct and IterResult): +

 iter :: Monad m =>
+      String -> Double -> UTCTime -> IterAct m [(String, Double, UTCTime)]
+
result and result' +

The result (lazy) and result' (strict) functions are another convenient shorthand + for returning values from iteratee functions. The return type from an iteratee is actually + Either seed seed, where you return Right if you want processing to continue, + or Left if you want processing to stop before the result-set is exhausted. + The common case is: +

 query1Iteratee a b c accum = return (Right ((a, b, c):accum))
+

which we can write as +

 query1Iteratee a b c accum = result $ (a, b, c):accum)
+

We have lazy and strict versions of result. The strict version is almost certainly + the one you want to use. If you come across a case where the lazy function is useful, + please tell us about it. The lazy function tends to exhaust the stack for large result-sets, + whereas the strict function does not. + This is due to the accumulation of a large number of unevaluated thunks, + and will happen even for simple arithmetic operations such as counting or summing. +

If you use the lazy function and you have stack/memory problems, do some profiling. + With GHC: +

  • ensure the iteratee has its own cost-centre (make it a top-level function) +
  • compile with -prof -auto-all +
  • run with +RTS -p -hr -RTS +
  • run hp2ps over the resulting .hp file to get a .ps document, and take a look at it. + Retainer sets are listed on the RHS, and are prefixed with numbers e.g. (13)CAF, (2)SYSTEM. + At the bottom of the .prof file you'll find the full descriptions of the retainer sets. + Match the number in parentheses on the .ps graph with a SET in the .prof file; + the one at the top of the .ps graph is the one using the most memory. +

You'll probably find that the lazy iteratee is consuming all of the stack with lazy thunks, + which is why we recommend the strict function. +

Rank-2 types, ($), and the monomorphism restriction +

In some examples we use the application operator ($) instead of parentheses + (some might argue that this is a sign of developer laziness). + At first glance, ($) and conventional function application via juxtaposition + seem to be interchangeable e.g. +

 liftIO (putStrLn (show x))
+

looks equivalent to +

 liftIO $ putStrLn $ show x
+

But they're not, because Haskell's type system gives us a nice compromise. +

In a Hindley-Milner type system (like ML) there is no difference between + ($) and function application, because polymorphic functions are not + first-class and cannot be passed to other functions. + At the other end of the scale, ($) and function application in System F + are equivalent, because polymorphic functions can be passed to other + functions. However, type inference in System F is undecidable. +

Haskell hits the sweet spot: maintaining full inference, + and permitting rank-2 polymorphism, in exchange for very few + type annotations. Only functions that take polymorphic functions (and + thus are higher-rank) need type signatures. Rank-2 types can't be + inferred. The function ($) is a regular, rank-1 function, and so + it can't take polymorphic functions as arguments and return + polymorphic functions. +

Here's an example where ($) fails: + we supply a simple test program in the README file. + If you change the withSession line to use ($), like so + (and remove the matching end-parenthese): +

   withSession (connect "sqlite_db") $ do
+

then you get the error: +

 Main.hs:7:38:
+     Couldn't match expected type `forall mark. DBM mark Session a'
+            against inferred type `a1 b'
+     In the second argument of `($)', namely
+       ...
+

Another way of rewriting it is like this, where we separate the + DBM action into another function: +

 {-# OPTIONS -fglasgow-exts #-}
+ module Main where
+ import Database.Sqlite.Enumerator
+ import Control.Monad.Trans (liftIO)
+ main = flip catchDB reportRethrow $
+   withSession (connect "sqlite_db") hello
+
+ hello = withTransaction RepeatableRead $ do
+     let iter (s::String) (_::String) = result s
+     result <- doQuery (sql "select 'Hello world.'") iter ""
+     liftIO (putStrLn result)
+

which gives this error: +

 Main.hs:9:2:
+     Inferred type is less polymorphic than expected
+       Quantified type variable `mark' is mentioned in the environment:
+         hello :: DBM mark Session () (bound at Main.hs:15:0)
+         ...
+

This is just the monomorphism restriction in action. + Sans a type signature, the function hello is monomorphised + (that is, mark is replaced with (), per GHC rules). + This is easily fixed by adding this type declaration: +

 hello :: DBM mark Session ()
+
Bind Parameters +

Support for bind variables varies between DBMS's. +

We call withPreparedStatement function to prepare + the statement, and then call withBoundStatement + to provide the bind values and execute the query. + The value returned by withBoundStatement + is an instance of the Statement class, + so it can be passed to doQuery for result-set processing. +

When we call withPreparedStatement, we must pass + it a "preparation action", which is simply an action that returns + the prepared query. The function to create this action varies between backends, + and by convention is called prepareQuery. + For DML statements, you must use prepareCommand, + as the library needs to do something different depending on whether or not the + statement returns a result-set. +

For queries with large result-sets, we provide + prepareLargeQuery, + which takes an extra parameter: the number of rows to prefetch + in a network call to the server. + This aids performance in two ways: + 1. you can limit the number of rows that come back to the + client, in order to use less memory, and + 2. the client library will cache rows, so that a network call to + the server is not required for every row processed. +

With PostgreSQL, we must specify the types of the bind parameters + when the query is prepared, so the prepareQuery + function takes a list of bindType values. + Also, PostgreSQL requires that prepared statements are named, + although you can use "" as the name. +

With Sqlite and Oracle, we simply pass the query text to + prepareQuery, + so things are slightly simpler for these backends. +

Perhaps an example will explain it better: +

 postgresBindExample = do
+   let
+     query = sql "select blah from blahblah where id = ? and code = ?"
+     iter :: (Monad m) => String -> IterAct m [String]
+     iter s acc = result $ s:acc
+     bindVals = [bindP (12345::Int), bindP "CODE123"]
+     bindTypes = [bindType (0::Int), bindType ""]
+   withPreparedStatement (prepareQuery "stmt1" query bindTypes) $ \pstmt -> do
+     withBoundStatement pstmt bindVals $ \bstmt -> do
+       actual <- doQuery bstmt iter []
+       liftIO (print actual)
+

Note that we pass bstmt to doQuery; + this is the bound statement object created by + withBoundStatement. +

The Oracle/Sqlite example code is almost the same, except for the + call to prepareQuery: +

 sqliteBindExample = do
+   let
+     query = sql "select blah from blahblah where id = ? and code = ?"
+     iter :: (Monad m) => String -> IterAct m [String]
+     iter s acc = result $ s:acc
+     bindVals = [bindP (12345::Int), bindP "CODE123"]
+   withPreparedStatement (prepareQuery query) $ \pstmt -> do
+     withBoundStatement pstmt bindVals $ \bstmt -> do
+       actual <- doQuery bstmt iter []
+       liftIO (print actual)
+

It can be a bit tedious to always use the withPreparedStatement+withBoundStatement + combination, so for the case where you don't plan to re-use the query, + we support a short-cut for bundling the query text and parameters. + The next example is valid for PostgreSQL, Sqlite, and Oracle + (the Sqlite implementation provides a dummy prefetch + function to ensure we have a consistent API). + Sqlite has no facility for prefetching - it's an embedded database, so no + network round-trip - so the Sqlite implementation ignores the prefetch count: +

 bindShortcutExample = do
+   let
+     iter :: (Monad m) => String -> IterAct m [String]
+     iter s acc = result $ s:acc
+     bindVals = [bindP (12345::Int), bindP "CODE123"]
+     query = prefetch 1000 "select blah from blahblah where id = ? and code = ?" bindVals
+   actual <- doQuery query iter []
+   liftIO (print actual)
+

A caveat of using prefetch with PostgreSQL is that you must be inside a transaction. + This is because the PostgreSQL implementation uses a cursor and "FETCH FORWARD" + to implement fetching a block of rows in a single network call, + and PostgreSQL requires that cursors are only used inside transactions. + It can be as simple as wrapping calls to doQuery by + withTransaction, + or you may prefer to delimit your transactions elsewhere (the API supports + beginTransaction and + commit, if you prefer to use them): +

   withTransaction RepeatableRead $ do
+     actual <- doQuery query iter []
+     liftIO (print actual)
+

You may have noticed that for Int and Double literal + bind values, we have to tell the compiler the type of the literal. + This is due to interaction with the numeric literal defaulting mechanism. + For non-numeric literals the compiler can (usually) determine the correct types to use. +

If you omit type information for numeric literals, from GHC the error + message looks something like this: +

 Database/PostgreSQL/Test/Enumerator.lhs:194:4:
+     Overlapping instances for Database.InternalEnumerator.DBBind a
+                                  Session
+                                  Database.PostgreSQL.PGEnumerator.PreparedStmt
+                                  Database.PostgreSQL.PGEnumerator.BindObj
+       arising from use of `bindP' at Database/PostgreSQL/Test/Enumerator.lhs:194:4-8
+     Matching instances:
+       Imported from Database.PostgreSQL.PGEnumerator:
+     instance (Database.InternalEnumerator.DBBind (Maybe a)
+                              Session
+                              Database.PostgreSQL.PGEnumerator.PreparedStmt
+                              Database.PostgreSQL.PGEnumerator.BindObj) =>
+          Database.InternalEnumerator.DBBind a
+                             Session
+                             Database.PostgreSQL.PGEnumerator.PreparedStmt
+                             Database.PostgreSQL.PGEnumerator.BindObj
+       Imported from Database.PostgreSQL.PGEnumerator:
+     instance Database.InternalEnumerator.DBBind (Maybe Double)
+                        ....
+
Multiple (and nested) Result Sets +

Support for returning multiple result sets from a single + statement exists for PostgreSQL and Oracle. + Such functionality does not exist in Sqlite. +

The general idea is to invoke a database procedure or function which + returns cursor variables. The variables can be processed by + doQuery in one of two styles: linear or nested. +

Linear style: +

If we assume the existence of the following PostgreSQL function, + which is used in the test suite in Database.PostgreSQL.Test.Enumerator: +

 CREATE OR REPLACE FUNCTION takusenTestFunc() RETURNS SETOF refcursor AS $$
+ DECLARE refc1 refcursor; refc2 refcursor;
+ BEGIN
+     OPEN refc1 FOR SELECT n*n from t_natural where n < 10 order by 1;
+     RETURN NEXT refc1;
+     OPEN refc2 FOR SELECT n, n*n, n*n*n from t_natural where n < 10 order by 1;
+     RETURN NEXT refc2;
+ END;$$ LANGUAGE plpgsql;
+

... then this code shows how linear processing of cursors would be done: +

   withTransaction RepeatableRead $ do
+   withPreparedStatement (prepareQuery "stmt1" (sql "select * from takusenTestFunc()") []) $ \pstmt -> do
+   withBoundStatement pstmt [] $ \bstmt -> do
+     dummy <- doQuery bstmt iterMain []
+     result1 <- doQuery (NextResultSet pstmt) iterRS1 []
+     result2 <- doQuery (NextResultSet pstmt) iterRS2 []
+   where
+     iterMain :: (Monad m) => (RefCursor String) -> IterAct m [RefCursor String]
+     iterMain c acc = result (acc ++ [c])
+     iterRS1 :: (Monad m) => Int -> IterAct m [Int]
+     iterRS1 i acc = result (acc ++ [i])
+     iterRS2 :: (Monad m) => Int -> Int -> Int -> IterAct m [(Int, Int, Int)]
+     iterRS2 i i2 i3 acc = result (acc ++ [(i, i2, i3)])
+

Notes: +

  • the use of a RefCursor String + type in the iteratee function indicates + to the backend that it should save each cursor value returned, + which it does by stuffing them into a list attached to the + prepared statement object. + This means that we must use withPreparedStatement + to create a prepared statement object; the prepared statament oject + is the container for the cursors returned. +
  • in this example we choose to discard the results of the first iteratee. + This is not necessary, but in this case the only column is a + RefCursor, and the values are already saved + in the prepared statement object. +
  • saved cursors are consumed one-at-a-time by calling doQuery, + passing NextResultSet pstmt + (i.e. passing the prepared statement oject wrapped by + NextResultSet). + This simply pulls the next cursor off the list + - they're processed in the order they were pushed on (FIFO) - + and processes it with the given iteratee. +
  • if you try to process too many cursors i.e. make too many calls + to doQuery passing NextResultSet pstmt, + then an exception will be thrown. + OTOH, failing to process returned cursors will not raise errors, + but the cursors will remain open on the server according to whatever scoping + rules the server applies. + For PostgreSQL, this will be until the transaction (or session) ends. +

Nested style: +

The linear style of cursor processing is the only style supported by + MS SQL Server and ODBC (which we do not yet support). + However, PostgreSQL and Oracle also support using nested cursors in queries. +

Again for PostgreSQL, assuming we have these functions in the database: +

 CREATE OR REPLACE FUNCTION takusenTestFunc(lim int4) RETURNS refcursor AS $$
+ DECLARE refc refcursor;
+ BEGIN
+     OPEN refc FOR SELECT n, takusenTestFunc2(n) from t_natural where n < lim order by n;
+     RETURN refc;
+ END; $$ LANGUAGE plpgsql;
+
 CREATE OR REPLACE FUNCTION takusenTestFunc2(lim int4) RETURNS refcursor AS $$
+ DECLARE refc refcursor;
+ BEGIN
+     OPEN refc FOR SELECT n from t_natural where n < lim order by n;
+     RETURN refc;
+ END; $$ LANGUAGE plpgsql;
+

... then this code shows how nested queries might work: +

 selectNestedMultiResultSet = do
+   let
+     q = "SELECT n, takusenTestFunc(n) from t_natural where n < 10 order by n"
+     iterMain   (i::Int) (c::RefCursor String) acc = result' ((i,c):acc)
+     iterInner  (i::Int) (c::RefCursor String) acc = result' ((i,c):acc)
+     iterInner2 (i::Int) acc = result' (i:acc)
+   withTransaction RepeatableRead $ do
+     rs <- doQuery (sql q) iterMain []
+     flip mapM_ rs $ \(outer, c) -> do
+       rs <- doQuery c iterInner []
+       flip mapM_ rs $ \(inner, c) -> do
+         rs <- doQuery c iterInner2 []
+         flip mapM_ rs $ \i -> do
+           liftIO (putStrLn (show outer ++ " " ++ show inner ++ " " ++ show i))
+

Just to make it clear: the outer query returns a result-set that includes + a RefCursor column. Each cursor from that column is passed to + doQuery to process it's result-set; + here we use mapM_ to apply an IO action to the list returned by + doQuery. +

For Oracle the example is slightly different. + The reason it's different is that: +

  • Oracle requires that the parent cursor must remain open + while processing the children + (in the PostgreSQL example, doQuery + closes the parent cursor after constructing the list, + before the list is processed. This is OK because PostgreSQL + keeps the child cursors open on the server until they are explicitly + closed, or the transaction or session ends). +
  • our current Oracle implementation prevents marshalling + of the cursor in the result-set buffer to a Haskell value, + so each fetch overwrites the buffer value with a new cursor. + This means you have to fully process a given cursor before + fetching the next one. +

Contrast this with the PostgreSQL example above, + where the entire result-set is processed to give a + list of RefCursor values, and then we run a list of actions + over this list with mapM_. + This is possible because PostgreSQL refcursors are just the + database cursor names, which are Strings, which we can marshal + to Haskell values easily. +

 selectNestedMultiResultSet = do
+   let
+     q = "select n, cursor(SELECT nat2.n, cursor"
+         ++ "     (SELECT nat3.n from t_natural nat3 where nat3.n < nat2.n order by n)"
+         ++ "   from t_natural nat2 where nat2.n < nat.n order by n)"
+         ++ " from t_natural nat where n < 10 order by n"
+     iterMain   (outer::Int) (c::RefCursor StmtHandle) acc = do
+       rs <- doQuery c (iterInner outer) []
+       result' ((outer,c):acc)
+     iterInner outer (inner::Int) (c::RefCursor StmtHandle) acc = do
+       rs <- doQuery c (iterInner2 outer inner) []
+       result' ((inner,c):acc)
+     iterInner2 outer inner (i::Int) acc = do
+       liftIO (putStrLn (show outer ++ " " ++ show inner ++ " " ++ show i))
+       result' (i:acc)
+   withTransaction RepeatableRead $ do
+     rs <- doQuery (sql q) iterMain []
+     return ()
+

Note that the PostgreSQL example can also be written like this + (except, of course, that the actual query text is that + from the PostgreSQL example). +

Sessions and Transactions +
data DBM mark sess a
show/hide Instances
ISession si => CaughtMonadIO (DBM mark si)
(ISession sess, ??? a sess) => Functor (DBM mark sess a)
(ISession sess, ??? a sess) => Monad (DBM mark sess a)
(ISession sess, ??? a sess) => MonadFix (DBM mark sess a)
(ISession sess, ??? a sess) => MonadIO (DBM mark sess a)
class ISession sess

The ISession class describes a database session to a particular + DBMS. Oracle has its own Session object, SQLite has its own + session object (which maintains the connection handle to the database + engine and other related stuff). Session objects for different databases + normally have different types -- yet they all belong to the class ISession + so we can do generic operations like commit, execDDL, etc. + in a database-independent manner. +

Session objects per se are created by database connection/login functions. +

The class ISession is thus an interface between low-level (and + database-specific) code and the Enumerator, database-independent + code. + The ISession class is NOT visible to the end user -- neither the class, + nor any of its methods. +

The ISession class describes the mapping from connection object to + the session object. The connection object is created by the end user + (and this is how the end user tells which particular back end he wants). + The session object is not accessible by the end user in any way. + Even the type of the session object should be hidden! +

show/hide Instances
data ConnectA sess
A wrapper around the action to open the database. That wrapper is not + exported to the end user. The only reason for the wrapper is to + guarantee that the only thing to do with the result of + connect function is to pass it out + directly to withSession. +
show/hide Instances
??? sess => Typeable (ConnectA sess)
withSession :: (Typeable a, ISession sess) => ConnectA sess -> (forall mark . DBM mark sess a) -> IO a
Typeable constraint is to prevent the leakage of Session and other + marked objects. +
withContinuedSession :: (Typeable a, ISession sess) => ConnectA sess -> (forall mark . DBM mark sess a) -> IO (a, ConnectA sess)

Persistent database connections. + This issue has been brought up by Shanky Surana. The following design + is inspired by that exchange. +

On one hand, implementing persistent connections is easy. One may say we should + have added them long time ago, to match HSQL, HDBC, and similar + database interfaces. Alas, implementing persistent connection + safely is another matter. The simplest design is like the following +

 withContinuedSession :: (Typeable a, IE.ISession sess) => 
+     IE.ConnectA sess -> (forall mark. DBM mark sess a) -> 
+     IO (a, IE.ConnectA sess)
+ withContinuedSession (IE.ConnectA connecta) m = do
+     conn <- connecta
+     r <- runReaderT (unDBM m) conn
+     return (r,(return conn))
+

so that the connection object is returned as the result and can be + used again with withContinuedSession or withSession. The problem is + that nothing prevents us from writing: +

     (r1,conn) <- withContinuedSession (connect "...") query1
+     r2        <- withSession conn query2
+     r3        <- withSession conn query3
+

That is, we store the suspended connection and then use it twice. + But the first withSession closes the connection. So, the second + withSession gets an invalid session object. Invalid in a sense that + even memory may be deallocated, so there is no telling what happens + next. Also, as we can see, it is difficult to handle errors and + automatically dispose of the connections if the fatal error is + encountered. +

All these problems are present in other interfaces... In the + case of a suspended connection, the problem is how to enforce the + linear access to a variable. It can be enforced, via a + state-changing monad. The implementation below makes + the non-linear use of a suspended connection a run-time checkable + condition. It will be generic and safe - fatal errors close the + connection, an attempt to use a closed connection raises an error, and + we cannot reuse a connection. We have to write: +

     (r1, conn1) <- withContinuedSession conn  ...
+     (r2, conn2) <- withContinuedSession conn1 ...
+     (r3, conn3) <- withContinuedSession conn2 ...
+

etc. If we reuse a suspended connection or use a closed connection, + we get a run-time (exception). That is of course not very + satisfactory - and yet better than a segmentation fault. +

commit :: ISession s => DBM mark s ()
rollback :: ISession s => DBM mark s ()
beginTransaction :: (MonadReader s (ReaderT s IO), ISession s) => IsolationLevel -> DBM mark s ()
withTransaction :: ISession s => IsolationLevel -> DBM mark s a -> DBM mark s a
Perform an action as a transaction: commit afterwards, + unless there was an exception, in which case rollback. +
data IsolationLevel
Constructors
ReadUncommitted
ReadCommitted
RepeatableRead
Serialisable
Serializablefor alternative spellers +
show/hide Instances
execDDL :: Command stmt s => stmt -> DBM mark s ()
DDL operations don't manipulate data, so we return no information. + If there is a problem, an exception will be raised. +
execDML :: Command stmt s => stmt -> DBM mark s Int
Returns the number of rows affected. +
inquire :: EnvInquiry key s result => key -> DBM mark s result
Allows arbitrary actions to be run the DBM monad. + The back-end developer must supply instances of EnvInquiry, + which is hidden away in Database.InternalEnumerator. + An example of this is LastInsertRowid. +
Exceptions and handlers +
data DBException
Constructors
DBError SqlState Int StringDBMS error message. +
DBFatal SqlState Int String
DBUnexpectedNull RowNum ColNumthe iteratee function used for queries accepts both nullable (Maybe) and + non-nullable types. If the query itself returns a null in a column where a + non-nullable type was specified, we can't handle it, so DBUnexpectedNull is thrown. +
DBNoDataThrown by cursor functions if you try to fetch after the end. +
show/hide Instances
formatDBException :: DBException -> String
A show for DBExceptions. +
basicDBExceptionReporter :: CaughtMonadIO m => DBException -> m ()
This simple handler reports the error to stdout and swallows it + i.e. it doesn't propagate. +
reportRethrow :: CaughtMonadIO m => DBException -> m a
This handler reports the error and propagates it + (usually to force the program to halt). +
reportRethrowMsg :: CaughtMonadIO m => String -> DBException -> m a
Same as reportRethrow, but you can prefix some text to the error + (perhaps to indicate which part of your program raised it). +
catchDB :: CaughtMonadIO m => m a -> (DBException -> m a) -> m a
Catch DBExceptions thrown in the DBM + monad. +
catchDBError :: CaughtMonadIO m => Int -> m a -> (DBException -> m a) -> m a
If you want to trap a specific error number, use this. + It passes anything else up. +
ignoreDBError :: CaughtMonadIO m => Int -> m a -> m a
Analogous to catchDBError, but ignores specific errors instead + (propagates anything else). +
throwDB :: DBException -> a
Throw a DBException. It's just a type-specific throwDyn. +
type ColNum = Int
type RowNum = Int
type SqlState = (SqlStateClass, SqlStateSubClass)
type SqlStateClass = String
type SqlStateSubClass = String
Preparing and Binding +
data PreparedStmt mark stmt
withPreparedStatement
:: (Typeable a, IPrepared stmt sess bstmt bo)
=> PreparationA sess stmtpreparation action to create prepared statement; + this action is usually created by prepareQuery/Command +
-> (PreparedStmt mark stmt -> DBM mark sess a)DBM action that takes a prepared statement +
-> DBM mark sess a

Prepare a statement and run a DBM action over it. + This gives us the ability to re-use a statement, + for example by passing different bind values for each execution. +

The Typeable constraint is to prevent the leakage of marked things. + The type of bound statements should not be exported (and should not be + in Typeable) so the bound statement can't leak either. +

withBoundStatement
:: (Typeable a, IPrepared stmt s bstmt bo)
=> PreparedStmt mark stmtprepared statement created by withPreparedStatement +
-> [BindA s stmt bo]bind values +
-> (bstmt -> DBM mark s a)action to run over bound statement +
-> DBM mark s a

Applies a prepared statement to bind variables to get a bound statement, + which is passed to the provided action. + Note that by the time it is passed to the action, the query or command + has usually been executed. + A bound statement would normally be an instance of + Statement, so it can be passed to + doQuery + in order to process the result-set, and also an instance of + Command, so that we can write + re-usable DML statements (inserts, updates, deletes). +

The Typeable constraint is to prevent the leakage of marked things. + The type of bound statements should not be exported (and should not be + in Typeable) so the bound statement can't leak either. +

class ISession sess => Statement stmt sess q | stmt sess -> q
Statement defines the API for query objects i.e. + which types can be queries. +
show/hide Instances
Statement BoundStmt Session Query
Statement BoundStmt Session Query
Statement BoundStmt Session Query
Statement BoundStmt Session Query
Statement PreparedStmtObj Session Query
Statement PreparedStmtObj Session Query
Statement PreparedStmtObj Session Query
Statement QueryString Session Query
Statement QueryString Session Query
Statement QueryString Session Query
Statement QueryString Session Query
Statement QueryString Session Query
Statement QueryStringTuned Session Query
Statement QueryStringTuned Session Query
Statement QueryStringTuned Session Query
Statement StmtBind Session Query
Statement StmtBind Session Query
Statement String Session Query
Statement String Session Query
Statement String Session Query
Statement String Session Query
Statement (RefCursor StmtHandle) Session Query
Statement (RefCursor String) Session Query
Statement (NextResultSet mark PreparedStmtObj) Session Query
Statement (NextResultSet mark PreparedStmtObj) Session Query
class ISession sess => Command stmt sess
Command is not a query: command deletes or updates rows, creates/drops + tables, or changes database state. + executeCommand returns the number of affected rows (or 0 if DDL i.e. not DML). +
show/hide Instances
Command BoundStmt Session
Command BoundStmt Session
Command BoundStmt Session
Command BoundStmt Session
Command CommandBind Session
Command CommandBind Session
Command QueryString Session
Command QueryString Session
Command QueryString Session
Command QueryString Session
Command QueryString Session
Command QueryStringTuned Session
Command StmtBind Session
Command StmtBind Session
Command String Session
Command String Session
Command String Session
Command String Session
class ISession sess => EnvInquiry inquirykey sess result | inquirykey sess -> result
show/hide Instances
data PreparationA sess stmt

This type is not visible to the end user (cf. ConnectA). It forms a private + `communication channel' between Database.Enumerator and a back end. +

Why don't we make a user-visible class with a prepare method? + Because it means to standardize the preparation method signature + across all databases. Some databases need more parameters, some + fewer. There may be several statement preparation functions within one + database. So, instead of standardizing the signature of the + preparation function, we standardize on the _result_ of that + function. To be more precise, we standardize on the properties of the + result: whatever it is, the eventual prepared statement should be + suitable to be passed to bindRun. +

class ISession sess => IPrepared stmt sess bound_stmt bo | stmt -> bound_stmt, stmt -> bo
show/hide Instances
IPrepared PreparedStmtObj Session BoundStmt BindObj
IPrepared PreparedStmtObj Session BoundStmt BindObj
IPrepared PreparedStmtObj Session BoundStmt BindObj
IPrepared PreparedStmtObj Session BoundStmt BindObj
data BindA sess stmt bo
The binding object (bo) below is very abstract, on purpose. + It may be |IO a|, it may be String, it may be a function, etc. + The binding object can hold the result of marshalling, + or bo can hold the current counter, etc. + Different databases do things very differently: + compare PostgreSQL and the Stub (which models Oracle). +
class ISession sess => DBBind a sess stmt bo | stmt -> bo where
The class DBBind is not used by the end-user. + It is used to tie up low-level database access and the enumerator. + A database-specific library must provide a set of instances for DBBind. + The latter are the dual of DBType. +
Methods
bindP :: a -> BindA sess stmt bo
This is really just a wrapper that lets us write lists of + heterogenous bind values e.g. [bindP "string", bindP (0::Int), ...] +
show/hide Instances
DBBind (Maybe a) Session PreparedStmtObj BindObj => DBBind a Session PreparedStmtObj BindObj
DBBind (Maybe a) Session PreparedStmtObj BindObj => DBBind a Session PreparedStmtObj BindObj
DBBind (Maybe a) Session PreparedStmtObj BindObj => DBBind a Session PreparedStmtObj BindObj
DBBind (Maybe a) Session PreparedStmtObj BindObj => DBBind a Session PreparedStmtObj BindObj
DBBind (Maybe CalendarTime) Session PreparedStmtObj BindObj
DBBind (Maybe CalendarTime) Session PreparedStmtObj BindObj
DBBind (Maybe Double) Session PreparedStmtObj BindObj
DBBind (Maybe Double) Session PreparedStmtObj BindObj
DBBind (Maybe Double) Session PreparedStmtObj BindObj
DBBind (Maybe Double) Session PreparedStmtObj BindObj
DBBind (Maybe Float) Session PreparedStmtObj BindObj
DBBind (Maybe Int) Session PreparedStmtObj BindObj
DBBind (Maybe Int) Session PreparedStmtObj BindObj
DBBind (Maybe Int) Session PreparedStmtObj BindObj
DBBind (Maybe Int) Session PreparedStmtObj BindObj
DBBind (Maybe Int64) Session PreparedStmtObj BindObj
DBBind (Maybe Int64) Session PreparedStmtObj BindObj
DBBind (Maybe String) Session PreparedStmtObj BindObj
DBBind (Maybe String) Session PreparedStmtObj BindObj
DBBind (Maybe String) Session PreparedStmtObj BindObj
DBBind (Maybe String) Session PreparedStmtObj BindObj
DBBind (Maybe UTCTime) Session PreparedStmtObj BindObj
DBBind (Maybe UTCTime) Session PreparedStmtObj BindObj
DBBind (Maybe UTCTime) Session PreparedStmtObj BindObj
DBBind (Maybe UTCTime) Session PreparedStmtObj BindObj
Show a => DBBind (Maybe a) Session PreparedStmtObj BindObj
Show a => DBBind (Maybe a) Session PreparedStmtObj BindObj
Show a => DBBind (Maybe a) Session PreparedStmtObj BindObj
Show a => DBBind (Maybe a) Session PreparedStmtObj BindObj
DBBind (Out (Maybe Double)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe Double)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe Int)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe Int)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe StmtHandle)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe String)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe String)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe UTCTime)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe UTCTime)) Session PreparedStmtObj BindObj
Show a => DBBind (Out (Maybe a)) Session PreparedStmtObj BindObj
Show a => DBBind (Out (Maybe a)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe a)) Session PreparedStmtObj BindObj => DBBind (Out a) Session PreparedStmtObj BindObj
DBBind (Out (Maybe a)) Session PreparedStmtObj BindObj => DBBind (Out a) Session PreparedStmtObj BindObj
bindP :: DBBind a sess stmt bo => a -> BindA sess stmt bo
This is really just a wrapper that lets us write lists of + heterogenous bind values e.g. [bindP "string", bindP (0::Int), ...] +
Iteratees and Cursors +
class ISession sess => IQuery q sess b | q -> sess, q -> b where

The class IQuery describes the class of query objects. Each + database (that is, each Session object) has its own Query object. + We may assume that a Query object includes (at least, conceptually) + a (pointer to) a Session object, so a Query object determines the + Session object. + A back-end provides an instance (or instances) of IQuery. + The end user never seens the IQuery class (let alone its methods). +

Can a session have several types of query objects? + Let's assume that it can: but a statement plus the session uniquely + determine the query, +

Note that we explicitly use IO monad because we will have to explicitly + do FFI. +

Methods
currentRowNum :: q -> IO Int
show/hide Instances
IQuery Query Session ColumnBuffer
IQuery Query Session ColumnBuffer
IQuery Query Session ColumnBuffer
IQuery Query Session ColumnBuffer
IQuery Query Session ColumnBuffer
doQuery
:: (Statement stmt sess q, QueryIteratee (DBM mark sess) q i seed b, IQuery q sess b)
=> stmtquery +
-> iiteratee function +
-> seedseed value +
-> DBM mark sess seed
The left-fold interface. +
class DBType a q b | q -> b

A 'buffer' means a column buffer: a data structure that points to a + block of memory allocated for the values of one particular + column. Since a query normally fetches a row of several columns, we + typically deal with a list of column buffers. Although the column data + are typed (e.g., Integer, CalendarDate, etc), column buffers hide that + type. Think of the column buffer as Dynamics. The class DBType below + describes marshalling functions, to fetch a typed value out of the + 'untyped' columnBuffer. +

Different DBMS's (that is, different session objects) have, in + general, columnBuffers of different types: the type of Column Buffer + is specific to a database. + So, ISession (m) uniquely determines the buffer type (b)?? + Or, actually, a query uniquely determines the buffer. +

The class DBType is not used by the end-user. + It is used to tie up low-level database access and the enumerator. + A database-specific library must provide a set of instances for DBType. +

show/hide Instances
DBType (Maybe a) Query ColumnBuffer => DBType a Query ColumnBuffer
DBType (Maybe a) Query ColumnBuffer => DBType a Query ColumnBuffer
DBType (Maybe a) Query ColumnBuffer => DBType a Query ColumnBuffer
DBType (Maybe a) Query ColumnBuffer => DBType a Query ColumnBuffer
DBType (Maybe a) Query ColumnBuffer => DBType a Query ColumnBuffer
DBType (Maybe CalendarTime) Query ColumnBuffer
DBType (Maybe CalendarTime) Query ColumnBuffer
DBType (Maybe CalendarTime) Query ColumnBuffer
DBType (Maybe CalendarTime) Query ColumnBuffer
DBType (Maybe Double) Query ColumnBuffer
DBType (Maybe Double) Query ColumnBuffer
DBType (Maybe Double) Query ColumnBuffer
DBType (Maybe Double) Query ColumnBuffer
DBType (Maybe Double) Query ColumnBuffer
DBType (Maybe Float) Query ColumnBuffer
DBType (Maybe Int) Query ColumnBuffer
DBType (Maybe Int) Query ColumnBuffer
DBType (Maybe Int) Query ColumnBuffer
DBType (Maybe Int) Query ColumnBuffer
DBType (Maybe Int) Query ColumnBuffer
DBType (Maybe Int64) Query ColumnBuffer
DBType (Maybe Int64) Query ColumnBuffer
DBType (Maybe String) Query ColumnBuffer
DBType (Maybe String) Query ColumnBuffer
DBType (Maybe String) Query ColumnBuffer
DBType (Maybe String) Query ColumnBuffer
DBType (Maybe String) Query ColumnBuffer
DBType (Maybe UTCTime) Query ColumnBuffer
DBType (Maybe UTCTime) Query ColumnBuffer
DBType (Maybe UTCTime) Query ColumnBuffer
DBType (Maybe UTCTime) Query ColumnBuffer
(Show a, Read a) => DBType (Maybe a) Query ColumnBuffer
(Show a, Read a) => DBType (Maybe a) Query ColumnBuffer
(Show a, Read a) => DBType (Maybe a) Query ColumnBuffer
(Show a, Read a) => DBType (Maybe a) Query ColumnBuffer
(Show a, Read a) => DBType (Maybe a) Query ColumnBuffer
DBType (RefCursor StmtHandle) Query ColumnBuffer
DBType (RefCursor String) Query ColumnBuffer
type IterResult seedType = Either seedType seedType
IterResult and IterAct give us some type sugar. + Without them, the types of iteratee functions become + quite unwieldy. +
type IterAct m seedType = seedType -> m (IterResult seedType)
currentRowNum :: IQuery q sess b => q -> IO Int
data NextResultSet mark stmt
Constructors
NextResultSet (PreparedStmt mark stmt)
show/hide Instances
Statement (NextResultSet mark PreparedStmtObj) Session Query
Statement (NextResultSet mark PreparedStmtObj) Session Query
data RefCursor a
Constructors
RefCursor a
show/hide Instances
DBType (RefCursor StmtHandle) Query ColumnBuffer
DBType (RefCursor String) Query ColumnBuffer
Statement (RefCursor StmtHandle) Session Query
Statement (RefCursor String) Session Query
cursorIsEOF :: DBCursor mark (DBM mark s) a -> DBM mark s Bool

cursorIsEOF's return value tells you if there are any more rows or not. + If you call cursorNext when there are no more rows, + a DBNoData exception is thrown. + Cursors are automatically closed and freed when: +

  • the iteratee returns Left a +
  • the query result-set is exhausted. +

To make life easier, we've created a withCursor function, + which will clean up if an error (exception) occurs, + or the code exits early. + You can nest them to get interleaving, if you desire: +

  withCursor query1 iter1 [] $ \c1 -> do
+    withCursor query2 iter2 [] $ \c2 -> do
+      r1 <- cursorCurrent c1
+      r2 <- cursorCurrent c2
+      ...
+      return something
+
cursorCurrent :: DBCursor mark (DBM mark s) a -> DBM mark s a
Returns the results fetched so far, processed by iteratee function. +
cursorNext :: DBCursor mark (DBM mark s) a -> DBM mark s (DBCursor mark (DBM mark s) a)
Advance the cursor. Returns the cursor. The return value is usually ignored. +
withCursor
:: (Typeable a, Statement stmt sess q, QueryIteratee (DBM mark sess) q i seed b, IQuery q sess b)
=> stmtquery +
-> iiteratee function +
-> seedseed value +
-> (DBCursor mark (DBM mark sess) seed -> DBM mark sess a)action taking cursor parameter +
-> DBM mark sess a
Ensures cursor resource is properly tidied up in exceptional cases. + Propagates exceptions after closing cursor. + The Typeable constraint is to prevent cursors and other marked values + (like cursor computations) from escaping. +
type Position = Int
Utilities +
ifNull
:: Maybe anullable value +
-> avalue to substitute if first parameter is null i.e. Nothing +
-> a
Useful utility function, for SQL weenies. +
result :: Monad m => IterAct m a
Another useful utility function. + Use this to return a value from an iteratee function (the one passed to + doQuery). + Note that you should probably nearly always use the strict version. +
result' :: Monad m => IterAct m a
A strict version. This is recommended unless you have a specific need for laziness, + as the lazy version will gobble stack and heap. + If you have a large result-set (in the order of 10-100K rows or more), + it is likely to exhaust the standard 1M GHC stack. + Whether or not result eats memory depends on what x does: + if it's a delayed computation then it almost certainly will. + This includes consing elements onto a list, + and arithmetic operations (counting, summing, etc). +
Produced by Haddock version 0.7
diff --git a/doc/html/Database-ODBC-Enumerator.html b/doc/html/Database-ODBC-Enumerator.html new file mode 100644 --- /dev/null +++ b/doc/html/Database-ODBC-Enumerator.html @@ -0,0 +1,655 @@ + + +Database.ODBC.Enumerator
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Database.ODBC.Enumerator
Portabilitynon-portable
Stabilityexperimental
Maintaineroleg@pobox.com, alistair@abayley.org
Description
ODBC implementation of Database.Enumerator. +
Documentation
data Session
show/hide Instances
ISession Session
Typeable Session
Command BoundStmt Session
Command QueryString Session
Command StmtBind Session
Command String Session
IQuery Query Session ColumnBuffer
Statement BoundStmt Session Query
Statement PreparedStmtObj Session Query
Statement QueryString Session Query
Statement StmtBind Session Query
Statement String Session Query
DBBind (Maybe a) Session PreparedStmtObj BindObj => DBBind a Session PreparedStmtObj BindObj
IPrepared PreparedStmtObj Session BoundStmt BindObj
DBBind (Maybe Double) Session PreparedStmtObj BindObj
DBBind (Maybe Int) Session PreparedStmtObj BindObj
DBBind (Maybe String) Session PreparedStmtObj BindObj
DBBind (Maybe UTCTime) Session PreparedStmtObj BindObj
Show a => DBBind (Maybe a) Session PreparedStmtObj BindObj
DBBind (Out (Maybe Double)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe Int)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe String)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe UTCTime)) Session PreparedStmtObj BindObj
Show a => DBBind (Out (Maybe a)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe a)) Session PreparedStmtObj BindObj => DBBind (Out a) Session PreparedStmtObj BindObj
connect :: String -> ConnectA Session
prepareStmt :: QueryString -> PreparationA Session PreparedStmtObj
preparePrefetch :: Int -> QueryString -> PreparationA Session PreparedStmtObj
prepareQuery :: QueryString -> PreparationA Session PreparedStmtObj
prepareLargeQuery :: Int -> QueryString -> PreparationA Session PreparedStmtObj
prepareCommand :: QueryString -> PreparationA Session PreparedStmtObj
sql :: String -> QueryString
sqlbind :: String -> [BindA Session PreparedStmtObj BindObj] -> StmtBind
prefetch :: Int -> String -> [BindA Session PreparedStmtObj BindObj] -> StmtBind
cmdbind :: String -> [BindA Session PreparedStmtObj BindObj] -> StmtBind
newtype Out a
Constructors
Out a
show/hide Instances
DBBind (Out (Maybe Double)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe Int)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe String)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe UTCTime)) Session PreparedStmtObj BindObj
Show a => DBBind (Out (Maybe a)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe a)) Session PreparedStmtObj BindObj => DBBind (Out a) Session PreparedStmtObj BindObj
module Database.Enumerator
Produced by Haddock version 0.7
diff --git a/doc/html/Database-ODBC-OdbcFunctions.html b/doc/html/Database-ODBC-OdbcFunctions.html new file mode 100644 --- /dev/null +++ b/doc/html/Database-ODBC-OdbcFunctions.html @@ -0,0 +1,5679 @@ + + +Database.ODBC.OdbcFunctions
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Database.ODBC.OdbcFunctions
Portabilitynon-portable
Stabilityexperimental
Maintaineroleg@pobox.com, alistair@abayley.org
Description
Wrappers for ODBC FFI functions, plus buffer marshaling. +
Synopsis
data HandleObj = HandleObj
type Handle = Ptr HandleObj
data EnvObj = EnvObj
type EnvHandle = Ptr EnvObj
data ConnObj = ConnObj
type ConnHdl = Ptr ConnObj
data ConnHandle = ConnHandle {
connHdl :: ConnHdl
connDbms :: String
}
data StmtObj = StmtObj
type StmtHdl = Ptr StmtObj
data StmtHandle = StmtHandle {
stmtHdl :: StmtHdl
stmtDbms :: String
}
type WindowHandle = Ptr ()
data Buffer = Buffer
type BufferFPtr = ForeignPtr Buffer
type SizeFPtr = ForeignPtr SqlLen
type MyCString = CString
type MyCStringLen = CStringLen
data BindBuffer = BindBuffer {
bindBufPtr :: BufferFPtr
bindBufSzPtr :: SizeFPtr
bindBufSize :: SqlLen
}
type SqlInteger = Int32
type SqlUInteger = Word32
type SqlSmallInt = Int16
type SqlUSmallInt = Word16
type SqlLen = Int32
type SqlULen = Word32
type SqlReturn = SqlSmallInt
type SqlHandleType = SqlSmallInt
type SqlDataType = SqlSmallInt
type SqlCDataType = SqlSmallInt
type SqlParamDirection = SqlSmallInt
type SqlInfoType = SqlUSmallInt
sqlDriverNoPrompt :: SqlUSmallInt
sqlNullTermedString :: SqlInteger
sqlNullData :: SqlLen
sqlTransCommit :: SqlSmallInt
sqlTransRollback :: SqlSmallInt
sqlAutoCommitOn :: SqlInteger
sqlAutoCommitOff :: SqlInteger
data OdbcException = OdbcException Int String String [OdbcException]
catchOdbc :: IO a -> (OdbcException -> IO a) -> IO a
throwOdbc :: OdbcException -> a
getDiagRec :: SqlReturn -> SqlHandleType -> Handle -> SqlSmallInt -> IO [OdbcException]
checkError :: SqlReturn -> SqlHandleType -> Handle -> IO ()
allocHdl :: Storable a => Handle -> SqlHandleType -> IO a
allocEnv :: IO EnvHandle
allocConn :: EnvHandle -> IO ConnHandle
allocStmt :: ConnHandle -> IO StmtHandle
freeHandle :: SqlHandleType -> Handle -> IO ()
freeEnv :: EnvHandle -> IO ()
freeConn :: ConnHandle -> IO ()
freeStmt :: StmtHandle -> IO ()
int2Ptr :: SqlInteger -> Ptr ()
setOdbcVer :: EnvHandle -> IO ()
connect :: ConnHandle -> String -> IO String
disconnect :: ConnHandle -> IO ()
prepareStmt :: StmtHandle -> String -> IO ()
executeStmt :: StmtHandle -> IO ()
closeCursor :: StmtHandle -> IO ()
rowCount :: StmtHandle -> IO Int
fetch :: StmtHandle -> IO Bool
moreResults :: StmtHandle -> IO Bool
commit :: ConnHandle -> IO ()
rollback :: ConnHandle -> IO ()
setAutoCommitOn :: ConnHandle -> IO ()
setAutoCommitOff :: ConnHandle -> IO ()
setTxnIsolation :: ConnHandle -> SqlInteger -> IO ()
getInfoString :: ConnHandle -> SqlInfoType -> IO String
getInfoDbmsName :: ConnHandle -> IO String
getInfoDbmsVer :: ConnHandle -> IO String
getInfoDatabaseName :: ConnHandle -> IO String
getInfoDriverName :: ConnHandle -> IO String
getInfoDriverVer :: ConnHandle -> IO String
getNativeSql :: ConnHandle -> String -> IO String
getMaybeFromBuffer :: Storable a => Ptr SqlLen -> Ptr a -> (Ptr a -> SqlLen -> IO b) -> IO (Maybe b)
getDataStorable :: Storable a => StmtHandle -> Int -> SqlDataType -> Int -> (a -> b) -> IO (Maybe b)
getDataUtcTime :: StmtHandle -> Int -> IO (Maybe UTCTime)
getDataCStringLen :: StmtHandle -> Int -> IO (Maybe CStringLen)
getDataUTF8String :: StmtHandle -> Int -> IO (Maybe String)
getDataCString :: StmtHandle -> Int -> IO (Maybe String)
peekSmallInt :: Ptr a -> Int -> IO SqlSmallInt
peekUSmallInt :: Ptr a -> Int -> IO SqlUSmallInt
peekUInteger :: Ptr a -> Int -> IO SqlUInteger
readUtcTimeFromMemory :: Ptr Word8 -> IO UTCTime
bindColumnBuffer :: StmtHandle -> Int -> SqlDataType -> SqlLen -> IO BindBuffer
createEmptyBuffer :: SqlLen -> IO BindBuffer
testForNull :: BindBuffer -> (Ptr Buffer -> SqlLen -> IO a) -> IO (Maybe a)
getStorableFromBuffer :: Storable a => BindBuffer -> IO (Maybe a)
getCAStringFromBuffer :: BindBuffer -> IO (Maybe String)
getCWStringFromBuffer :: BindBuffer -> IO (Maybe String)
getUTF8StringFromBuffer :: BindBuffer -> IO (Maybe String)
getUtcTimeFromBuffer :: BindBuffer -> IO (Maybe UTCTime)
createBufferForStorable :: Storable a => Maybe a -> IO BindBuffer
createBufferHelper :: Storable a => a -> SqlLen -> Int -> IO BindBuffer
wrapSizedBuffer :: Ptr a -> SqlLen -> Int -> IO BindBuffer
bindParam :: StmtHandle -> Int -> SqlParamDirection -> SqlCDataType -> SqlDataType -> SqlULen -> SqlSmallInt -> BindBuffer -> IO ()
bindNull :: StmtHandle -> Int -> SqlParamDirection -> SqlCDataType -> SqlDataType -> IO BindBuffer
bindParamCStringLen :: StmtHandle -> Int -> SqlParamDirection -> Maybe CStringLen -> Int -> IO BindBuffer
bindEncodedString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> (String -> ((Ptr a, Int) -> IO BindBuffer) -> IO BindBuffer) -> Int -> IO BindBuffer
bindParamUTF8String :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> Int -> IO BindBuffer
bindParamCAString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> Int -> IO BindBuffer
bindParamCWString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> Int -> IO BindBuffer
pokeSmallInt :: Ptr a -> Int -> SqlSmallInt -> IO ()
pokeUSmallInt :: Ptr a -> Int -> SqlUSmallInt -> IO ()
pokeUInteger :: Ptr a -> Int -> SqlUInteger -> IO ()
writeUTCTimeToMemory :: Ptr Word8 -> UTCTime -> IO ()
makeUtcTimeBuffer :: UTCTime -> IO BindBuffer
makeUtcTimeStringBuffer :: UTCTime -> IO BindBuffer
bindParamUtcTime :: StmtHandle -> Int -> SqlParamDirection -> Maybe UTCTime -> IO BindBuffer
sizeOfMaybe :: forall a . Storable a => Maybe a -> Int
newtype OutParam a = OutParam a
newtype InOutParam a = InOutParam a
class OdbcBindBuffer a where
bindColBuffer :: StmtHandle -> Int -> Int -> a -> IO BindBuffer
getFromBuffer :: BindBuffer -> IO a
getData :: StmtHandle -> Int -> IO a
class OdbcBindParam a where
bindParamBuffer :: StmtHandle -> Int -> a -> Int -> IO BindBuffer
sqlAllocHandle :: SqlHandleType -> Handle -> Ptr Handle -> IO SqlReturn
sqlFreeHandle :: SqlSmallInt -> Handle -> IO SqlReturn
sqlGetDiagRec :: SqlHandleType -> Handle -> SqlSmallInt -> MyCString -> Ptr SqlInteger -> MyCString -> SqlSmallInt -> Ptr SqlSmallInt -> IO SqlReturn
sqlDriverConnect :: ConnHdl -> WindowHandle -> MyCString -> SqlSmallInt -> MyCString -> SqlSmallInt -> Ptr SqlSmallInt -> SqlUSmallInt -> IO SqlReturn
sqlDisconnect :: ConnHdl -> IO SqlReturn
sqlSetEnvAttr :: EnvHandle -> SqlInteger -> Ptr () -> SqlInteger -> IO SqlReturn
sqlSetConnectAttr :: ConnHdl -> SqlInteger -> Ptr () -> SqlInteger -> IO SqlReturn
sqlPrepare :: StmtHdl -> MyCString -> SqlInteger -> IO SqlReturn
sqlBindParameter :: StmtHdl -> SqlUSmallInt -> SqlParamDirection -> SqlCDataType -> SqlDataType -> SqlULen -> SqlSmallInt -> Ptr Buffer -> SqlLen -> Ptr SqlLen -> IO SqlReturn
sqlExecute :: StmtHdl -> IO SqlReturn
sqlNumResultCols :: StmtHdl -> Ptr SqlSmallInt -> IO SqlReturn
sqlRowCount :: StmtHdl -> Ptr SqlLen -> IO SqlReturn
sqlDescribeCol :: StmtHdl -> SqlUSmallInt -> MyCString -> SqlSmallInt -> Ptr SqlSmallInt -> Ptr SqlDataType -> Ptr SqlULen -> Ptr SqlSmallInt -> Ptr SqlSmallInt -> IO SqlReturn
sqlBindCol :: StmtHdl -> SqlUSmallInt -> SqlDataType -> Ptr Buffer -> SqlLen -> Ptr SqlLen -> IO SqlReturn
sqlFetch :: StmtHdl -> IO SqlReturn
sqlGetData :: StmtHdl -> SqlUSmallInt -> SqlDataType -> Ptr Buffer -> SqlLen -> Ptr SqlLen -> IO SqlReturn
sqlCloseCursor :: StmtHdl -> IO SqlReturn
sqlMoreResults :: StmtHdl -> IO SqlReturn
sqlEndTran :: SqlSmallInt -> Handle -> SqlSmallInt -> IO SqlReturn
sqlGetInfo :: ConnHdl -> SqlInfoType -> Ptr Buffer -> SqlSmallInt -> Ptr SqlSmallInt -> IO SqlReturn
sqlNativeSql :: ConnHdl -> MyCString -> SqlInteger -> MyCString -> SqlInteger -> Ptr SqlInteger -> IO SqlReturn
Documentation
data HandleObj
Constructors
HandleObj
type Handle = Ptr HandleObj
data EnvObj
Constructors
EnvObj
type EnvHandle = Ptr EnvObj
data ConnObj
Constructors
ConnObj
type ConnHdl = Ptr ConnObj
data ConnHandle
Constructors
ConnHandle
connHdl :: ConnHdl
connDbms :: String
data StmtObj
Constructors
StmtObj
type StmtHdl = Ptr StmtObj
data StmtHandle
Constructors
StmtHandle
stmtHdl :: StmtHdl
stmtDbms :: String
type WindowHandle = Ptr ()
data Buffer
Constructors
Buffer
type BufferFPtr = ForeignPtr Buffer
type SizeFPtr = ForeignPtr SqlLen
type MyCString = CString
type MyCStringLen = CStringLen
data BindBuffer
Constructors
BindBuffer
bindBufPtr :: BufferFPtr
bindBufSzPtr :: SizeFPtr
bindBufSize :: SqlLen
type SqlInteger = Int32
type SqlUInteger = Word32
type SqlSmallInt = Int16
type SqlUSmallInt = Word16
type SqlLen = Int32
type SqlULen = Word32
type SqlReturn = SqlSmallInt
type SqlHandleType = SqlSmallInt
type SqlDataType = SqlSmallInt
type SqlCDataType = SqlSmallInt
type SqlParamDirection = SqlSmallInt
type SqlInfoType = SqlUSmallInt
sqlDriverNoPrompt :: SqlUSmallInt
sqlNullTermedString :: SqlInteger
sqlNullData :: SqlLen
sqlTransCommit :: SqlSmallInt
sqlTransRollback :: SqlSmallInt
sqlAutoCommitOn :: SqlInteger
sqlAutoCommitOff :: SqlInteger
data OdbcException
Constructors
OdbcException Int String String [OdbcException]
show/hide Instances
catchOdbc :: IO a -> (OdbcException -> IO a) -> IO a
throwOdbc :: OdbcException -> a
getDiagRec :: SqlReturn -> SqlHandleType -> Handle -> SqlSmallInt -> IO [OdbcException]
checkError :: SqlReturn -> SqlHandleType -> Handle -> IO ()
allocHdl :: Storable a => Handle -> SqlHandleType -> IO a
allocEnv :: IO EnvHandle
allocConn :: EnvHandle -> IO ConnHandle
allocStmt :: ConnHandle -> IO StmtHandle
freeHandle :: SqlHandleType -> Handle -> IO ()
freeEnv :: EnvHandle -> IO ()
freeConn :: ConnHandle -> IO ()
freeStmt :: StmtHandle -> IO ()
int2Ptr :: SqlInteger -> Ptr ()
setOdbcVer :: EnvHandle -> IO ()
connect :: ConnHandle -> String -> IO String
disconnect :: ConnHandle -> IO ()
prepareStmt :: StmtHandle -> String -> IO ()
executeStmt :: StmtHandle -> IO ()
closeCursor :: StmtHandle -> IO ()
rowCount :: StmtHandle -> IO Int
fetch :: StmtHandle -> IO Bool
Return True if there are more rows, False if end-of-data. +
moreResults :: StmtHandle -> IO Bool
Return True if there is another result-set to process. + Presumably the StmtHandle is modified to reference the + new result-set. +
commit :: ConnHandle -> IO ()
rollback :: ConnHandle -> IO ()
setAutoCommitOn :: ConnHandle -> IO ()
setAutoCommitOff :: ConnHandle -> IO ()
setTxnIsolation :: ConnHandle -> SqlInteger -> IO ()
getInfoString :: ConnHandle -> SqlInfoType -> IO String
getInfoDbmsName :: ConnHandle -> IO String
getInfoDbmsVer :: ConnHandle -> IO String
getInfoDatabaseName :: ConnHandle -> IO String
getInfoDriverName :: ConnHandle -> IO String
getInfoDriverVer :: ConnHandle -> IO String
getNativeSql :: ConnHandle -> String -> IO String
getMaybeFromBuffer :: Storable a => Ptr SqlLen -> Ptr a -> (Ptr a -> SqlLen -> IO b) -> IO (Maybe b)
getDataStorable :: Storable a => StmtHandle -> Int -> SqlDataType -> Int -> (a -> b) -> IO (Maybe b)
getDataUtcTime :: StmtHandle -> Int -> IO (Maybe UTCTime)
getDataCStringLen :: StmtHandle -> Int -> IO (Maybe CStringLen)
getDataUTF8String :: StmtHandle -> Int -> IO (Maybe String)
getDataCString :: StmtHandle -> Int -> IO (Maybe String)
peekSmallInt :: Ptr a -> Int -> IO SqlSmallInt
peekUSmallInt :: Ptr a -> Int -> IO SqlUSmallInt
peekUInteger :: Ptr a -> Int -> IO SqlUInteger
readUtcTimeFromMemory :: Ptr Word8 -> IO UTCTime
bindColumnBuffer :: StmtHandle -> Int -> SqlDataType -> SqlLen -> IO BindBuffer
createEmptyBuffer :: SqlLen -> IO BindBuffer
testForNull :: BindBuffer -> (Ptr Buffer -> SqlLen -> IO a) -> IO (Maybe a)
getStorableFromBuffer :: Storable a => BindBuffer -> IO (Maybe a)
getCAStringFromBuffer :: BindBuffer -> IO (Maybe String)
getCWStringFromBuffer :: BindBuffer -> IO (Maybe String)
getUTF8StringFromBuffer :: BindBuffer -> IO (Maybe String)
getUtcTimeFromBuffer :: BindBuffer -> IO (Maybe UTCTime)
createBufferForStorable :: Storable a => Maybe a -> IO BindBuffer
createBufferHelper :: Storable a => a -> SqlLen -> Int -> IO BindBuffer
wrapSizedBuffer :: Ptr a -> SqlLen -> Int -> IO BindBuffer
bindParam :: StmtHandle -> Int -> SqlParamDirection -> SqlCDataType -> SqlDataType -> SqlULen -> SqlSmallInt -> BindBuffer -> IO ()
bindNull :: StmtHandle -> Int -> SqlParamDirection -> SqlCDataType -> SqlDataType -> IO BindBuffer
bindParamCStringLen :: StmtHandle -> Int -> SqlParamDirection -> Maybe CStringLen -> Int -> IO BindBuffer
bindEncodedString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> (String -> ((Ptr a, Int) -> IO BindBuffer) -> IO BindBuffer) -> Int -> IO BindBuffer
bindParamUTF8String :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> Int -> IO BindBuffer
bindParamCAString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> Int -> IO BindBuffer
bindParamCWString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> Int -> IO BindBuffer
pokeSmallInt :: Ptr a -> Int -> SqlSmallInt -> IO ()
pokeUSmallInt :: Ptr a -> Int -> SqlUSmallInt -> IO ()
pokeUInteger :: Ptr a -> Int -> SqlUInteger -> IO ()
writeUTCTimeToMemory :: Ptr Word8 -> UTCTime -> IO ()
makeUtcTimeBuffer :: UTCTime -> IO BindBuffer
makeUtcTimeStringBuffer :: UTCTime -> IO BindBuffer
bindParamUtcTime :: StmtHandle -> Int -> SqlParamDirection -> Maybe UTCTime -> IO BindBuffer
sizeOfMaybe :: forall a . Storable a => Maybe a -> Int
newtype OutParam a
Constructors
OutParam a
show/hide Instances
OdbcBindParam (OutParam (Maybe Double))
OdbcBindParam (OutParam (Maybe Int))
OdbcBindParam (OutParam (Maybe String))
OdbcBindParam (OutParam (Maybe UTCTime))
newtype InOutParam a
Constructors
InOutParam a
show/hide Instances
OdbcBindParam (InOutParam (Maybe Double))
OdbcBindParam (InOutParam (Maybe Int))
OdbcBindParam (InOutParam (Maybe String))
OdbcBindParam (InOutParam (Maybe UTCTime))
class OdbcBindBuffer a where
Methods
bindColBuffer
:: StmtHandlestmt handle +
-> Intcolumn position (1-indexed) +
-> Intsize of result buffer (ignored when it can be inferred from type of a) +
-> adummy value of the appropriate type (just to ensure we get the right class instance) +
-> IO BindBufferreturns a BindBuffer object +
getFromBuffer :: BindBuffer -> IO a
getData :: StmtHandle -> Int -> IO a
show/hide Instances
OdbcBindBuffer (Maybe Double)
OdbcBindBuffer (Maybe Int)
OdbcBindBuffer (Maybe String)
OdbcBindBuffer (Maybe UTCTime)
class OdbcBindParam a where
Methods
bindParamBuffer
:: StmtHandlestmt handle +
-> Intparameter position (1-indexed) +
-> avalue to write to buffer +
-> Intsize of buffer, for output. + Value is ignored if input only (buffer will be sized to exactly hold input only) + or size is fixed by type (e.g. Int, Double) +
-> IO BindBufferreturns a BindBuffer object +
show/hide Instances
OdbcBindParam (InOutParam (Maybe Double))
OdbcBindParam (InOutParam (Maybe Int))
OdbcBindParam (InOutParam (Maybe String))
OdbcBindParam (InOutParam (Maybe UTCTime))
OdbcBindParam (Maybe Double)
OdbcBindParam (Maybe Int)
OdbcBindParam (Maybe String)
OdbcBindParam (Maybe UTCTime)
OdbcBindParam (OutParam (Maybe Double))
OdbcBindParam (OutParam (Maybe Int))
OdbcBindParam (OutParam (Maybe String))
OdbcBindParam (OutParam (Maybe UTCTime))
sqlAllocHandle :: SqlHandleType -> Handle -> Ptr Handle -> IO SqlReturn
sqlFreeHandle :: SqlSmallInt -> Handle -> IO SqlReturn
sqlGetDiagRec
:: SqlHandleTypeenum: which handle type is the next parameter? +
-> Handlegeneric handle ptr +
-> SqlSmallIntrow (or message) number +
-> MyCStringOUT: state +
-> Ptr SqlIntegerOUT: error number +
-> MyCStringOUT: error message +
-> SqlSmallIntIN: message buffer size +
-> Ptr SqlSmallIntOUT: message length +
-> IO SqlReturn
sqlDriverConnect
:: ConnHdl
-> WindowHandlejust pass nullPtr +
-> MyCStringconnection string +
-> SqlSmallIntconnection string size +
-> MyCStringOUT: buffer for normalised connection string +
-> SqlSmallIntbuffer size +
-> Ptr SqlSmallIntOUT: length of returned string +
-> SqlUSmallIntenum: should driver prompt user for missing info? +
-> IO SqlReturn
sqlDisconnect :: ConnHdl -> IO SqlReturn
sqlSetEnvAttr
:: EnvHandleEnv Handle +
-> SqlIntegerAttribute (enumeration) +
-> Ptr ()value (cast to void*) +
-> SqlInteger? - set to 0 +
-> IO SqlReturn
sqlSetConnectAttr
:: ConnHdlConnection Handle +
-> SqlIntegerAttribute (enumeration) +
-> Ptr ()value (cast to void*) +
-> SqlInteger? - set to 0 +
-> IO SqlReturn
sqlPrepare :: StmtHdl -> MyCString -> SqlInteger -> IO SqlReturn
sqlBindParameter
:: StmtHdl
-> SqlUSmallIntposition, 1-indexed +
-> SqlParamDirectiondirection: IN, OUT +
-> SqlCDataTypeC data type: char, int, long, float, etc +
-> SqlDataTypeSQL data type: string, int, long, date, etc +
-> SqlULencol size (precision) +
-> SqlSmallIntdecimal digits (scale) +
-> Ptr Bufferinput+output buffer +
-> SqlLenbuffer size +
-> Ptr SqlLeninput+output data size, or -1 (SQL_NULL_DATA) for null +
-> IO SqlReturn
sqlExecute :: StmtHdl -> IO SqlReturn
sqlNumResultCols :: StmtHdl -> Ptr SqlSmallInt -> IO SqlReturn
sqlRowCount :: StmtHdl -> Ptr SqlLen -> IO SqlReturn
sqlDescribeCol
:: StmtHdl
-> SqlUSmallIntposition, 1-indexed +
-> MyCStringbuffer for column name +
-> SqlSmallIntsize of column name buffer +
-> Ptr SqlSmallIntsize of column name output string +
-> Ptr SqlDataTypeSQL data type: string, int, long, date, etc +
-> Ptr SqlULencol size (precision) +
-> Ptr SqlSmallIntdecimal digits (scale) +
-> Ptr SqlSmallIntnullable: SQL_NO_NULLS, SQL_NULLABLE, or SQL_NULLABLE_UNKNOWN +
-> IO SqlReturn
sqlBindCol
:: StmtHdl
-> SqlUSmallIntcolumn position, 1-indexed +
-> SqlDataTypeSQL data type: string, int, long, date, etc +
-> Ptr Bufferoutput buffer +
-> SqlLenoutput buffer size +
-> Ptr SqlLenoutput data size, or -1 (SQL_NULL_DATA) for null +
-> IO SqlReturn
sqlFetch :: StmtHdl -> IO SqlReturn
sqlGetData
:: StmtHdl
-> SqlUSmallIntcolumn position, 1-indexed +
-> SqlDataTypeSQL data type: string, int, long, date, etc +
-> Ptr Bufferoutput buffer +
-> SqlLenoutput buffer size +
-> Ptr SqlLenoutput data size, or -1 (SQL_NULL_DATA) for null +
-> IO SqlReturn
sqlCloseCursor :: StmtHdl -> IO SqlReturn
sqlMoreResults :: StmtHdl -> IO SqlReturn
sqlEndTran :: SqlSmallInt -> Handle -> SqlSmallInt -> IO SqlReturn
sqlGetInfo
:: ConnHdl
-> SqlInfoTypeinformation type +
-> Ptr Bufferoutput buffer +
-> SqlSmallIntoutput buffer size +
-> Ptr SqlSmallIntoutput data size, or -1 (SQL_NULL_DATA) for null +
-> IO SqlReturn
sqlNativeSql
:: ConnHdl
-> MyCStringsql text in +
-> SqlIntegersize of sql text +
-> MyCStringbuffer for output text +
-> SqlIntegersize of output buffer +
-> Ptr SqlIntegersize of text in output buffer +
-> IO SqlReturn
Produced by Haddock version 0.7
diff --git a/doc/html/Database-Oracle-Enumerator.html b/doc/html/Database-Oracle-Enumerator.html new file mode 100644 --- /dev/null +++ b/doc/html/Database-Oracle-Enumerator.html @@ -0,0 +1,966 @@ + + +Database.Oracle.Enumerator
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Database.Oracle.Enumerator
Portabilitynon-portable
Stabilityexperimental
Maintaineroleg@pobox.com, alistair@abayley.org
Description
Oracle OCI implementation of Database.Enumerator. +
Synopsis
data Session
connect :: String -> String -> String -> ConnectA Session
prepareStmt :: QueryString -> PreparationA Session PreparedStmtObj
preparePrefetch :: Int -> QueryString -> PreparationA Session PreparedStmtObj
prepareQuery :: QueryString -> PreparationA Session PreparedStmtObj
prepareLargeQuery :: Int -> QueryString -> PreparationA Session PreparedStmtObj
prepareCommand :: QueryString -> PreparationA Session PreparedStmtObj
prepareLargeCommand :: Int -> QueryString -> PreparationA Session PreparedStmtObj
sql :: String -> QueryString
sqlbind :: String -> [BindA Session PreparedStmtObj BindObj] -> QueryStringTuned
prefetch :: Int -> String -> [BindA Session PreparedStmtObj BindObj] -> QueryStringTuned
cmdbind :: String -> [BindA Session PreparedStmtObj BindObj] -> CommandBind
type StmtHandle = Ptr StmtStruct
newtype Out a = Out a
module Database.Enumerator
Documentation
data Session
show/hide Instances
ISession Session
Typeable Session
Command BoundStmt Session
Command CommandBind Session
Command QueryString Session
Command String Session
IQuery Query Session ColumnBuffer
Statement BoundStmt Session Query
Statement PreparedStmtObj Session Query
Statement QueryString Session Query
Statement QueryStringTuned Session Query
Statement String Session Query
DBBind (Maybe a) Session PreparedStmtObj BindObj => DBBind a Session PreparedStmtObj BindObj
IPrepared PreparedStmtObj Session BoundStmt BindObj
Statement (RefCursor StmtHandle) Session Query
DBBind (Maybe CalendarTime) Session PreparedStmtObj BindObj
DBBind (Maybe Double) Session PreparedStmtObj BindObj
DBBind (Maybe Int) Session PreparedStmtObj BindObj
DBBind (Maybe String) Session PreparedStmtObj BindObj
DBBind (Maybe UTCTime) Session PreparedStmtObj BindObj
Show a => DBBind (Maybe a) Session PreparedStmtObj BindObj
DBBind (Out (Maybe Double)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe Int)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe StmtHandle)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe String)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe UTCTime)) Session PreparedStmtObj BindObj
Show a => DBBind (Out (Maybe a)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe a)) Session PreparedStmtObj BindObj => DBBind (Out a) Session PreparedStmtObj BindObj
Statement (NextResultSet mark PreparedStmtObj) Session Query
connect :: String -> String -> String -> ConnectA Session
prepareStmt :: QueryString -> PreparationA Session PreparedStmtObj
preparePrefetch :: Int -> QueryString -> PreparationA Session PreparedStmtObj
prepareQuery :: QueryString -> PreparationA Session PreparedStmtObj
prepareLargeQuery :: Int -> QueryString -> PreparationA Session PreparedStmtObj
prepareCommand :: QueryString -> PreparationA Session PreparedStmtObj
prepareLargeCommand :: Int -> QueryString -> PreparationA Session PreparedStmtObj
Seems like an odd alternative to prepareCommand (what is a large command?) + but is actually useful for when the outer query it a procedure call that + returns one or more cursors. The prefetch count for the inner cursors is + inherited from the outer statement, which in this case is a command, rather + than a select. Normally prefetch would be irrelevant (and indeed it is for + the outer command), but we also save it in the statement so that it can be + reused for the child cursors. +
sql :: String -> QueryString
sqlbind :: String -> [BindA Session PreparedStmtObj BindObj] -> QueryStringTuned
prefetch :: Int -> String -> [BindA Session PreparedStmtObj BindObj] -> QueryStringTuned
cmdbind :: String -> [BindA Session PreparedStmtObj BindObj] -> CommandBind
type StmtHandle = Ptr StmtStruct
newtype Out a
Constructors
Out a
show/hide Instances
DBBind (Out (Maybe Double)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe Int)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe StmtHandle)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe String)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe UTCTime)) Session PreparedStmtObj BindObj
Show a => DBBind (Out (Maybe a)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe a)) Session PreparedStmtObj BindObj => DBBind (Out a) Session PreparedStmtObj BindObj
module Database.Enumerator
Produced by Haddock version 0.7
diff --git a/doc/html/Database-Oracle-OCIConstants.html b/doc/html/Database-Oracle-OCIConstants.html new file mode 100644 --- /dev/null +++ b/doc/html/Database-Oracle-OCIConstants.html @@ -0,0 +1,1059 @@ + + +Database.Oracle.OCIConstants
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Database.Oracle.OCIConstants
Portabilitynon-portable
Stabilityexperimental
Maintaineroleg@pobox.com, alistair@abayley.org
Contents
Used all over the place: +
Handle types: +
Error code types: +
Attribute types: +
Authentication options: +
Syntax types (i.e. does the DBMS understand v7 or v8 syntax, etc): +
Scrollable Cursor Options: +
OCI datatypes: +
Transaction types; parameters for ociTransStart. +
Description
Contains CInt equivalents of the #defines in the oci library headers. + This is not a complete set; just enough to get the Haskell libraries working. + This also might not be particularly portable, but I don't think Oracle are going + to change these in a hurry (that would break compiled programs, wouldn't it?). +
Synopsis
oci_DEFAULT :: CInt
oci_CRED_RDBMS :: CInt
oci_CRED_EXT :: CInt
oci_CRED_PROXY :: CInt
oci_NTV_SYNTAX :: CInt
oci_FETCH_NEXT :: CInt
oci_FETCH_FIRST :: CInt
oci_FETCH_LAST :: CInt
oci_FETCH_PRIOR :: CInt
oci_FETCH_ABSOLUTE :: CInt
oci_FETCH_RELATIVE :: CInt
oci_FETCH_RESERVED :: CInt
oci_SQLT_CHR :: CInt
oci_SQLT_NUM :: CInt
oci_SQLT_INT :: CInt
oci_SQLT_FLT :: CInt
oci_SQLT_STR :: CInt
oci_SQLT_VNU :: CInt
oci_SQLT_LNG :: CInt
oci_SQLT_VCS :: CInt
oci_SQLT_RID :: CInt
oci_SQLT_DAT :: CInt
oci_SQLT_VBI :: CInt
oci_SQLT_BIN :: CInt
oci_SQLT_LBI :: CInt
oci_SQLT_UIN :: CInt
oci_SQLT_LVC :: CInt
oci_SQLT_LVB :: CInt
oci_SQLT_AFC :: CInt
oci_SQLT_AVC :: CInt
oci_SQLT_RSET :: CInt
oci_TRANS_READONLY :: CInt
oci_TRANS_READWRITE :: CInt
oci_TRANS_SERIALIZABLE :: CInt
Used all over the place: +
oci_DEFAULT :: CInt
Handle types: +
Error code types: +
Attribute types: +
Authentication options: +
oci_CRED_RDBMS :: CInt
Found in $ORAHOME/oci/include/oci.h +
oci_CRED_EXT :: CInt
oci_CRED_PROXY :: CInt
Syntax types (i.e. does the DBMS understand v7 or v8 syntax, etc): +
oci_NTV_SYNTAX :: CInt
Found in $ORAHOME/oci/include/oci.h +
Scrollable Cursor Options: +
oci_FETCH_NEXT :: CInt
Found in $ORAHOME/oci/include/oci.h +
oci_FETCH_FIRST :: CInt
oci_FETCH_LAST :: CInt
oci_FETCH_PRIOR :: CInt
oci_FETCH_ABSOLUTE :: CInt
oci_FETCH_RELATIVE :: CInt
oci_FETCH_RESERVED :: CInt
OCI datatypes: +
oci_SQLT_CHR :: CInt
Found in $ORAHOME/oci/include/ocidfn.h +
oci_SQLT_NUM :: CInt
oci_SQLT_INT :: CInt
oci_SQLT_FLT :: CInt
oci_SQLT_STR :: CInt
oci_SQLT_VNU :: CInt
oci_SQLT_LNG :: CInt
oci_SQLT_VCS :: CInt
oci_SQLT_RID :: CInt
oci_SQLT_DAT :: CInt
oci_SQLT_VBI :: CInt
oci_SQLT_BIN :: CInt
oci_SQLT_LBI :: CInt
oci_SQLT_UIN :: CInt
oci_SQLT_LVC :: CInt
oci_SQLT_LVB :: CInt
oci_SQLT_AFC :: CInt
oci_SQLT_AVC :: CInt
oci_SQLT_RSET :: CInt
Transaction types; parameters for ociTransStart. +
oci_TRANS_READONLY :: CInt
Found in $ORAHOME/oci/include/oci.h. + There are more than this, but they're related to complicated + transaction-management stuff in the OCI libraries that I don't understand. + These should be sufficient to support the simple transaction model + understood by most developers. +
oci_TRANS_READWRITE :: CInt
oci_TRANS_SERIALIZABLE :: CInt
Produced by Haddock version 0.7
diff --git a/doc/html/Database-Oracle-OCIFunctions.html b/doc/html/Database-Oracle-OCIFunctions.html new file mode 100644 --- /dev/null +++ b/doc/html/Database-Oracle-OCIFunctions.html @@ -0,0 +1,4524 @@ + + +Database.Oracle.OCIFunctions
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Database.Oracle.OCIFunctions
Portabilitynon-portable
Stabilityexperimental
Maintaineroleg@pobox.com, alistair@abayley.org
Description

Simple wrappers for OCI functions (FFI). +

The functions in this file are simple wrappers for OCI functions. + The wrappers add error detection and exceptions; + functions in this module raise OCIException. + The next layer up traps these and turns them into DBException. +

Note that OCIException does not contain the error number and text + returned by getOCIErrorMsg. + It is the job of the next layer (module) up to catch the OCIException + and then call getOCIErrorMsg to get the actual error details. + The OCIException simply contains the error number returned by + the OCI call, and some text identifying the wrapper function. + See formatErrorCodeDesc for the set of possible values for the OCI error numbers. +

Synopsis
data OCIStruct = OCIStruct
type OCIHandle = Ptr OCIStruct
data OCIBuffer = OCIBuffer
type BufferPtr = Ptr OCIBuffer
type BufferFPtr = ForeignPtr OCIBuffer
type ColumnResultBuffer = ForeignPtr OCIBuffer
type BindBuffer = (ForeignPtr CShort, ForeignPtr OCIBuffer, ForeignPtr CUShort)
data Context = Context
type ContextPtr = Ptr Context
data EnvStruct = EnvStruct
type EnvHandle = Ptr EnvStruct
data ErrorStruct = ErrorStruct
type ErrorHandle = Ptr ErrorStruct
data ServerStruct = ServerStruct
type ServerHandle = Ptr ServerStruct
data UserStruct = UserStruct
type UserHandle = Ptr UserStruct
data ConnStruct = ConnStruct
type ConnHandle = Ptr ConnStruct
data SessStruct = SessStruct
type SessHandle = Ptr SessStruct
data StmtStruct = StmtStruct
type StmtHandle = Ptr StmtStruct
data DefnStruct = DefnStruct
type DefnHandle = Ptr DefnStruct
data ParamStruct = ParamStruct
type ParamHandle = Ptr ParamStruct
data BindStruct = BindStruct
type BindHandle = Ptr BindStruct
type ColumnInfo = (DefnHandle, ColumnResultBuffer, ForeignPtr CShort, ForeignPtr CUShort)
data OCIException = OCIException CInt String
catchOCI :: IO a -> (OCIException -> IO a) -> IO a
throwOCI :: OCIException -> a
mkCInt :: Int -> CInt
mkCShort :: CInt -> CShort
mkCUShort :: CInt -> CUShort
cStrLen :: CStringLen -> CInt
cStr :: CStringLen -> CString
ociEnvCreate :: Ptr EnvHandle -> CInt -> Ptr a -> FunPtr a -> FunPtr a -> FunPtr a -> CInt -> Ptr (Ptr a) -> IO CInt
ociHandleAlloc :: OCIHandle -> Ptr OCIHandle -> CInt -> CInt -> Ptr a -> IO CInt
ociHandleFree :: OCIHandle -> CInt -> IO CInt
ociErrorGet :: OCIHandle -> CInt -> CString -> Ptr CInt -> CString -> CInt -> CInt -> IO CInt
ociParamGet :: OCIHandle -> CInt -> ErrorHandle -> Ptr OCIHandle -> CInt -> IO CInt
ociAttrGet :: OCIHandle -> CInt -> BufferPtr -> Ptr CInt -> CInt -> ErrorHandle -> IO CInt
ociAttrSet :: OCIHandle -> CInt -> BufferPtr -> CInt -> CInt -> ErrorHandle -> IO CInt
ociLogon :: EnvHandle -> ErrorHandle -> Ptr ConnHandle -> CString -> CInt -> CString -> CInt -> CString -> CInt -> IO CInt
ociLogoff :: ConnHandle -> ErrorHandle -> IO CInt
ociSessionBegin :: ConnHandle -> ErrorHandle -> SessHandle -> CInt -> CInt -> IO CInt
ociSessionEnd :: ConnHandle -> ErrorHandle -> SessHandle -> CInt -> IO CInt
ociServerAttach :: ServerHandle -> ErrorHandle -> CString -> CInt -> CInt -> IO CInt
ociServerDetach :: ServerHandle -> ErrorHandle -> CInt -> IO CInt
ociTerminate :: CInt -> IO CInt
ociTransStart :: ConnHandle -> ErrorHandle -> Word8 -> CInt -> IO CInt
ociTransCommit :: ConnHandle -> ErrorHandle -> CInt -> IO CInt
ociTransRollback :: ConnHandle -> ErrorHandle -> CInt -> IO CInt
ociStmtPrepare :: StmtHandle -> ErrorHandle -> CString -> CInt -> CInt -> CInt -> IO CInt
ociDefineByPos :: StmtHandle -> Ptr DefnHandle -> ErrorHandle -> CInt -> BufferPtr -> CInt -> CUShort -> Ptr CShort -> Ptr CUShort -> Ptr CUShort -> CInt -> IO CInt
ociStmtExecute :: ConnHandle -> StmtHandle -> ErrorHandle -> CInt -> CInt -> OCIHandle -> OCIHandle -> CInt -> IO CInt
ociStmtFetch :: StmtHandle -> ErrorHandle -> CInt -> CShort -> CInt -> IO CInt
ociBindByPos :: StmtHandle -> Ptr BindHandle -> ErrorHandle -> CUInt -> BufferPtr -> CInt -> CUShort -> Ptr CShort -> Ptr CUShort -> Ptr CUShort -> CUInt -> Ptr CUInt -> CUInt -> IO CInt
ociBindDynamic :: BindHandle -> ErrorHandle -> ContextPtr -> FunPtr OCICallbackInBind -> ContextPtr -> FunPtr OCICallbackOutBind -> IO CInt
type OCICallbackInBind = ContextPtr -> BindHandle -> CInt -> CInt -> Ptr BufferPtr -> CInt -> Ptr Word8 -> Ptr CShort -> IO CInt
type OCICallbackOutBind = ContextPtr -> BindHandle -> CInt -> CInt -> Ptr BufferPtr -> Ptr CInt -> Ptr Word8 -> Ptr CShort -> Ptr (Ptr CShort) -> IO CInt
mkOCICallbackInBind :: OCICallbackInBind -> IO (FunPtr OCICallbackInBind)
mkOCICallbackOutBind :: OCICallbackOutBind -> IO (FunPtr OCICallbackOutBind)
getOCIErrorMsg2 :: OCIHandle -> CInt -> Ptr CInt -> CString -> CInt -> IO (CInt, String)
getOCIErrorMsg :: OCIHandle -> CInt -> IO (CInt, String)
fromEnumOCIErrorCode :: CInt -> String
formatErrorCodeDesc :: CInt -> String -> String
formatOCIMsg :: CInt -> String -> OCIHandle -> CInt -> IO (Int, String)
formatMsgCommon :: OCIException -> OCIHandle -> CInt -> IO (Int, String)
formatErrorMsg :: OCIException -> ErrorHandle -> IO (Int, String)
formatEnvMsg :: OCIException -> EnvHandle -> IO (Int, String)
testForError :: CInt -> String -> a -> IO a
testForErrorWithPtr :: Storable a => CInt -> String -> Ptr a -> IO a
envCreate :: IO EnvHandle
handleAlloc :: CInt -> OCIHandle -> IO OCIHandle
handleFree :: CInt -> OCIHandle -> IO ()
setHandleAttr :: ErrorHandle -> OCIHandle -> CInt -> Ptr a -> CInt -> IO ()
setHandleAttrString :: ErrorHandle -> OCIHandle -> CInt -> String -> CInt -> IO ()
getHandleAttr :: Storable a => ErrorHandle -> OCIHandle -> CInt -> CInt -> IO a
getParam :: ErrorHandle -> StmtHandle -> Int -> IO ParamHandle
dbLogon :: String -> String -> String -> EnvHandle -> ErrorHandle -> IO ConnHandle
dbLogoff :: ErrorHandle -> ConnHandle -> IO ()
terminate :: IO ()
serverDetach :: ErrorHandle -> ServerHandle -> IO ()
serverAttach :: ErrorHandle -> ServerHandle -> String -> IO ()
getSession :: ErrorHandle -> ConnHandle -> IO SessHandle
sessionBegin :: ErrorHandle -> ConnHandle -> SessHandle -> CInt -> IO ()
sessionEnd :: ErrorHandle -> ConnHandle -> SessHandle -> IO ()
beginTrans :: ErrorHandle -> ConnHandle -> CInt -> IO ()
commitTrans :: ErrorHandle -> ConnHandle -> IO ()
rollbackTrans :: ErrorHandle -> ConnHandle -> IO ()
stmtPrepare :: ErrorHandle -> StmtHandle -> String -> IO ()
stmtExecute :: ErrorHandle -> ConnHandle -> StmtHandle -> Int -> IO ()
defineByPos :: ErrorHandle -> StmtHandle -> Int -> Int -> CInt -> IO ColumnInfo
sbph :: String -> Int -> Bool -> String -> String
bindByPos :: ErrorHandle -> StmtHandle -> Int -> CShort -> BufferPtr -> Int -> CInt -> IO ()
bindOutputByPos :: ErrorHandle -> StmtHandle -> Int -> BindBuffer -> Int -> CInt -> IO BindHandle
stmtFetch :: ErrorHandle -> StmtHandle -> IO CInt
maybeBufferNull :: ForeignPtr CShort -> Maybe a -> IO a -> IO (Maybe a)
nullByte :: CChar
cShort2Int :: CShort -> Int
cUShort2Int :: CUShort -> Int
cuCharToInt :: CUChar -> Int
byteToInt :: Ptr CUChar -> Int -> IO Int
bufferToString :: ColumnInfo -> IO (Maybe String)
makeYear :: Int -> Int -> Int
makeYearByte :: Int -> Word8
makeCentByte :: Int -> Word8
dumpBuffer :: Ptr Word8 -> IO ()
bufferToCaltime :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CalendarTime)
bufferToUTCTime :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe UTCTime)
setBufferByte :: BufferPtr -> Int -> Word8 -> IO ()
calTimeToBuffer :: BufferPtr -> CalendarTime -> IO ()
utcTimeToBuffer :: BufferPtr -> UTCTime -> IO ()
bufferPeekValue :: Storable a => BufferFPtr -> IO a
bufferToA :: Storable a => ForeignPtr CShort -> BufferFPtr -> IO (Maybe a)
bufferToCInt :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CInt)
bufferToInt :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe Int)
bufferToCDouble :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CDouble)
bufferToDouble :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe Double)
bufferToStmtHandle :: BufferFPtr -> IO StmtHandle
Documentation
data OCIStruct
  • Each handle type has its own data type, to prevent stupid errors + i.e. using the wrong handle at the wrong time. +
  • In GHC you can simply say data OCIStruct i.e. there's no need for = OCIStruct. + I've decided to be more portable, as it doesn't cost much. +
  • Use castPtr if you need to convert handles (say OCIHandle to a more specific type, or vice versa). +
Constructors
OCIStruct
type OCIHandle = Ptr OCIStruct
data OCIBuffer
Constructors
OCIBuffer
type BufferPtr = Ptr OCIBuffer
type BufferFPtr = ForeignPtr OCIBuffer
type ColumnResultBuffer = ForeignPtr OCIBuffer
type BindBuffer = (ForeignPtr CShort, ForeignPtr OCIBuffer, ForeignPtr CUShort)
data Context
Constructors
Context
type ContextPtr = Ptr Context
data EnvStruct
Constructors
EnvStruct
type EnvHandle = Ptr EnvStruct
data ErrorStruct
Constructors
ErrorStruct
type ErrorHandle = Ptr ErrorStruct
data ServerStruct
Constructors
ServerStruct
type ServerHandle = Ptr ServerStruct
data UserStruct
Constructors
UserStruct
type UserHandle = Ptr UserStruct
data ConnStruct
Constructors
ConnStruct
type ConnHandle = Ptr ConnStruct
data SessStruct
Constructors
SessStruct
type SessHandle = Ptr SessStruct
data StmtStruct
Constructors
StmtStruct
type StmtHandle = Ptr StmtStruct
data DefnStruct
Constructors
DefnStruct
type DefnHandle = Ptr DefnStruct
data ParamStruct
Constructors
ParamStruct
type ParamHandle = Ptr ParamStruct
data BindStruct
Constructors
BindStruct
type BindHandle = Ptr BindStruct
type ColumnInfo = (DefnHandle, ColumnResultBuffer, ForeignPtr CShort, ForeignPtr CUShort)
data OCIException
Low-level, OCI library errors. +
Constructors
OCIException CInt String
show/hide Instances
catchOCI :: IO a -> (OCIException -> IO a) -> IO a
throwOCI :: OCIException -> a
mkCInt :: Int -> CInt
mkCShort :: CInt -> CShort
mkCUShort :: CInt -> CUShort
cStrLen :: CStringLen -> CInt
cStr :: CStringLen -> CString
ociEnvCreate :: Ptr EnvHandle -> CInt -> Ptr a -> FunPtr a -> FunPtr a -> FunPtr a -> CInt -> Ptr (Ptr a) -> IO CInt
ociHandleAlloc :: OCIHandle -> Ptr OCIHandle -> CInt -> CInt -> Ptr a -> IO CInt
ociHandleFree :: OCIHandle -> CInt -> IO CInt
ociErrorGet :: OCIHandle -> CInt -> CString -> Ptr CInt -> CString -> CInt -> CInt -> IO CInt
ociParamGet :: OCIHandle -> CInt -> ErrorHandle -> Ptr OCIHandle -> CInt -> IO CInt
ociAttrGet :: OCIHandle -> CInt -> BufferPtr -> Ptr CInt -> CInt -> ErrorHandle -> IO CInt
ociAttrSet :: OCIHandle -> CInt -> BufferPtr -> CInt -> CInt -> ErrorHandle -> IO CInt
ociLogon :: EnvHandle -> ErrorHandle -> Ptr ConnHandle -> CString -> CInt -> CString -> CInt -> CString -> CInt -> IO CInt
ociLogoff :: ConnHandle -> ErrorHandle -> IO CInt
ociSessionBegin :: ConnHandle -> ErrorHandle -> SessHandle -> CInt -> CInt -> IO CInt
ociSessionEnd :: ConnHandle -> ErrorHandle -> SessHandle -> CInt -> IO CInt
ociServerAttach :: ServerHandle -> ErrorHandle -> CString -> CInt -> CInt -> IO CInt
ociServerDetach :: ServerHandle -> ErrorHandle -> CInt -> IO CInt
ociTerminate :: CInt -> IO CInt
ociTransStart :: ConnHandle -> ErrorHandle -> Word8 -> CInt -> IO CInt
ociTransCommit :: ConnHandle -> ErrorHandle -> CInt -> IO CInt
ociTransRollback :: ConnHandle -> ErrorHandle -> CInt -> IO CInt
ociStmtPrepare :: StmtHandle -> ErrorHandle -> CString -> CInt -> CInt -> CInt -> IO CInt
ociDefineByPos :: StmtHandle -> Ptr DefnHandle -> ErrorHandle -> CInt -> BufferPtr -> CInt -> CUShort -> Ptr CShort -> Ptr CUShort -> Ptr CUShort -> CInt -> IO CInt
ociStmtExecute :: ConnHandle -> StmtHandle -> ErrorHandle -> CInt -> CInt -> OCIHandle -> OCIHandle -> CInt -> IO CInt
ociStmtFetch :: StmtHandle -> ErrorHandle -> CInt -> CShort -> CInt -> IO CInt
ociBindByPos :: StmtHandle -> Ptr BindHandle -> ErrorHandle -> CUInt -> BufferPtr -> CInt -> CUShort -> Ptr CShort -> Ptr CUShort -> Ptr CUShort -> CUInt -> Ptr CUInt -> CUInt -> IO CInt
ociBindDynamic :: BindHandle -> ErrorHandle -> ContextPtr -> FunPtr OCICallbackInBind -> ContextPtr -> FunPtr OCICallbackOutBind -> IO CInt
type OCICallbackInBind = ContextPtr -> BindHandle -> CInt -> CInt -> Ptr BufferPtr -> CInt -> Ptr Word8 -> Ptr CShort -> IO CInt
type OCICallbackOutBind = ContextPtr -> BindHandle -> CInt -> CInt -> Ptr BufferPtr -> Ptr CInt -> Ptr Word8 -> Ptr CShort -> Ptr (Ptr CShort) -> IO CInt
mkOCICallbackInBind :: OCICallbackInBind -> IO (FunPtr OCICallbackInBind)
mkOCICallbackOutBind :: OCICallbackOutBind -> IO (FunPtr OCICallbackOutBind)
getOCIErrorMsg2 :: OCIHandle -> CInt -> Ptr CInt -> CString -> CInt -> IO (CInt, String)
This is just an auxiliary function for getOCIErrorMsg. +
getOCIErrorMsg :: OCIHandle -> CInt -> IO (CInt, String)
fromEnumOCIErrorCode :: CInt -> String
formatErrorCodeDesc :: CInt -> String -> String
formatOCIMsg :: CInt -> String -> OCIHandle -> CInt -> IO (Int, String)
Given the two parts of an OCIException (the error number and text) + get the actual error message from the DBMS and construct an error message + from all of these pieces. +
formatMsgCommon :: OCIException -> OCIHandle -> CInt -> IO (Int, String)
We have two format functions: formatEnvMsg takes the EnvHandle, + formatErrorMsg takes the ErrorHandle. + They're just type-safe wrappers for formatMsgCommon. +
formatErrorMsg :: OCIException -> ErrorHandle -> IO (Int, String)
formatEnvMsg :: OCIException -> EnvHandle -> IO (Int, String)
testForError :: CInt -> String -> a -> IO a

The testForError functions are the only places where OCIException is thrown, + so if you want to change or embellish it, your changes will be localised here. + These functions factor out common error handling code + from the OCI wrapper functions that follow. +

Typically an OCI wrapper function would look like: +

 handleAlloc handleType env = alloca ptr -> do
+   rc <- ociHandleAlloc env ptr handleType 0 nullPtr
+   if rc < 0
+     then throwOCI (OCIException rc msg)
+     else return ()
+

where the code from if rc < 0 onwards was identical. + testForError replaces the code from if rc < 0 ... onwards. +

testForErrorWithPtr :: Storable a => CInt -> String -> Ptr a -> IO a
Like testForError but when the value you want to return + is at the end of a pointer. + Either there was an error, in which case the pointer probably isn't valid, + or there is something at the end of the pointer to return. + See dbLogon and getHandleAttr for example usage. +
envCreate :: IO EnvHandle
handleAlloc :: CInt -> OCIHandle -> IO OCIHandle
handleFree :: CInt -> OCIHandle -> IO ()
setHandleAttr :: ErrorHandle -> OCIHandle -> CInt -> Ptr a -> CInt -> IO ()
setHandleAttrString :: ErrorHandle -> OCIHandle -> CInt -> String -> CInt -> IO ()
getHandleAttr :: Storable a => ErrorHandle -> OCIHandle -> CInt -> CInt -> IO a
getParam :: ErrorHandle -> StmtHandle -> Int -> IO ParamHandle
dbLogon :: String -> String -> String -> EnvHandle -> ErrorHandle -> IO ConnHandle
The OCI Logon function doesn't behave as you'd expect when the password is due to expire. + ociLogon returns oci_SUCCESS_WITH_INFO, + but the ConnHandle returned is not valid. + In this case we have to change oci_SUCCESS_WITH_INFO + to oci_ERROR, + so that the error handling code will catch it and abort. + I don't know why the handle returned isn't valid, + as the logon process should be able to complete successfully in this case. +
dbLogoff :: ErrorHandle -> ConnHandle -> IO ()
terminate :: IO ()
serverDetach :: ErrorHandle -> ServerHandle -> IO ()
serverAttach :: ErrorHandle -> ServerHandle -> String -> IO ()
getSession :: ErrorHandle -> ConnHandle -> IO SessHandle
Having established a connection (Service Context), now get the Session. + You can have more than one session per connection, + but I haven't implemented it yet. +
sessionBegin :: ErrorHandle -> ConnHandle -> SessHandle -> CInt -> IO ()
sessionEnd :: ErrorHandle -> ConnHandle -> SessHandle -> IO ()
beginTrans :: ErrorHandle -> ConnHandle -> CInt -> IO ()
commitTrans :: ErrorHandle -> ConnHandle -> IO ()
rollbackTrans :: ErrorHandle -> ConnHandle -> IO ()
stmtPrepare :: ErrorHandle -> StmtHandle -> String -> IO ()

With the OCI you do queries with these steps: +

  • prepare your statement (it's just a String) - no communication with DBMS +
  • execute it (this sends it to the DBMS for parsing etc) +
  • allocate result set buffers by calling defineByPos for each column +
  • call fetch for each row. +
  • call handleFree for the StmtHandle + (I assume this is the approved way of terminating the query; + the OCI docs aren't explicit about this.) +
stmtExecute :: ErrorHandle -> ConnHandle -> StmtHandle -> Int -> IO ()
defineByPos
:: ErrorHandle
-> StmtHandle
-> IntPosition +
-> IntBuffer size in bytes +
-> CIntSQL Datatype (from Database.Oracle.OCIConstants) +
-> IO ColumnInfotuple: (DefnHandle, Ptr to buffer, Ptr to null indicator, Ptr to size of value in buffer) +

defineByPos allocates memory for a single column value. + The allocated components are: +

  • the result (i.e. value) - you have to say how big with bufsize. +
  • the null indicator (int16) +
  • the size of the returned data (int16) +

Previously it was the caller's responsibility to free the memory after they're done with it. + Now we use mallocForeignPtr, so manual memory management is hopefully + a thing of the past. + The caller will also have to cast the data in bufferptr to the expected type + (using castPtr). +

sbph :: String -> Int -> Bool -> String -> String
bindByPos
:: ErrorHandle
-> StmtHandle
-> IntPosition +
-> CShortNull ind: 0 == not null, -1 == null +
-> BufferPtrpayload +
-> Intpayload size in bytes +
-> CIntSQL Datatype (from Database.Oracle.OCIConstants) +
-> IO ()
bindOutputByPos
:: ErrorHandle
-> StmtHandle
-> IntPosition +
-> BindBuffertriple of (null-ind, payload, output-size) +
-> Intpayload input size in bytes +
-> CIntSQL Datatype (from Database.Oracle.OCIConstants) +
-> IO BindHandle
stmtFetch :: ErrorHandle -> StmtHandle -> IO CInt
Fetch a single row into the buffers. + If you have specified a prefetch count > 1 then the row + might already be cached by the OCI library. +
maybeBufferNull :: ForeignPtr CShort -> Maybe a -> IO a -> IO (Maybe a)
Short-circuit null test: if the buffer contains a null then return Nothing. + Otherwise, run the IO action to extract a value from the buffer and return Just it. +
nullByte :: CChar
cShort2Int :: CShort -> Int
cUShort2Int :: CUShort -> Int
cuCharToInt :: CUChar -> Int
byteToInt :: Ptr CUChar -> Int -> IO Int
bufferToString :: ColumnInfo -> IO (Maybe String)
makeYear :: Int -> Int -> Int

Oracle's excess-something-or-other encoding for years: + year = 100*(c - 100) + (y - 100), + c = (year div 100) + 100, + y = (year mod 100) + 100. +

+1999 -> 119, 199 + +0100 -> 101, 100 + +0001 -> 100, 101 + -0001 -> 100, 99 + -0100 -> 99, 100 + -1999 -> 81, 1 +

makeYearByte :: Int -> Word8
makeCentByte :: Int -> Word8
dumpBuffer :: Ptr Word8 -> IO ()
bufferToCaltime :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CalendarTime)
bufferToUTCTime :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe UTCTime)
setBufferByte :: BufferPtr -> Int -> Word8 -> IO ()
calTimeToBuffer :: BufferPtr -> CalendarTime -> IO ()
utcTimeToBuffer :: BufferPtr -> UTCTime -> IO ()
bufferPeekValue :: Storable a => BufferFPtr -> IO a
bufferToA :: Storable a => ForeignPtr CShort -> BufferFPtr -> IO (Maybe a)
bufferToCInt :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CInt)
bufferToInt :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe Int)
bufferToCDouble :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CDouble)
bufferToDouble :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe Double)
bufferToStmtHandle :: BufferFPtr -> IO StmtHandle
Produced by Haddock version 0.7
diff --git a/doc/html/Database-PostgreSQL-Enumerator.html b/doc/html/Database-PostgreSQL-Enumerator.html new file mode 100644 --- /dev/null +++ b/doc/html/Database-PostgreSQL-Enumerator.html @@ -0,0 +1,961 @@ + + +Database.PostgreSQL.Enumerator
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Database.PostgreSQL.Enumerator
Portabilitynon-portable
Stabilityexperimental
Maintaineroleg@pobox.com, alistair@abayley.org
Description
PostgreSQL implementation of Database.Enumerator. +
Synopsis
data Session
connect :: [ConnectAttr] -> ConnectA Session
data ConnectAttr
= CAhost String
| CAhostaddr String
| CAport String
| CAdbname String
| CAuser String
| CApassword String
| CAconnect_timeout Int
| CAoptions String
| CAsslmode String
| CAservice String
prepareStmt :: String -> QueryString -> [Oid] -> PreparationA Session PreparedStmtObj
preparePrefetch :: Int -> String -> QueryString -> [Oid] -> PreparationA Session PreparedStmtObj
prepareQuery :: String -> QueryString -> [Oid] -> PreparationA Session PreparedStmtObj
prepareLargeQuery :: Int -> String -> QueryString -> [Oid] -> PreparationA Session PreparedStmtObj
prepareCommand :: String -> QueryString -> [Oid] -> PreparationA Session PreparedStmtObj
sql :: String -> QueryString
sqlbind :: String -> [BindA Session PreparedStmtObj BindObj] -> QueryStringTuned
prefetch :: Int -> String -> [BindA Session PreparedStmtObj BindObj] -> QueryStringTuned
cmdbind :: String -> [BindA Session PreparedStmtObj BindObj] -> CommandBind
bindType :: PGType a => a -> Oid
module Database.Enumerator
Documentation
data Session
show/hide Instances
ISession Session
Typeable Session
Command BoundStmt Session
Command CommandBind Session
Command QueryString Session
Command String Session
IQuery Query Session ColumnBuffer
Statement BoundStmt Session Query
Statement QueryString Session Query
Statement QueryStringTuned Session Query
Statement String Session Query
DBBind (Maybe a) Session PreparedStmtObj BindObj => DBBind a Session PreparedStmtObj BindObj
IPrepared PreparedStmtObj Session BoundStmt BindObj
Statement (RefCursor String) Session Query
DBBind (Maybe Double) Session PreparedStmtObj BindObj
DBBind (Maybe Float) Session PreparedStmtObj BindObj
DBBind (Maybe Int) Session PreparedStmtObj BindObj
DBBind (Maybe Int64) Session PreparedStmtObj BindObj
DBBind (Maybe String) Session PreparedStmtObj BindObj
DBBind (Maybe UTCTime) Session PreparedStmtObj BindObj
Show a => DBBind (Maybe a) Session PreparedStmtObj BindObj
Statement (NextResultSet mark PreparedStmtObj) Session Query
connect :: [ConnectAttr] -> ConnectA Session
data ConnectAttr
Specify connection options to connect. + You only need to use whatever subset is relevant for your connection. +
Constructors
CAhost String
CAhostaddr String
CAport String
CAdbname String
CAuser String
CApassword String
CAconnect_timeout Int
CAoptions String
CAsslmode String
CAservice String
prepareStmt :: String -> QueryString -> [Oid] -> PreparationA Session PreparedStmtObj
preparePrefetch :: Int -> String -> QueryString -> [Oid] -> PreparationA Session PreparedStmtObj
prepareQuery :: String -> QueryString -> [Oid] -> PreparationA Session PreparedStmtObj
prepareLargeQuery :: Int -> String -> QueryString -> [Oid] -> PreparationA Session PreparedStmtObj
prepareCommand :: String -> QueryString -> [Oid] -> PreparationA Session PreparedStmtObj
sql :: String -> QueryString
The simplest kind of a statement: no tuning parameters, + all default, little overhead. +
sqlbind :: String -> [BindA Session PreparedStmtObj BindObj] -> QueryStringTuned
prefetch :: Int -> String -> [BindA Session PreparedStmtObj BindObj] -> QueryStringTuned
cmdbind :: String -> [BindA Session PreparedStmtObj BindObj] -> CommandBind
bindType :: PGType a => a -> Oid
bindType is useful when constructing the list of Oids for stmtPrepare. + You don't need to pass the actual bind values, just dummy values + of the same type (the value isn't used, so undefined is OK here). +
module Database.Enumerator
Produced by Haddock version 0.7
diff --git a/doc/html/Database-PostgreSQL-PGFunctions.html b/doc/html/Database-PostgreSQL-PGFunctions.html new file mode 100644 --- /dev/null +++ b/doc/html/Database-PostgreSQL-PGFunctions.html @@ -0,0 +1,3314 @@ + + +Database.PostgreSQL.PGFunctions
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Database.PostgreSQL.PGFunctions
Portabilitynon-portable
Stabilityexperimental
Maintaineroleg@pobox.com, alistair@abayley.org
Description
Simple wrappers for PostgreSQL functions (FFI) plus middle-level + wrappers (in the second part of this file) +
Synopsis
data DBHandleStruct = PGconn
type DBHandle = Ptr DBHandleStruct
data StmtStruct = PGresult
type ResultSetHandle = Ptr StmtStruct
type Oid = CUInt
type Format = CInt
type Void = ()
type ParamLen = CInt
data PGException = PGException Int String
catchPG :: IO a -> (PGException -> IO a) -> IO a
throwPG :: Integral a => a -> String -> any
rethrowPG :: PGException -> any
cStr :: CStringLen -> CString
cStrLen :: CStringLen -> CInt
fPQconnectdb :: CString -> IO DBHandle
fPQfinish :: DBHandle -> IO ()
fPQreset :: DBHandle -> IO ()
fPQdb :: DBHandle -> CString
type ConnStatusType = CInt
fPQstatus :: DBHandle -> IO ConnStatusType
fPQerrorMessage :: DBHandle -> IO CString
fPQsetClientEncoding :: DBHandle -> CString -> IO CString
type NoticeReceiver = Ptr () -> ResultSetHandle -> IO ()
type NoticeProcessor = Ptr () -> CString -> IO ()
mkNoticeReceiver :: NoticeReceiver -> IO (FunPtr NoticeReceiver)
mkNoticeProcessor :: NoticeProcessor -> IO (FunPtr NoticeProcessor)
fPQsetNoticeReceiver :: DBHandle -> FunPtr NoticeReceiver -> Ptr () -> IO (FunPtr NoticeReceiver)
fPQsetNoticeProcessor :: DBHandle -> FunPtr NoticeProcessor -> Ptr () -> IO (FunPtr NoticeProcessor)
fPQexecParams :: DBHandle -> CString -> CInt -> Ptr Oid -> Ptr Void -> Ptr ParamLen -> Ptr Format -> CInt -> IO ResultSetHandle
fPQprepare :: DBHandle -> CString -> CString -> CInt -> Ptr Oid -> IO ResultSetHandle
fPQexecPrepared :: DBHandle -> CString -> CInt -> Ptr Void -> Ptr ParamLen -> Ptr Format -> CInt -> IO ResultSetHandle
fPQresultStatus :: ResultSetHandle -> IO ExecStatusType
type ExecStatusType = CInt
fPQresultErrorMessage :: ResultSetHandle -> IO CString
fPQclear :: ResultSetHandle -> IO ()
fPQntuples :: ResultSetHandle -> IO CInt
fPQnfields :: ResultSetHandle -> IO CInt
fPQfname :: ResultSetHandle -> CInt -> IO CString
fPQfformat :: ResultSetHandle -> CInt -> IO CInt
fPQftype :: ResultSetHandle -> CInt -> IO Oid
fPQgetvalue :: ResultSetHandle -> CInt -> CInt -> IO (Ptr Word8)
fPQgetisnull :: ResultSetHandle -> CInt -> CInt -> IO CInt
fPQgetlength :: ResultSetHandle -> CInt -> CInt -> IO CInt
fPQcmdStatus :: ResultSetHandle -> IO CString
fPQcmdTuples :: ResultSetHandle -> IO CString
fPQoidValue :: ResultSetHandle -> IO Oid
fPQputCopyData :: DBHandle -> Ptr Word8 -> CInt -> IO CInt
fPQputCopyEnd :: DBHandle -> CString -> IO CInt
fPQgetResult :: DBHandle -> IO ResultSetHandle
type PGVerbosity = CInt
fPQsetErrorVerbosity :: DBHandle -> PGVerbosity -> IO PGVerbosity
type LOAccessType = CInt
type WhenceType = CInt
flo_creat :: DBHandle -> LOAccessType -> IO Oid
flo_import :: DBHandle -> CString -> IO Oid
flo_export :: DBHandle -> Oid -> CString -> IO CInt
flo_open :: DBHandle -> Oid -> LOAccessType -> IO CInt
flo_write :: DBHandle -> CInt -> Ptr Word8 -> CUInt -> IO CInt
flo_read :: DBHandle -> CInt -> Ptr Word8 -> CUInt -> IO CInt
flo_lseek :: DBHandle -> CInt -> CInt -> WhenceType -> IO CInt
flo_tell :: DBHandle -> CInt -> IO CInt
flo_close :: DBHandle -> CInt -> IO CInt
flo_unlink :: DBHandle -> Oid -> IO CInt
getError :: DBHandle -> IO String
openDb :: String -> IO DBHandle
closeDb :: DBHandle -> IO ()
class PGType a where
pgTypeFormat :: a -> Format
pgTypeOid :: a -> Oid
pgNewValue :: a -> IO (Ptr Word8)
pgPeek :: Ptr Word8 -> IO a
pgSize :: a -> Int
data PGBindVal = PGBindVal {
bindValOid :: Oid
bindValFormat :: Format
bindValSize :: CInt
bindValPtr :: (IO (Ptr Word8))
}
toCChar :: Char -> CChar
fromCChar :: CChar -> Char
toCInt :: Int -> CInt
check'stmt :: DBHandle -> ExecStatusType -> ResultSetHandle -> IO ResultSetHandle
stmtPrepare :: DBHandle -> String -> String -> [Oid] -> IO String
nqExec :: DBHandle -> String -> IO (String, String, Oid)
execCommand :: DBHandle -> String -> [PGBindVal] -> IO (String, String, Oid)
execPreparedCommand :: DBHandle -> String -> [PGBindVal] -> IO (String, String, Oid)
stmtExecImm :: DBHandle -> String -> [PGBindVal] -> IO (ResultSetHandle, Int)
stmtExecImm0 :: DBHandle -> String -> IO (ResultSetHandle, Int)
stmtExec0 :: DBHandle -> String -> IO (ResultSetHandle, Int)
stmtExec0t :: DBHandle -> String -> IO (ResultSetHandle, Int)
stmtExec :: DBHandle -> String -> [PGBindVal] -> IO (ResultSetHandle, Int)
execPrepared :: DBHandle -> String -> [PGBindVal] -> CInt -> IO (ResultSetHandle, Int)
prepare'n'exec :: DBHandle -> String -> String -> [PGBindVal] -> IO (ResultSetHandle, Int)
stmtFinalise :: ResultSetHandle -> IO ()
colValPtr :: ResultSetHandle -> Int -> Int -> IO (Ptr Word8)
colVal :: PGType a => ResultSetHandle -> Int -> Int -> IO a
colValString :: ResultSetHandle -> Int -> Int -> IO String
colValInt :: ResultSetHandle -> Int -> Int -> IO Int
colValInt64 :: ResultSetHandle -> Int -> Int -> IO Int64
colValDouble :: ResultSetHandle -> Int -> Int -> IO Double
colValFloat :: ResultSetHandle -> Int -> Int -> IO Float
colValUTCTime :: ResultSetHandle -> Int -> Int -> IO UTCTime
colValCalTime :: ResultSetHandle -> Int -> Int -> IO CalendarTime
colValNull :: ResultSetHandle -> Int -> Int -> IO Bool
sbph :: String -> Int -> Bool -> String -> String
nqCopyIn_buflen :: Int
nqCopyIn :: DBHandle -> String -> Handle -> IO ()
Documentation
data DBHandleStruct
Constructors
PGconn
type DBHandle = Ptr DBHandleStruct
data StmtStruct
Constructors
PGresult
type ResultSetHandle = Ptr StmtStruct
type Oid = CUInt
type Format = CInt
type Void = ()
type ParamLen = CInt
data PGException
Constructors
PGException Int String
show/hide Instances
catchPG :: IO a -> (PGException -> IO a) -> IO a
throwPG :: Integral a => a -> String -> any
rethrowPG :: PGException -> any
cStr :: CStringLen -> CString
cStrLen :: CStringLen -> CInt
fPQconnectdb :: CString -> IO DBHandle
fPQfinish :: DBHandle -> IO ()
fPQreset :: DBHandle -> IO ()
fPQdb :: DBHandle -> CString
type ConnStatusType = CInt
fPQstatus :: DBHandle -> IO ConnStatusType
fPQerrorMessage :: DBHandle -> IO CString
fPQsetClientEncoding :: DBHandle -> CString -> IO CString
type NoticeReceiver = Ptr () -> ResultSetHandle -> IO ()
type NoticeProcessor = Ptr () -> CString -> IO ()
mkNoticeReceiver :: NoticeReceiver -> IO (FunPtr NoticeReceiver)
mkNoticeProcessor :: NoticeProcessor -> IO (FunPtr NoticeProcessor)
fPQsetNoticeReceiver :: DBHandle -> FunPtr NoticeReceiver -> Ptr () -> IO (FunPtr NoticeReceiver)
fPQsetNoticeProcessor :: DBHandle -> FunPtr NoticeProcessor -> Ptr () -> IO (FunPtr NoticeProcessor)
fPQexecParams :: DBHandle -> CString -> CInt -> Ptr Oid -> Ptr Void -> Ptr ParamLen -> Ptr Format -> CInt -> IO ResultSetHandle
fPQprepare :: DBHandle -> CString -> CString -> CInt -> Ptr Oid -> IO ResultSetHandle
fPQexecPrepared :: DBHandle -> CString -> CInt -> Ptr Void -> Ptr ParamLen -> Ptr Format -> CInt -> IO ResultSetHandle
fPQresultStatus :: ResultSetHandle -> IO ExecStatusType
type ExecStatusType = CInt
fPQresultErrorMessage :: ResultSetHandle -> IO CString
fPQclear :: ResultSetHandle -> IO ()
fPQntuples :: ResultSetHandle -> IO CInt
fPQnfields :: ResultSetHandle -> IO CInt
fPQfname :: ResultSetHandle -> CInt -> IO CString
fPQfformat :: ResultSetHandle -> CInt -> IO CInt
fPQftype :: ResultSetHandle -> CInt -> IO Oid
fPQgetvalue :: ResultSetHandle -> CInt -> CInt -> IO (Ptr Word8)
fPQgetisnull :: ResultSetHandle -> CInt -> CInt -> IO CInt
fPQgetlength :: ResultSetHandle -> CInt -> CInt -> IO CInt
fPQcmdStatus :: ResultSetHandle -> IO CString
fPQcmdTuples :: ResultSetHandle -> IO CString
fPQoidValue :: ResultSetHandle -> IO Oid
fPQputCopyData :: DBHandle -> Ptr Word8 -> CInt -> IO CInt
fPQputCopyEnd :: DBHandle -> CString -> IO CInt
fPQgetResult :: DBHandle -> IO ResultSetHandle
type PGVerbosity = CInt
fPQsetErrorVerbosity :: DBHandle -> PGVerbosity -> IO PGVerbosity
type LOAccessType = CInt
type WhenceType = CInt
flo_creat :: DBHandle -> LOAccessType -> IO Oid
flo_import :: DBHandle -> CString -> IO Oid
flo_export :: DBHandle -> Oid -> CString -> IO CInt
flo_open :: DBHandle -> Oid -> LOAccessType -> IO CInt
flo_write :: DBHandle -> CInt -> Ptr Word8 -> CUInt -> IO CInt
flo_read :: DBHandle -> CInt -> Ptr Word8 -> CUInt -> IO CInt
flo_lseek :: DBHandle -> CInt -> CInt -> WhenceType -> IO CInt
flo_tell :: DBHandle -> CInt -> IO CInt
flo_close :: DBHandle -> CInt -> IO CInt
flo_unlink :: DBHandle -> Oid -> IO CInt
getError :: DBHandle -> IO String
openDb :: String -> IO DBHandle
closeDb :: DBHandle -> IO ()
class PGType a where
Methods
pgTypeFormat
:: a
-> Format1 == binary (default), 0 == text +
pgTypeOid :: a -> Oid
pgNewValue :: a -> IO (Ptr Word8)
pgPeek :: Ptr Word8 -> IO a
pgSize :: a -> Int
show/hide Instances
PGType CalendarTime
PGType Char
PGType Double
PGType Float
PGType Int
PGType Int16
PGType Int32
PGType Int64
PGType Integer
PGType String
PGType UTCTime
PGType a => PGType (Maybe a)
data PGBindVal
Constructors
PGBindVal
bindValOid :: Oid
bindValFormat :: Format
bindValSize :: CInt
bindValPtr :: (IO (Ptr Word8))
toCChar :: Char -> CChar
fromCChar :: CChar -> Char
toCInt :: Int -> CInt
check'stmt :: DBHandle -> ExecStatusType -> ResultSetHandle -> IO ResultSetHandle
stmtPrepare :: DBHandle -> String -> String -> [Oid] -> IO String
nqExec :: DBHandle -> String -> IO (String, String, Oid)
execCommand :: DBHandle -> String -> [PGBindVal] -> IO (String, String, Oid)
execPreparedCommand :: DBHandle -> String -> [PGBindVal] -> IO (String, String, Oid)
This is for commands, as opposed to queries. + The query equivalent of execPreparedCommand is stmtExec. +
stmtExecImm :: DBHandle -> String -> [PGBindVal] -> IO (ResultSetHandle, Int)
stmtExecImm0 :: DBHandle -> String -> IO (ResultSetHandle, Int)
stmtExec0 :: DBHandle -> String -> IO (ResultSetHandle, Int)
stmtExec0t :: DBHandle -> String -> IO (ResultSetHandle, Int)
stmtExec :: DBHandle -> String -> [PGBindVal] -> IO (ResultSetHandle, Int)
execPrepared :: DBHandle -> String -> [PGBindVal] -> CInt -> IO (ResultSetHandle, Int)
prepare'n'exec :: DBHandle -> String -> String -> [PGBindVal] -> IO (ResultSetHandle, Int)
stmtFinalise :: ResultSetHandle -> IO ()
colValPtr :: ResultSetHandle -> Int -> Int -> IO (Ptr Word8)
Column numbers are zero-indexed, so subtract one + from given index (we present a one-indexed interface). + So are the row numbers. +
colVal :: PGType a => ResultSetHandle -> Int -> Int -> IO a
colValString :: ResultSetHandle -> Int -> Int -> IO String
colValInt :: ResultSetHandle -> Int -> Int -> IO Int
colValInt64 :: ResultSetHandle -> Int -> Int -> IO Int64
colValDouble :: ResultSetHandle -> Int -> Int -> IO Double
colValFloat :: ResultSetHandle -> Int -> Int -> IO Float
colValUTCTime :: ResultSetHandle -> Int -> Int -> IO UTCTime
colValCalTime :: ResultSetHandle -> Int -> Int -> IO CalendarTime
colValNull :: ResultSetHandle -> Int -> Int -> IO Bool
sbph :: String -> Int -> Bool -> String -> String
nqCopyIn_buflen :: Int
nqCopyIn :: DBHandle -> String -> Handle -> IO ()
Produced by Haddock version 0.7
diff --git a/doc/html/Database-Sqlite-Enumerator.html b/doc/html/Database-Sqlite-Enumerator.html new file mode 100644 --- /dev/null +++ b/doc/html/Database-Sqlite-Enumerator.html @@ -0,0 +1,559 @@ + + +Database.Sqlite.Enumerator
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Database.Sqlite.Enumerator
Portabilitynon-portable
Stabilityexperimental
Maintaineroleg@pobox.com, alistair@abayley.org
Description
Sqlite implementation of Database.Enumerator. +
Documentation
data Session
show/hide Instances
ISession Session
Typeable Session
Command BoundStmt Session
Command QueryString Session
Command StmtBind Session
Command String Session
EnvInquiry LastInsertRowid Session Int64
IQuery Query Session ColumnBuffer
Statement BoundStmt Session Query
Statement PreparedStmtObj Session Query
Statement QueryString Session Query
Statement StmtBind Session Query
Statement String Session Query
DBBind (Maybe a) Session PreparedStmtObj BindObj => DBBind a Session PreparedStmtObj BindObj
IPrepared PreparedStmtObj Session BoundStmt BindObj
DBBind (Maybe CalendarTime) Session PreparedStmtObj BindObj
DBBind (Maybe Double) Session PreparedStmtObj BindObj
DBBind (Maybe Int) Session PreparedStmtObj BindObj
DBBind (Maybe Int64) Session PreparedStmtObj BindObj
DBBind (Maybe String) Session PreparedStmtObj BindObj
DBBind (Maybe UTCTime) Session PreparedStmtObj BindObj
Show a => DBBind (Maybe a) Session PreparedStmtObj BindObj
connect :: String -> ConnectA Session
prepareStmt :: QueryString -> PreparationA Session PreparedStmtObj
preparePrefetch :: Int -> QueryString -> PreparationA Session PreparedStmtObj
prepareQuery :: QueryString -> PreparationA Session PreparedStmtObj
prepareLargeQuery :: Int -> QueryString -> PreparationA Session PreparedStmtObj
prepareCommand :: QueryString -> PreparationA Session PreparedStmtObj
sql :: String -> QueryString
sqlbind :: String -> [BindA Session PreparedStmtObj BindObj] -> StmtBind
prefetch :: Int -> String -> [BindA Session PreparedStmtObj BindObj] -> StmtBind
cmdbind :: String -> [BindA Session PreparedStmtObj BindObj] -> StmtBind
data LastInsertRowid
Constructors
LastInsertRowid
show/hide Instances
module Database.Enumerator
Produced by Haddock version 0.7
diff --git a/doc/html/Database-Sqlite-SqliteFunctions.html b/doc/html/Database-Sqlite-SqliteFunctions.html new file mode 100644 --- /dev/null +++ b/doc/html/Database-Sqlite-SqliteFunctions.html @@ -0,0 +1,2160 @@ + + +Database.Sqlite.SqliteFunctions
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Database.Sqlite.SqliteFunctions
Portabilitynon-portable
Stabilityexperimental
Maintaineroleg@pobox.com, alistair@abayley.org
Description
Simple wrappers for Sqlite functions (FFI). +
Synopsis
data DBHandleStruct = DBHandleStruct
type DBHandle = Ptr DBHandleStruct
data StmtStruct = StmtStruct
type StmtHandle = Ptr StmtStruct
type Blob = Ptr Word8
type SqliteCallback a = FunPtr (Ptr a -> CInt -> Ptr CString -> Ptr CString -> IO Int)
type FreeFunPtr = FunPtr (Ptr Word8 -> IO ())
data SqliteException = SqliteException Int String
catchSqlite :: IO a -> (SqliteException -> IO a) -> IO a
throwSqlite :: SqliteException -> a
sqliteOK :: CInt
sqliteERROR :: CInt
sqliteROW :: CInt
sqliteDONE :: CInt
cStr :: CStringLen -> CString
cStrLen :: CStringLen -> CInt
type UTF16CString = CString
type UTF8CString = CString
sqliteOpen :: UTF8CString -> Ptr DBHandle -> IO CInt
sqliteClose :: DBHandle -> IO CInt
sqlitePrepare :: DBHandle -> UTF8CString -> CInt -> Ptr StmtHandle -> Ptr CString -> IO CInt
sqliteExec :: DBHandle -> UTF8CString -> SqliteCallback a -> Ptr a -> Ptr CString -> IO CInt
sqliteColumnCount :: StmtHandle -> IO CInt
sqliteStep :: StmtHandle -> IO CInt
sqliteFinalise :: StmtHandle -> IO CInt
sqliteReset :: StmtHandle -> IO CInt
sqliteChanges :: DBHandle -> IO CInt
sqliteLastInsertRowid :: DBHandle -> IO CLLong
sqliteFree :: Ptr a -> IO ()
sqliteErrcode :: DBHandle -> IO CInt
sqliteErrmsg :: DBHandle -> IO UTF8CString
sqliteColumnBytes :: StmtHandle -> CInt -> IO Int
sqliteColumnBlob :: StmtHandle -> CInt -> IO Blob
sqliteColumnDouble :: StmtHandle -> CInt -> IO CDouble
sqliteColumnInt :: StmtHandle -> CInt -> IO CInt
sqliteColumnInt64 :: StmtHandle -> CInt -> IO CLLong
sqliteColumnText :: StmtHandle -> CInt -> IO UTF8CString
sqliteColumnText16 :: StmtHandle -> CInt -> IO UTF16CString
sqliteBindBlob :: StmtHandle -> CInt -> Blob -> CInt -> FreeFunPtr -> IO CInt
sqliteBindDouble :: StmtHandle -> CInt -> CDouble -> IO CInt
sqliteBindInt :: StmtHandle -> CInt -> CInt -> IO CInt
sqliteBindInt64 :: StmtHandle -> CInt -> CLLong -> IO CInt
sqliteBindNull :: StmtHandle -> CInt -> IO CInt
sqliteBindText :: StmtHandle -> CInt -> UTF8CString -> CInt -> FreeFunPtr -> IO CInt
sqliteBindText16 :: StmtHandle -> CInt -> UTF16CString -> CInt -> FreeFunPtr -> IO CInt
getError :: DBHandle -> IO SqliteException
getAndRaiseError :: Int -> DBHandle -> IO a
errorTest :: DBHandle -> CInt -> IO a -> IO a
testForError :: DBHandle -> CInt -> a -> IO a
testForErrorWithPtr :: Storable a => DBHandle -> CInt -> Ptr a -> IO a
openDb :: String -> IO DBHandle
closeDb :: DBHandle -> IO ()
stmtExec :: DBHandle -> String -> IO Int
stmtChanges :: DBHandle -> IO Int
stmtPrepare :: DBHandle -> String -> IO StmtHandle
stmtFetch :: DBHandle -> StmtHandle -> IO CInt
stmtFinalise :: DBHandle -> StmtHandle -> IO ()
stmtReset :: DBHandle -> StmtHandle -> IO ()
checkColumnRange :: StmtHandle -> Int -> IO ()
colValInt :: StmtHandle -> Int -> IO Int
colValInt64 :: StmtHandle -> Int -> IO Int64
colValDouble :: StmtHandle -> Int -> IO Double
colValString :: StmtHandle -> Int -> IO (Maybe String)
colValBlob :: StmtHandle -> Int -> IO (ForeignPtr Blob)
bindDouble :: DBHandle -> StmtHandle -> Int -> Double -> IO ()
bindInt :: DBHandle -> StmtHandle -> Int -> Int -> IO ()
bindInt64 :: DBHandle -> StmtHandle -> Int -> Int64 -> IO ()
bindNull :: DBHandle -> StmtHandle -> Int -> IO ()
bindString :: DBHandle -> StmtHandle -> Int -> String -> IO ()
bindBlob :: DBHandle -> StmtHandle -> Int -> Blob -> Int -> IO ()
Documentation
data DBHandleStruct
Constructors
DBHandleStruct
type DBHandle = Ptr DBHandleStruct
data StmtStruct
Constructors
StmtStruct
type StmtHandle = Ptr StmtStruct
type Blob = Ptr Word8
type SqliteCallback a = FunPtr (Ptr a -> CInt -> Ptr CString -> Ptr CString -> IO Int)
type FreeFunPtr = FunPtr (Ptr Word8 -> IO ())
data SqliteException
Constructors
SqliteException Int String
show/hide Instances
catchSqlite :: IO a -> (SqliteException -> IO a) -> IO a
throwSqlite :: SqliteException -> a
sqliteOK :: CInt
sqliteERROR :: CInt
sqliteROW :: CInt
sqliteDONE :: CInt
cStr :: CStringLen -> CString
cStrLen :: CStringLen -> CInt
type UTF16CString = CString
type UTF8CString = CString
sqliteOpen :: UTF8CString -> Ptr DBHandle -> IO CInt
sqliteClose :: DBHandle -> IO CInt
sqlitePrepare :: DBHandle -> UTF8CString -> CInt -> Ptr StmtHandle -> Ptr CString -> IO CInt
sqliteExec :: DBHandle -> UTF8CString -> SqliteCallback a -> Ptr a -> Ptr CString -> IO CInt
sqliteColumnCount :: StmtHandle -> IO CInt
sqliteStep :: StmtHandle -> IO CInt
sqliteFinalise :: StmtHandle -> IO CInt
sqliteReset :: StmtHandle -> IO CInt
sqliteChanges :: DBHandle -> IO CInt
sqliteLastInsertRowid :: DBHandle -> IO CLLong
sqliteFree :: Ptr a -> IO ()
sqliteErrcode :: DBHandle -> IO CInt
sqliteErrmsg :: DBHandle -> IO UTF8CString
sqliteColumnBytes :: StmtHandle -> CInt -> IO Int
sqliteColumnBlob :: StmtHandle -> CInt -> IO Blob
sqliteColumnDouble :: StmtHandle -> CInt -> IO CDouble
sqliteColumnInt :: StmtHandle -> CInt -> IO CInt
sqliteColumnInt64 :: StmtHandle -> CInt -> IO CLLong
sqliteColumnText :: StmtHandle -> CInt -> IO UTF8CString
sqliteColumnText16 :: StmtHandle -> CInt -> IO UTF16CString
sqliteBindBlob :: StmtHandle -> CInt -> Blob -> CInt -> FreeFunPtr -> IO CInt
sqliteBindDouble :: StmtHandle -> CInt -> CDouble -> IO CInt
sqliteBindInt :: StmtHandle -> CInt -> CInt -> IO CInt
sqliteBindInt64 :: StmtHandle -> CInt -> CLLong -> IO CInt
sqliteBindNull :: StmtHandle -> CInt -> IO CInt
sqliteBindText :: StmtHandle -> CInt -> UTF8CString -> CInt -> FreeFunPtr -> IO CInt
sqliteBindText16 :: StmtHandle -> CInt -> UTF16CString -> CInt -> FreeFunPtr -> IO CInt
getError :: DBHandle -> IO SqliteException
getAndRaiseError :: Int -> DBHandle -> IO a
errorTest :: DBHandle -> CInt -> IO a -> IO a
testForError :: DBHandle -> CInt -> a -> IO a
testForErrorWithPtr :: Storable a => DBHandle -> CInt -> Ptr a -> IO a
openDb :: String -> IO DBHandle
closeDb :: DBHandle -> IO ()
stmtExec :: DBHandle -> String -> IO Int
This function is not used internally, so it's only provided + as a user convenience. +
stmtChanges :: DBHandle -> IO Int
stmtPrepare :: DBHandle -> String -> IO StmtHandle
stmtFetch :: DBHandle -> StmtHandle -> IO CInt
stmtFinalise :: DBHandle -> StmtHandle -> IO ()
stmtReset :: DBHandle -> StmtHandle -> IO ()
checkColumnRange :: StmtHandle -> Int -> IO ()
colValInt :: StmtHandle -> Int -> IO Int
Column numbers are zero-indexed, so subtract one + from given index (we present a one-indexed interface). +
colValInt64 :: StmtHandle -> Int -> IO Int64
colValDouble :: StmtHandle -> Int -> IO Double
colValString :: StmtHandle -> Int -> IO (Maybe String)
colValBlob :: StmtHandle -> Int -> IO (ForeignPtr Blob)
bindDouble :: DBHandle -> StmtHandle -> Int -> Double -> IO ()
bindInt :: DBHandle -> StmtHandle -> Int -> Int -> IO ()
bindInt64 :: DBHandle -> StmtHandle -> Int -> Int64 -> IO ()
bindNull :: DBHandle -> StmtHandle -> Int -> IO ()
bindString :: DBHandle -> StmtHandle -> Int -> String -> IO ()
bindBlob :: DBHandle -> StmtHandle -> Int -> Blob -> Int -> IO ()
Produced by Haddock version 0.7
diff --git a/doc/html/Database-Stub-Enumerator.html b/doc/html/Database-Stub-Enumerator.html new file mode 100644 --- /dev/null +++ b/doc/html/Database-Stub-Enumerator.html @@ -0,0 +1,483 @@ + + +Database.Stub.Enumerator
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Database.Stub.Enumerator
Portabilitynon-portable
Stabilityexperimental
Maintaineroleg@pobox.com, alistair@abayley.org
Description

Stub implementation of Database.Enumerator. + Useful for people who can't or won't install a DBMS, + so that they can try out the Enumerator interface. +

Currently last last row of any fetch will have a null in its Int columns + (this makes it easier to test handling of nulls and DBUnexpectedNull). + See fetchIntVal. +

Synopsis
data Session
data ConnParm = ConnParm {
user, pswd, dbname :: String
}
connect :: ConnParm -> ConnectA Session
sql :: String -> QueryString
prefetch :: Int -> String -> QueryStringTuned
data QueryResourceUsage = QueryResourceUsage {
prefetchRowCount :: Int
}
Documentation
data Session
show/hide Instances
ISession Session
Command QueryString Session
Command QueryStringTuned Session
IQuery Query Session ColumnBuffer
Statement QueryString Session Query
Statement QueryStringTuned Session Query
data ConnParm
Constructors
ConnParm
user, pswd, dbname :: String
connect :: ConnParm -> ConnectA Session
sql :: String -> QueryString
prefetch :: Int -> String -> QueryStringTuned
data QueryResourceUsage
At present the only resource tuning we support is the number of rows + prefetched by the FFI library. + We use a record to (hopefully) make it easy to add other + tuning parameters later. +
Constructors
QueryResourceUsage
prefetchRowCount :: Int
Produced by Haddock version 0.7
diff --git a/doc/html/Database-Util.html b/doc/html/Database-Util.html new file mode 100644 --- /dev/null +++ b/doc/html/Database-Util.html @@ -0,0 +1,668 @@ + + +Database.Util
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Database.Util
Portabilitynon-portable
Stabilityexperimental
Maintaineroleg@pobox.com, alistair@abayley.org
Description
Utility functions. Mostly used in database back-ends, and tests. +
Synopsis
class Show a => MyShow a where
show_ :: a -> String
print_ :: (MonadIO m, MyShow a) => a -> m ()
mkUTCTime :: (Integral a, Real b) => a -> a -> a -> a -> a -> b -> UTCTime
mkCalTime :: Integral a => a -> a -> a -> a -> a -> a -> CalendarTime
int64ToDateParts :: Int64 -> (Int64, Int64, Int64, Int64, Int64, Int64)
datePartsToInt64 :: (Integral a1, Integral a2, Integral a3, Integral a4, Integral a5, Integral a6) => (a1, a2, a3, a4, a5, a6) -> Int64
calTimeToInt64 :: CalendarTime -> Int64
int64ToCalTime :: Int64 -> CalendarTime
int64ToUTCTime :: Int64 -> UTCTime
wordsBy :: (Char -> Bool) -> String -> [String]
skipNonMatch :: (Char -> Bool) -> String -> [String]
positions :: Eq a => [a] -> [a] -> [Int]
pgDatetimetoUTCTime :: String -> UTCTime
pgDatetimetoCalTime :: String -> CalendarTime
pgDatetimeToParts :: String -> (Int, Int, Int, Int, Int, Double, Int)
utcTimeToIsoString :: (Integral a, Integral b) => UTCTime -> String -> (a -> a) -> (b -> String) -> String
utcTimeToPGDatetime :: UTCTime -> String
utcTimeToIsoDatetime :: UTCTime -> String
utcTimeToOdbcDatetime :: UTCTime -> String
calTimeToPGDatetime :: CalendarTime -> String
Documentation
class Show a => MyShow a where
Methods
show_ :: a -> String
show/hide Instances
MyShow String
Show a => MyShow a
print_ :: (MonadIO m, MyShow a) => a -> m ()
Like print, except that Strings are not escaped or quoted. +
mkUTCTime :: (Integral a, Real b) => a -> a -> a -> a -> a -> b -> UTCTime
Convenience for making UTCTimes. Assumes the time given is already UTC time + i.e. there's no timezone adjustment. +
mkCalTime :: Integral a => a -> a -> a -> a -> a -> a -> CalendarTime
int64ToDateParts :: Int64 -> (Int64, Int64, Int64, Int64, Int64, Int64)
datePartsToInt64 :: (Integral a1, Integral a2, Integral a3, Integral a4, Integral a5, Integral a6) => (a1, a2, a3, a4, a5, a6) -> Int64
calTimeToInt64 :: CalendarTime -> Int64
int64ToCalTime :: Int64 -> CalendarTime
int64ToUTCTime :: Int64 -> UTCTime
wordsBy :: (Char -> Bool) -> String -> [String]
skipNonMatch :: (Char -> Bool) -> String -> [String]
positions :: Eq a => [a] -> [a] -> [Int]
pgDatetimetoUTCTime :: String -> UTCTime
pgDatetimetoCalTime :: String -> CalendarTime
pgDatetimeToParts :: String -> (Int, Int, Int, Int, Int, Double, Int)
utcTimeToIsoString :: (Integral a, Integral b) => UTCTime -> String -> (a -> a) -> (b -> String) -> String
utcTimeToPGDatetime :: UTCTime -> String
utcTimeToIsoDatetime :: UTCTime -> String
utcTimeToOdbcDatetime :: UTCTime -> String
calTimeToPGDatetime :: CalendarTime -> String
Assumes CalendarTime is also UTC i.e. ignores ctTZ component. +
Produced by Haddock version 0.7
diff --git a/doc/html/Foreign-C-UTF8.html b/doc/html/Foreign-C-UTF8.html new file mode 100644 --- /dev/null +++ b/doc/html/Foreign-C-UTF8.html @@ -0,0 +1,415 @@ + + +Foreign.C.UTF8
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Foreign.C.UTF8
Portabilityportable
Stabilityexperimental
Maintaineralistair@abayley.org
Description

Marshall Haskell Strings to and from UTF8-encoded CStrings. + This module's code is inspired by John Meacham's UTF8 en- & de-coders, + and also those found in the HXT library (module Text.XML.HXT.DOM.Unicode). +

Note that the -Len functions all return the length in bytes, + not Chars (this is more useful, as you are most likely to want + to pass the length to an FFI function, which is most likely + expecting the length in bytes). If you want the length in Chars, + well, you have the original String, so... +

Synopsis
peekUTF8String :: CString -> IO String
peekUTF8StringLen :: CStringLen -> IO String
newUTF8String :: String -> IO CString
withUTF8String :: String -> (CString -> IO a) -> IO a
withUTF8StringLen :: String -> (CStringLen -> IO a) -> IO a
toUTF8String :: String -> String
fromUTF8String :: String -> String
lengthUTF8 :: String -> Int
fromUTF8 :: [Word8] -> String
toUTF8 :: String -> [Word8]
Documentation
peekUTF8String :: CString -> IO String
Analogous to peekCString. Converts UTF8 CString to String. +
peekUTF8StringLen :: CStringLen -> IO String
Analogous to peekCStringLen. Converts UTF8 CString to String. + The resulting String will end either when len bytes + have been converted, or when a NULL is found. +
newUTF8String :: String -> IO CString
Analogous to newCString. Creates UTF8 encoded CString. +
withUTF8String :: String -> (CString -> IO a) -> IO a
Analogous to withCString. Creates UTF8 encoded CString. +
withUTF8StringLen :: String -> (CStringLen -> IO a) -> IO a
Analogous to withCStringLen. + The length returned is in bytes (encoding units), not chars. +
toUTF8String :: String -> String
Convert a Haskell String into a UTF8 String, where each UTF8 byte + is represented by its Char equivalent i.e. only chars 0-255 are used. + The resulting String can be marshalled to CString directly i.e. with + a Latin-1 encoding. +
fromUTF8String :: String -> String
Convert a String that was marshalled from a CString without + any decoder applied. This might be useful if the client encoding + is unknown, and the user code must convert. + We assume that the UTF8 CString was marshalled as if Latin-1 + i.e. all chars are in the range 0-255. +
lengthUTF8 :: String -> Int
fromUTF8 :: [Word8] -> String
Convert UTF-8 to Unicode. +
toUTF8 :: String -> [Word8]
Convert Unicode characters to UTF-8. +
Produced by Haddock version 0.7
diff --git a/doc/html/doc-index-A.html b/doc/html/doc-index-A.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-A.html @@ -0,0 +1,170 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (A)
allocConnDatabase.ODBC.OdbcFunctions
allocEnvDatabase.ODBC.OdbcFunctions
allocHdlDatabase.ODBC.OdbcFunctions
allocStmtDatabase.ODBC.OdbcFunctions
diff --git a/doc/html/doc-index-B.html b/doc/html/doc-index-B.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-B.html @@ -0,0 +1,598 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (B)
BindADatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
BindBuffer
1 (Type/Class)Database.ODBC.OdbcFunctions
2 (Data Constructor)Database.ODBC.OdbcFunctions
3 (Type/Class)Database.Oracle.OCIFunctions
BindHandleDatabase.Oracle.OCIFunctions
BindStruct
1 (Type/Class)Database.Oracle.OCIFunctions
2 (Data Constructor)Database.Oracle.OCIFunctions
BlobDatabase.Sqlite.SqliteFunctions
Buffer
1 (Type/Class)Database.ODBC.OdbcFunctions
2 (Data Constructor)Database.ODBC.OdbcFunctions
BufferFPtr
1 (Type/Class)Database.ODBC.OdbcFunctions
2 (Type/Class)Database.Oracle.OCIFunctions
BufferPtrDatabase.Oracle.OCIFunctions
basicDBExceptionReporterDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
beginTransDatabase.Oracle.OCIFunctions
beginTransactionDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
bindBlobDatabase.Sqlite.SqliteFunctions
bindBufPtrDatabase.ODBC.OdbcFunctions
bindBufSizeDatabase.ODBC.OdbcFunctions
bindBufSzPtrDatabase.ODBC.OdbcFunctions
bindByPosDatabase.Oracle.OCIFunctions
bindColBufferDatabase.ODBC.OdbcFunctions
bindColumnBufferDatabase.ODBC.OdbcFunctions
bindDoubleDatabase.Sqlite.SqliteFunctions
bindEncodedStringDatabase.ODBC.OdbcFunctions
bindIntDatabase.Sqlite.SqliteFunctions
bindInt64Database.Sqlite.SqliteFunctions
bindNull
1 (Function)Database.ODBC.OdbcFunctions
2 (Function)Database.Sqlite.SqliteFunctions
bindOutputByPosDatabase.Oracle.OCIFunctions
bindPDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
bindParamDatabase.ODBC.OdbcFunctions
bindParamBufferDatabase.ODBC.OdbcFunctions
bindParamCAStringDatabase.ODBC.OdbcFunctions
bindParamCStringLenDatabase.ODBC.OdbcFunctions
bindParamCWStringDatabase.ODBC.OdbcFunctions
bindParamUTF8StringDatabase.ODBC.OdbcFunctions
bindParamUtcTimeDatabase.ODBC.OdbcFunctions
bindStringDatabase.Sqlite.SqliteFunctions
bindTypeDatabase.PostgreSQL.Enumerator
bindValFormatDatabase.PostgreSQL.PGFunctions
bindValOidDatabase.PostgreSQL.PGFunctions
bindValPtrDatabase.PostgreSQL.PGFunctions
bindValSizeDatabase.PostgreSQL.PGFunctions
bufferPeekValueDatabase.Oracle.OCIFunctions
bufferToADatabase.Oracle.OCIFunctions
bufferToCDoubleDatabase.Oracle.OCIFunctions
bufferToCIntDatabase.Oracle.OCIFunctions
bufferToCaltimeDatabase.Oracle.OCIFunctions
bufferToDoubleDatabase.Oracle.OCIFunctions
bufferToIntDatabase.Oracle.OCIFunctions
bufferToStmtHandleDatabase.Oracle.OCIFunctions
bufferToStringDatabase.Oracle.OCIFunctions
bufferToUTCTimeDatabase.Oracle.OCIFunctions
byteToIntDatabase.Oracle.OCIFunctions
diff --git a/doc/html/doc-index-C.html b/doc/html/doc-index-C.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-C.html @@ -0,0 +1,934 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (C)
CAconnect_timeoutDatabase.PostgreSQL.Enumerator
CAdbnameDatabase.PostgreSQL.Enumerator
CAhostDatabase.PostgreSQL.Enumerator
CAhostaddrDatabase.PostgreSQL.Enumerator
CAoptionsDatabase.PostgreSQL.Enumerator
CApasswordDatabase.PostgreSQL.Enumerator
CAportDatabase.PostgreSQL.Enumerator
CAserviceDatabase.PostgreSQL.Enumerator
CAsslmodeDatabase.PostgreSQL.Enumerator
CAuserDatabase.PostgreSQL.Enumerator
CaughtMonadIOControl.Exception.MonadIO
ColNumDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
ColumnInfoDatabase.Oracle.OCIFunctions
ColumnResultBufferDatabase.Oracle.OCIFunctions
CommandDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
ConnHandle
1 (Type/Class)Database.ODBC.OdbcFunctions
2 (Data Constructor)Database.ODBC.OdbcFunctions
3 (Type/Class)Database.Oracle.OCIFunctions
ConnHdlDatabase.ODBC.OdbcFunctions
ConnObj
1 (Type/Class)Database.ODBC.OdbcFunctions
2 (Data Constructor)Database.ODBC.OdbcFunctions
ConnParm
1 (Type/Class)Database.Stub.Enumerator
2 (Data Constructor)Database.Stub.Enumerator
ConnStatusTypeDatabase.PostgreSQL.PGFunctions
ConnStruct
1 (Type/Class)Database.Oracle.OCIFunctions
2 (Data Constructor)Database.Oracle.OCIFunctions
ConnectADatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
ConnectAttrDatabase.PostgreSQL.Enumerator
Context
1 (Type/Class)Database.Oracle.OCIFunctions
2 (Data Constructor)Database.Oracle.OCIFunctions
ContextPtrDatabase.Oracle.OCIFunctions
cShort2IntDatabase.Oracle.OCIFunctions
cStr
1 (Function)Database.Oracle.OCIFunctions
2 (Function)Database.PostgreSQL.PGFunctions
3 (Function)Database.Sqlite.SqliteFunctions
cStrLen
1 (Function)Database.Oracle.OCIFunctions
2 (Function)Database.PostgreSQL.PGFunctions
3 (Function)Database.Sqlite.SqliteFunctions
cUShort2IntDatabase.Oracle.OCIFunctions
calTimeToBufferDatabase.Oracle.OCIFunctions
calTimeToInt64Database.Util
calTimeToPGDatetimeDatabase.Util
catchDBDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
catchDBErrorDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
catchOCIDatabase.Oracle.OCIFunctions
catchOdbcDatabase.ODBC.OdbcFunctions
catchPGDatabase.PostgreSQL.PGFunctions
catchSqliteDatabase.Sqlite.SqliteFunctions
check'stmtDatabase.PostgreSQL.PGFunctions
checkColumnRangeDatabase.Sqlite.SqliteFunctions
checkErrorDatabase.ODBC.OdbcFunctions
closeCursorDatabase.ODBC.OdbcFunctions
closeDb
1 (Function)Database.PostgreSQL.PGFunctions
2 (Function)Database.Sqlite.SqliteFunctions
cmdbind
1 (Function)Database.ODBC.Enumerator
2 (Function)Database.Oracle.Enumerator
3 (Function)Database.PostgreSQL.Enumerator
4 (Function)Database.Sqlite.Enumerator
colValDatabase.PostgreSQL.PGFunctions
colValBlobDatabase.Sqlite.SqliteFunctions
colValCalTimeDatabase.PostgreSQL.PGFunctions
colValDouble
1 (Function)Database.PostgreSQL.PGFunctions
2 (Function)Database.Sqlite.SqliteFunctions
colValFloatDatabase.PostgreSQL.PGFunctions
colValInt
1 (Function)Database.PostgreSQL.PGFunctions
2 (Function)Database.Sqlite.SqliteFunctions
colValInt64
1 (Function)Database.PostgreSQL.PGFunctions
2 (Function)Database.Sqlite.SqliteFunctions
colValNullDatabase.PostgreSQL.PGFunctions
colValPtrDatabase.PostgreSQL.PGFunctions
colValString
1 (Function)Database.PostgreSQL.PGFunctions
2 (Function)Database.Sqlite.SqliteFunctions
colValUTCTimeDatabase.PostgreSQL.PGFunctions
commit
1 (Function)Database.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
2 (Function)Database.ODBC.OdbcFunctions
commitTransDatabase.Oracle.OCIFunctions
connDbmsDatabase.ODBC.OdbcFunctions
connHdlDatabase.ODBC.OdbcFunctions
connect
1 (Function)Database.ODBC.Enumerator
2 (Function)Database.ODBC.OdbcFunctions
3 (Function)Database.Oracle.Enumerator
4 (Function)Database.PostgreSQL.Enumerator
5 (Function)Database.Sqlite.Enumerator
6 (Function)Database.Stub.Enumerator
createBufferForStorableDatabase.ODBC.OdbcFunctions
createBufferHelperDatabase.ODBC.OdbcFunctions
createEmptyBufferDatabase.ODBC.OdbcFunctions
cuCharToIntDatabase.Oracle.OCIFunctions
currentRowNumDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
cursorCurrentDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
cursorIsEOFDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
cursorNextDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
diff --git a/doc/html/doc-index-D.html b/doc/html/doc-index-D.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-D.html @@ -0,0 +1,342 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (D)
DBBindDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
DBErrorDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
DBExceptionDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
DBFatalDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
DBHandle
1 (Type/Class)Database.PostgreSQL.PGFunctions
2 (Type/Class)Database.Sqlite.SqliteFunctions
DBHandleStruct
1 (Type/Class)Database.PostgreSQL.PGFunctions
2 (Type/Class)Database.Sqlite.SqliteFunctions
3 (Data Constructor)Database.Sqlite.SqliteFunctions
DBMDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
DBNoDataDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
DBTypeDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
DBUnexpectedNullDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
DefnHandleDatabase.Oracle.OCIFunctions
DefnStruct
1 (Type/Class)Database.Oracle.OCIFunctions
2 (Data Constructor)Database.Oracle.OCIFunctions
datePartsToInt64Database.Util
dbLogoffDatabase.Oracle.OCIFunctions
dbLogonDatabase.Oracle.OCIFunctions
dbnameDatabase.Stub.Enumerator
defineByPosDatabase.Oracle.OCIFunctions
disconnectDatabase.ODBC.OdbcFunctions
doQueryDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
dumpBufferDatabase.Oracle.OCIFunctions
diff --git a/doc/html/doc-index-E.html b/doc/html/doc-index-E.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-E.html @@ -0,0 +1,306 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (E)
EnvHandle
1 (Type/Class)Database.ODBC.OdbcFunctions
2 (Type/Class)Database.Oracle.OCIFunctions
EnvInquiryDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
EnvObj
1 (Type/Class)Database.ODBC.OdbcFunctions
2 (Data Constructor)Database.ODBC.OdbcFunctions
EnvStruct
1 (Type/Class)Database.Oracle.OCIFunctions
2 (Data Constructor)Database.Oracle.OCIFunctions
ErrorHandleDatabase.Oracle.OCIFunctions
ErrorStruct
1 (Type/Class)Database.Oracle.OCIFunctions
2 (Data Constructor)Database.Oracle.OCIFunctions
ExecStatusTypeDatabase.PostgreSQL.PGFunctions
envCreateDatabase.Oracle.OCIFunctions
errorTestDatabase.Sqlite.SqliteFunctions
execCommandDatabase.PostgreSQL.PGFunctions
execDDLDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
execDMLDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
execPreparedDatabase.PostgreSQL.PGFunctions
execPreparedCommandDatabase.PostgreSQL.PGFunctions
executeStmtDatabase.ODBC.OdbcFunctions
diff --git a/doc/html/doc-index-F.html b/doc/html/doc-index-F.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-F.html @@ -0,0 +1,594 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (F)
FormatDatabase.PostgreSQL.PGFunctions
FreeFunPtrDatabase.Sqlite.SqliteFunctions
fPQclearDatabase.PostgreSQL.PGFunctions
fPQcmdStatusDatabase.PostgreSQL.PGFunctions
fPQcmdTuplesDatabase.PostgreSQL.PGFunctions
fPQconnectdbDatabase.PostgreSQL.PGFunctions
fPQdbDatabase.PostgreSQL.PGFunctions
fPQerrorMessageDatabase.PostgreSQL.PGFunctions
fPQexecParamsDatabase.PostgreSQL.PGFunctions
fPQexecPreparedDatabase.PostgreSQL.PGFunctions
fPQfformatDatabase.PostgreSQL.PGFunctions
fPQfinishDatabase.PostgreSQL.PGFunctions
fPQfnameDatabase.PostgreSQL.PGFunctions
fPQftypeDatabase.PostgreSQL.PGFunctions
fPQgetResultDatabase.PostgreSQL.PGFunctions
fPQgetisnullDatabase.PostgreSQL.PGFunctions
fPQgetlengthDatabase.PostgreSQL.PGFunctions
fPQgetvalueDatabase.PostgreSQL.PGFunctions
fPQnfieldsDatabase.PostgreSQL.PGFunctions
fPQntuplesDatabase.PostgreSQL.PGFunctions
fPQoidValueDatabase.PostgreSQL.PGFunctions
fPQprepareDatabase.PostgreSQL.PGFunctions
fPQputCopyDataDatabase.PostgreSQL.PGFunctions
fPQputCopyEndDatabase.PostgreSQL.PGFunctions
fPQresetDatabase.PostgreSQL.PGFunctions
fPQresultErrorMessageDatabase.PostgreSQL.PGFunctions
fPQresultStatusDatabase.PostgreSQL.PGFunctions
fPQsetClientEncodingDatabase.PostgreSQL.PGFunctions
fPQsetErrorVerbosityDatabase.PostgreSQL.PGFunctions
fPQsetNoticeProcessorDatabase.PostgreSQL.PGFunctions
fPQsetNoticeReceiverDatabase.PostgreSQL.PGFunctions
fPQstatusDatabase.PostgreSQL.PGFunctions
fetchDatabase.ODBC.OdbcFunctions
flo_closeDatabase.PostgreSQL.PGFunctions
flo_creatDatabase.PostgreSQL.PGFunctions
flo_exportDatabase.PostgreSQL.PGFunctions
flo_importDatabase.PostgreSQL.PGFunctions
flo_lseekDatabase.PostgreSQL.PGFunctions
flo_openDatabase.PostgreSQL.PGFunctions
flo_readDatabase.PostgreSQL.PGFunctions
flo_tellDatabase.PostgreSQL.PGFunctions
flo_unlinkDatabase.PostgreSQL.PGFunctions
flo_writeDatabase.PostgreSQL.PGFunctions
formatDBExceptionDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
formatEnvMsgDatabase.Oracle.OCIFunctions
formatErrorCodeDescDatabase.Oracle.OCIFunctions
formatErrorMsgDatabase.Oracle.OCIFunctions
formatMsgCommonDatabase.Oracle.OCIFunctions
formatOCIMsgDatabase.Oracle.OCIFunctions
freeConnDatabase.ODBC.OdbcFunctions
freeEnvDatabase.ODBC.OdbcFunctions
freeHandleDatabase.ODBC.OdbcFunctions
freeStmtDatabase.ODBC.OdbcFunctions
fromCCharDatabase.PostgreSQL.PGFunctions
fromEnumOCIErrorCodeDatabase.Oracle.OCIFunctions
fromUTF8Foreign.C.UTF8
fromUTF8StringForeign.C.UTF8
diff --git a/doc/html/doc-index-G.html b/doc/html/doc-index-G.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-G.html @@ -0,0 +1,422 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (G)
gbracketControl.Exception.MonadIO
gcatchControl.Exception.MonadIO
gcatchJustControl.Exception.MonadIO
getAndRaiseErrorDatabase.Sqlite.SqliteFunctions
getCAStringFromBufferDatabase.ODBC.OdbcFunctions
getCWStringFromBufferDatabase.ODBC.OdbcFunctions
getDataDatabase.ODBC.OdbcFunctions
getDataCStringDatabase.ODBC.OdbcFunctions
getDataCStringLenDatabase.ODBC.OdbcFunctions
getDataStorableDatabase.ODBC.OdbcFunctions
getDataUTF8StringDatabase.ODBC.OdbcFunctions
getDataUtcTimeDatabase.ODBC.OdbcFunctions
getDiagRecDatabase.ODBC.OdbcFunctions
getError
1 (Function)Database.PostgreSQL.PGFunctions
2 (Function)Database.Sqlite.SqliteFunctions
getFromBufferDatabase.ODBC.OdbcFunctions
getHandleAttrDatabase.Oracle.OCIFunctions
getInfoDatabaseNameDatabase.ODBC.OdbcFunctions
getInfoDbmsNameDatabase.ODBC.OdbcFunctions
getInfoDbmsVerDatabase.ODBC.OdbcFunctions
getInfoDriverNameDatabase.ODBC.OdbcFunctions
getInfoDriverVerDatabase.ODBC.OdbcFunctions
getInfoStringDatabase.ODBC.OdbcFunctions
getMaybeFromBufferDatabase.ODBC.OdbcFunctions
getNativeSqlDatabase.ODBC.OdbcFunctions
getOCIErrorMsgDatabase.Oracle.OCIFunctions
getOCIErrorMsg2Database.Oracle.OCIFunctions
getParamDatabase.Oracle.OCIFunctions
getSessionDatabase.Oracle.OCIFunctions
getStorableFromBufferDatabase.ODBC.OdbcFunctions
getUTF8StringFromBufferDatabase.ODBC.OdbcFunctions
getUtcTimeFromBufferDatabase.ODBC.OdbcFunctions
gfinallyControl.Exception.MonadIO
gtryControl.Exception.MonadIO
gtryJustControl.Exception.MonadIO
diff --git a/doc/html/doc-index-H.html b/doc/html/doc-index-H.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-H.html @@ -0,0 +1,182 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (H)
HandleDatabase.ODBC.OdbcFunctions
HandleObj
1 (Type/Class)Database.ODBC.OdbcFunctions
2 (Data Constructor)Database.ODBC.OdbcFunctions
handleAllocDatabase.Oracle.OCIFunctions
handleFreeDatabase.Oracle.OCIFunctions
diff --git a/doc/html/doc-index-I.html b/doc/html/doc-index-I.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-I.html @@ -0,0 +1,262 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (I)
IPreparedDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
IQueryDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
ISessionDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
InOutParam
1 (Type/Class)Database.ODBC.OdbcFunctions
2 (Data Constructor)Database.ODBC.OdbcFunctions
IsolationLevelDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
IterActDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
IterResultDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
ifNullDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
ignoreDBErrorDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
inquireDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
int2PtrDatabase.ODBC.OdbcFunctions
int64ToCalTimeDatabase.Util
int64ToDatePartsDatabase.Util
int64ToUTCTimeDatabase.Util
diff --git a/doc/html/doc-index-L.html b/doc/html/doc-index-L.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-L.html @@ -0,0 +1,174 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (L)
LOAccessTypeDatabase.PostgreSQL.PGFunctions
LastInsertRowid
1 (Type/Class)Database.Sqlite.Enumerator
2 (Data Constructor)Database.Sqlite.Enumerator
lengthUTF8Foreign.C.UTF8
diff --git a/doc/html/doc-index-M.html b/doc/html/doc-index-M.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-M.html @@ -0,0 +1,290 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (M)
MyCStringDatabase.ODBC.OdbcFunctions
MyCStringLenDatabase.ODBC.OdbcFunctions
MyShowDatabase.Util
makeCentByteDatabase.Oracle.OCIFunctions
makeUtcTimeBufferDatabase.ODBC.OdbcFunctions
makeUtcTimeStringBufferDatabase.ODBC.OdbcFunctions
makeYearDatabase.Oracle.OCIFunctions
makeYearByteDatabase.Oracle.OCIFunctions
maybeBufferNullDatabase.Oracle.OCIFunctions
mkCIntDatabase.Oracle.OCIFunctions
mkCShortDatabase.Oracle.OCIFunctions
mkCUShortDatabase.Oracle.OCIFunctions
mkCalTimeDatabase.Util
mkNoticeProcessorDatabase.PostgreSQL.PGFunctions
mkNoticeReceiverDatabase.PostgreSQL.PGFunctions
mkOCICallbackInBindDatabase.Oracle.OCIFunctions
mkOCICallbackOutBindDatabase.Oracle.OCIFunctions
mkUTCTimeDatabase.Util
moreResultsDatabase.ODBC.OdbcFunctions
diff --git a/doc/html/doc-index-N.html b/doc/html/doc-index-N.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-N.html @@ -0,0 +1,214 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (N)
NextResultSet
1 (Type/Class)Database.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
2 (Data Constructor)Database.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
NoticeProcessorDatabase.PostgreSQL.PGFunctions
NoticeReceiverDatabase.PostgreSQL.PGFunctions
newUTF8StringForeign.C.UTF8
nqCopyInDatabase.PostgreSQL.PGFunctions
nqCopyIn_buflenDatabase.PostgreSQL.PGFunctions
nqExecDatabase.PostgreSQL.PGFunctions
nullByteDatabase.Oracle.OCIFunctions
diff --git a/doc/html/doc-index-O.html b/doc/html/doc-index-O.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-O.html @@ -0,0 +1,798 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (O)
OCIBuffer
1 (Type/Class)Database.Oracle.OCIFunctions
2 (Data Constructor)Database.Oracle.OCIFunctions
OCICallbackInBindDatabase.Oracle.OCIFunctions
OCICallbackOutBindDatabase.Oracle.OCIFunctions
OCIException
1 (Type/Class)Database.Oracle.OCIFunctions
2 (Data Constructor)Database.Oracle.OCIFunctions
OCIHandleDatabase.Oracle.OCIFunctions
OCIStruct
1 (Type/Class)Database.Oracle.OCIFunctions
2 (Data Constructor)Database.Oracle.OCIFunctions
OdbcBindBufferDatabase.ODBC.OdbcFunctions
OdbcBindParamDatabase.ODBC.OdbcFunctions
OdbcException
1 (Type/Class)Database.ODBC.OdbcFunctions
2 (Data Constructor)Database.ODBC.OdbcFunctions
OidDatabase.PostgreSQL.PGFunctions
Out
1 (Type/Class)Database.ODBC.Enumerator
2 (Data Constructor)Database.ODBC.Enumerator
3 (Type/Class)Database.Oracle.Enumerator
4 (Data Constructor)Database.Oracle.Enumerator
OutParam
1 (Type/Class)Database.ODBC.OdbcFunctions
2 (Data Constructor)Database.ODBC.OdbcFunctions
ociAttrGetDatabase.Oracle.OCIFunctions
ociAttrSetDatabase.Oracle.OCIFunctions
ociBindByPosDatabase.Oracle.OCIFunctions
ociBindDynamicDatabase.Oracle.OCIFunctions
ociDefineByPosDatabase.Oracle.OCIFunctions
ociEnvCreateDatabase.Oracle.OCIFunctions
ociErrorGetDatabase.Oracle.OCIFunctions
ociHandleAllocDatabase.Oracle.OCIFunctions
ociHandleFreeDatabase.Oracle.OCIFunctions
ociLogoffDatabase.Oracle.OCIFunctions
ociLogonDatabase.Oracle.OCIFunctions
ociParamGetDatabase.Oracle.OCIFunctions
ociServerAttachDatabase.Oracle.OCIFunctions
ociServerDetachDatabase.Oracle.OCIFunctions
ociSessionBeginDatabase.Oracle.OCIFunctions
ociSessionEndDatabase.Oracle.OCIFunctions
ociStmtExecuteDatabase.Oracle.OCIFunctions
ociStmtFetchDatabase.Oracle.OCIFunctions
ociStmtPrepareDatabase.Oracle.OCIFunctions
ociTerminateDatabase.Oracle.OCIFunctions
ociTransCommitDatabase.Oracle.OCIFunctions
ociTransRollbackDatabase.Oracle.OCIFunctions
ociTransStartDatabase.Oracle.OCIFunctions
oci_CRED_EXTDatabase.Oracle.OCIConstants
oci_CRED_PROXYDatabase.Oracle.OCIConstants
oci_CRED_RDBMSDatabase.Oracle.OCIConstants
oci_DEFAULTDatabase.Oracle.OCIConstants
oci_FETCH_ABSOLUTEDatabase.Oracle.OCIConstants
oci_FETCH_FIRSTDatabase.Oracle.OCIConstants
oci_FETCH_LASTDatabase.Oracle.OCIConstants
oci_FETCH_NEXTDatabase.Oracle.OCIConstants
oci_FETCH_PRIORDatabase.Oracle.OCIConstants
oci_FETCH_RELATIVEDatabase.Oracle.OCIConstants
oci_FETCH_RESERVEDDatabase.Oracle.OCIConstants
oci_NTV_SYNTAXDatabase.Oracle.OCIConstants
oci_SQLT_AFCDatabase.Oracle.OCIConstants
oci_SQLT_AVCDatabase.Oracle.OCIConstants
oci_SQLT_BINDatabase.Oracle.OCIConstants
oci_SQLT_CHRDatabase.Oracle.OCIConstants
oci_SQLT_DATDatabase.Oracle.OCIConstants
oci_SQLT_FLTDatabase.Oracle.OCIConstants
oci_SQLT_INTDatabase.Oracle.OCIConstants
oci_SQLT_LBIDatabase.Oracle.OCIConstants
oci_SQLT_LNGDatabase.Oracle.OCIConstants
oci_SQLT_LVBDatabase.Oracle.OCIConstants
oci_SQLT_LVCDatabase.Oracle.OCIConstants
oci_SQLT_NUMDatabase.Oracle.OCIConstants
oci_SQLT_RIDDatabase.Oracle.OCIConstants
oci_SQLT_RSETDatabase.Oracle.OCIConstants
oci_SQLT_STRDatabase.Oracle.OCIConstants
oci_SQLT_UINDatabase.Oracle.OCIConstants
oci_SQLT_VBIDatabase.Oracle.OCIConstants
oci_SQLT_VCSDatabase.Oracle.OCIConstants
oci_SQLT_VNUDatabase.Oracle.OCIConstants
oci_TRANS_READONLYDatabase.Oracle.OCIConstants
oci_TRANS_READWRITEDatabase.Oracle.OCIConstants
oci_TRANS_SERIALIZABLEDatabase.Oracle.OCIConstants
openDb
1 (Function)Database.PostgreSQL.PGFunctions
2 (Function)Database.Sqlite.SqliteFunctions
diff --git a/doc/html/doc-index-P.html b/doc/html/doc-index-P.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-P.html @@ -0,0 +1,678 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (P)
PGBindVal
1 (Type/Class)Database.PostgreSQL.PGFunctions
2 (Data Constructor)Database.PostgreSQL.PGFunctions
PGException
1 (Type/Class)Database.PostgreSQL.PGFunctions
2 (Data Constructor)Database.PostgreSQL.PGFunctions
PGTypeDatabase.PostgreSQL.PGFunctions
PGVerbosityDatabase.PostgreSQL.PGFunctions
PGconnDatabase.PostgreSQL.PGFunctions
PGresultDatabase.PostgreSQL.PGFunctions
ParamHandleDatabase.Oracle.OCIFunctions
ParamLenDatabase.PostgreSQL.PGFunctions
ParamStruct
1 (Type/Class)Database.Oracle.OCIFunctions
2 (Data Constructor)Database.Oracle.OCIFunctions
PositionDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
PreparationADatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
PreparedStmtDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
peekSmallIntDatabase.ODBC.OdbcFunctions
peekUIntegerDatabase.ODBC.OdbcFunctions
peekUSmallIntDatabase.ODBC.OdbcFunctions
peekUTF8StringForeign.C.UTF8
peekUTF8StringLenForeign.C.UTF8
pgDatetimeToPartsDatabase.Util
pgDatetimetoCalTimeDatabase.Util
pgDatetimetoUTCTimeDatabase.Util
pgNewValueDatabase.PostgreSQL.PGFunctions
pgPeekDatabase.PostgreSQL.PGFunctions
pgSizeDatabase.PostgreSQL.PGFunctions
pgTypeFormatDatabase.PostgreSQL.PGFunctions
pgTypeOidDatabase.PostgreSQL.PGFunctions
pokeSmallIntDatabase.ODBC.OdbcFunctions
pokeUIntegerDatabase.ODBC.OdbcFunctions
pokeUSmallIntDatabase.ODBC.OdbcFunctions
positionsDatabase.Util
prefetch
1 (Function)Database.ODBC.Enumerator
2 (Function)Database.Oracle.Enumerator
3 (Function)Database.PostgreSQL.Enumerator
4 (Function)Database.Sqlite.Enumerator
5 (Function)Database.Stub.Enumerator
prefetchRowCountDatabase.Stub.Enumerator
prepare'n'execDatabase.PostgreSQL.PGFunctions
prepareCommand
1 (Function)Database.ODBC.Enumerator
2 (Function)Database.Oracle.Enumerator
3 (Function)Database.PostgreSQL.Enumerator
4 (Function)Database.Sqlite.Enumerator
prepareLargeCommandDatabase.Oracle.Enumerator
prepareLargeQuery
1 (Function)Database.ODBC.Enumerator
2 (Function)Database.Oracle.Enumerator
3 (Function)Database.PostgreSQL.Enumerator
4 (Function)Database.Sqlite.Enumerator
preparePrefetch
1 (Function)Database.ODBC.Enumerator
2 (Function)Database.Oracle.Enumerator
3 (Function)Database.PostgreSQL.Enumerator
4 (Function)Database.Sqlite.Enumerator
prepareQuery
1 (Function)Database.ODBC.Enumerator
2 (Function)Database.Oracle.Enumerator
3 (Function)Database.PostgreSQL.Enumerator
4 (Function)Database.Sqlite.Enumerator
prepareStmt
1 (Function)Database.ODBC.Enumerator
2 (Function)Database.ODBC.OdbcFunctions
3 (Function)Database.Oracle.Enumerator
4 (Function)Database.PostgreSQL.Enumerator
5 (Function)Database.Sqlite.Enumerator
print_Database.Util
pswdDatabase.Stub.Enumerator
diff --git a/doc/html/doc-index-Q.html b/doc/html/doc-index-Q.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-Q.html @@ -0,0 +1,158 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (Q)
QueryResourceUsage
1 (Type/Class)Database.Stub.Enumerator
2 (Data Constructor)Database.Stub.Enumerator
diff --git a/doc/html/doc-index-R.html b/doc/html/doc-index-R.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-R.html @@ -0,0 +1,282 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (R)
ReadCommittedDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
ReadUncommittedDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
RefCursor
1 (Type/Class)Database.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
2 (Data Constructor)Database.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
RepeatableReadDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
ResultSetHandleDatabase.PostgreSQL.PGFunctions
RowNumDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
readUtcTimeFromMemoryDatabase.ODBC.OdbcFunctions
reportRethrowDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
reportRethrowMsgDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
resultDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
result'Database.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
rethrowPGDatabase.PostgreSQL.PGFunctions
rollback
1 (Function)Database.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
2 (Function)Database.ODBC.OdbcFunctions
rollbackTransDatabase.Oracle.OCIFunctions
rowCountDatabase.ODBC.OdbcFunctions
diff --git a/doc/html/doc-index-S.html b/doc/html/doc-index-S.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-S.html @@ -0,0 +1,1372 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (S)
SerialisableDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
SerializableDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
ServerHandleDatabase.Oracle.OCIFunctions
ServerStruct
1 (Type/Class)Database.Oracle.OCIFunctions
2 (Data Constructor)Database.Oracle.OCIFunctions
SessHandleDatabase.Oracle.OCIFunctions
SessStruct
1 (Type/Class)Database.Oracle.OCIFunctions
2 (Data Constructor)Database.Oracle.OCIFunctions
Session
1 (Type/Class)Database.ODBC.Enumerator
2 (Type/Class)Database.Oracle.Enumerator
3 (Type/Class)Database.PostgreSQL.Enumerator
4 (Type/Class)Database.Sqlite.Enumerator
5 (Type/Class)Database.Stub.Enumerator
SizeFPtrDatabase.ODBC.OdbcFunctions
SqlCDataTypeDatabase.ODBC.OdbcFunctions
SqlDataTypeDatabase.ODBC.OdbcFunctions
SqlHandleTypeDatabase.ODBC.OdbcFunctions
SqlInfoTypeDatabase.ODBC.OdbcFunctions
SqlIntegerDatabase.ODBC.OdbcFunctions
SqlLenDatabase.ODBC.OdbcFunctions
SqlParamDirectionDatabase.ODBC.OdbcFunctions
SqlReturnDatabase.ODBC.OdbcFunctions
SqlSmallIntDatabase.ODBC.OdbcFunctions
SqlStateDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
SqlStateClassDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
SqlStateSubClassDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
SqlUIntegerDatabase.ODBC.OdbcFunctions
SqlULenDatabase.ODBC.OdbcFunctions
SqlUSmallIntDatabase.ODBC.OdbcFunctions
SqliteCallbackDatabase.Sqlite.SqliteFunctions
SqliteException
1 (Type/Class)Database.Sqlite.SqliteFunctions
2 (Data Constructor)Database.Sqlite.SqliteFunctions
StatementDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
StmtHandle
1 (Type/Class)Database.ODBC.OdbcFunctions
2 (Data Constructor)Database.ODBC.OdbcFunctions
3 (Type/Class)Database.Oracle.OCIFunctions, Database.Oracle.Enumerator
4 (Type/Class)Database.Sqlite.SqliteFunctions
StmtHdlDatabase.ODBC.OdbcFunctions
StmtObj
1 (Type/Class)Database.ODBC.OdbcFunctions
2 (Data Constructor)Database.ODBC.OdbcFunctions
StmtStruct
1 (Type/Class)Database.Oracle.OCIFunctions
2 (Data Constructor)Database.Oracle.OCIFunctions
3 (Type/Class)Database.PostgreSQL.PGFunctions
4 (Type/Class)Database.Sqlite.SqliteFunctions
5 (Data Constructor)Database.Sqlite.SqliteFunctions
sbph
1 (Function)Database.Oracle.OCIFunctions
2 (Function)Database.PostgreSQL.PGFunctions
serverAttachDatabase.Oracle.OCIFunctions
serverDetachDatabase.Oracle.OCIFunctions
sessionBeginDatabase.Oracle.OCIFunctions
sessionEndDatabase.Oracle.OCIFunctions
setAutoCommitOffDatabase.ODBC.OdbcFunctions
setAutoCommitOnDatabase.ODBC.OdbcFunctions
setBufferByteDatabase.Oracle.OCIFunctions
setHandleAttrDatabase.Oracle.OCIFunctions
setHandleAttrStringDatabase.Oracle.OCIFunctions
setOdbcVerDatabase.ODBC.OdbcFunctions
setTxnIsolationDatabase.ODBC.OdbcFunctions
show_Database.Util
sizeOfMaybeDatabase.ODBC.OdbcFunctions
skipNonMatchDatabase.Util
sql
1 (Function)Database.ODBC.Enumerator
2 (Function)Database.Oracle.Enumerator
3 (Function)Database.PostgreSQL.Enumerator
4 (Function)Database.Sqlite.Enumerator
5 (Function)Database.Stub.Enumerator
sqlAllocHandleDatabase.ODBC.OdbcFunctions
sqlAutoCommitOffDatabase.ODBC.OdbcFunctions
sqlAutoCommitOnDatabase.ODBC.OdbcFunctions
sqlBindColDatabase.ODBC.OdbcFunctions
sqlBindParameterDatabase.ODBC.OdbcFunctions
sqlCloseCursorDatabase.ODBC.OdbcFunctions
sqlDescribeColDatabase.ODBC.OdbcFunctions
sqlDisconnectDatabase.ODBC.OdbcFunctions
sqlDriverConnectDatabase.ODBC.OdbcFunctions
sqlDriverNoPromptDatabase.ODBC.OdbcFunctions
sqlEndTranDatabase.ODBC.OdbcFunctions
sqlExecuteDatabase.ODBC.OdbcFunctions
sqlFetchDatabase.ODBC.OdbcFunctions
sqlFreeHandleDatabase.ODBC.OdbcFunctions
sqlGetDataDatabase.ODBC.OdbcFunctions
sqlGetDiagRecDatabase.ODBC.OdbcFunctions
sqlGetInfoDatabase.ODBC.OdbcFunctions
sqlMoreResultsDatabase.ODBC.OdbcFunctions
sqlNativeSqlDatabase.ODBC.OdbcFunctions
sqlNullDataDatabase.ODBC.OdbcFunctions
sqlNullTermedStringDatabase.ODBC.OdbcFunctions
sqlNumResultColsDatabase.ODBC.OdbcFunctions
sqlPrepareDatabase.ODBC.OdbcFunctions
sqlRowCountDatabase.ODBC.OdbcFunctions
sqlSetConnectAttrDatabase.ODBC.OdbcFunctions
sqlSetEnvAttrDatabase.ODBC.OdbcFunctions
sqlTransCommitDatabase.ODBC.OdbcFunctions
sqlTransRollbackDatabase.ODBC.OdbcFunctions
sqlbind
1 (Function)Database.ODBC.Enumerator
2 (Function)Database.Oracle.Enumerator
3 (Function)Database.PostgreSQL.Enumerator
4 (Function)Database.Sqlite.Enumerator
sqliteBindBlobDatabase.Sqlite.SqliteFunctions
sqliteBindDoubleDatabase.Sqlite.SqliteFunctions
sqliteBindIntDatabase.Sqlite.SqliteFunctions
sqliteBindInt64Database.Sqlite.SqliteFunctions
sqliteBindNullDatabase.Sqlite.SqliteFunctions
sqliteBindTextDatabase.Sqlite.SqliteFunctions
sqliteBindText16Database.Sqlite.SqliteFunctions
sqliteChangesDatabase.Sqlite.SqliteFunctions
sqliteCloseDatabase.Sqlite.SqliteFunctions
sqliteColumnBlobDatabase.Sqlite.SqliteFunctions
sqliteColumnBytesDatabase.Sqlite.SqliteFunctions
sqliteColumnCountDatabase.Sqlite.SqliteFunctions
sqliteColumnDoubleDatabase.Sqlite.SqliteFunctions
sqliteColumnIntDatabase.Sqlite.SqliteFunctions
sqliteColumnInt64Database.Sqlite.SqliteFunctions
sqliteColumnTextDatabase.Sqlite.SqliteFunctions
sqliteColumnText16Database.Sqlite.SqliteFunctions
sqliteDONEDatabase.Sqlite.SqliteFunctions
sqliteERRORDatabase.Sqlite.SqliteFunctions
sqliteErrcodeDatabase.Sqlite.SqliteFunctions
sqliteErrmsgDatabase.Sqlite.SqliteFunctions
sqliteExecDatabase.Sqlite.SqliteFunctions
sqliteFinaliseDatabase.Sqlite.SqliteFunctions
sqliteFreeDatabase.Sqlite.SqliteFunctions
sqliteLastInsertRowidDatabase.Sqlite.SqliteFunctions
sqliteOKDatabase.Sqlite.SqliteFunctions
sqliteOpenDatabase.Sqlite.SqliteFunctions
sqlitePrepareDatabase.Sqlite.SqliteFunctions
sqliteROWDatabase.Sqlite.SqliteFunctions
sqliteResetDatabase.Sqlite.SqliteFunctions
sqliteStepDatabase.Sqlite.SqliteFunctions
stmtChangesDatabase.Sqlite.SqliteFunctions
stmtDbmsDatabase.ODBC.OdbcFunctions
stmtExec
1 (Function)Database.PostgreSQL.PGFunctions
2 (Function)Database.Sqlite.SqliteFunctions
stmtExec0Database.PostgreSQL.PGFunctions
stmtExec0tDatabase.PostgreSQL.PGFunctions
stmtExecImmDatabase.PostgreSQL.PGFunctions
stmtExecImm0Database.PostgreSQL.PGFunctions
stmtExecuteDatabase.Oracle.OCIFunctions
stmtFetch
1 (Function)Database.Oracle.OCIFunctions
2 (Function)Database.Sqlite.SqliteFunctions
stmtFinalise
1 (Function)Database.PostgreSQL.PGFunctions
2 (Function)Database.Sqlite.SqliteFunctions
stmtHdlDatabase.ODBC.OdbcFunctions
stmtPrepare
1 (Function)Database.Oracle.OCIFunctions
2 (Function)Database.PostgreSQL.PGFunctions
3 (Function)Database.Sqlite.SqliteFunctions
stmtResetDatabase.Sqlite.SqliteFunctions
diff --git a/doc/html/doc-index-T.html b/doc/html/doc-index-T.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-T.html @@ -0,0 +1,266 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (T)
terminateDatabase.Oracle.OCIFunctions
testForError
1 (Function)Database.Oracle.OCIFunctions
2 (Function)Database.Sqlite.SqliteFunctions
testForErrorWithPtr
1 (Function)Database.Oracle.OCIFunctions
2 (Function)Database.Sqlite.SqliteFunctions
testForNullDatabase.ODBC.OdbcFunctions
throwDBDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
throwOCIDatabase.Oracle.OCIFunctions
throwOdbcDatabase.ODBC.OdbcFunctions
throwPGDatabase.PostgreSQL.PGFunctions
throwSqliteDatabase.Sqlite.SqliteFunctions
toCCharDatabase.PostgreSQL.PGFunctions
toCIntDatabase.PostgreSQL.PGFunctions
toUTF8Foreign.C.UTF8
toUTF8StringForeign.C.UTF8
diff --git a/doc/html/doc-index-U.html b/doc/html/doc-index-U.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-U.html @@ -0,0 +1,230 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (U)
UTF16CStringDatabase.Sqlite.SqliteFunctions
UTF8CStringDatabase.Sqlite.SqliteFunctions
UserHandleDatabase.Oracle.OCIFunctions
UserStruct
1 (Type/Class)Database.Oracle.OCIFunctions
2 (Data Constructor)Database.Oracle.OCIFunctions
userDatabase.Stub.Enumerator
utcTimeToBufferDatabase.Oracle.OCIFunctions
utcTimeToIsoDatetimeDatabase.Util
utcTimeToIsoStringDatabase.Util
utcTimeToOdbcDatetimeDatabase.Util
utcTimeToPGDatetimeDatabase.Util
diff --git a/doc/html/doc-index-V.html b/doc/html/doc-index-V.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-V.html @@ -0,0 +1,146 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (V)
VoidDatabase.PostgreSQL.PGFunctions
diff --git a/doc/html/doc-index-W.html b/doc/html/doc-index-W.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index-W.html @@ -0,0 +1,242 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
ABCDEFGHILMNOPQRSTUVW
Index (W)
WhenceTypeDatabase.PostgreSQL.PGFunctions
WindowHandleDatabase.ODBC.OdbcFunctions
withBoundStatementDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
withContinuedSessionDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
withCursorDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
withPreparedStatementDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
withSessionDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
withTransactionDatabase.Enumerator, Database.ODBC.Enumerator, Database.Oracle.Enumerator, Database.PostgreSQL.Enumerator, Database.Sqlite.Enumerator
withUTF8StringForeign.C.UTF8
withUTF8StringLenForeign.C.UTF8
wordsByDatabase.Util
wrapSizedBufferDatabase.ODBC.OdbcFunctions
writeUTCTimeToMemoryDatabase.ODBC.OdbcFunctions
diff --git a/doc/html/doc-index.html b/doc/html/doc-index.html new file mode 100644 --- /dev/null +++ b/doc/html/doc-index.html @@ -0,0 +1,132 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. (Index)
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Index
ABCDEFGHILMNOPQRSTUVW
diff --git a/doc/html/haddock.css b/doc/html/haddock.css new file mode 100644 --- /dev/null +++ b/doc/html/haddock.css @@ -0,0 +1,235 @@ +/* -------- Global things --------- */ + +BODY { + background-color: #ffffff; + color: #000000; + font-family: sans-serif; + } + +A:link { color: #0000e0; text-decoration: none } +A:visited { color: #0000a0; text-decoration: none } +A:hover { background-color: #e0e0ff; text-decoration: none } + +TABLE.vanilla { + width: 100%; + border-width: 0px; + /* I can't seem to specify cellspacing or cellpadding properly using CSS... */ +} + +TABLE.vanilla2 { + border-width: 0px; +} + +/* font is a little too small in MSIE */ +TT { font-size: 100%; } +PRE { font-size: 100%; } + +LI P { margin: 0pt } + +TD { + border-width: 0px; +} + +TABLE.narrow { + border-width: 0px; +} + +TD.s8 { height: 8px; } +TD.s15 { height: 15px; } + +SPAN.keyword { text-decoration: underline; } + +/* Resize the buttom image to match the text size */ +IMG.coll { width : 0.75em; height: 0.75em; margin-bottom: 0; margin-right: 0.5em } + +/* --------- Contents page ---------- */ + +DIV.node { + padding-left: 3em; +} + +DIV.cnode { + padding-left: 1.75em; +} + +SPAN.pkg { + position: absolute; + left: 50em; +} + +/* --------- Documentation elements ---------- */ + +TD.children { + padding-left: 25px; + } + +TD.synopsis { + padding: 2px; + background-color: #f0f0f0; + font-family: monospace + } + +TD.decl { + padding: 2px; + background-color: #f0f0f0; + font-family: monospace; + vertical-align: top; + } + +/* + arg is just like decl, except that wrapping is not allowed. It is + used for function and constructor arguments which have a text box + to the right, where if wrapping is allowed the text box squashes up + the declaration by wrapping it. +*/ +TD.arg { + padding: 2px; + background-color: #f0f0f0; + font-family: monospace; + vertical-align: top; + white-space: nowrap; + } + +TD.recfield { padding-left: 20px } + +TD.doc { + padding-top: 2px; + padding-left: 10px; + } + +TD.ndoc { + padding: 2px; + } + +TD.rdoc { + padding: 2px; + padding-left: 10px; + width: 100%; + } + +TD.body { + padding-left: 10px + } + +TD.pkg { + width: 100%; + padding-left: 10px +} + +TD.indexentry { + vertical-align: top; + padding-right: 10px + } + +TD.indexannot { + vertical-align: top; + padding-left: 20px; + white-space: nowrap + } + +TD.indexlinks { + width: 100% + } + +/* ------- Section Headings ------- */ + +TD.section1 { + padding-top: 15px; + font-weight: bold; + font-size: 150% + } + +TD.section2 { + padding-top: 10px; + font-weight: bold; + font-size: 130% + } + +TD.section3 { + padding-top: 5px; + font-weight: bold; + font-size: 110% + } + +TD.section4 { + font-weight: bold; + font-size: 100% + } + +/* -------------- The title bar at the top of the page */ + +TD.infohead { + color: #ffffff; + font-weight: bold; + padding-right: 10px; + text-align: left; +} + +TD.infoval { + color: #ffffff; + padding-right: 10px; + text-align: left; +} + +TD.topbar { + background-color: #000099; + padding: 5px; +} + +TD.title { + color: #ffffff; + padding-left: 10px; + width: 100% + } + +TD.topbut { + padding-left: 5px; + padding-right: 5px; + border-left-width: 1px; + border-left-color: #ffffff; + border-left-style: solid; + white-space: nowrap; + } + +TD.topbut A:link { + color: #ffffff + } + +TD.topbut A:visited { + color: #ffff00 + } + +TD.topbut A:hover { + background-color: #6060ff; + } + +TD.topbut:hover { + background-color: #6060ff + } + +TD.modulebar { + background-color: #0077dd; + padding: 5px; + border-top-width: 1px; + border-top-color: #ffffff; + border-top-style: solid; + } + +/* --------- The page footer --------- */ + +TD.botbar { + background-color: #000099; + color: #ffffff; + padding: 5px + } +TD.botbar A:link { + color: #ffffff; + text-decoration: underline + } +TD.botbar A:visited { + color: #ffff00 + } +TD.botbar A:hover { + background-color: #6060ff + } + diff --git a/doc/html/haddock.js b/doc/html/haddock.js new file mode 100644 --- /dev/null +++ b/doc/html/haddock.js @@ -0,0 +1,15 @@ +// Haddock JavaScript utilities +function toggle(button,id) +{ + var n = document.getElementById(id).style; + if (n.display == "none") + { + button.src = "minus.gif"; + n.display = "block"; + } + else + { + button.src = "plus.gif"; + n.display = "none"; + } +} diff --git a/doc/html/haskell_icon.gif b/doc/html/haskell_icon.gif new file mode 100644 Binary files /dev/null and b/doc/html/haskell_icon.gif differ diff --git a/doc/html/index.html b/doc/html/index.html new file mode 100644 --- /dev/null +++ b/doc/html/index.html @@ -0,0 +1,375 @@ + + +Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.

Takusen is a DBMS access library. Like HSQL and HDBC, we support +arbitrary SQL statements (currently strings, extensible to anything +that can be converted to a string). +

Takusen's unique selling point is safety and efficiency. +We statically ensure all acquired database resources - such +as cursors, connections, and statement handles - are released, exactly +once, at predictable times. Takusen can avoid loading the whole result +set in memory, and so can handle queries returning millions of rows in +constant space. Takusen also supports automatic marshalling and +unmarshalling of results and query parameters. These benefits come +from the design of query result processing around a left-fold +enumerator. +

Currently we fully support ODBC, Oracle, Sqlite, and PostgreSQL. +

Modules
show/hideControl
show/hideException
Control.Exception.MonadIO
show/hideDatabase
Database.Enumerator
show/hideODBC
Database.ODBC.Enumerator
Database.ODBC.OdbcFunctions
show/hideOracle
Database.Oracle.Enumerator
Database.Oracle.OCIConstants
Database.Oracle.OCIFunctions
show/hidePostgreSQL
Database.PostgreSQL.Enumerator
Database.PostgreSQL.PGFunctions
show/hideSqlite
Database.Sqlite.Enumerator
Database.Sqlite.SqliteFunctions
show/hideStub
Database.Stub.Enumerator
Database.Util
show/hideForeign
show/hideC
Foreign.C.UTF8
Produced by Haddock version 0.7
diff --git a/doc/html/minus.gif b/doc/html/minus.gif new file mode 100644 Binary files /dev/null and b/doc/html/minus.gif differ diff --git a/doc/html/plus.gif b/doc/html/plus.gif new file mode 100644 Binary files /dev/null and b/doc/html/plus.gif differ