module Database.PostgreSQL.PQTypes.Cursor
  ( CursorName(..)
  , Scroll(..)
  , Hold(..)
  , Cursor
  , CursorDirection(..)
  , cursorName
  , cursorQuery
  , withCursor
  , withCursorSQL
  , cursorFetch
  , cursorFetch_
  , cursorMove
  , cursorMove_
  ) where

import Control.Monad
import Control.Monad.Catch
import Data.String

import Data.Monoid.Utils
import Database.PostgreSQL.PQTypes.Class
import Database.PostgreSQL.PQTypes.SQL
import Database.PostgreSQL.PQTypes.SQL.Class
import Database.PostgreSQL.PQTypes.Utils

-- | Name of a cursor.
newtype CursorName sql = CursorName { forall sql. CursorName sql -> sql
unCursorName :: sql }
  deriving (CursorName sql -> CursorName sql -> Bool
forall sql. Eq sql => CursorName sql -> CursorName sql -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CursorName sql -> CursorName sql -> Bool
$c/= :: forall sql. Eq sql => CursorName sql -> CursorName sql -> Bool
== :: CursorName sql -> CursorName sql -> Bool
$c== :: forall sql. Eq sql => CursorName sql -> CursorName sql -> Bool
Eq, CursorName sql -> CursorName sql -> Bool
CursorName sql -> CursorName sql -> Ordering
CursorName sql -> CursorName sql -> CursorName sql
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {sql}. Ord sql => Eq (CursorName sql)
forall sql. Ord sql => CursorName sql -> CursorName sql -> Bool
forall sql. Ord sql => CursorName sql -> CursorName sql -> Ordering
forall sql.
Ord sql =>
CursorName sql -> CursorName sql -> CursorName sql
min :: CursorName sql -> CursorName sql -> CursorName sql
$cmin :: forall sql.
Ord sql =>
CursorName sql -> CursorName sql -> CursorName sql
max :: CursorName sql -> CursorName sql -> CursorName sql
$cmax :: forall sql.
Ord sql =>
CursorName sql -> CursorName sql -> CursorName sql
>= :: CursorName sql -> CursorName sql -> Bool
$c>= :: forall sql. Ord sql => CursorName sql -> CursorName sql -> Bool
> :: CursorName sql -> CursorName sql -> Bool
$c> :: forall sql. Ord sql => CursorName sql -> CursorName sql -> Bool
<= :: CursorName sql -> CursorName sql -> Bool
$c<= :: forall sql. Ord sql => CursorName sql -> CursorName sql -> Bool
< :: CursorName sql -> CursorName sql -> Bool
$c< :: forall sql. Ord sql => CursorName sql -> CursorName sql -> Bool
compare :: CursorName sql -> CursorName sql -> Ordering
$ccompare :: forall sql. Ord sql => CursorName sql -> CursorName sql -> Ordering
Ord)

instance IsString sql => IsString (CursorName sql) where
  fromString :: String -> CursorName sql
fromString = forall sql. sql -> CursorName sql
CursorName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

instance Show sql => Show (CursorName sql) where
  showsPrec :: Int -> CursorName sql -> ShowS
showsPrec Int
n (CursorName sql
name) = (String
"Cursor " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
n sql
name

----------------------------------------

-- | Defines whether a cursor will be declared as @SCROLL@ or @NO
-- SCROLL@. Scrollable cursors can be scrolled in all directions, otherwise only
-- forward.
data Scroll = Scroll | NoScroll
  deriving (Scroll -> Scroll -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scroll -> Scroll -> Bool
$c/= :: Scroll -> Scroll -> Bool
== :: Scroll -> Scroll -> Bool
$c== :: Scroll -> Scroll -> Bool
Eq, Eq Scroll
Scroll -> Scroll -> Bool
Scroll -> Scroll -> Ordering
Scroll -> Scroll -> Scroll
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Scroll -> Scroll -> Scroll
$cmin :: Scroll -> Scroll -> Scroll
max :: Scroll -> Scroll -> Scroll
$cmax :: Scroll -> Scroll -> Scroll
>= :: Scroll -> Scroll -> Bool
$c>= :: Scroll -> Scroll -> Bool
> :: Scroll -> Scroll -> Bool
$c> :: Scroll -> Scroll -> Bool
<= :: Scroll -> Scroll -> Bool
$c<= :: Scroll -> Scroll -> Bool
< :: Scroll -> Scroll -> Bool
$c< :: Scroll -> Scroll -> Bool
compare :: Scroll -> Scroll -> Ordering
$ccompare :: Scroll -> Scroll -> Ordering
Ord, Int -> Scroll -> ShowS
[Scroll] -> ShowS
Scroll -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scroll] -> ShowS
$cshowList :: [Scroll] -> ShowS
show :: Scroll -> String
$cshow :: Scroll -> String
showsPrec :: Int -> Scroll -> ShowS
$cshowsPrec :: Int -> Scroll -> ShowS
Show)

