{-# LANGUAGE FlexibleContexts #-}

module Opaleye.SQLite.RunQuery (module Opaleye.SQLite.RunQuery,
                         QueryRunner,
                         IRQ.QueryRunnerColumn,
                         IRQ.fieldQueryRunnerColumn) where

import qualified Database.SQLite.Simple as PGS
import qualified Database.SQLite.Simple.FromRow as FR
import qualified Data.String as String

import           Opaleye.SQLite.Column (Column)
import qualified Opaleye.SQLite.Sql as S
import           Opaleye.SQLite.QueryArr (Query)
import           Opaleye.SQLite.Internal.RunQuery (QueryRunner(QueryRunner))
import qualified Opaleye.SQLite.Internal.RunQuery as IRQ
import qualified Opaleye.SQLite.Internal.QueryArr as Q

import qualified Data.Profunctor as P
import qualified Data.Profunctor.Product.Default as D

import           Control.Applicative ((*>))

-- | @runQuery@'s use of the 'D.Default' typeclass means that the
-- compiler will have trouble inferring types.  It is strongly
-- recommended that you provide full type signatures when using
-- @runQuery@.
--
-- Example type specialization:
--
-- @
-- runQuery :: Query (Column 'Opaleye.PGTypes.PGInt4', Column 'Opaleye.PGTypes.PGText') -> IO [(Column Int, Column String)]
-- @
--
-- Assuming the @makeAdaptorAndInstance@ splice has been run for the product type @Foo@:
--
-- @
-- runQuery :: Query (Foo (Column 'Opaleye.PGTypes.PGInt4') (Column 'Opaleye.PGTypes.PGText') (Column 'Opaleye.PGTypes.PGBool')
--          -> IO [(Foo (Column Int) (Column String) (Column Bool)]
-- @
--
-- Opaleye types are converted to Haskell types based on instances of
-- the 'Opaleye.Internal.RunQuery.QueryRunnerColumnDefault' typeclass.
runQuery :: D.Default QueryRunner columns haskells
         => PGS.Connection
         -> Query columns
         -> IO [haskells]
runQuery :: Connection -> Query columns -> IO [haskells]
runQuery = QueryRunner columns haskells
-> Connection -> Query columns -> IO [haskells]
forall columns haskells.
QueryRunner columns haskells
-> Connection -> Query columns -> IO [haskells]
runQueryExplicit QueryRunner columns haskells
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

runQueryExplicit :: QueryRunner columns haskells
                 -> PGS.Connection
                 -> Query columns
                 -> IO [haskells]
runQueryExplicit :: QueryRunner columns haskells
-> Connection -> Query columns -> IO [haskells]
runQueryExplicit (QueryRunner Unpackspec columns ()
u columns -> RowParser haskells
rowParser columns -> Bool
nonZeroColumns) Connection
conn Query columns
q =
  RowParser haskells -> Connection -> Query -> IO [haskells]
forall r. RowParser r -> Connection -> Query -> IO [r]
PGS.queryWith_ RowParser haskells
parser Connection
conn Query
sql
  where sql :: PGS.Query
        sql :: Query
sql = String -> Query
forall a. IsString a => String -> a
String.fromString (Unpackspec columns () -> Query columns -> String
forall columns b. Unpackspec columns b -> Query columns -> String
S.showSqlForPostgresExplicit Unpackspec columns ()
u Query columns
q)
        -- FIXME: We're doing work twice here
        (columns
b, PrimQuery
_, Tag
_) = Query columns -> () -> (columns, PrimQuery, Tag)
forall a b. QueryArr a b -> a -> (b, PrimQuery, Tag)
Q.runSimpleQueryArrStart Query columns
q ()
        parser :: RowParser haskells
parser = if columns -> Bool
nonZeroColumns columns
b
                 then columns -> RowParser haskells
rowParser columns
b
                 else (RowParser (Only Int)
forall a. FromRow a => RowParser a
FR.fromRow :: FR.RowParser (PGS.Only Int)) RowParser (Only Int) -> RowParser haskells -> RowParser haskells
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> columns -> RowParser haskells
rowParser columns
b
                 -- If we are selecting zero columns then the SQL
                 -- generator will have to put a dummy 0 into the
                 -- SELECT statement, since we can't select zero
                 -- columns.  In that case we have to make sure we
                 -- read a single Int.

-- | Use 'queryRunnerColumn' to make an instance to allow you to run queries on
--   your own datatypes.  For example:
--
-- @
-- newtype Foo = Foo Int
-- instance Default QueryRunnerColumn Foo Foo where
--    def = queryRunnerColumn ('Opaleye.Column.unsafeCoerce' :: Column Foo -> Column PGInt4) Foo def
-- @
queryRunnerColumn :: (Column a' -> Column a) -> (b -> b')
                  -> IRQ.QueryRunnerColumn a b -> IRQ.QueryRunnerColumn a' b'
queryRunnerColumn :: (Column a' -> Column a)
-> (b -> b') -> QueryRunnerColumn a b -> QueryRunnerColumn a' b'
queryRunnerColumn Column a' -> Column a
colF b -> b'
haskellF QueryRunnerColumn a b
qrc = Unpackspec (Column a') ()
-> FieldParser b' -> QueryRunnerColumn a' b'
forall sqlType haskellType.
Unpackspec (Column sqlType) ()
-> FieldParser haskellType -> QueryRunnerColumn sqlType haskellType
IRQ.QueryRunnerColumn ((Column a' -> Column a)
-> Unpackspec (Column a) () -> Unpackspec (Column a') ()
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
P.lmap Column a' -> Column a
colF Unpackspec (Column a) ()
u)
                                                            ((b -> b') -> (Field -> Ok b) -> FieldParser b'
forall a b. (a -> b) -> (Field -> Ok a) -> Field -> Ok b
fmapFP b -> b'
haskellF Field -> Ok b
fp)
  where IRQ.QueryRunnerColumn Unpackspec (Column a) ()
u Field -> Ok b
fp = QueryRunnerColumn a b
qrc
        fmapFP :: (a -> b) -> (Field -> Ok a) -> Field -> Ok b
fmapFP = (Ok a -> Ok b) -> (Field -> Ok a) -> Field -> Ok b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Ok a -> Ok b) -> (Field -> Ok a) -> Field -> Ok b)
-> ((a -> b) -> Ok a -> Ok b)
-> (a -> b)
-> (Field -> Ok a)
-> Field
-> Ok b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Ok a -> Ok b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap