{-# 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.Typeable (Typeable)
import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Reader
import Database.SQLite.Simple.Ok
import qualified Database.SQLite3 as Base
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
data Field = Field {
Field -> SQLData
result :: Base.SQLData
, Field -> Int
column :: {-# UNPACK #-} !Int
}
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 _) = "INTEGER"
gettypename (Base.SQLFloat _) = "FLOAT"
gettypename (Base.SQLText _) = "TEXT"
gettypename (Base.SQLBlob _) = "BLOB"
gettypename Base.SQLNull = "NULL"