{- This file is part of persistent-migration.
 -
 - Written in 2016, 2017, 2018, 2019, 2020, 2022, 2023
 - by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

{-# LANGUAGE OverloadedStrings #-}

-- | Due to an incomplete implementation of this backend, it's advised to use
-- it with the following care (for now):
--
-- * Don't use Uniques at all
-- * Don't use refs at all, instead plain Int64
-- * Don't attempt any finding/fixing of misnamed foreigns
--
-- In more detail, the following stuff doesn't work in this backend currently:
--
-- * Certain features are broken and require care when using this backend:
--     - Foreign key constraints (i.e. a column whose type is the Id of some
--       table) aren't created at all on the SQL side, this is silent and
--       doesn't raise any error
--     - Unique constraints aren't created at all on the SQL side, this is
--       silent and doesn't raise any error
--     - Renaming/removing a Unique doesn't do anything on the SQL side, just
--       silently passes
-- * Certain migrations don't work and will throw an error if attempted:
--     - Retype a column
--     - Renull a column
--     - set/unset default value for a column
-- * Table references don't have a constraint name, this makes
--   'findMisnamedForeigns' fail so don't use it with this backend
module Database.Persist.Schema.SQLite
    ( schemaBackend
    )
where

import Data.Text (Text)
import Database.Persist.Sql (SqlBackend)
import Database.Persist.Types (SqlType (..))

import qualified Data.Text as T

import Database.Persist.Schema.SQL
import Database.Persist.Schema.SQL.Internal

constraint2sql :: ConstraintName -> Text
constraint2sql = quoteName . unConstraintName

typeSql :: SqlType -> Text
typeSql SqlString = "VARCHAR"
typeSql SqlInt32 = "INTEGER"
typeSql SqlInt64 = "INTEGER"
typeSql SqlReal = "REAL"
typeSql (SqlNumeric precision scale) = T.concat [ "NUMERIC(", T.pack (show precision), ",", T.pack (show scale), ")" ]
typeSql SqlDay = "DATE"
typeSql SqlTime = "TIME"
typeSql SqlDayTime = "TIMESTAMP"
typeSql SqlBlob = "BLOB"
typeSql SqlBool = "BOOLEAN"
typeSql (SqlOther t) = t

columnSql :: Column -> Text
columnSql (Column name typ mnull) = mconcat
    [ column2sql name, " "
    , typeSql typ
    , case mnull of
        MaybeNull -> " NULL"
        NotNull   -> " NOT NULL"
    ]

idCol :: ColumnName
idCol = ColumnName "id"

idSql :: Text
idSql = "id INTEGER PRIMARY KEY"

schemaBackend :: SchemaBackend SqlBackend
schemaBackend = SqlSchemaBackend
    { ssbRefType = SqlInt64
    , ssbDoesTableExist =
        "SELECT COUNT(*) FROM sqlite_schema WHERE type='table' AND name=?"
    , ssbAnyTablesExist =
        "SELECT EXISTS (SELECT 1 FROM sqlite_schema WHERE type='table')"
    , ssbGetTableNames =
        "SELECT name FROM sqlite_schema WHERE type='table' AND name!=?"
    , ssbGetTableColumnNames =
        "SELECT name FROM PRAGMA_TABLE_INFO(?)"
    , ssbGetColumnForeign =
        "SELECT ?, ? WHERE FALSE"
    , ssbGetTableForeigns =
        "SELECT ? WHERE FALSE"
    , ssbAnyRowsExist = \ table -> mconcat
        [ "SELECT EXISTS (SELECT 1 FROM ", table2sql table, ")"
        ]
    , ssbCreateTable = \ table columns -> mconcat
        [ "CREATE TABLE ", table2sql table, " ("
        , idSql
        , if null columns then T.empty else ", "
        , T.intercalate ", " $ map columnSql columns
        , ")"
        ]
    , ssbRenameTable = \ old new -> mconcat
        [ "ALTER TABLE ", table2sql old
        , " RENAME TO ", table2sql new
        ]
    , ssbDropTable = \ table -> mconcat
        [ "DROP TABLE ", table2sql table
        ]
    , ssbAddColumn = \ table column withdef -> mconcat
        [ "ALTER TABLE ", table2sql table
        , " ADD COLUMN ", columnSql column
        , if withdef
            then " DEFAULT ?"
            else T.empty
        ]
    , ssbRenameColumn = \ table old new -> mconcat
        [ "ALTER TABLE ", table2sql table
        , " RENAME COLUMN ", column2sql old, " TO ", column2sql new
        ]
    , ssbRetypeColumn = error "SQLite ssbRetypeColumn"
    , ssbRetypeColumnConst = error "SQLite ssbRetypeColumnConst"
    , ssbRenullColumn = error "SQLite ssbRenullColumn"
    , ssbUnnullColumn = \ table column -> mconcat
        [ "UPDATE ", table2sql table
        , " SET ", column2sql column, " = ?"
        , " WHERE ", column2sql column, " IS NULL"
        ]
    , ssbDefColumn = error "SQLite ssbDefColumn"
    , ssbUndefColumn = error "SQLite ssbUndefColumn"
    , ssbDropColumn = \ table column -> mconcat
        [ "ALTER TABLE ", table2sql table
        , " DROP COLUMN ", column2sql column
        ]
    , ssbAddUnique = \ _ _ _ -> "PRAGMA noop_ssb_add_unique"
    , ssbAddForeignKey = \ _ _ _ _ -> "PRAGMA noop_ssb_add_foreign_key"
    , ssbRenameConstraint = \ _ _ _ -> "PRAGMA noop_ssb_rename_constraint"
    , ssbDropConstraint = \ _ _ -> "PRAGMA noop_ssb_drop_constraint"
    }