module Database.Selda.Table.Type where
import Database.Selda.SqlType (SqlTypeRep)
import Database.Selda.SQL (SQL)
import Database.Selda.Types ( TableName, ColName )
import Database.Selda.Exp ( UntypedCol )

-- | A database table, based on some Haskell data type.
--   Any single constructor type can form the basis of a table, as long as
--   it derives @Generic@ and all of its fields are instances of @SqlType@.
data Table a = Table
  { -- | Name of the table. NOT guaranteed to be a valid SQL name.
    forall a. Table a -> TableName
tableName :: TableName

    -- | All table columns.
    --   Invariant: the 'colAttrs' list of each column is sorted and contains
    --   no duplicates.
  , forall a. Table a -> [ColInfo]
tableCols :: [ColInfo]

    -- | Does the given table have an auto-incrementing primary key?
  , forall a. Table a -> Bool
tableHasAutoPK :: Bool

    -- | Attributes involving multiple columns.
  , forall a. Table a -> [([Int], ColAttr)]
tableAttrs :: [([Int], ColAttr)]
  }

-- | A complete description of a database column.
data ColInfo = ColInfo
  { ColInfo -> ColName
colName  :: ColName
  , ColInfo -> SqlTypeRep
colType  :: SqlTypeRep
  , ColInfo -> [ColAttr]
colAttrs :: [ColAttr]
  , ColInfo -> [(Table (), ColName)]
colFKs   :: [(Table (), ColName)]
  , ColInfo -> UntypedCol SQL
colExpr  :: UntypedCol SQL
  }

-- | Strongly or weakly auto-incrementing primary key?
data AutoIncType = Weak | Strong
  deriving (Int -> AutoIncType -> ShowS
[AutoIncType] -> ShowS
AutoIncType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AutoIncType] -> ShowS
$cshowList :: [AutoIncType] -> ShowS
show :: AutoIncType -> String
$cshow :: AutoIncType -> String
showsPrec :: Int -> AutoIncType -> ShowS
$cshowsPrec :: Int -> AutoIncType -> ShowS
Show, AutoIncType -> AutoIncType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AutoIncType -> AutoIncType -> Bool
$c/= :: AutoIncType -> AutoIncType -> Bool
== :: AutoIncType -> AutoIncType -> Bool
$c== :: AutoIncType -> AutoIncType -> Bool
Eq, Eq AutoIncType
AutoIncType -> AutoIncType -> Bool
AutoIncType -> AutoIncType -> Ordering
AutoIncType -> AutoIncType -> AutoIncType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AutoIncType -> AutoIncType -> AutoIncType
$cmin :: AutoIncType -> AutoIncType -> AutoIncType
max :: AutoIncType -> AutoIncType -> AutoIncType
$cmax :: AutoIncType -> AutoIncType -> AutoIncType
>= :: AutoIncType -> AutoIncType -> Bool
$c>= :: AutoIncType -> AutoIncType -> Bool
> :: AutoIncType -> AutoIncType -> Bool
$c> :: AutoIncType -> AutoIncType -> Bool
<= :: AutoIncType -> AutoIncType -> Bool
$c<= :: AutoIncType -> AutoIncType -> Bool
< :: AutoIncType -> AutoIncType -> Bool
$c< :: AutoIncType -> AutoIncType -> Bool
compare :: AutoIncType -> AutoIncType -> Ordering
$ccompare :: AutoIncType -> AutoIncType -> Ordering
Ord)

