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

module PostgREST.DbStructure.Relationship
  ( Cardinality(..)
  , PrimaryKey(..)
  , Relationship(..)
  , Junction(..)
  , isSelfReference
  ) where

import qualified Data.Aeson as JSON

import PostgREST.DbStructure.Table (Column (..), Table (..))

import Protolude


-- | Relationship between two tables.
--
-- The order of the relColumns and relForeignColumns should be maintained to get the
-- join conditions right.
--
-- TODO merge relColumns and relForeignColumns to a tuple or Data.Bimap
data Relationship = Relationship
  { Relationship -> Table
relTable          :: Table
  , Relationship -> [Column]
relColumns        :: [Column]
  , Relationship -> Table
relForeignTable   :: Table
  , Relationship -> [Column]
relForeignColumns :: [Column]
  , Relationship -> Cardinality
relCardinality    :: Cardinality
  }
  deriving (Relationship -> Relationship -> Bool
(Relationship -> Relationship -> Bool)
-> (Relationship -> Relationship -> Bool) -> Eq Relationship
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relationship -> Relationship -> Bool
$c/= :: Relationship -> Relationship -> Bool
== :: Relationship -> Relationship -> Bool
$c== :: Relationship -> Relationship -> Bool
Eq, (forall x. Relationship -> Rep Relationship x)
-> (forall x. Rep Relationship x -> Relationship)
-> Generic Relationship
forall x. Rep Relationship x -> Relationship
forall x. Relationship -> Rep Relationship x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Relationship x -> Relationship
$cfrom :: forall x. Relationship -> Rep Relationship x
Generic, [Relationship] -> Encoding
[Relationship] -> Value
Relationship -> Encoding
Relationship -> Value
(Relationship -> Value)
-> (Relationship -> Encoding)
-> ([Relationship] -> Value)
-> ([Relationship] -> Encoding)
-> ToJSON Relationship
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Relationship] -> Encoding
$ctoEncodingList :: [Relationship] -> Encoding
toJSONList :: [Relationship] -> Value
$ctoJSONList :: [Relationship] -> Value
toEncoding :: Relationship -> Encoding
$ctoEncoding :: Relationship -> Encoding
toJSON :: Relationship -> Value
$ctoJSON :: Relationship -> Value
JSON.ToJSON)

-- | The relationship cardinality
-- | https://en.wikipedia.org/wiki/Cardinality_(data_modeling)
-- TODO: missing one-to-one
data Cardinality
  = O2M FKConstraint -- ^ one-to-many cardinality
  | M2O FKConstraint -- ^ many-to-one cardinality
  | M2M Junction     -- ^ many-to-many cardinality
  deriving (Cardinality -> Cardinality -> Bool
(Cardinality -> Cardinality -> Bool)
-> (Cardinality -> Cardinality -> Bool) -> Eq Cardinality
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cardinality -> Cardinality -> Bool
$c/= :: Cardinality -> Cardinality -> Bool
== :: Cardinality -> Cardinality -> Bool
$c== :: Cardinality -> Cardinality -> Bool
Eq, (forall x. Cardinality -> Rep Cardinality x)
-> (forall x. Rep Cardinality x -> Cardinality)
-> Generic Cardinality
forall x. Rep Cardinality x -> Cardinality
forall x. Cardinality -> Rep Cardinality x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cardinality x -> Cardinality
$cfrom :: forall x. Cardinality -> Rep Cardinality x
Generic, [Cardinality] -> Encoding
[Cardinality] -> Value
Cardinality -> Encoding
Cardinality -> Value
(Cardinality -> Value)
-> (Cardinality -> Encoding)
-> ([Cardinality] -> Value)
-> ([Cardinality] -> Encoding)
-> ToJSON Cardinality
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Cardinality] -> Encoding
$ctoEncodingList :: [Cardinality] -> Encoding
toJSONList :: [Cardinality] -> Value
$ctoJSONList :: [Cardinality] -> Value
toEncoding :: Cardinality -> Encoding
$ctoEncoding :: Cardinality -> Encoding
toJSON :: Cardinality -> Value
$ctoJSON :: Cardinality -> Value
JSON.ToJSON)

type FKConstraint = Text

-- | Junction table on an M2M relationship
data Junction = Junction
  { Junction -> Table
junTable       :: Table
  , Junction -> FKConstraint
junConstraint1 :: FKConstraint
  , Junction -> [Column]
junColumns1    :: [Column]
  , Junction -> FKConstraint
junConstraint2 :: FKConstraint
  , Junction -> [Column]
junColumns2    :: [Column]
  }
  deriving (Junction -> Junction -> Bool
(Junction -> Junction -> Bool)
-> (Junction -> Junction -> Bool) -> Eq Junction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Junction -> Junction -> Bool
$c/= :: Junction -> Junction -> Bool
== :: Junction -> Junction -> Bool
$c== :: Junction -> Junction -> Bool
Eq, (forall x. Junction -> Rep Junction x)
-> (forall x. Rep Junction x -> Junction) -> Generic Junction
forall x. Rep Junction x -> Junction
forall x. Junction -> Rep Junction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Junction x -> Junction
$cfrom :: forall x. Junction -> Rep Junction x
Generic, [Junction] -> Encoding
[Junction] -> Value
Junction -> Encoding
Junction -> Value
(Junction -> Value)
-> (Junction -> Encoding)
-> ([Junction] -> Value)
-> ([Junction] -> Encoding)
-> ToJSON Junction
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Junction] -> Encoding
$ctoEncodingList :: [Junction] -> Encoding
toJSONList :: [Junction] -> Value
$ctoJSONList :: [Junction] -> Value
toEncoding :: Junction -> Encoding
$ctoEncoding :: Junction -> Encoding
toJSON :: Junction -> Value
$ctoJSON :: Junction -> Value
JSON.ToJSON)

isSelfReference :: Relationship -> Bool
isSelfReference :: Relationship -> Bool
isSelfReference Relationship
r = Relationship -> Table
relTable Relationship
r Table -> Table -> Bool
forall a. Eq a => a -> a -> Bool
== Relationship -> Table
relForeignTable Relationship
r

data PrimaryKey = PrimaryKey
  { PrimaryKey -> Table
pkTable :: Table
  , PrimaryKey -> FKConstraint
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)