{-# LANGUAGE OverloadedStrings #-}
module Database.Selda.SQL.Print.Config (PPConfig (..), defPPConfig) where
import Data.Text (Text)
import qualified Data.Text as T
import Database.Selda.SqlType ( SqlTypeRep(..) )
import Database.Selda.Table.Type
    ( IndexMethod, ColAttr(..), AutoIncType(Weak, Strong) )

-- | Backend-specific configuration for the SQL pretty-printer.
data PPConfig = PPConfig
  { -- | The SQL type name of the given type.
    --
    --   This function should be used everywhere a type is needed to be printed but in primary
    --   keys position. This is due to the fact that some backends might have a special
    --   representation of primary keys (using sequences are such). If you have such a need,
    --   please use the 'ppTypePK' record instead.
    PPConfig -> SqlTypeRep -> Text
ppType :: SqlTypeRep -> Text

    -- | Hook that allows you to modify 'ppType' output.
  , PPConfig -> SqlTypeRep -> [ColAttr] -> (SqlTypeRep -> Text) -> Text
ppTypeHook :: SqlTypeRep -> [ColAttr] -> (SqlTypeRep -> Text) -> Text

    -- | The SQL type name of the given type for primary keys uses.
  , PPConfig -> SqlTypeRep -> Text
ppTypePK :: SqlTypeRep -> Text

    -- | Parameter placeholder for the @n@th parameter.
  , PPConfig -> Int -> Text
ppPlaceholder :: Int -> Text

    -- | List of column attributes.
  , PPConfig -> [ColAttr] -> Text
ppColAttrs :: [ColAttr] -> Text

    -- | Hook that allows you to modify 'ppColAttrs' output.
  , PPConfig -> SqlTypeRep -> [ColAttr] -> ([ColAttr] -> Text) -> Text
ppColAttrsHook :: SqlTypeRep -> [ColAttr] -> ([ColAttr] -> Text) -> Text

    -- | The value used for the next value for an auto-incrementing column.
    --   For instance, @DEFAULT@ for PostgreSQL, and @NULL@ for SQLite.
  , PPConfig -> Text
ppAutoIncInsert :: Text

    -- | Insert queries may have at most this many parameters; if an insertion
    --   has more parameters than this, it will be chunked.
    --
    --   Note that only insertions of multiple rows are chunked. If your table
    --   has more than this many columns, you should really rethink
    --   your database design.
  , PPConfig -> Maybe Int
ppMaxInsertParams :: Maybe Int

    -- | @CREATE INDEX@ suffix to indicate that the index should use the given
    --   index method.
  , PPConfig -> IndexMethod -> Text
ppIndexMethodHook :: IndexMethod -> Text
  }

-- | Default settings for pretty-printing.
--   Geared towards SQLite.
--
--   The default definition of 'ppTypePK' is 'defType, so that you don’t have to do anything
--   special if you don’t use special types for primary keys.
defPPConfig :: PPConfig
defPPConfig :: PPConfig
defPPConfig = PPConfig
    { ppType :: SqlTypeRep -> Text
ppType = SqlTypeRep -> Text
defType
    , ppTypeHook :: SqlTypeRep -> [ColAttr] -> (SqlTypeRep -> Text) -> Text
ppTypeHook = \SqlTypeRep
ty [ColAttr]
_ SqlTypeRep -> Text
_ -> SqlTypeRep -> Text
defType SqlTypeRep
ty
    , ppTypePK :: SqlTypeRep -> Text
ppTypePK = SqlTypeRep -> Text
defType
    , ppPlaceholder :: Int -> Text
ppPlaceholder = Char -> Text -> Text
T.cons Char
'$' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
    , ppColAttrs :: [ColAttr] -> Text
ppColAttrs = [Text] -> Text
T.unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ColAttr -> Text
defColAttr
    , ppColAttrsHook :: SqlTypeRep -> [ColAttr] -> ([ColAttr] -> Text) -> Text
ppColAttrsHook = \SqlTypeRep
_ [ColAttr]
ats [ColAttr] -> Text
_ -> [Text] -> Text
T.unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ColAttr -> Text
defColAttr [ColAttr]
ats
    , ppAutoIncInsert :: Text
ppAutoIncInsert = Text
"NULL"
    , ppMaxInsertParams :: Maybe Int
ppMaxInsertParams = forall a. Maybe a
Nothing
    , ppIndexMethodHook :: IndexMethod -> Text
ppIndexMethodHook = forall a b. a -> b -> a
const Text
""
    }

-- | Default compilation for SQL types.
--   By default, anything we don't know is just a blob.
defType :: SqlTypeRep -> Text
defType :: SqlTypeRep -> Text
defType SqlTypeRep
TText     = Text
"TEXT"
defType SqlTypeRep
TRowID    = Text
"INTEGER"
defType SqlTypeRep
TInt32    = Text
"INT"
defType SqlTypeRep
TInt64    = Text
"BIGINT"
defType SqlTypeRep
TFloat    = Text
"DOUBLE PRECISION"
defType SqlTypeRep
TBool     = Text
"BOOLEAN"
defType SqlTypeRep
TDateTime = Text
"DATETIME"
defType SqlTypeRep
TDate     = Text
"DATE"
defType SqlTypeRep
TTime     = Text
"TIME"
defType SqlTypeRep
TBlob     = Text
"BLOB"
defType SqlTypeRep
TUUID     = Text
"BLOB"
defType SqlTypeRep
TJSON     = Text
"BLOB"

-- | Default compilation for a column attribute.
defColAttr :: ColAttr -> Text
defColAttr :: ColAttr -> Text
defColAttr ColAttr
Primary              = Text
""
defColAttr (AutoPrimary AutoIncType
Strong) = Text
"PRIMARY KEY AUTOINCREMENT"
defColAttr (AutoPrimary AutoIncType
Weak)   = Text
"PRIMARY KEY"
defColAttr ColAttr
Required             = Text
"NOT NULL"
defColAttr ColAttr
Optional             = Text
"NULL"
defColAttr ColAttr
Unique               = Text
"UNIQUE"
defColAttr (Indexed Maybe IndexMethod
_)          = Text
""