{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric  #-}

module PostgREST.DbStructure.Table
  ( Column(..)
  , Table(..)
  , tableQi
  ) where

import qualified Data.Aeson as JSON

import PostgREST.DbStructure.Identifiers (FieldName,
                                          QualifiedIdentifier (..),
                                          Schema, TableName)

import Protolude


data Table = Table
  { Table -> Schema
tableSchema      :: Schema
  , Table -> Schema
tableName        :: TableName
  , Table -> Maybe Schema
tableDescription :: Maybe Text
    -- The following fields identify what can be done on the table/view, they're not related to the privileges granted to it
  , Table -> Bool
tableInsertable  :: Bool
  , Table -> Bool
tableUpdatable   :: Bool
  , Table -> Bool
tableDeletable   :: Bool
  }
  deriving (Int -> Table -> ShowS
[Table] -> ShowS
Table -> String
(Int -> Table -> ShowS)
-> (Table -> String) -> ([Table] -> ShowS) -> Show Table
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Table] -> ShowS
$cshowList :: [Table] -> ShowS
show :: Table -> String
$cshow :: Table -> String
showsPrec :: Int -> Table -> ShowS
$cshowsPrec :: Int -> Table -> ShowS
Show, Eq Table
Eq Table
-> (Table -> Table -> Ordering)
-> (Table -> Table -> Bool)
-> (Table -> Table -> Bool)
-> (Table -> Table -> Bool)
-> (Table -> Table -> Bool)
-> (Table -> Table -> Table)
-> (Table -> Table -> Table)
-> Ord Table
Table -> Table -> Bool
Table -> Table -> Ordering
Table -> Table -> Table
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 :: Table -> Table -> Table
$cmin :: Table -> Table -> Table
max :: Table -> Table -> Table
$cmax :: Table -> Table -> Table
>= :: Table -> Table -> Bool
$c>= :: Table -> Table -> Bool
> :: Table -> Table -> Bool
$c> :: Table -> Table -> Bool
<= :: Table -> Table -> Bool
$c<= :: Table -> Table -> Bool
< :: Table -> Table -> Bool
$c< :: Table -> Table -> Bool
compare :: Table -> Table -> Ordering
$ccompare :: Table -> Table -> Ordering
$cp1Ord :: Eq Table
Ord, (forall x. Table -> Rep Table x)
-> (forall x. Rep Table x -> Table) -> Generic Table
forall x. Rep Table x -> Table
forall x. Table -> Rep Table x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Table x -> Table
$cfrom :: forall x. Table -> Rep Table x
Generic, [Table] -> Encoding
[Table] -> Value
Table -> Encoding
Table -> Value
(Table -> Value)
-> (Table -> Encoding)
-> ([Table] -> Value)
-> ([Table] -> Encoding)
-> ToJSON Table
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Table] -> Encoding
$ctoEncodingList :: [Table] -> Encoding
toJSONList :: [Table] -> Value
$ctoJSONList :: [Table] -> Value
toEncoding :: Table -> Encoding
$ctoEncoding :: Table -> Encoding
toJSON :: Table -> Value
$ctoJSON :: Table -> Value
JSON.ToJSON)

instance Eq Table where
  Table{tableSchema :: Table -> Schema
tableSchema=Schema
s1,tableName :: Table -> Schema
tableName=Schema
n1} == :: Table -> Table -> Bool
== Table{tableSchema :: Table -> Schema
tableSchema=Schema
s2,tableName :: Table -> Schema
tableName=Schema
n2} = Schema
s1 Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
s2 Bool -> Bool -> Bool
&& Schema
n1 Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
n2

tableQi :: Table -> QualifiedIdentifier
tableQi :: Table -> QualifiedIdentifier
tableQi Table{tableSchema :: Table -> Schema
tableSchema=Schema
s, tableName :: Table -> Schema
tableName=Schema
n} = Schema -> Schema -> QualifiedIdentifier
QualifiedIdentifier Schema
s Schema
n

