-- | Easy to use interface for SQLite3 using the @direct-sqlite@ library.
--
-- This can be useful for your toy, hobby projects.
module Database.Sqlite.Easy
  ( -- * Connect to the database
    -- $connecting
    withDb
  , withDatabase
  , ConnectionString(..)
  , Database
    -- ** Pooling connections
    -- $pooling
  , Pool
  , createSqlitePool
  , withPool
  , withResource
  , destroyAllResources
    -- * Running statements and queries
    -- $running
  , run
  , runWith
  , SQLite
  , liftIO
  , fromString
  , -- ** Database types
    SQL
  , SQLData(..)
  , SQLError(..)
  , ColumnType(..)
    -- * Running transactions
    -- $transactions
  , transaction
  , rollback
  , rollbackAll
  , -- * Migrations
    -- $migrations
    module Migrant,
    void
  , -- * Fun types to export
    Int64, Text, ByteString
    -- * Suggestions
    -- $suggestions
  )
  where

import Data.Pool (Pool, destroyAllResources, withResource)
import Database.SQLite3 (SQLData(..), Database, SQLError(..), ColumnType(..))
import Database.Sqlite.Easy.Internal
import Database.Sqlite.Easy.Migrant as Migrant
import Database.Migrant as Migrant hiding (migrate)
import Data.Int (Int64)
import Data.Text (Text)
import Data.ByteString (ByteString)
import Data.String (fromString)
import Control.Monad.Reader (liftIO)
import Control.Monad (void)

{- $connecting

The easiest way to run some statements on the database is using the
'withDb' function. 'withDb' expects a connection string
(such as a file with flags or @:memory:@, see sqlite3 docs:
<https://www.sqlite.org/c3ref/open.html>), and SQLite action(s),
such as queries and statements.
It will open the connection to the database and run the SQLite actions
on that database.

=== Example

> do
>   results <- withDb ":memory:" (run "select 1 + 1")
>   case results of
>     [[SQLInteger n]] -> print n
>     _ -> error ("Got unexpected results: " <> show results)

Note: use 'Data.String.fromString' to convert a 'String' to a 'ConnectionString'
      or to 'SQL' if you prefer not to use @OverloadedStrings@.
-}

{- $pooling

An alternative to 'withDb' is to create a resource 'Pool'.
A resource pool is an abstraction for automatically managing connections
to a resource (such as a database).

We can use the 'createSqlitePool' function to create a @Pool 'Database'@
and pass that around until you are ready to use the database.

We can use 'withPool' like we did with 'withDb' but passing a @Pool Database@
instead of a 'ConnectionString'.

=== Example

> do
>   pool <- createSqlitePool ":memory:"
>   results <- withPool pool (run "select 1 + 1")
>   case results of
>     [[SQLInteger n]] -> print n
>     _ -> error ("Got unexpected results: " <> show results)

Note: a resource pool disconnects automatically after some time,
so if you are using @:memory:@ as your database, you will lose your
data when the connection closes!

-}

{- $running

To execute a statement or query, use the 'run' or 'runWith' functions.

'run' is used to execute a statement or query and fetch the results.

'runWith' is similar to 'run', but lets us place parameters instead of
places where we write @?@ in the query.
If you want to pass user data, use 'runWith' to avoid SQL injection!

The list of lists of SQLData returned from these functions are
rows of columns of sqlite values. Sqlite only has a few possible
values: integers, floating-point numbers, text, bytes and null.
The 'SQLData' type encodes these options.

=== Example

> do
>   results <- withDb ":memory:" $ do
>     [] <- run "CREATE TABLE characters(id INTEGER PRIMARY KEY AUTOINCREMENT, name TEXT)"
>     [] <- run "INSERT INTO characters(name) VALUES ('Scanlan'),('Nott'),('Fresh Cut Grass')"
>     runWith "SELECT * FROM characters WHERE id = ?" [SQLInteger 2]
>
>   for_ results $ \case
>     [SQLInteger id', SQLText name] -> putStrLn (show id' <> ", " <> show name)
>     row -> hPutStrLn stderr ("Unexpected row: " <> show row)

-}

{- $transactions

If you'd like to run multiple statements and queries atomically, use 'transaction'.

=== Example

> withDb ":memory:" $ do
>   ( transaction $ do
>       [] <- run "CREATE TABLE t1(id INTEGER, name TEXT)"
>       [] <- run "CREATE TABLE t2(id INTEGER, name TEXT)"
>       [] <- run "CREATE TABLE t3id INTEGER, name TEXT)" -- whoops
>       [] <- run "CREATE TABLE t4(id INTEGER, name TEXT)"
>       pure ()
>     ) `catch` (\(SomeException e) -> liftIO $ print ("Transaction rolled back", e))
>   run "select * from t1" -- throws an exception (table not found) because the transaction was rolled back

You can also decide to rollback the current transaction yourself by supplying the result value
with 'rollback', or rollback all transactions with 'rollbackAll'.

Note, catching an exception from within 'SQLite' as was done in the previous
snippet is not recommended because it can mix with rollback code,
but it can be done using the 'unliftio' package.

-}

{- $migrations

Database migrations are a way to setup a database with the relevant information
(such as table structure) needed for the application to start, and update it
from a possible older version to a newer version (or even go the other direction).

Migrations are a list of statements we run in order to upgrade or downgrade a database.
We use the @migrant@ library to semi-automate this process - we write the upgrade
and downgrade steps, and it runs them. For more information, consult the @migrant@
documentation: <https://github.com/tdammers/migrant>.

To create a migration we need to write the following things:

1) A list of migration names

> migrations :: [MigrationName]
> migrations =
>   [ "user-table"
>   , "article-table"
>   ]

2) Migration up steps - a mapping from migration name to what to do.