-- | Defines whether a cursor will be declared as @WITH HOLD@ or @WITHOUT HOLD@.
--
-- From the PostgreSQL manual: WITH HOLD specifies that the cursor can continue
-- to be used after the transaction that created it successfully commits.
-- WITHOUT HOLD specifies that the cursor cannot be used outside of the
-- transaction that created it.
data Hold = Hold | NoHold
  deriving (Hold -> Hold -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hold -> Hold -> Bool
$c/= :: Hold -> Hold -> Bool
== :: Hold -> Hold -> Bool
$c== :: Hold -> Hold -> Bool
Eq, Eq Hold
Hold -> Hold -> Bool
Hold -> Hold -> Ordering
Hold -> Hold -> Hold
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Hold -> Hold -> Hold
$cmin :: Hold -> Hold -> Hold
max :: Hold -> Hold -> Hold
$cmax :: Hold -> Hold -> Hold
>= :: Hold -> Hold -> Bool
$c>= :: Hold -> Hold -> Bool
> :: Hold -> Hold -> Bool
$c> :: Hold -> Hold -> Bool
<= :: Hold -> Hold -> Bool
$c<= :: Hold -> Hold -> Bool
< :: Hold -> Hold -> Bool
$c< :: Hold -> Hold -> Bool
compare :: Hold -> Hold -> Ordering
$ccompare :: Hold -> Hold -> Ordering
Ord, Int -> Hold -> ShowS
[Hold] -> ShowS
Hold -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hold] -> ShowS
$cshowList :: [Hold] -> ShowS
show :: Hold -> String
$cshow :: Hold -> String
showsPrec :: Int -> Hold -> ShowS
$cshowsPrec :: Int -> Hold -> ShowS
Show)

-- | Data representing a created cursor.
data Cursor sql = Cursor !(CursorName sql) !sql
  deriving (Cursor sql -> Cursor sql -> Bool
forall sql. Eq sql => Cursor sql -> Cursor sql -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cursor sql -> Cursor sql -> Bool
$c/= :: forall sql. Eq sql => Cursor sql -> Cursor sql -> Bool
== :: Cursor sql -> Cursor sql -> Bool
$c== :: forall sql. Eq sql => Cursor sql -> Cursor sql -> Bool
Eq, Cursor sql -> Cursor sql -> Bool
Cursor sql -> Cursor sql -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {sql}. Ord sql => Eq (Cursor sql)
forall sql. Ord sql => Cursor sql -> Cursor sql -> Bool
forall sql. Ord sql => Cursor sql -> Cursor sql -> Ordering
forall sql. Ord sql => Cursor sql -> Cursor sql -> Cursor sql
min :: Cursor sql -> Cursor sql -> Cursor sql
$cmin :: forall sql. Ord sql => Cursor sql -> Cursor sql -> Cursor sql
max :: Cursor sql -> Cursor sql -> Cursor sql
$cmax :: forall sql. Ord sql => Cursor sql -> Cursor sql -> Cursor sql
>= :: Cursor sql -> Cursor sql -> Bool
$c>= :: forall sql. Ord sql => Cursor sql -> Cursor sql -> Bool
> :: Cursor sql -> Cursor sql -> Bool
$c> :: forall sql. Ord sql => Cursor sql -> Cursor sql -> Bool
<= :: Cursor sql -> Cursor sql -> Bool
$c<= :: forall sql. Ord sql => Cursor sql -> Cursor sql -> Bool
< :: Cursor sql -> Cursor sql -> Bool
$c< :: forall sql. Ord sql => Cursor sql -> Cursor sql -> Bool
compare :: Cursor sql -> Cursor sql -> Ordering
$ccompare :: forall sql. Ord sql => Cursor sql -> Cursor sql -> Ordering
Ord, Int -> Cursor sql -> ShowS
forall sql. Show sql => Int -> Cursor sql -> ShowS
forall sql. Show sql => [Cursor sql] -> ShowS
forall sql. Show sql => Cursor sql -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cursor sql] -> ShowS
$cshowList :: forall sql. Show sql => [Cursor sql] -> ShowS
show :: Cursor sql -> String
$cshow :: forall sql. Show sql => Cursor sql -> String
showsPrec :: Int -> Cursor sql -> ShowS
$cshowsPrec :: forall sql. Show sql => Int -> Cursor sql -> ShowS
Show)

