{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
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.IORef
import Data.Typeable (Typeable)
import Data.Word
import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Reader
import Database.SQLite.Simple.Ok
import qualified Database.SQLite3 as Base
data Connection = Connection
{ Connection -> Database
connectionHandle :: {-# UNPACK #-} !Base.Database
, Connection -> IORef Word64
connectionTempNameCounter :: {-# UNPACK #-} !(IORef Word64)
}
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
$c== :: ColumnOutOfBounds -> ColumnOutOfBounds -> Bool
== :: ColumnOutOfBounds -> ColumnOutOfBounds -> Bool
$c/= :: ColumnOutOfBounds -> ColumnOutOfBounds -> Bool
/= :: 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
$cshowsPrec :: Int -> ColumnOutOfBounds -> ShowS
showsPrec :: Int -> ColumnOutOfBounds -> ShowS
$cshow :: ColumnOutOfBounds -> String
show :: ColumnOutOfBounds -> String
$cshowList :: [ColumnOutOfBounds] -> ShowS
showList :: [ColumnOutOfBounds] -> ShowS
Show, Typeable)
instance Exception ColumnOutOfBounds
data Field = Field {
Field -> SQLData
result :: Base.SQLData
, Field -> Int
column :: {-# UNPACK #-} !Int
}
newtype RowParseRO = RowParseRO { RowParseRO -> Int
nColumns :: Int }
newtype RowParser a = RP { forall a.
RowParser a -> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a
unRP :: ReaderT RowParseRO (StateT (Int, [Base.SQLData]) Ok) a }
deriving ( (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
$cfmap :: forall a b. (a -> b) -> RowParser a -> RowParser b
fmap :: forall a b. (a -> b) -> RowParser a -> RowParser b
$c<$ :: forall a b. a -> RowParser b -> RowParser a
<$ :: forall a b. a -> RowParser b -> RowParser a
Functor, Functor RowParser
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
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
$cpure :: forall a. a -> RowParser a
pure :: forall a. a -> RowParser a
$c<*> :: forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
<*> :: forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
$cliftA2 :: forall a b c.
(a -> b -> c) -> RowParser a -> RowParser b -> RowParser c
liftA2 :: forall a b c.
(a -> b -> c) -> RowParser a -> RowParser b -> RowParser c
$c*> :: forall a b. RowParser a -> RowParser b -> RowParser b
*> :: forall a b. RowParser a -> RowParser b -> RowParser b
$c<* :: forall a b. RowParser a -> RowParser b -> RowParser a
<* :: forall a b. RowParser a -> RowParser b -> RowParser a
Applicative, Applicative RowParser
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
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
$cempty :: forall a. RowParser a
empty :: forall a. RowParser a
$c<|> :: forall a. RowParser a -> RowParser a -> RowParser a
<|> :: forall a. RowParser a -> RowParser a -> RowParser a
$csome :: forall a. RowParser a -> RowParser [a]
some :: forall a. RowParser a -> RowParser [a]
$cmany :: forall a. RowParser a -> RowParser [a]
many :: forall a. RowParser a -> RowParser [a]
Alternative, Applicative RowParser
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
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
$c>>= :: forall a b. RowParser a -> (a -> RowParser b) -> RowParser b
>>= :: forall a b. RowParser a -> (a -> RowParser b) -> RowParser b
$c>> :: forall a b. RowParser a -> RowParser b -> RowParser b
>> :: forall a b. RowParser a -> RowParser b -> RowParser b
$creturn :: forall a. a -> RowParser a
return :: forall a. a -> RowParser a
Monad, Monad RowParser
Alternative RowParser
(Alternative RowParser, Monad RowParser) =>
(forall a. RowParser a)
-> (forall a. RowParser a -> RowParser a -> RowParser a)
-> MonadPlus RowParser
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
$cmzero :: forall a. RowParser a
mzero :: forall a. RowParser a
$cmplus :: forall a. RowParser a -> RowParser a -> RowParser a
mplus :: forall a. RowParser a -> RowParser a -> RowParser a
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"