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
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
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)
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 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)
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)
cursorName :: Cursor sql -> CursorName sql
cursorName :: forall sql. Cursor sql -> CursorName sql
cursorName (Cursor CursorName sql
name sql
_) = CursorName sql
name
cursorQuery :: Cursor sql -> sql
cursorQuery :: forall sql. Cursor sql -> sql
cursorQuery (Cursor CursorName sql
_ sql
query) = sql
query
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
]
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 $$"
]
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
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
]
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
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
]
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