----------------------------------------

-- | Direction in which to move the cursor. Note that cursors declared as @NO
-- SCROLL@ can only move forward (i.e. only 'CD_Next', 'CD_Forward_All' and
-- 'CD_Forward' is allowed).
data CursorDirection
  = CD_Next
  | CD_Prior
  | CD_First
  | CD_Last
  | CD_Forward_All
  | CD_Backward_All
  | CD_Absolute Int
  | CD_Relative Int
  | CD_Forward  Int
  | CD_Backward Int
  deriving (CursorDirection -> CursorDirection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CursorDirection -> CursorDirection -> Bool
$c/= :: CursorDirection -> CursorDirection -> Bool
== :: CursorDirection -> CursorDirection -> Bool
$c== :: CursorDirection -> CursorDirection -> Bool
Eq, Eq CursorDirection
CursorDirection -> CursorDirection -> Bool
CursorDirection -> CursorDirection -> Ordering
CursorDirection -> CursorDirection -> CursorDirection
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CursorDirection -> CursorDirection -> CursorDirection
$cmin :: CursorDirection -> CursorDirection -> CursorDirection
max :: CursorDirection -> CursorDirection -> CursorDirection
$cmax :: CursorDirection -> CursorDirection -> CursorDirection
>= :: CursorDirection -> CursorDirection -> Bool
$c>= :: CursorDirection -> CursorDirection -> Bool
> :: CursorDirection -> CursorDirection -> Bool
$c> :: CursorDirection -> CursorDirection -> Bool
<= :: CursorDirection -> CursorDirection -> Bool
$c<= :: CursorDirection -> CursorDirection -> Bool
< :: CursorDirection -> CursorDirection -> Bool
$c< :: CursorDirection -> CursorDirection -> Bool
compare :: CursorDirection -> CursorDirection -> Ordering
$ccompare :: CursorDirection -> CursorDirection -> Ordering
Ord, Int -> CursorDirection -> ShowS
[CursorDirection] -> ShowS
CursorDirection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CursorDirection] -> ShowS
$cshowList :: [CursorDirection] -> ShowS
show :: CursorDirection -> String
$cshow :: CursorDirection -> String
showsPrec :: Int -> CursorDirection -> ShowS
$cshowsPrec :: Int -> CursorDirection -> ShowS
Show)

cursorDirectionToSQL :: (IsString sql, IsSQL sql, Monoid sql) => CursorDirection -> sql
cursorDirectionToSQL :: forall sql.
(IsString sql, IsSQL sql, Monoid sql) =>
CursorDirection -> sql
cursorDirectionToSQL = \case
  CursorDirection
CD_Next         -> sql
"NEXT"
  CursorDirection
CD_Prior        -> sql
"PRIOR"
  CursorDirection
CD_First        -> sql
"FIRST"
  CursorDirection
CD_Last         -> sql
"LAST"
  CursorDirection
CD_Forward_All  -> sql
"FORWARD ALL"
  CursorDirection
CD_Backward_All -> sql
"BACKWARD ALL"
  CD_Absolute Int
n   -> sql
"ABSOLUTE" forall m. (IsString m, Monoid m) => m -> m -> m
<+> forall sql. (IsSQL sql, IsString sql) => String -> sql
unsafeSQL (forall a. Show a => a -> String
show Int
n)
  CD_Relative Int