-- | Column attributes such as nullability, auto increment, etc.
--   When adding elements, make sure that they are added in the order
--   required by SQL syntax, as this list is only sorted before being
--   pretty-printed.
data ColAttr
  = Primary
  | AutoPrimary AutoIncType
  | Required
  | Optional
  | Unique
  | Indexed (Maybe IndexMethod)
  deriving (Int -> ColAttr -> ShowS
[ColAttr] -> ShowS
ColAttr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColAttr] -> ShowS
$cshowList :: [ColAttr] -> ShowS
show :: ColAttr -> String
$cshow :: ColAttr -> String
showsPrec :: Int -> ColAttr -> ShowS
$cshowsPrec :: Int -> ColAttr -> ShowS
Show, ColAttr -> ColAttr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColAttr -> ColAttr -> Bool
$c/= :: ColAttr -> ColAttr -> Bool
== :: ColAttr -> ColAttr -> Bool
$c== :: ColAttr -> ColAttr -> Bool
Eq, Eq ColAttr
ColAttr -> ColAttr -> Bool
ColAttr -> ColAttr -> Ordering
ColAttr -> ColAttr -> ColAttr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ColAttr -> ColAttr -> ColAttr
$cmin :: ColAttr -> ColAttr -> ColAttr
max :: ColAttr -> ColAttr -> ColAttr
$cmax :: ColAttr -> ColAttr -> ColAttr
>= :: ColAttr -> ColAttr -> Bool
$c>= :: ColAttr -> ColAttr -> Bool
> :: ColAttr -> ColAttr -> Bool
$c> :: ColAttr -> ColAttr -> Bool
<= :: ColAttr -> ColAttr -> Bool
$c<= :: ColAttr -> ColAttr -> Bool
< :: ColAttr -> ColAttr -> Bool
$c< :: ColAttr -> ColAttr -> Bool
compare :: ColAttr -> ColAttr -> Ordering
$ccompare :: ColAttr -> ColAttr -> Ordering
Ord)

isAutoPrimary :: ColAttr -> Bool
isAutoPrimary :: ColAttr -> Bool
isAutoPrimary (AutoPrimary AutoIncType
_) = Bool
True
isAutoPrimary ColAttr
_               = Bool
False

isPrimary :: ColAttr -> Bool
isPrimary :: ColAttr -> Bool
isPrimary ColAttr
Primary = Bool
True
isPrimary ColAttr
attr    = ColAttr -> Bool
isAutoPrimary ColAttr
attr

isUnique :: ColAttr -> Bool
isUnique :: ColAttr -> Bool
isUnique ColAttr
Unique      = Bool
True
isUnique (Indexed Maybe IndexMethod
_) = Bool
True
isUnique ColAttr
attr        = ColAttr -> Bool
isPrimary ColAttr
attr

-- | Method to use for indexing with 'indexedUsing'.
--   Index methods are ignored by the SQLite backend, as SQLite doesn't support
--   different index methods.
data IndexMethod
  = BTreeIndex
  | HashIndex
-- Omitted until the operator class business is sorted out
--  | GistIndex
--  | GinIndex
  deriving (Int -> IndexMethod -> ShowS
[IndexMethod] -> ShowS
IndexMethod -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexMethod] -> ShowS
$cshowList :: [IndexMethod] -> ShowS
show :: IndexMethod -> String
$cshow :: IndexMethod -> String
showsPrec :: Int -> IndexMethod -> ShowS
$cshowsPrec :: Int -> IndexMethod -> ShowS
Show, IndexMethod -> IndexMethod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexMethod -> IndexMethod -> Bool
$c/= :: IndexMethod -> IndexMethod -> Bool
== :: IndexMethod -> IndexMethod -> Bool
$c== :: IndexMethod -> IndexMethod -> Bool
Eq, Eq IndexMethod
IndexMethod -> IndexMethod -> Bool
IndexMethod -> IndexMethod -> Ordering
IndexMethod -> IndexMethod -> IndexMethod
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IndexMethod -> IndexMethod -> IndexMethod
$cmin :: IndexMethod -> IndexMethod -> IndexMethod
max :: IndexMethod -> IndexMethod -> IndexMethod
$cmax :: IndexMethod -> IndexMethod -> IndexMethod
>= :: IndexMethod -> IndexMethod -> Bool
$c>= :: IndexMethod -> IndexMethod -> Bool
> :: IndexMethod -> IndexMethod -> Bool
$c> :: IndexMethod -> IndexMethod -> Bool
<= :: IndexMethod -> IndexMethod -> Bool
$c<= :: IndexMethod -> IndexMethod -> Bool
< :: IndexMethod -> IndexMethod -> Bool
$c< :: IndexMethod -> IndexMethod -> Bool
compare :: IndexMethod -> IndexMethod -> Ordering
$ccompare :: IndexMethod -> IndexMethod -> Ordering
Ord)