{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoFieldSelectors #-}

-- | High-level SQLite client library
--
-- ⚠️  __This is an early preview release of this library. Use at your own risk.__
--
--
-- @
-- import qualified "Sq"
-- @
--
-- Things currently supported:
--
-- * Type-safe __encoding__ of SQL query parameters and columns ('Encode',
-- 'Input').
--
-- * Type-safe __decoding__ of SQL output rows and columns ('Decode', 'Output').
--
-- * Type-safe __concurrent connections__ with read and write database access
-- ('Pool').
--
-- * Type-safe __'Control.Concurrent.STM'-like transactional__ interactions
-- with the database, including 'Control.Concurrent.STM.retry'-like,
-- 'Control.Concurrent.STM.TVar'-like, and
-- 'Control.Concurrent.STM.catchSTM'-like tools ('Transactional', 'retry',
-- 'Ref').
--
-- * Type-safe __distinction between 'Read'-only and read-'Write'__ things.
--
-- * Type-safe __streaming and interleaving of 'IO'__ with output rows
-- ('streamIO', 'foldIO').
--
-- * Type-safe __resource management__ (via 'A.Acquire', see 'new', 'with',
-- 'uith').
--
-- * 'Savepoint's.
--
-- * A lot of logging.
--
-- Things not supported yet:
--
-- * Type-safe 'SQL'.
--
-- * Manual and automatic migrations solution.
--
-- * Probably other things.
--
-- If you have questions or suggestions, just say so at
-- <https://github.com/k0001/hs-sq/issues>.
--
-- ⚠️  __This is an early preview release of this library. Use at your own risk.__
module Sq
   ( -- * Statement
    Statement
   , readStatement
   , writeStatement

    -- ** SQL
   , SQL
   , sql

    -- ** Input
   , Input
   , encode
   , input

    -- *** Encode
   , Encode (..)
   , encodeRefine
   , EncodeDefault (..)
   , encodeMaybe
   , encodeEither
   , encodeSizedIntegral
   , encodeAeson
   , encodeBinary
   , encodeShow

    -- ** Output
   , Output
   , decode
   , output

    -- *** Decode
   , Decode (..)
   , decodeRefine
   , DecodeDefault (..)
   , decodeMaybe
   , decodeEither
   , decodeSizedIntegral
   , decodeAeson
   , decodeBinary
   , decodeRead

    -- ** Name
   , Name
   , name

    -- * Transactional
   , Transactional
   , read
   , commit
   , rollback
   , embed
   , Ref
   , retry
   , orElse

    -- ** Querying
   , one
   , maybe
   , zero
   , some
   , list
   , fold
   , foldM

    -- * Interleaving
   , streamIO
   , foldIO

    -- * Pool
   , Pool
   , readPool
   , writePool
   , tempPool
   , subPool

    -- * Settings
   , Settings (..)
   , settings

    -- * Transaction
   , Transaction
   , readTransaction
   , commitTransaction
   , rollbackTransaction

    -- * Resources
    -- $resources
   , new
   , with
   , uith

    -- * Savepoint
   , Savepoint
   , savepoint
   , savepointRollback
   , savepointRelease

    -- * Miscellaneuos
   , Retry (..)
   , BindingName
   , Mode (..)
   , SubMode
   , Null (..)

    -- * Errors
   , ErrEncode (..)
   , ErrInput (..)
   , ErrDecode (..)
   , ErrOutput (..)
   , ErrStatement (..)
   , ErrRows (..)

    -- * Re-exports
   , S.SQLData (..)
   , S.SQLVFS (..)
   )
where

import Control.Exception.Safe qualified as Ex
import Control.Foldl qualified as F
import Control.Monad hiding (foldM)
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource qualified as R
import Control.Monad.Trans.Resource.Extra qualified as R
import Data.Acquire qualified as A
import Data.Function
import Data.Int
import Data.List.NonEmpty (NonEmpty)
import Database.SQLite3 qualified as S
import Di.Df1 qualified as Di
import System.FilePath
import Prelude hiding (Read, maybe, read)

import Sq.Connection
import Sq.Decoders
import Sq.Encoders
import Sq.Input
import Sq.Mode
import Sq.Names
import Sq.Null
import Sq.Output
import Sq.Pool
import Sq.Statement
import Sq.Support
import Sq.Transactional

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

-- $resources
--
-- "Sq" relies heavily on 'A.Acquire' for safe resource management in light of
-- concurrency and dependencies between resources.
--
-- As a user of "Sq", you mostly just have to figure out how to obtain a 'Pool'.
-- For that, you will probably benefit use one of these functions:
--
-- * 'with' for integrating with 'Ex.MonadMask' from the @exceptions@ library.
--
-- * 'new' for integrating with 'R.MonadResource' from the @resourcet@ library.
--
-- * 'uith' for integrating with 'R.MonadUnliftIO' from the @unliftio@ library.
--
-- If you have no idea what I'm talking about, just use 'with'.
-- Here is an example:
--
-- @
-- 'with' 'tempPool' \\(__pool__ :: 'Pool' \''Write') ->
--     /-- Here use __pool__ as necessary./
--     /-- The resources associated with it will be/
--     /-- automatically released after leaving this scope./
-- @
--
-- Now that you have a 'Pool', try to solve your problems within
-- 'Transactional' by means of 'Sq.read', 'Sq.commit' or 'Sq.rollback'.
--
-- However, if you need to interleave 'IO' actions while streaming result rows
-- out of the database, 'Transactional' won't be enough. You will need to use
-- 'foldIO' or 'streamIO'.

-- | 'A.Acquire' through 'R.MonadResource'.
--
-- @
-- 'new' = 'fmap' 'snd' . "Data.Acquire".'A.allocateAcquire'
-- @
new :: (R.MonadResource m) => A.Acquire a -> m a
new :: forall (m :: * -> *) a. MonadResource m => Acquire a -> m a
new = ((ReleaseKey, a) -> a) -> m (ReleaseKey, a) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReleaseKey, a) -> a
forall a b. (a, b) -> b
snd (m (ReleaseKey, a) -> m a)
-> (Acquire a -> m (ReleaseKey, a)) -> Acquire a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acquire a -> m (ReleaseKey, a)
forall (m :: * -> *) a.
MonadResource m =>
Acquire a -> m (ReleaseKey, a)
A.allocateAcquire

-- | 'A.Acquire' through 'Ex.MonadMask'.
--
-- @
-- 'with' = "Control.Monad.Trans.Resource.Extra".'R.withAcquire'.
-- @
with :: (Ex.MonadMask m, MonadIO m) => A.Acquire a -> (a -> m b) -> m b
with :: forall (m :: * -> *) a b.
(MonadMask m, MonadIO m) =>
Acquire a -> (a -> m b) -> m b
with = Acquire a -> (a -> m b) -> m b
forall (m :: * -> *) a b.
(MonadMask m, MonadIO m) =>
Acquire a -> (a -> m b) -> m b
R.withAcquire

-- | 'A.Acquire' through 'R.MonadUnliftIO'.
--
-- @
-- 'uith' = "Data.Acquire".'A.with'
-- @
uith :: (R.MonadUnliftIO m) => A.Acquire a -> (a -> m b) -> m b
uith :: forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
uith = Acquire a -> (a -> m b) -> m b
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
A.with

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

-- | Acquire a read-'Write' 'Pool' temporarily persisted in the file-system.
-- It will be deleted once released. This can be useful for testing.
--
-- * Use "Di".'Di.new' to obtain the 'Di.Df1' parameter. Consider using
-- "Di.Core".'Di.Core.filter' to filter-out excessive logging. For example:
--
--       @"Di.Core".'Di.Core.filter' \\l _ _ -> l >= "Df1".'Df1.Info'@
tempPool :: Di.Df1 -> A.Acquire (Pool Write)
tempPool :: Df1 -> Acquire (Pool 'Write)
tempPool Df1
di0 = do
   FilePath
d <- Acquire FilePath
acquireTmpDir
   SMode 'Write -> Df1 -> Settings -> Acquire (Pool 'Write)
forall (p :: Mode). SMode p -> Df1 -> Settings -> Acquire (Pool p)
pool SMode 'Write
SWrite (Segment -> Df1 -> Df1
forall level msg. Segment -> Di level Path msg -> Di level Path msg
Di.push Segment
"sq" Df1
di0) (Settings -> Acquire (Pool 'Write))
-> Settings -> Acquire (Pool 'Write)
forall a b. (a -> b) -> a -> b
$ FilePath -> Settings
settings (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
"db.sqlite")

-- | Acquire a read-'Write' 'Pool' according to the given 'Settings'.
--
-- * Use "Di".'Di.new' to obtain the 'Di.Df1' parameter. Consider using
-- "Di.Core".'Di.Core.filter' to filter-out excessive logging. For example:
--
--       @"Di.Core".'Di.Core.filter' \\l _ _ -> l >= "Df1".'Df1.Info'@
writePool :: Di.Df1 -> Settings -> A.Acquire (Pool Write)
writePool :: Df1 -> Settings -> Acquire (Pool 'Write)
writePool Df1
di0 = SMode 'Write -> Df1 -> Settings -> Acquire (Pool 'Write)
forall (p :: Mode). SMode p -> Df1 -> Settings -> Acquire (Pool p)
pool SMode 'Write
SWrite (Segment -> Df1 -> Df1
forall level msg. Segment -> Di level Path msg -> Di level Path msg
Di.push Segment
"sq" Df1
di0)
{-# INLINE writePool #-}

-- | Acquire a 'Read'-only 'Pool' according to the given 'Settings'.
--
-- * Use "Di".'Di.new' to obtain the 'Di.Df1' parameter. Consider using
-- "Di.Core".'Di.Core.filter' to filter-out excessive logging. For example:
--
--       @"Di.Core".'Di.Core.filter' \\l _ _ -> l >= "Df1".'Df1.Info'@
readPool :: Di.Df1 -> Settings -> A.Acquire (Pool Read)
readPool :: Df1 -> Settings -> Acquire (Pool 'Read)
readPool Df1
di0 = SMode 'Read -> Df1 -> Settings -> Acquire (Pool 'Read)
forall (p :: Mode). SMode p -> Df1 -> Settings -> Acquire (Pool p)
pool SMode 'Read
SRead (Segment -> Df1 -> Df1
forall level msg. Segment -> Di level Path msg -> Di level Path msg
Di.push Segment
"sq" Df1
di0)
{-# INLINE readPool #-}

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

-- | Executes a 'Statement' expected to return __zero or one__ rows.
--
-- * Throws 'ErrRows_TooMany' if more than one row.
maybe :: (SubMode t s) => Statement s i o -> i -> Transactional g r t (Maybe o)
maybe :: forall {k} (t :: Mode) (s :: Mode) i o (g :: k) (r :: Retry).
SubMode t s =>
Statement s i o -> i -> Transactional g r t (Maybe o)
maybe = FoldM (Transactional g r t) o (Maybe o)
-> Statement s i o -> i -> Transactional g r t (Maybe o)
forall {k} (t :: Mode) (s :: Mode) (g :: k) (r :: Retry) o z i.
SubMode t s =>
FoldM (Transactional g r t) o z
-> Statement s i o -> i -> Transactional g r t z
foldM (FoldM (Transactional g r t) o (Maybe o)
 -> Statement s i o -> i -> Transactional g r t (Maybe o))
-> FoldM (Transactional g r t) o (Maybe o)
-> Statement s i o
-> i
-> Transactional g r t (Maybe o)
forall a b. (a -> b) -> a -> b
$ ErrRows -> FoldM (Transactional g r t) o (Maybe o)
forall (m :: * -> *) e o.
(MonadThrow m, Exception e) =>
e -> FoldM m o (Maybe o)
foldMaybeM ErrRows
ErrRows_TooMany
{-# INLINE maybe #-}

-- | Executes a 'Statement' expected to return exactly __one__ row.
--
-- * Throws 'ErrRows_TooFew' if zero rows, 'ErrRows_TooMany' if more than one row.
one :: (SubMode t s) => Statement s i o -> i -> Transactional g r t o
one :: forall {k} (t :: Mode) (s :: Mode) i o (g :: k) (r :: Retry).
SubMode t s =>
Statement s i o -> i -> Transactional g r t o
one = FoldM (Transactional g r t) o o
-> Statement s i o -> i -> Transactional g r t o
forall {k} (t :: Mode) (s :: Mode) (g :: k) (r :: Retry) o z i.
SubMode t s =>
FoldM (Transactional g r t) o z
-> Statement s i o -> i -> Transactional g r t z
foldM (FoldM (Transactional g r t) o o
 -> Statement s i o -> i -> Transactional g r t o)
-> FoldM (Transactional g r t) o o
-> Statement s i o
-> i
-> Transactional g r t o
forall a b. (a -> b) -> a -> b
$ ErrRows -> ErrRows -> FoldM (Transactional g r t) o o
forall (m :: * -> *) e o.
(MonadThrow m, Exception e) =>
e -> e -> FoldM m o o
foldOneM ErrRows
ErrRows_TooFew ErrRows
ErrRows_TooMany
{-# INLINE one #-}

-- | Executes a 'Statement' expected to return exactly __zero__ rows.
--
-- * Throws 'ErrRows_TooMany' if more than zero rows.
zero :: (SubMode t s) => Statement s i o -> i -> Transactional g r t ()
zero :: forall {k} (t :: Mode) (s :: Mode) i o (g :: k) (r :: Retry).
SubMode t s =>
Statement s i o -> i -> Transactional g r t ()
zero = FoldM (Transactional g r t) o ()
-> Statement s i o -> i -> Transactional g r t ()
forall {k} (t :: Mode) (s :: Mode) (g :: k) (r :: Retry) o z i.
SubMode t s =>
FoldM (Transactional g r t) o z
-> Statement s i o -> i -> Transactional g r t z
foldM (FoldM (Transactional g r t) o ()
 -> Statement s i o -> i -> Transactional g r t ())
-> FoldM (Transactional g r t) o ()
-> Statement s i o
-> i
-> Transactional g r t ()
forall a b. (a -> b) -> a -> b
$ ErrRows -> FoldM (Transactional g r t) o ()
forall (m :: * -> *) e o.
(MonadThrow m, Exception e) =>
e -> FoldM m o ()
foldZeroM ErrRows
ErrRows_TooMany
{-# INLINE zero #-}

-- | Executes a 'Statement' expected to return __one or more__ rows.
--
-- * Returns the length of the 'NonEmpty' list, too.
--
-- * Throws 'ErrRows_TooFew' if zero rows.
some
   :: (SubMode t s)
   => Statement s i o
   -> i
   -> Transactional g r t (Int64, NonEmpty o)
some :: forall {k} (t :: Mode) (s :: Mode) i o (g :: k) (r :: Retry).
SubMode t s =>
Statement s i o -> i -> Transactional g r t (Int64, NonEmpty o)
some = FoldM (Transactional g r t) o (Int64, NonEmpty o)
-> Statement s i o -> i -> Transactional g r t (Int64, NonEmpty o)
forall {k} (t :: Mode) (s :: Mode) (g :: k) (r :: Retry) o z i.
SubMode t s =>
FoldM (Transactional g r t) o z
-> Statement s i o -> i -> Transactional g r t z
foldM (FoldM (Transactional g r t) o (Int64, NonEmpty o)
 -> Statement s i o -> i -> Transactional g r t (Int64, NonEmpty o))
-> FoldM (Transactional g r t) o (Int64, NonEmpty o)
-> Statement s i o
-> i
-> Transactional g r t (Int64, NonEmpty o)
forall a b. (a -> b) -> a -> b
$ ErrRows -> FoldM (Transactional g r t) o (Int64, NonEmpty o)
forall (m :: * -> *) e o.
(MonadThrow m, Exception e) =>
e -> FoldM m o (Int64, NonEmpty o)
foldNonEmptyM ErrRows
ErrRows_TooFew
{-# INLINE some #-}

-- | Executes a 'Statement' expected to return __zero or more__ rows.
--
-- * Returns the length of the list, too.
list
   :: (SubMode t s)
   => Statement s i o
   -> i
   -> Transactional g r t (Int64, [o])
list :: forall {k} (t :: Mode) (s :: Mode) i o (g :: k) (r :: Retry).
SubMode t s =>
Statement s i o -> i -> Transactional g r t (Int64, [o])
list = Fold o (Int64, [o])
-> Statement s i o -> i -> Transactional g r t (Int64, [o])
forall {k} (t :: Mode) (s :: Mode) o z i (g :: k) (r :: Retry).
SubMode t s =>
Fold o z -> Statement s i o -> i -> Transactional g r t z
fold Fold o (Int64, [o])
forall o. Fold o (Int64, [o])
foldList
{-# INLINE list #-}

-- | __Purely fold__ all the output rows.
fold
   :: (SubMode t s)
   => F.Fold o z
   -> Statement s i o
   -> i
   -> Transactional g r t z
fold :: forall {k} (t :: Mode) (s :: Mode) o z i (g :: k) (r :: Retry).
SubMode t s =>
Fold o z -> Statement s i o -> i -> Transactional g r t z
fold = FoldM (Transactional g r t) o z
-> Statement s i o -> i -> Transactional g r t z
forall {k} (t :: Mode) (s :: Mode) (g :: k) (r :: Retry) o z i.
SubMode t s =>
FoldM (Transactional g r t) o z
-> Statement s i o -> i -> Transactional g r t z
foldM (FoldM (Transactional g r t) o z
 -> Statement s i o -> i -> Transactional g r t z)
-> (Fold o z -> FoldM (Transactional g r t) o z)
-> Fold o z
-> Statement s i o
-> i
-> Transactional g r t z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fold o z -> FoldM (Transactional g r t) o z
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
F.generalize
{-# INLINE fold #-}

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

-- | Execute a 'Read'-only 'Transactional' in a fresh 'Transaction' that will
-- be automatically released when done.
read
   :: (MonadIO m, SubMode p 'Read)
   => Pool p
   -> (forall g. Transactional g 'Retry 'Read a)
   -> m a
read :: forall {k} (m :: * -> *) (p :: Mode) a.
(MonadIO m, SubMode p 'Read) =>
Pool p -> (forall (g :: k). Transactional g 'Retry 'Read a) -> m a
read Pool p
p = Acquire (Transaction 'Read)
-> (forall {g :: k}. Transactional g 'Retry 'Read a) -> m a
forall {k} (m :: * -> *) (r :: Retry) (t :: Mode) a.
MonadIO m =>
Acquire (Transaction t)
-> (forall (g :: k). Transactional g r t a) -> m a
transactionalRetry (Acquire (Transaction 'Read)
 -> (forall {g :: k}. Transactional g 'Retry 'Read a) -> m a)
-> Acquire (Transaction 'Read)
-> (forall {g :: k}. Transactional g 'Retry 'Read a)
-> m a
forall a b. (a -> b) -> a -> b
$ Pool p -> Acquire (Transaction 'Read)
forall (mode :: Mode). Pool mode -> Acquire (Transaction 'Read)
readTransaction Pool p
p
{-# INLINE read #-}

-- | Execute a read-'Write' 'Transactional' in a fresh 'Transaction' that will
-- be automatically committed when done.
commit
   :: (MonadIO m)
   => Pool 'Write
   -> (forall g. Transactional g 'Retry 'Write a)
   -> m a
commit :: forall {k} (m :: * -> *) a.
MonadIO m =>
Pool 'Write
-> (forall (g :: k). Transactional g 'Retry 'Write a) -> m a
commit Pool 'Write
p = Acquire (Transaction 'Write)
-> (forall {g :: k}. Transactional g 'Retry 'Write a) -> m a
forall {k} (m :: * -> *) (r :: Retry) (t :: Mode) a.
MonadIO m =>
Acquire (Transaction t)
-> (forall (g :: k). Transactional g r t a) -> m a
transactionalRetry (Acquire (Transaction 'Write)
 -> (forall {g :: k}. Transactional g 'Retry 'Write a) -> m a)
-> Acquire (Transaction 'Write)
-> (forall {g :: k}. Transactional g 'Retry 'Write a)
-> m a
forall a b. (a -> b) -> a -> b
$ Pool 'Write -> Acquire (Transaction 'Write)
commitTransaction Pool 'Write
p
{-# INLINE commit #-}

-- | Execute a read-'Write' 'Transactional' in a fresh 'Transaction' that will
-- be automatically rolled-back when done.
--
-- __This is mostly useful for testing__.
rollback
   :: (MonadIO m)
   => Pool 'Write
   -> (forall g. Transactional g 'Retry 'Write a)
   -> m a
rollback :: forall {k} (m :: * -> *) a.
MonadIO m =>
Pool 'Write
-> (forall (g :: k). Transactional g 'Retry 'Write a) -> m a
rollback Pool 'Write
p = Acquire (Transaction 'Write)
-> (forall {g :: k}. Transactional g 'Retry 'Write a) -> m a
forall {k} (m :: * -> *) (r :: Retry) (t :: Mode) a.
MonadIO m =>
Acquire (Transaction t)
-> (forall (g :: k). Transactional g r t a) -> m a
transactionalRetry (Acquire (Transaction 'Write)
 -> (forall {g :: k}. Transactional g 'Retry 'Write a) -> m a)
-> Acquire (Transaction 'Write)
-> (forall {g :: k}. Transactional g 'Retry 'Write a)
-> m a
forall a b. (a -> b) -> a -> b
$ Pool 'Write -> Acquire (Transaction 'Write)
rollbackTransaction Pool 'Write
p
{-# INLINE rollback #-}