-- | SQLite storage: one file, WAL mode, one connection shared behind a
-- lock. SQLite runs one writer at a time anyway, and a TodoMVC request
-- is a handful of indexed statements, so a pool would buy nothing.
module Todo.Db
  ( Db
  , open
  , close
  , findList
  , createList
  , listTodos
  , addTodo
  , toggleTodo
  , renameTodo
  , deleteTodo
  , toggleAll
  , clearCompleted
  ) where

import Control.Concurrent.MVar
import Control.Monad (forM_)
import Data.Text (Text)
import Data.Text qualified as T
import Database.SQLite.Simple (Connection, Only (..), Query (..), execute, execute_, query, query_, withTransaction)
import Database.SQLite.Simple qualified as SQL
import Todo.Model

newtype Db = Db (MVar Connection)

-- | Opens (creating if needed) the database and brings its schema up to
-- date.
open :: FilePath -> IO Db
open path = do
  conn <- SQL.open path
  -- journal_mode answers with a row, so it goes through query_.
  _ <- query_ conn "PRAGMA journal_mode = WAL" :: IO [Only Text]
  execute_ conn "PRAGMA synchronous = NORMAL"
  execute_ conn "PRAGMA foreign_keys = ON"
  execute_ conn "PRAGMA busy_timeout = 5000"
  migrate conn
  Db <$> newMVar conn

-- | Folds the WAL back into the main file and closes the connection.
close :: Db -> IO ()
close (Db var) = withMVar var $ \conn -> do
  _ <- query_ conn "PRAGMA wal_checkpoint(TRUNCATE)" :: IO [(Int, Int, Int)]
  SQL.close conn

-- | The schema's history. Each entry runs once, in order, and the number
-- applied is kept in @user_version@. Entries are only ever appended, and
-- they only ever add: no drops, no rewrites.
migrations :: [[Query]]
migrations =
  [ [ "CREATE TABLE lists (\
      \  id INTEGER PRIMARY KEY,\
      \  token TEXT NOT NULL UNIQUE,\
      \  created_at TEXT NOT NULL DEFAULT (strftime('%Y-%m-%dT%H:%M:%fZ', 'now')))"
    , "CREATE TABLE todos (\
      \  id INTEGER PRIMARY KEY,\
      \  list_id INTEGER NOT NULL REFERENCES lists (id),\
      \  title TEXT NOT NULL,\
      \  completed INTEGER NOT NULL DEFAULT 0,\
      \  created_at TEXT NOT NULL DEFAULT (strftime('%Y-%m-%dT%H:%M:%fZ', 'now')))"
    , "CREATE INDEX todos_by_list ON todos (list_id, id)"
    ]
  ]

migrate :: Connection -> IO ()
migrate conn = do
  applied <- query_ conn "PRAGMA user_version"
  let done = case applied of
        [Only n] -> n
        _ -> 0
  forM_ (drop done (zip [1 :: Int ..] migrations)) $ \(n, statements) ->
    withTransaction conn $ do
      mapM_ (execute_ conn) statements
      -- PRAGMA takes no parameters, so the number is written in.
      execute_ conn (Query ("PRAGMA user_version = " <> T.pack (show n)))

with :: Db -> (Connection -> IO a) -> IO a
with (Db var) = withMVar var

findList :: Db -> Text -> IO (Maybe ListId)
findList db token = with db $ \conn -> do
  rows <- query conn "SELECT id FROM lists WHERE token = ?" (Only token)
  pure $ case rows of
    [Only n] -> Just (ListId n)
    _ -> Nothing

createList :: Db -> Text -> IO ListId
createList db token = with db $ \conn -> do
  execute conn "INSERT INTO lists (token) VALUES (?)" (Only token)
  ListId <$> SQL.lastInsertRowId conn

listTodos :: Db -> ListId -> IO [Todo]
listTodos db (ListId list) = with db $ \conn -> do
  rows <- query conn "SELECT id, title, completed FROM todos WHERE list_id = ? ORDER BY id" (Only list)
  pure [Todo (TodoId i) t c | (i, t, c) <- rows]

addTodo :: Db -> ListId -> Text -> IO ()
addTodo db (ListId list) title = with db $ \conn ->
  execute conn "INSERT INTO todos (list_id, title) VALUES (?, ?)" (list, title)

-- The functions that change one todo answer whether it was in that list.

toggleTodo :: Db -> ListId -> TodoId -> IO Bool
toggleTodo db (ListId list) (TodoId todo) = with db $ \conn -> do
  execute conn "UPDATE todos SET completed = NOT completed WHERE id = ? AND list_id = ?" (todo, list)
  changed conn

renameTodo :: Db -> ListId -> TodoId -> Text -> IO Bool
renameTodo db (ListId list) (TodoId todo) title = with db $ \conn -> do
  execute conn "UPDATE todos SET title = ? WHERE id = ? AND list_id = ?" (title, todo, list)
  changed conn

deleteTodo :: Db -> ListId -> TodoId -> IO Bool
deleteTodo db (ListId list) (TodoId todo) = with db $ \conn -> do
  execute conn "DELETE FROM todos WHERE id = ? AND list_id = ?" (todo, list)
  changed conn

changed :: Connection -> IO Bool
changed conn = (> 0) <$> SQL.changes conn

-- | Completes everything, unless everything already is, in which case it
-- makes everything active again.
toggleAll :: Db -> ListId -> IO ()
toggleAll db (ListId list) = with db $ \conn -> withTransaction conn $ do
  rows <- query conn "SELECT EXISTS (SELECT 1 FROM todos WHERE list_id = ? AND NOT completed)" (Only list)
  let anyActive = case rows of
        [Only b] -> b
        _ -> False
  execute conn "UPDATE todos SET completed = ? WHERE list_id = ?" (anyActive, list)

clearCompleted :: Db -> ListId -> IO ()
clearCompleted db (ListId list) = with db $ \conn ->
  execute conn "DELETE FROM todos WHERE list_id = ? AND completed" (Only list)