n   -> sql
"RELATIVE" forall m. (IsString m, Monoid m) => m -> m -> m
<+> forall sql. (IsSQL sql, IsString sql) => String -> sql
unsafeSQL (forall a. Show a => a -> String
show Int
n)
  CD_Forward Int
n    -> sql
"FORWARD"  forall m. (IsString m, Monoid m) => m -> m -> m
<+> forall sql. (IsSQL sql, IsString sql) => String -> sql
unsafeSQL (forall a. Show a => a -> String
show Int
n)
  CD_Backward Int
n   -> sql
"BACKWARD" forall m. (IsString m, Monoid m) => m -> m -> m
<+> forall sql. (IsSQL sql, IsString sql) => String -> sql
unsafeSQL (forall a. Show a => a -> String
show Int
n)

----------------------------------------

-- | Retrieve the name of a cursor.
cursorName :: Cursor sql -> CursorName sql
cursorName :: forall sql. Cursor sql -> CursorName sql
cursorName (Cursor CursorName sql
name sql
_) = CursorName sql
name

-- | Retrieve SQL query used to create a cursor.
cursorQuery :: Cursor sql -> sql
cursorQuery :: forall sql. Cursor sql -> sql
cursorQuery (Cursor CursorName sql
_ sql
query) = sql
query

-- | Create a cursor from the SQL query and use it within the given context.
withCursor
  :: (IsString sql, IsSQL sql, Monoid sql, MonadDB m, MonadMask m)
  => CursorName sql
  -> Scroll
  -> Hold
  -> sql
  -> (Cursor sql -> m r)
  -> m r