> migrateUp :: MigrationName -> SQLite ()
> migrateUp = \case
>   "user-table" ->
>     void (run "CREATE TABLE user(id INTEGER, name TEXT)")
>   "article-table" ->
>     void (run "CREATE TABLE article(id integer, title TEXT, content TEXT, author_id integer)")
>   unknown ->
>     error ("Unexpected migration: " <> show unknown)

3) Migration down steps

> migrateDown :: MigrationName -> SQLite ()
> migrateDown = \case
>   "user-table" ->
>     void (run "DROP TABLE user")
>   "article-table" ->
>     void (run "DROP TABLE article")
>   unknown ->
>     error ("Unexpected migration: " <> show unknown)

After doing that, we can run a migration with the 'migrate' function:

> runMigrations :: SQLite ()
> runMigrations = migrate migrations migrateUp migrateDown

-}

{- $suggestions

A suggestion for the architecture of your database interactions: use the handle pattern!

=== 1. Create a type for your API

Think about what actions you want to perform on your database:

For example:

> data DB
>   = DB
>     { getPost :: Id -> IO (Id, Post)
>     , getPosts :: IO [(Id, Post)]
>     , insertPost :: Post -> IO Id
>     , deletePostById :: Id -> IO ()
>     }

Note how we don't mention the database connection here!

=== 2. Create a smart constructor

This function should:

1. Create a resource pool with the database
2. Run the database migrations
3. Return a @DB@ such that each function in the API is a closure over the pool

For example:

> mkDB :: ConnectionString -> IO DB
> mkDB connectionString = do
>   pool <- createSqlitePool connectionString
>   withPool pool runMigrations
>   pure $ DB
>     { getPost = withPool pool . getPostFromDb
>     , getPosts = withPool pool getPostsFromDb
>     , insertPost = withPool pool . insertPostToDb
>     , deletePostById = withPool pool . deletePostByIdFromDb
>     }

Where:

> getPostFromDb :: Id -> SQLite (Id, Post)

> insertPostToDb :: Post -> SQLite Id

and so on.

=== 3. Use the handle from your application code

When you start the application, run @mkDB@ and get a handle, and pass it around
(or use @ReaderT@). When you need to run a database command, call a field from @DB@:

> -- A page for a specific post
> [ Twain.get "/post/:id" $ do
>   postId <- Twain.param "id"
>   post <- liftIO $ getPost db postId -- (*)
>   Twain.send (displayPost post)
> ]

Or, with @OverloadedRecordDot@,

>   post <- liftIO $ db.getPost postId

== Complete Example

Visit this link for a more complete example:
<https://github.com/soupi/sqlite-easy-example-todo>
-}