data Column = Column
  { Column -> Table
colTable       :: Table
  , Column -> Schema
colName        :: FieldName
  , Column -> Maybe Schema
colDescription :: Maybe Text
  , Column -> Bool
colNullable    :: Bool
  , Column -> Schema
colType        :: Text
  , Column -> Maybe Int32
colMaxLen      :: Maybe Int32
  , Column -> Maybe Schema
colDefault     :: Maybe Text
  , Column -> [Schema]
colEnum        :: [Text]
  }
  deriving (Eq Column
Eq Column
-> (Column -> Column -> Ordering)
-> (Column -> Column -> Bool)
-> (Column -> Column -> Bool)
-> (Column -> Column -> Bool)
-> (Column -> Column -> Bool)
-> (Column -> Column -> Column)
-> (Column -> Column -> Column)
-> Ord Column
Column -> Column -> Bool
Column -> Column -> Ordering
Column -> Column -> Column
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 :: Column -> Column -> Column
$cmin :: Column -> Column -> Column
max :: Column -> Column -> Column
$cmax :: Column -> Column -> Column
>= :: Column -> Column -> Bool
$c>= :: Column -> Column -> Bool
> :: Column -> Column -> Bool
$c> :: Column -> Column -> Bool
<= :: Column -> Column -> Bool
$c<= :: Column -> Column -> Bool
< :: Column -> Column -> Bool
$c< :: Column -> Column -> Bool
compare :: Column -> Column -> Ordering
$ccompare :: Column -> Column -> Ordering
$cp1Ord :: Eq Column
Ord, (forall x. Column -> Rep Column x)
-> (forall x. Rep Column x -> Column) -> Generic Column
forall x. Rep Column x -> Column
forall x. Column -> Rep Column x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Column x -> Column
$cfrom :: forall x. Column -> Rep Column x
Generic, [Column] -> Encoding
[Column] -> Value
Column -> Encoding
Column -> Value
(Column -> Value)
-> (Column -> Encoding)
-> ([Column] -> Value)
-> ([Column] -> Encoding)
-> ToJSON Column
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Column] -> Encoding
$ctoEncodingList :: [Column] -> Encoding
toJSONList :: [Column] -> Value
$ctoJSONList :: [Column] -> Value
toEncoding :: Column -> Encoding
$ctoEncoding :: Column -> Encoding
toJSON :: Column -> Value
$ctoJSON :: Column -> Value
JSON.ToJSON)

instance Eq Column where
  Column{colTable :: Column -> Table
colTable=Table
t1,colName :: Column -> Schema
colName=Schema
n1} == :: Column -> Column -> Bool
== Column{colTable :: Column -> Table
colTable=Table
t2,colName :: Column -> Schema
colName=Schema
n2} = Table
t1 Table -> Table -> Bool
forall a. Eq a => a -> a -> Bool
== Table
t2 Bool -> Bool -> Bool
&& Schema
n1 Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
n2

data PrimaryKey = PrimaryKey
  { PrimaryKey -> Table
pkTable :: Table
  , PrimaryKey -> Schema
pkName  :: Text
  }
  deriving ((forall x. PrimaryKey -> Rep PrimaryKey x)
-> (forall x. Rep PrimaryKey x -> PrimaryKey) -> Generic PrimaryKey
forall x. Rep PrimaryKey x -> PrimaryKey
forall x. PrimaryKey -> Rep PrimaryKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PrimaryKey x -> PrimaryKey
$cfrom :: forall x. PrimaryKey -> Rep PrimaryKey x
Generic, [PrimaryKey] -> Encoding
[PrimaryKey] -> Value
PrimaryKey -> Encoding
PrimaryKey -> Value
(PrimaryKey -> Value)
-> (PrimaryKey -> Encoding)
-> ([PrimaryKey] -> Value)
-> ([PrimaryKey] -> Encoding)
-> ToJSON PrimaryKey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PrimaryKey] -> Encoding
$ctoEncodingList :: [PrimaryKey] -> Encoding
toJSONList :: [PrimaryKey] -> Value
$ctoJSONList :: [PrimaryKey] -> Value
toEncoding :: PrimaryKey -> Encoding
$ctoEncoding :: PrimaryKey -> Encoding
toJSON :: PrimaryKey -> Value
$ctoJSON :: PrimaryKey -> Value
JSON.ToJSON)