{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}

module Opaleye.RunSelect
  (-- * Running 'S.Select's
   runSelect,
   runSelectI,
   runSelectTF,
   runSelectFold,
   -- * Cursor interface
   declareCursor,
   closeCursor,
   foldForward,
   -- * Creating new 'FromField's
   unsafeFromField,
   -- * Explicit versions
   runSelectExplicit,
   runSelectFoldExplicit,
   declareCursorExplicit,
   -- * Datatypes
   IRQ.Cursor,
   IRQ.FromFields,
   IRQ.FromField,
   IRQ.DefaultFromField(defaultFromField),
   -- * Helper functions
   IRQ.fromPGSFromField,
   IRQ.fromPGSFieldParser) where

import qualified Data.Profunctor            as P
import qualified Database.PostgreSQL.Simple as PGS

import qualified Opaleye.Column as C
import qualified Opaleye.Select as S
import qualified Opaleye.Internal.RunQueryExternal as RQ
import qualified Opaleye.TypeFamilies as TF
import           Opaleye.Internal.RunQuery (FromFields)
import qualified Opaleye.Internal.RunQuery as IRQ
import           Opaleye.Internal.Inferrable (Inferrable, runInferrable)

import qualified Data.Profunctor.Product.Default as D

-- | @runSelect@'s use of the @'D.Default' 'FromFields'@
-- typeclass means that the
-- compiler will have trouble inferring types.  It is strongly
-- recommended that you provide full type signatures when using
-- @runSelect@.
--
-- Example type specialization:
--
-- @
-- runSelect :: 'S.Select' ('Opaleye.Field.Field' 'Opaleye.SqlTypes.SqlInt4', 'Opaleye.Field.Field' 'Opaleye.SqlTypes.SqlText') -> IO [(Int, String)]
-- @
--
-- Assuming the @makeAdaptorAndInstance@ splice has been run for the product type @Foo@:
--
-- @
-- runSelect :: 'S.Select' (Foo ('Opaleye.Field.Field' 'Opaleye.SqlTypes.SqlInt4') ('Opaleye.Field.Field' 'Opaleye.SqlTypes.SqlText') ('Opaleye.Field.Field' 'Opaleye.SqlTypes.SqlBool')
--           -> IO [Foo Int String Bool]
-- @
runSelect :: D.Default FromFields fields haskells
          => PGS.Connection
          -- ^
          -> S.Select fields
          -- ^
          -> IO [haskells]
runSelect :: Connection -> Select fields -> IO [haskells]
runSelect = Connection -> Select fields -> IO [haskells]
forall fields haskells.
Default FromFields fields haskells =>
Connection -> Select fields -> IO [haskells]
RQ.runQuery

-- | 'runSelectTF' has better type inference than 'runSelect' but only
-- works with "higher-kinded data" types.
runSelectTF :: D.Default FromFields (rec TF.O) (rec TF.H)
            => PGS.Connection
            -- ^
            -> S.Select (rec TF.O)
            -- ^
            -> IO [rec TF.H]
runSelectTF :: Connection -> Select (rec O) -> IO [rec H]
runSelectTF = Connection -> Select (rec O) -> IO [rec H]
forall fields haskells.
Default FromFields fields haskells =>
Connection -> Select fields -> IO [haskells]
RQ.runQuery

-- | @runSelectFold@ streams the results of a query incrementally and consumes
-- the results with a left fold.
--
-- This fold is /not/ strict. The stream consumer is responsible for
-- forcing the evaluation of its result to avoid space leaks.
runSelectFold
  :: D.Default FromFields fields haskells
  => PGS.Connection
  -- ^
  -> S.Select fields
  -- ^
  -> b
  -- ^
  -> (b -> haskells -> IO b)
  -- ^
  -> IO b
runSelectFold :: Connection -> Select fields -> b -> (b -> haskells -> IO b) -> IO b
runSelectFold = Connection -> Select fields -> b -> (b -> haskells -> IO b) -> IO b
forall fields haskells b.
Default FromFields fields haskells =>
Connection -> Select fields -> b -> (b -> haskells -> IO b) -> IO b
RQ.runQueryFold

-- | Declare a temporary cursor. The cursor is given a unique name for the given
-- connection.
declareCursor
    :: D.Default FromFields fields haskells
    => PGS.Connection
    -- ^
    -> S.Select fields
    -- ^
    -> IO (IRQ.Cursor haskells)
declareCursor :: Connection -> Select fields -> IO (Cursor haskells)
declareCursor = Connection -> Select fields -> IO (Cursor haskells)
forall fields haskells.
Default FromFields fields haskells =>
Connection -> Select fields -> IO (Cursor haskells)
RQ.declareCursor

-- | Close the given cursor.
closeCursor :: IRQ.Cursor fields -> IO ()
closeCursor :: Cursor fields -> IO ()
closeCursor = Cursor fields -> IO ()
forall fields. Cursor fields -> IO ()
RQ.closeCursor

-- | Fold over a chunk of rows, calling the supplied fold-like function on each
-- row as it is received. In case the cursor is exhausted, a 'Left' value is
-- returned, otherwise a 'Right' value is returned.
foldForward
    :: IRQ.Cursor haskells
    -- ^
    -> Int
    -- ^
    -> (a -> haskells -> IO a)
    -- ^
    -> a
    -- ^
    -> IO (Either a a)
foldForward :: Cursor haskells
-> Int -> (a -> haskells -> IO a) -> a -> IO (Either a a)
foldForward = Cursor haskells
-> Int -> (a -> haskells -> IO a) -> a -> IO (Either a a)
forall haskells a.
Cursor haskells
-> Int -> (a -> haskells -> IO a) -> a -> IO (Either a a)
RQ.foldForward

-- | Use 'unsafeFromField' to make an instance to allow you to run
--   queries on your own datatypes.  For example:
--
-- @
-- newtype Foo = Foo Int
--
-- instance DefaultFromField Foo Foo where
--    defaultFromField = unsafeFromField Foo defaultFromField
-- @
--
-- It is \"unsafe\" because it does not check that the @sqlType@
-- correctly corresponds to the Haskell type.
unsafeFromField :: (b -> b')
                -> IRQ.FromField sqlType b
                -> IRQ.FromField sqlType' b'
unsafeFromField :: (b -> b') -> FromField sqlType b -> FromField sqlType' b'
unsafeFromField b -> b'
haskellF FromField sqlType b
qrc = Unpackspec (Column sqlType') ()
-> FieldParser b' -> FromField sqlType' b'
forall pgType haskellType.
Unpackspec (Column pgType) ()
-> FieldParser haskellType -> FromField pgType haskellType
IRQ.QueryRunnerColumn ((Column sqlType' -> Column sqlType)
-> Unpackspec (Column sqlType) ()
-> Unpackspec (Column sqlType') ()
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
P.lmap Column sqlType' -> Column sqlType
forall a b. Column a -> Column b
colF Unpackspec (Column sqlType) ()
u)
                                                     ((b -> b')
-> (Field -> Maybe ByteString -> Conversion b) -> FieldParser b'
forall a b.
(a -> b)
-> (Field -> Maybe ByteString -> Conversion a)
-> Field
-> Maybe ByteString
-> Conversion b
fmapFP b -> b'
haskellF Field -> Maybe ByteString -> Conversion b
fp)
  where IRQ.QueryRunnerColumn Unpackspec (Column sqlType) ()
u Field -> Maybe ByteString -> Conversion b
fp = FromField sqlType b
qrc
        fmapFP :: (a -> b)
-> (Field -> Maybe ByteString -> Conversion a)
-> Field
-> Maybe ByteString
-> Conversion b
fmapFP = ((Maybe ByteString -> Conversion a)
 -> Maybe ByteString -> Conversion b)
-> (Field -> Maybe ByteString -> Conversion a)
-> Field
-> Maybe ByteString
-> Conversion b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Maybe ByteString -> Conversion a)
  -> Maybe ByteString -> Conversion b)
 -> (Field -> Maybe ByteString -> Conversion a)
 -> Field
 -> Maybe ByteString
 -> Conversion b)
-> ((a -> b)
    -> (Maybe ByteString -> Conversion a)
    -> Maybe ByteString
    -> Conversion b)
-> (a -> b)
-> (Field -> Maybe ByteString -> Conversion a)
-> Field
-> Maybe ByteString
-> Conversion b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Conversion a -> Conversion b)
-> (Maybe ByteString -> Conversion a)
-> Maybe ByteString
-> Conversion b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Conversion a -> Conversion b)
 -> (Maybe ByteString -> Conversion a)
 -> Maybe ByteString
 -> Conversion b)
-> ((a -> b) -> Conversion a -> Conversion b)
-> (a -> b)
-> (Maybe ByteString -> Conversion a)
-> Maybe ByteString
-> Conversion b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Conversion a -> Conversion b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        colF :: Column a -> Column b
colF = Column a -> Column b
forall a b. Column a -> Column b
C.unsafeCoerceColumn

runSelectExplicit :: FromFields fields haskells
                  -> PGS.Connection
                  -> S.Select fields
                  -> IO [haskells]
runSelectExplicit :: FromFields fields haskells
-> Connection -> Select fields -> IO [haskells]
runSelectExplicit = FromFields fields haskells
-> Connection -> Select fields -> IO [haskells]
forall fields haskells.
FromFields fields haskells
-> Connection -> Select fields -> IO [haskells]
RQ.runQueryExplicit

runSelectFoldExplicit
  :: FromFields fields haskells
  -> PGS.Connection
  -> S.Select fields
  -> b
  -> (b -> haskells -> IO b)
  -> IO b
runSelectFoldExplicit :: FromFields fields haskells
-> Connection
-> Select fields
-> b
-> (b -> haskells -> IO b)
-> IO b
runSelectFoldExplicit = FromFields fields haskells
-> Connection
-> Select fields
-> b
-> (b -> haskells -> IO b)
-> IO b
forall fields haskells b.
FromFields fields haskells
-> Connection
-> Select fields
-> b
-> (b -> haskells -> IO b)
-> IO b
RQ.runQueryFoldExplicit

declareCursorExplicit
    :: FromFields fields haskells
    -> PGS.Connection
    -> S.Select fields
    -> IO (IRQ.Cursor haskells)
declareCursorExplicit :: FromFields fields haskells
-> Connection -> Select fields -> IO (Cursor haskells)
declareCursorExplicit = FromFields fields haskells
-> Connection -> Select fields -> IO (Cursor haskells)
forall fields haskells.
FromFields fields haskells
-> Connection -> Select fields -> IO (Cursor haskells)
RQ.declareCursorExplicit

-- | Version of 'runSelect' with better type inference
runSelectI :: (D.Default (Inferrable FromFields) fields haskells)
           => PGS.Connection
           -- ^
           -> S.Select fields
           -- ^
           -> IO [haskells]
runSelectI :: Connection -> Select fields -> IO [haskells]
runSelectI = FromFields fields haskells
-> Connection -> Select fields -> IO [haskells]
forall fields haskells.
FromFields fields haskells
-> Connection -> Select fields -> IO [haskells]
RQ.runQueryExplicit (Inferrable FromFields fields haskells -> FromFields fields haskells
forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable Inferrable FromFields fields haskells
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def)