{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
------------------------------------------------------------------------------
-- |
-- Module:      Database.SQLite.Simple.Internal
-- Copyright:   (c) 2011-2012 Leon P Smith
--              (c) 2012-2013 Janne Hellsten
-- License:     BSD3
-- Maintainer:  Janne Hellsten <jjhellst@gmail.com>
-- Portability: portable
--
-- Internal bits.  This interface is less stable and can change at any time.
-- In particular this means that while the rest of the sqlite-simple
-- package endeavors to follow the package versioning policy,  this module
-- does not.  Also, at the moment there are things in here that aren't
-- particularly internal and are exported elsewhere;  these will eventually
-- disappear from this module.
--
------------------------------------------------------------------------------

module Database.SQLite.Simple.Internal where

import           Control.Exception (Exception)
import           Control.Monad
import           Control.Applicative
import           Data.ByteString (ByteString)
import           Data.ByteString.Char8()
import           Data.Typeable (Typeable)
import           Control.Monad.Trans.State.Strict
import           Control.Monad.Trans.Reader

import           Database.SQLite.Simple.Ok
import qualified Database.SQLite3 as Base

-- | Connection to an open database.
--
-- You can use 'connectionHandle' to gain access to the underlying
-- <http://hackage.haskell.org/package/direct-sqlite> connection.
-- This may be useful if you need to access some direct-sqlite
-- functionality that's not exposed in the sqlite-simple API.  This
-- should be a safe thing to do although mixing both APIs is
-- discouraged.
newtype Connection = Connection { Connection -> Database
connectionHandle :: Base.Database }

data ColumnOutOfBounds = ColumnOutOfBounds { ColumnOutOfBounds -> Int
errorColumnIndex :: !Int }
                      deriving (ColumnOutOfBounds -> ColumnOutOfBounds -> Bool
(ColumnOutOfBounds -> ColumnOutOfBounds -> Bool)
-> (ColumnOutOfBounds -> ColumnOutOfBounds -> Bool)
-> Eq ColumnOutOfBounds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnOutOfBounds -> ColumnOutOfBounds -> Bool
$c/= :: ColumnOutOfBounds -> ColumnOutOfBounds -> Bool
== :: ColumnOutOfBounds -> ColumnOutOfBounds -> Bool
$c== :: ColumnOutOfBounds -> ColumnOutOfBounds -> Bool
Eq, Int -> ColumnOutOfBounds -> ShowS
[ColumnOutOfBounds] -> ShowS
ColumnOutOfBounds -> String
(Int -> ColumnOutOfBounds -> ShowS)
-> (ColumnOutOfBounds -> String)
-> ([ColumnOutOfBounds] -> ShowS)
-> Show ColumnOutOfBounds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnOutOfBounds] -> ShowS
$cshowList :: [ColumnOutOfBounds] -> ShowS
show :: ColumnOutOfBounds -> String
$cshow :: ColumnOutOfBounds -> String
showsPrec :: Int -> ColumnOutOfBounds -> ShowS
$cshowsPrec :: Int -> ColumnOutOfBounds -> ShowS
Show, Typeable)

instance Exception ColumnOutOfBounds

-- | A Field represents metadata about a particular field
data Field = Field {
     Field -> SQLData
result   :: Base.SQLData
   , Field -> Int
column   :: {-# UNPACK #-} !Int
   }

-- Named type for holding RowParser read-only state.  Just for making
-- it easier to make sense out of types in FromRow.
newtype RowParseRO = RowParseRO { RowParseRO -> Int
nColumns :: Int }

newtype RowParser a = RP { RowParser a -> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a
unRP :: ReaderT RowParseRO (StateT (Int, [Base.SQLData]) Ok) a }
   deriving ( a -> RowParser b -> RowParser a
(a -> b) -> RowParser a -> RowParser b
(forall a b. (a -> b) -> RowParser a -> RowParser b)
-> (forall a b. a -> RowParser b -> RowParser a)
-> Functor RowParser
forall a b. a -> RowParser b -> RowParser a
forall a b. (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RowParser b -> RowParser a
$c<$ :: forall a b. a -> RowParser b -> RowParser a
fmap :: (a -> b) -> RowParser a -> RowParser b
$cfmap :: forall a b. (a -> b) -> RowParser a -> RowParser b
Functor, Functor RowParser
a -> RowParser a
Functor RowParser
-> (forall a. a -> RowParser a)
-> (forall a b. RowParser (a -> b) -> RowParser a -> RowParser b)
-> (forall a b c.
    (a -> b -> c) -> RowParser a -> RowParser b -> RowParser c)
-> (forall a b. RowParser a -> RowParser b -> RowParser b)
-> (forall a b. RowParser a -> RowParser b -> RowParser a)
-> Applicative RowParser
RowParser a -> RowParser b -> RowParser b
RowParser a -> RowParser b -> RowParser a
RowParser (a -> b) -> RowParser a -> RowParser b
(a -> b -> c) -> RowParser a -> RowParser b -> RowParser c
forall a. a -> RowParser a
forall a b. RowParser a -> RowParser b -> RowParser a
forall a b. RowParser a -> RowParser b -> RowParser b
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall a b c.
(a -> b -> c) -> RowParser a -> RowParser b -> RowParser c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: RowParser a -> RowParser b -> RowParser a
$c<* :: forall a b. RowParser a -> RowParser b -> RowParser a
*> :: RowParser a -> RowParser b -> RowParser b
$c*> :: forall a b. RowParser a -> RowParser b -> RowParser b
liftA2 :: (a -> b -> c) -> RowParser a -> RowParser b -> RowParser c
$cliftA2 :: forall a b c.
(a -> b -> c) -> RowParser a -> RowParser b -> RowParser c
<*> :: RowParser (a -> b) -> RowParser a -> RowParser b
$c<*> :: forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
pure :: a -> RowParser a
$cpure :: forall a. a -> RowParser a
$cp1Applicative :: Functor RowParser
Applicative, Applicative RowParser
RowParser a
Applicative RowParser
-> (forall a. RowParser a)
-> (forall a. RowParser a -> RowParser a -> RowParser a)
-> (forall a. RowParser a -> RowParser [a])
-> (forall a. RowParser a -> RowParser [a])
-> Alternative RowParser
RowParser a -> RowParser a -> RowParser a
RowParser a -> RowParser [a]
RowParser a -> RowParser [a]
forall a. RowParser a
forall a. RowParser a -> RowParser [a]
forall a. RowParser a -> RowParser a -> RowParser a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: RowParser a -> RowParser [a]
$cmany :: forall a. RowParser a -> RowParser [a]
some :: RowParser a -> RowParser [a]
$csome :: forall a. RowParser a -> RowParser [a]
<|> :: RowParser a -> RowParser a -> RowParser a
$c<|> :: forall a. RowParser a -> RowParser a -> RowParser a
empty :: RowParser a
$cempty :: forall a. RowParser a
$cp1Alternative :: Applicative RowParser
Alternative, Applicative RowParser
a -> RowParser a
Applicative RowParser
-> (forall a b. RowParser a -> (a -> RowParser b) -> RowParser b)
-> (forall a b. RowParser a -> RowParser b -> RowParser b)
-> (forall a. a -> RowParser a)
-> Monad RowParser
RowParser a -> (a -> RowParser b) -> RowParser b
RowParser a -> RowParser b -> RowParser b
forall a. a -> RowParser a
forall a b. RowParser a -> RowParser b -> RowParser b
forall a b. RowParser a -> (a -> RowParser b) -> RowParser b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> RowParser a
$creturn :: forall a. a -> RowParser a
>> :: RowParser a -> RowParser b -> RowParser b
$c>> :: forall a b. RowParser a -> RowParser b -> RowParser b
>>= :: RowParser a -> (a -> RowParser b) -> RowParser b
$c>>= :: forall a b. RowParser a -> (a -> RowParser b) -> RowParser b
$cp1Monad :: Applicative RowParser
Monad, Monad RowParser
Alternative RowParser
RowParser a
Alternative RowParser
-> Monad RowParser
-> (forall a. RowParser a)
-> (forall a. RowParser a -> RowParser a -> RowParser a)
-> MonadPlus RowParser
RowParser a -> RowParser a -> RowParser a
forall a. RowParser a
forall a. RowParser a -> RowParser a -> RowParser a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: RowParser a -> RowParser a -> RowParser a
$cmplus :: forall a. RowParser a -> RowParser a -> RowParser a
mzero :: RowParser a
$cmzero :: forall a. RowParser a
$cp2MonadPlus :: Monad RowParser
$cp1MonadPlus :: Alternative RowParser
MonadPlus )

gettypename :: Base.SQLData -> ByteString
gettypename :: SQLData -> ByteString
gettypename (Base.SQLInteger Int64
_) = ByteString
"INTEGER"
gettypename (Base.SQLFloat Double
_) = ByteString
"FLOAT"
gettypename (Base.SQLText Text
_) = ByteString
"TEXT"
gettypename (Base.SQLBlob ByteString
_) = ByteString
"BLOB"
gettypename SQLData
Base.SQLNull = ByteString
"NULL"