withCursor :: forall sql (m :: * -> *) r.
(IsString sql, IsSQL sql, Monoid sql, MonadDB m, MonadMask m) =>
CursorName sql
-> Scroll -> Hold -> sql -> (Cursor sql -> m r) -> m r
withCursor CursorName sql
name Scroll
scroll Hold
hold sql
sql Cursor sql -> m r
k = forall (m :: * -> *) a c b. MonadMask m => m a -> m c -> m b -> m b
bracket_
  (forall sql (m :: * -> *). (IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ sql
declareCursor)
  (forall sql (m :: * -> *). (IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ sql
closeCursor)
  (Cursor sql -> m r
k forall a b. (a -> b) -> a -> b
$ forall sql. CursorName sql -> sql -> Cursor sql
Cursor CursorName sql
name sql
sql)
  where
    declareCursor :: sql
declareCursor = forall m. (IsString m, Monoid m) => [m] -> m
smconcat
      [ sql
"DECLARE"
      , forall sql. CursorName sql -> sql
unCursorName CursorName sql
name
      , case Scroll
scroll of
          Scroll
Scroll   -> sql
"SCROLL"
          Scroll
NoScroll -> sql
"NO SCROLL"
      , sql
"CURSOR"
      , case Hold
hold of
          Hold
Hold   -> sql
"WITH HOLD"
          Hold
NoHold -> sql
"WITHOUT HOLD"
      , sql
"FOR"
      , sql
sql
      ]

    -- Because the cursor might potentially be closed within the continuation
    -- (either by an explicit CLOSE or finishing the current transaction), we
    -- need to supress a potential 'InvalidCursorName' exception.
    closeCursor :: sql
closeCursor = forall m. (IsString m, Monoid m) => [m] -> m
smconcat
      [ sql
"DO $$"
      , sql
"BEGIN"
      , sql
"  EXECUTE 'CLOSE" forall m. (IsString m, Monoid m) => m -> m -> m
<+> forall sql. CursorName sql -> sql
unCursorName CursorName sql
name forall m. (IsString m, Monoid m) => m -> m -> m
<+> sql
"';"
      , sql
"EXCEPTION WHEN invalid_cursor_name THEN"
      , sql
"END $$"
      ]

-- | Version of 'withCursor' without the @sql@ type parameter for convenience.
withCursorSQL
  :: (MonadDB m, MonadMask m)
  => CursorName SQL
  -> Scroll
  -> Hold
  -> SQL
  -> (Cursor SQL -> m r)
  -> m r
withCursorSQL :: forall (m :: * -> *) r.
(MonadDB m, MonadMask m) =>
CursorName SQL
-> Scroll -> Hold -> SQL -> (Cursor SQL -> m r) -> m r
withCursorSQL = forall sql (m :: * -> *) r.
(IsString sql, IsSQL sql, Monoid sql, MonadDB m, MonadMask m) =>
CursorName sql
-> Scroll -> Hold -> sql -> (Cursor sql -> m r) -> m r
withCursor

-- | Retrieve rows from a query using a cursor. See
-- https://www.postgresql.org/docs/current/sql-fetch.html for more information.
cursorFetch
  :: (IsSQL sql, IsString sql, Monoid sql, MonadDB m)
  => Cursor sql
  -> CursorDirection
  -> m Int
cursorFetch :: forall sql (m :: * -> *).
(IsSQL sql, IsString sql, Monoid sql, MonadDB m) =>
Cursor sql -> CursorDirection -> m Int
cursorFetch Cursor sql
cursor CursorDirection
direction = forall (m :: * -> *) sql. (MonadDB m, IsSQL sql) => sql -> m Int
runQuery forall a b. (a -> b) -> a -> b
$ forall m. (IsString m, Monoid m) => [m] -> m
smconcat
  [ sql
"FETCH"
  , forall sql.
(IsString sql, IsSQL sql, Monoid sql) =>
CursorDirection -> sql
cursorDirectionToSQL CursorDirection
direction
  , sql
"FROM"
  , forall sql. CursorName sql -> sql
unCursorName forall a b. (a -> b) -> a -> b
$ forall sql. Cursor sql -> CursorName sql
cursorName Cursor sql
cursor
  ]

-- | Same as 'cursorFetch', except the result (i.e. the number of fetched rows)
-- is ignored.
cursorFetch_ :: (IsSQL sql, IsString sql, Monoid sql, MonadDB m)
  => Cursor sql
  -> CursorDirection
  -> m ()
cursorFetch_ :: forall sql (m :: * -> *).
(IsSQL sql, IsString sql, Monoid sql, MonadDB m) =>
Cursor sql -> CursorDirection -> m ()
cursorFetch_ Cursor sql
cursor = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sql (m :: * -> *).
(IsSQL sql, IsString sql, Monoid sql, MonadDB m) =>
Cursor sql -> CursorDirection -> m Int
cursorFetch Cursor sql
cursor

-- | Move a cursor to a specific position. It works exactly like 'cursorFetch',
-- except it only positions the cursor and does not return rows. See
-- https://www.postgresql.org/docs/current/sql-move.html for more information.
cursorMove
  :: (IsSQL sql, IsString sql, Monoid sql, MonadDB m)
  => Cursor sql
  -> CursorDirection
  -> m Int
cursorMove :: forall sql (m :: * -> *).
(IsSQL sql, IsString sql, Monoid sql, MonadDB m) =>
Cursor sql -> CursorDirection -> m Int
cursorMove Cursor sql
cursor CursorDirection
direction = forall (m :: * -> *) sql. (MonadDB m, IsSQL sql) => sql -> m Int
runQuery forall a b. (a -> b) -> a -> b
$ forall m. (IsString m, Monoid m) => [m] -> m
smconcat
  [ sql
"MOVE"
  , forall sql.
(IsString sql, IsSQL sql, Monoid sql) =>
CursorDirection -> sql
cursorDirectionToSQL CursorDirection
direction
  , sql
"FROM"
  , forall sql. CursorName sql -> sql
unCursorName forall a b. (a -> b) -> a -> b
$ forall sql. Cursor sql -> CursorName sql
cursorName Cursor sql
cursor
  ]

-- | Same as 'cursorMove', except the result (i.e. the number of rows that would
-- be fetched) is ignored.
cursorMove_
  :: (IsSQL sql, IsString sql, Monoid sql, MonadDB m)
  => Cursor sql
  -> CursorDirection
  -> m ()
cursorMove_ :: forall sql (m :: * -> *).
(IsSQL sql, IsString sql, Monoid sql, MonadDB m) =>
Cursor sql -> CursorDirection -> m ()
cursorMove_ Cursor sql
cursor = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sql (m :: * -> *).
(IsSQL sql, IsString sql, Monoid sql, MonadDB m) =>
Cursor sql -> CursorDirection -> m Int
cursorMove Cursor sql
cursor