-- | An interpretation of Codd's Relational Model, as described in 'A Relational Model of Data for Large Shared Data Banks' (1970). Types ('domains') and values are parameterized so as to allow for application-specific implementations. No special support is provided for 'nonsimple' domains; i.e. relations are assumed to be normalized.

module Hydra.Langs.RelationalModel where

import qualified Hydra.Core as Core
import Data.Int
import Data.List as L
import Data.Map as M
import Data.Set as S

-- | A name for a domain which serves to identify the role played by that domain in the given relation; a 'role name' in Codd
newtype ColumnName = 
  ColumnName {
    ColumnName -> String
unColumnName :: String}
  deriving (ColumnName -> ColumnName -> Bool
(ColumnName -> ColumnName -> Bool)
-> (ColumnName -> ColumnName -> Bool) -> Eq ColumnName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColumnName -> ColumnName -> Bool
== :: ColumnName -> ColumnName -> Bool
$c/= :: ColumnName -> ColumnName -> Bool
/= :: ColumnName -> ColumnName -> Bool
Eq, Eq ColumnName
Eq ColumnName =>
(ColumnName -> ColumnName -> Ordering)
-> (ColumnName -> ColumnName -> Bool)
-> (ColumnName -> ColumnName -> Bool)
-> (ColumnName -> ColumnName -> Bool)
-> (ColumnName -> ColumnName -> Bool)
-> (ColumnName -> ColumnName -> ColumnName)
-> (ColumnName -> ColumnName -> ColumnName)
-> Ord ColumnName
ColumnName -> ColumnName -> Bool
ColumnName -> ColumnName -> Ordering
ColumnName -> ColumnName -> ColumnName
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
$ccompare :: ColumnName -> ColumnName -> Ordering
compare :: ColumnName -> ColumnName -> Ordering
$c< :: ColumnName -> ColumnName -> Bool
< :: ColumnName -> ColumnName -> Bool
$c<= :: ColumnName -> ColumnName -> Bool
<= :: ColumnName -> ColumnName -> Bool
$c> :: ColumnName -> ColumnName -> Bool
> :: ColumnName -> ColumnName -> Bool
$c>= :: ColumnName -> ColumnName -> Bool
>= :: ColumnName -> ColumnName -> Bool
$cmax :: ColumnName -> ColumnName -> ColumnName
max :: ColumnName -> ColumnName -> ColumnName
$cmin :: ColumnName -> ColumnName -> ColumnName
min :: ColumnName -> ColumnName -> ColumnName
Ord, ReadPrec [ColumnName]
ReadPrec ColumnName
Int -> ReadS ColumnName
ReadS [ColumnName]
(Int -> ReadS ColumnName)
-> ReadS [ColumnName]
-> ReadPrec ColumnName
-> ReadPrec [ColumnName]
-> Read ColumnName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ColumnName
readsPrec :: Int -> ReadS ColumnName
$creadList :: ReadS [ColumnName]
readList :: ReadS [ColumnName]
$creadPrec :: ReadPrec ColumnName
readPrec :: ReadPrec ColumnName
$creadListPrec :: ReadPrec [ColumnName]
readListPrec :: ReadPrec [ColumnName]
Read, Int -> ColumnName -> String -> String
[ColumnName] -> String -> String
ColumnName -> String
(Int -> ColumnName -> String -> String)
-> (ColumnName -> String)
-> ([ColumnName] -> String -> String)
-> Show ColumnName
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ColumnName -> String -> String
showsPrec :: Int -> ColumnName -> String -> String
$cshow :: ColumnName -> String
show :: ColumnName -> String
$cshowList :: [ColumnName] -> String -> String
showList :: [ColumnName] -> String -> String
Show)

_ColumnName :: Name
_ColumnName = (String -> Name
Core.Name String
"hydra/langs/relationalModel.ColumnName")

-- | An abstract specification of the domain represented by a column in a relation; a role
data ColumnSchema t = 
  ColumnSchema {
    -- | A unique name for the column
    forall t. ColumnSchema t -> ColumnName
columnSchemaName :: ColumnName,
    -- | The domain (type) of the column
    forall t. ColumnSchema t -> t
columnSchemaDomain :: t,
    -- | Whether this column represents the primary key of its relation
    forall t. ColumnSchema t -> Bool
columnSchemaIsPrimaryKey :: Bool}
  deriving (ColumnSchema t -> ColumnSchema t -> Bool
(ColumnSchema t -> ColumnSchema t -> Bool)
-> (ColumnSchema t -> ColumnSchema t -> Bool)
-> Eq (ColumnSchema t)
forall t. Eq t => ColumnSchema t -> ColumnSchema t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall t. Eq t => ColumnSchema t -> ColumnSchema t -> Bool
== :: ColumnSchema t -> ColumnSchema t -> Bool
$c/= :: forall t. Eq t => ColumnSchema t -> ColumnSchema t -> Bool
/= :: ColumnSchema t -> ColumnSchema t -> Bool
Eq, Eq (ColumnSchema t)
Eq (ColumnSchema t) =>
(ColumnSchema t -> ColumnSchema t -> Ordering)
-> (ColumnSchema t -> ColumnSchema t -> Bool)
-> (ColumnSchema t -> ColumnSchema t -> Bool)
-> (ColumnSchema t -> ColumnSchema t -> Bool)
-> (ColumnSchema t -> ColumnSchema t -> Bool)
-> (ColumnSchema t -> ColumnSchema t -> ColumnSchema t)
-> (ColumnSchema t -> ColumnSchema t -> ColumnSchema t)
-> Ord (ColumnSchema t)
ColumnSchema t -> ColumnSchema t -> Bool
ColumnSchema t -> ColumnSchema t -> Ordering
ColumnSchema t -> ColumnSchema t -> ColumnSchema t
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
forall t. Ord t => Eq (ColumnSchema t)
forall t. Ord t => ColumnSchema t -> ColumnSchema t -> Bool
forall t. Ord t => ColumnSchema t -> ColumnSchema t -> Ordering
forall t.
Ord t =>
ColumnSchema t -> ColumnSchema t -> ColumnSchema t
$ccompare :: forall t. Ord t => ColumnSchema t -> ColumnSchema t -> Ordering
compare :: ColumnSchema t -> ColumnSchema t -> Ordering
$c< :: forall t. Ord t => ColumnSchema t -> ColumnSchema t -> Bool
< :: ColumnSchema t -> ColumnSchema t -> Bool
$c<= :: forall t. Ord t => ColumnSchema t -> ColumnSchema t -> Bool
<= :: ColumnSchema t -> ColumnSchema t -> Bool
$c> :: forall t. Ord t => ColumnSchema t -> ColumnSchema t -> Bool
> :: ColumnSchema t -> ColumnSchema t -> Bool
$c>= :: forall t. Ord t => ColumnSchema t -> ColumnSchema t -> Bool
>= :: ColumnSchema t -> ColumnSchema t -> Bool
$cmax :: forall t.
Ord t =>
ColumnSchema t -> ColumnSchema t -> ColumnSchema t
max :: ColumnSchema t -> ColumnSchema t -> ColumnSchema t
$cmin :: forall t.
Ord t =>
ColumnSchema t -> ColumnSchema t -> ColumnSchema t
min :: ColumnSchema t -> ColumnSchema t -> ColumnSchema t
Ord, ReadPrec [ColumnSchema t]
ReadPrec (ColumnSchema t)
Int -> ReadS (ColumnSchema t)
ReadS [ColumnSchema t]
(Int -> ReadS (ColumnSchema t))
-> ReadS [ColumnSchema t]
-> ReadPrec (ColumnSchema t)
-> ReadPrec [ColumnSchema t]
-> Read (ColumnSchema t)
forall t. Read t => ReadPrec [ColumnSchema t]
forall t. Read t => ReadPrec (ColumnSchema t)
forall t. Read t => Int -> ReadS (ColumnSchema t)
forall t. Read t => ReadS [ColumnSchema t]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall t. Read t => Int -> ReadS (ColumnSchema t)
readsPrec :: Int -> ReadS (ColumnSchema t)
$creadList :: forall t. Read t => ReadS [ColumnSchema t]
readList :: ReadS [ColumnSchema t]
$creadPrec :: forall t. Read t => ReadPrec (ColumnSchema t)
readPrec :: ReadPrec (ColumnSchema t)
$creadListPrec :: forall t. Read t => ReadPrec [ColumnSchema t]
readListPrec :: ReadPrec [ColumnSchema t]
Read, Int -> ColumnSchema t -> String -> String
[ColumnSchema t] -> String -> String
ColumnSchema t -> String
(Int -> ColumnSchema t -> String -> String)
-> (ColumnSchema t -> String)
-> ([ColumnSchema t] -> String -> String)
-> Show (ColumnSchema t)
forall t. Show t => Int -> ColumnSchema t -> String -> String
forall t. Show t => [ColumnSchema t] -> String -> String
forall t. Show t => ColumnSchema t -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall t. Show t => Int -> ColumnSchema t -> String -> String
showsPrec :: Int -> ColumnSchema t -> String -> String
$cshow :: forall t. Show t => ColumnSchema t -> String
show :: ColumnSchema t -> String
$cshowList :: forall t. Show t => [ColumnSchema t] -> String -> String
showList :: [ColumnSchema t] -> String -> String
Show)

_ColumnSchema :: Name
_ColumnSchema = (String -> Name
Core.Name String
"hydra/langs/relationalModel.ColumnSchema")

_ColumnSchema_name :: Name
_ColumnSchema_name = (String -> Name
Core.Name String
"name")

_ColumnSchema_domain :: Name
_ColumnSchema_domain = (String -> Name
Core.Name String
"domain")

_ColumnSchema_isPrimaryKey :: Name
_ColumnSchema_isPrimaryKey = (String -> Name
Core.Name String
"isPrimaryKey")

-- | A mapping from certain columns of a source relation to primary key columns of a target relation
data ForeignKey = 
  ForeignKey {
    -- | The name of the target relation
    ForeignKey -> RelationName
foreignKeyForeignRelation :: RelationName,
    ForeignKey -> Map ColumnName ColumnName
foreignKeyKeys :: (Map ColumnName ColumnName)}
  deriving (ForeignKey -> ForeignKey -> Bool
(ForeignKey -> ForeignKey -> Bool)
-> (ForeignKey -> ForeignKey -> Bool) -> Eq ForeignKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ForeignKey -> ForeignKey -> Bool
== :: ForeignKey -> ForeignKey -> Bool
$c/= :: ForeignKey -> ForeignKey -> Bool
/= :: ForeignKey -> ForeignKey -> Bool
Eq, Eq ForeignKey
Eq ForeignKey =>
(ForeignKey -> ForeignKey -> Ordering)
-> (ForeignKey -> ForeignKey -> Bool)
-> (ForeignKey -> ForeignKey -> Bool)
-> (ForeignKey -> ForeignKey -> Bool)
-> (ForeignKey -> ForeignKey -> Bool)
-> (ForeignKey -> ForeignKey -> ForeignKey)
-> (ForeignKey -> ForeignKey -> ForeignKey)
-> Ord ForeignKey
ForeignKey -> ForeignKey -> Bool
ForeignKey -> ForeignKey -> Ordering
ForeignKey -> ForeignKey -> ForeignKey
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
$ccompare :: ForeignKey -> ForeignKey -> Ordering
compare :: ForeignKey -> ForeignKey -> Ordering
$c< :: ForeignKey -> ForeignKey -> Bool
< :: ForeignKey -> ForeignKey -> Bool
$c<= :: ForeignKey -> ForeignKey -> Bool
<= :: ForeignKey -> ForeignKey -> Bool
$c> :: ForeignKey -> ForeignKey -> Bool
> :: ForeignKey -> ForeignKey -> Bool
$c>= :: ForeignKey -> ForeignKey -> Bool
>= :: ForeignKey -> ForeignKey -> Bool
$cmax :: ForeignKey -> ForeignKey -> ForeignKey
max :: ForeignKey -> ForeignKey -> ForeignKey
$cmin :: ForeignKey -> ForeignKey -> ForeignKey
min :: ForeignKey -> ForeignKey -> ForeignKey
Ord, ReadPrec [ForeignKey]
ReadPrec ForeignKey
Int -> ReadS ForeignKey
ReadS [ForeignKey]
(Int -> ReadS ForeignKey)
-> ReadS [ForeignKey]
-> ReadPrec ForeignKey
-> ReadPrec [ForeignKey]
-> Read ForeignKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ForeignKey
readsPrec :: Int -> ReadS ForeignKey
$creadList :: ReadS [ForeignKey]
readList :: ReadS [ForeignKey]
$creadPrec :: ReadPrec ForeignKey
readPrec :: ReadPrec ForeignKey
$creadListPrec :: ReadPrec [ForeignKey]
readListPrec :: ReadPrec [ForeignKey]
Read, Int -> ForeignKey -> String -> String
[ForeignKey] -> String -> String
ForeignKey -> String
(Int -> ForeignKey -> String -> String)
-> (ForeignKey -> String)
-> ([ForeignKey] -> String -> String)
-> Show ForeignKey
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ForeignKey -> String -> String
showsPrec :: Int -> ForeignKey -> String -> String
$cshow :: ForeignKey -> String
show :: ForeignKey -> String
$cshowList :: [ForeignKey] -> String -> String
showList :: [ForeignKey] -> String -> String
Show)

_ForeignKey :: Name
_ForeignKey = (String -> Name
Core.Name String
"hydra/langs/relationalModel.ForeignKey")

_ForeignKey_foreignRelation :: Name
_ForeignKey_foreignRelation = (String -> Name
Core.Name String
"foreignRelation")

_ForeignKey_keys :: Name
_ForeignKey_keys = (String -> Name
Core.Name String
"keys")

-- | A primary key of a relation, specified either as a single column, or as a list of columns
newtype PrimaryKey = 
  PrimaryKey {
    PrimaryKey -> [ColumnName]
unPrimaryKey :: [ColumnName]}
  deriving (PrimaryKey -> PrimaryKey -> Bool
(PrimaryKey -> PrimaryKey -> Bool)
-> (PrimaryKey -> PrimaryKey -> Bool) -> Eq PrimaryKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrimaryKey -> PrimaryKey -> Bool
== :: PrimaryKey -> PrimaryKey -> Bool
$c/= :: PrimaryKey -> PrimaryKey -> Bool
/= :: PrimaryKey -> PrimaryKey -> Bool
Eq, Eq PrimaryKey
Eq PrimaryKey =>
(PrimaryKey -> PrimaryKey -> Ordering)
-> (PrimaryKey -> PrimaryKey -> Bool)
-> (PrimaryKey -> PrimaryKey -> Bool)
-> (PrimaryKey -> PrimaryKey -> Bool)
-> (PrimaryKey -> PrimaryKey -> Bool)
-> (PrimaryKey -> PrimaryKey -> PrimaryKey)
-> (PrimaryKey -> PrimaryKey -> PrimaryKey)
-> Ord PrimaryKey
PrimaryKey -> PrimaryKey -> Bool
PrimaryKey -> PrimaryKey -> Ordering
PrimaryKey -> PrimaryKey -> PrimaryKey
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
$ccompare :: PrimaryKey -> PrimaryKey -> Ordering
compare :: PrimaryKey -> PrimaryKey -> Ordering
$c< :: PrimaryKey -> PrimaryKey -> Bool
< :: PrimaryKey -> PrimaryKey -> Bool
$c<= :: PrimaryKey -> PrimaryKey -> Bool
<= :: PrimaryKey -> PrimaryKey -> Bool
$c> :: PrimaryKey -> PrimaryKey -> Bool
> :: PrimaryKey -> PrimaryKey -> Bool
$c>= :: PrimaryKey -> PrimaryKey -> Bool
>= :: PrimaryKey -> PrimaryKey -> Bool
$cmax :: PrimaryKey -> PrimaryKey -> PrimaryKey
max :: PrimaryKey -> PrimaryKey -> PrimaryKey
$cmin :: PrimaryKey -> PrimaryKey -> PrimaryKey
min :: PrimaryKey -> PrimaryKey -> PrimaryKey
Ord, ReadPrec [PrimaryKey]
ReadPrec PrimaryKey
Int -> ReadS PrimaryKey
ReadS [PrimaryKey]
(Int -> ReadS PrimaryKey)
-> ReadS [PrimaryKey]
-> ReadPrec PrimaryKey
-> ReadPrec [PrimaryKey]
-> Read PrimaryKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PrimaryKey
readsPrec :: Int -> ReadS PrimaryKey
$creadList :: ReadS [PrimaryKey]
readList :: ReadS [PrimaryKey]
$creadPrec :: ReadPrec PrimaryKey
readPrec :: ReadPrec PrimaryKey
$creadListPrec :: ReadPrec [PrimaryKey]
readListPrec :: ReadPrec [PrimaryKey]
Read, Int -> PrimaryKey -> String -> String
[PrimaryKey] -> String -> String
PrimaryKey -> String
(Int -> PrimaryKey -> String -> String)
-> (PrimaryKey -> String)
-> ([PrimaryKey] -> String -> String)
-> Show PrimaryKey
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PrimaryKey -> String -> String
showsPrec :: Int -> PrimaryKey -> String -> String
$cshow :: PrimaryKey -> String
show :: PrimaryKey -> String
$cshowList :: [PrimaryKey] -> String -> String
showList :: [PrimaryKey] -> String -> String
Show)

_PrimaryKey :: Name
_PrimaryKey = (String -> Name
Core.Name String
"hydra/langs/relationalModel.PrimaryKey")

-- | A set of distinct n-tuples; a table
newtype Relation v = 
  Relation {
    forall v. Relation v -> Set [v]
unRelation :: (Set [v])}
  deriving (Relation v -> Relation v -> Bool
(Relation v -> Relation v -> Bool)
-> (Relation v -> Relation v -> Bool) -> Eq (Relation v)
forall v. Eq v => Relation v -> Relation v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => Relation v -> Relation v -> Bool
== :: Relation v -> Relation v -> Bool
$c/= :: forall v. Eq v => Relation v -> Relation v -> Bool
/= :: Relation v -> Relation v -> Bool
Eq, Eq (Relation v)
Eq (Relation v) =>
(Relation v -> Relation v -> Ordering)
-> (Relation v -> Relation v -> Bool)
-> (Relation v -> Relation v -> Bool)
-> (Relation v -> Relation v -> Bool)
-> (Relation v -> Relation v -> Bool)
-> (Relation v -> Relation v -> Relation v)
-> (Relation v -> Relation v -> Relation v)
-> Ord (Relation v)
Relation v -> Relation v -> Bool
Relation v -> Relation v -> Ordering
Relation v -> Relation v -> Relation v
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
forall v. Ord v => Eq (Relation v)
forall v. Ord v => Relation v -> Relation v -> Bool
forall v. Ord v => Relation v -> Relation v -> Ordering
forall v. Ord v => Relation v -> Relation v -> Relation v
$ccompare :: forall v. Ord v => Relation v -> Relation v -> Ordering
compare :: Relation v -> Relation v -> Ordering
$c< :: forall v. Ord v => Relation v -> Relation v -> Bool
< :: Relation v -> Relation v -> Bool
$c<= :: forall v. Ord v => Relation v -> Relation v -> Bool
<= :: Relation v -> Relation v -> Bool
$c> :: forall v. Ord v => Relation v -> Relation v -> Bool
> :: Relation v -> Relation v -> Bool
$c>= :: forall v. Ord v => Relation v -> Relation v -> Bool
>= :: Relation v -> Relation v -> Bool
$cmax :: forall v. Ord v => Relation v -> Relation v -> Relation v
max :: Relation v -> Relation v -> Relation v
$cmin :: forall v. Ord v => Relation v -> Relation v -> Relation v
min :: Relation v -> Relation v -> Relation v
Ord, ReadPrec [Relation v]
ReadPrec (Relation v)
Int -> ReadS (Relation v)
ReadS [Relation v]
(Int -> ReadS (Relation v))
-> ReadS [Relation v]
-> ReadPrec (Relation v)
-> ReadPrec [Relation v]
-> Read (Relation v)
forall v. (Read v, Ord v) => ReadPrec [Relation v]
forall v. (Read v, Ord v) => ReadPrec (Relation v)
forall v. (Read v, Ord v) => Int -> ReadS (Relation v)
forall v. (Read v, Ord v) => ReadS [Relation v]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall v. (Read v, Ord v) => Int -> ReadS (Relation v)
readsPrec :: Int -> ReadS (Relation v)
$creadList :: forall v. (Read v, Ord v) => ReadS [Relation v]
readList :: ReadS [Relation v]
$creadPrec :: forall v. (Read v, Ord v) => ReadPrec (Relation v)
readPrec :: ReadPrec (Relation v)
$creadListPrec :: forall v. (Read v, Ord v) => ReadPrec [Relation v]
readListPrec :: ReadPrec [Relation v]
Read, Int -> Relation v -> String -> String
[Relation v] -> String -> String
Relation v -> String
(Int -> Relation v -> String -> String)
-> (Relation v -> String)
-> ([Relation v] -> String -> String)
-> Show (Relation v)
forall v. Show v => Int -> Relation v -> String -> String
forall v. Show v => [Relation v] -> String -> String
forall v. Show v => Relation v -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall v. Show v => Int -> Relation v -> String -> String
showsPrec :: Int -> Relation v -> String -> String
$cshow :: forall v. Show v => Relation v -> String
show :: Relation v -> String
$cshowList :: forall v. Show v => [Relation v] -> String -> String
showList :: [Relation v] -> String -> String
Show)

_Relation :: Name
_Relation = (String -> Name
Core.Name String
"hydra/langs/relationalModel.Relation")

-- | A unique relation (table) name
newtype RelationName = 
  RelationName {
    RelationName -> String
unRelationName :: String}
  deriving (RelationName -> RelationName -> Bool
(RelationName -> RelationName -> Bool)
-> (RelationName -> RelationName -> Bool) -> Eq RelationName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelationName -> RelationName -> Bool
== :: RelationName -> RelationName -> Bool
$c/= :: RelationName -> RelationName -> Bool
/= :: RelationName -> RelationName -> Bool
Eq, Eq RelationName
Eq RelationName =>
(RelationName -> RelationName -> Ordering)
-> (RelationName -> RelationName -> Bool)
-> (RelationName -> RelationName -> Bool)
-> (RelationName -> RelationName -> Bool)
-> (RelationName -> RelationName -> Bool)
-> (RelationName -> RelationName -> RelationName)
-> (RelationName -> RelationName -> RelationName)
-> Ord RelationName
RelationName -> RelationName -> Bool
RelationName -> RelationName -> Ordering
RelationName -> RelationName -> RelationName
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
$ccompare :: RelationName -> RelationName -> Ordering
compare :: RelationName -> RelationName -> Ordering
$c< :: RelationName -> RelationName -> Bool
< :: RelationName -> RelationName -> Bool
$c<= :: RelationName -> RelationName -> Bool
<= :: RelationName -> RelationName -> Bool
$c> :: RelationName -> RelationName -> Bool
> :: RelationName -> RelationName -> Bool
$c>= :: RelationName -> RelationName -> Bool
>= :: RelationName -> RelationName -> Bool
$cmax :: RelationName -> RelationName -> RelationName
max :: RelationName -> RelationName -> RelationName
$cmin :: RelationName -> RelationName -> RelationName
min :: RelationName -> RelationName -> RelationName
Ord, ReadPrec [RelationName]
ReadPrec RelationName
Int -> ReadS RelationName
ReadS [RelationName]
(Int -> ReadS RelationName)
-> ReadS [RelationName]
-> ReadPrec RelationName
-> ReadPrec [RelationName]
-> Read RelationName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RelationName
readsPrec :: Int -> ReadS RelationName
$creadList :: ReadS [RelationName]
readList :: ReadS [RelationName]
$creadPrec :: ReadPrec RelationName
readPrec :: ReadPrec RelationName
$creadListPrec :: ReadPrec [RelationName]
readListPrec :: ReadPrec [RelationName]
Read, Int -> RelationName -> String -> String
[RelationName] -> String -> String
RelationName -> String
(Int -> RelationName -> String -> String)
-> (RelationName -> String)
-> ([RelationName] -> String -> String)
-> Show RelationName
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> RelationName -> String -> String
showsPrec :: Int -> RelationName -> String -> String
$cshow :: RelationName -> String
show :: RelationName -> String
$cshowList :: [RelationName] -> String -> String
showList :: [RelationName] -> String -> String
Show)

_RelationName :: Name
_RelationName = (String -> Name
Core.Name String
"hydra/langs/relationalModel.RelationName")

-- | An abstract relation; the name and columns of a relation without its actual data
data RelationSchema t = 
  RelationSchema {
    -- | A unique name for the relation
    forall t. RelationSchema t -> RelationName
relationSchemaName :: RelationName,
    -- | A list of column specifications
    forall t. RelationSchema t -> [ColumnSchema t]
relationSchemaColumns :: [ColumnSchema t],
    -- | Any number of primary keys for the relation, each of which must be valid for this relation
    forall t. RelationSchema t -> [PrimaryKey]
relationSchemaPrimaryKeys :: [PrimaryKey],
    -- | Any number of foreign keys, each of which must be valid for both this relation and the target relation
    forall t. RelationSchema t -> [ForeignKey]
relationSchemaForeignKeys :: [ForeignKey]}
  deriving (RelationSchema t -> RelationSchema t -> Bool
(RelationSchema t -> RelationSchema t -> Bool)
-> (RelationSchema t -> RelationSchema t -> Bool)
-> Eq (RelationSchema t)
forall t. Eq t => RelationSchema t -> RelationSchema t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall t. Eq t => RelationSchema t -> RelationSchema t -> Bool
== :: RelationSchema t -> RelationSchema t -> Bool
$c/= :: forall t. Eq t => RelationSchema t -> RelationSchema t -> Bool
/= :: RelationSchema t -> RelationSchema t -> Bool
Eq, Eq (RelationSchema t)
Eq (RelationSchema t) =>
(RelationSchema t -> RelationSchema t -> Ordering)
-> (RelationSchema t -> RelationSchema t -> Bool)
-> (RelationSchema t -> RelationSchema t -> Bool)
-> (RelationSchema t -> RelationSchema t -> Bool)
-> (RelationSchema t -> RelationSchema t -> Bool)
-> (RelationSchema t -> RelationSchema t -> RelationSchema t)
-> (RelationSchema t -> RelationSchema t -> RelationSchema t)
-> Ord (RelationSchema t)
RelationSchema t -> RelationSchema t -> Bool
RelationSchema t -> RelationSchema t -> Ordering
RelationSchema t -> RelationSchema t -> RelationSchema t
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
forall t. Ord t => Eq (RelationSchema t)
forall t. Ord t => RelationSchema t -> RelationSchema t -> Bool
forall t. Ord t => RelationSchema t -> RelationSchema t -> Ordering
forall t.
Ord t =>
RelationSchema t -> RelationSchema t -> RelationSchema t
$ccompare :: forall t. Ord t => RelationSchema t -> RelationSchema t -> Ordering
compare :: RelationSchema t -> RelationSchema t -> Ordering
$c< :: forall t. Ord t => RelationSchema t -> RelationSchema t -> Bool
< :: RelationSchema t -> RelationSchema t -> Bool
$c<= :: forall t. Ord t => RelationSchema t -> RelationSchema t -> Bool
<= :: RelationSchema t -> RelationSchema t -> Bool
$c> :: forall t. Ord t => RelationSchema t -> RelationSchema t -> Bool
> :: RelationSchema t -> RelationSchema t -> Bool
$c>= :: forall t. Ord t => RelationSchema t -> RelationSchema t -> Bool
>= :: RelationSchema t -> RelationSchema t -> Bool
$cmax :: forall t.
Ord t =>
RelationSchema t -> RelationSchema t -> RelationSchema t
max :: RelationSchema t -> RelationSchema t -> RelationSchema t
$cmin :: forall t.
Ord t =>
RelationSchema t -> RelationSchema t -> RelationSchema t
min :: RelationSchema t -> RelationSchema t -> RelationSchema t
Ord, ReadPrec [RelationSchema t]
ReadPrec (RelationSchema t)
Int -> ReadS (RelationSchema t)
ReadS [RelationSchema t]
(Int -> ReadS (RelationSchema t))
-> ReadS [RelationSchema t]
-> ReadPrec (RelationSchema t)
-> ReadPrec [RelationSchema t]
-> Read (RelationSchema t)
forall t. Read t => ReadPrec [RelationSchema t]
forall t. Read t => ReadPrec (RelationSchema t)
forall t. Read t => Int -> ReadS (RelationSchema t)
forall t. Read t => ReadS [RelationSchema t]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall t. Read t => Int -> ReadS (RelationSchema t)
readsPrec :: Int -> ReadS (RelationSchema t)
$creadList :: forall t. Read t => ReadS [RelationSchema t]
readList :: ReadS [RelationSchema t]
$creadPrec :: forall t. Read t => ReadPrec (RelationSchema t)
readPrec :: ReadPrec (RelationSchema t)
$creadListPrec :: forall t. Read t => ReadPrec [RelationSchema t]
readListPrec :: ReadPrec [RelationSchema t]
Read, Int -> RelationSchema t -> String -> String
[RelationSchema t] -> String -> String
RelationSchema t -> String
(Int -> RelationSchema t -> String -> String)
-> (RelationSchema t -> String)
-> ([RelationSchema t] -> String -> String)
-> Show (RelationSchema t)
forall t. Show t => Int -> RelationSchema t -> String -> String
forall t. Show t => [RelationSchema t] -> String -> String
forall t. Show t => RelationSchema t -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall t. Show t => Int -> RelationSchema t -> String -> String
showsPrec :: Int -> RelationSchema t -> String -> String
$cshow :: forall t. Show t => RelationSchema t -> String
show :: RelationSchema t -> String
$cshowList :: forall t. Show t => [RelationSchema t] -> String -> String
showList :: [RelationSchema t] -> String -> String
Show)

_RelationSchema :: Name
_RelationSchema = (String -> Name
Core.Name String
"hydra/langs/relationalModel.RelationSchema")

_RelationSchema_name :: Name
_RelationSchema_name = (String -> Name
Core.Name String
"name")

_RelationSchema_columns :: Name
_RelationSchema_columns = (String -> Name
Core.Name String
"columns")

_RelationSchema_primaryKeys :: Name
_RelationSchema_primaryKeys = (String -> Name
Core.Name String
"primaryKeys")

_RelationSchema_foreignKeys :: Name
_RelationSchema_foreignKeys = (String -> Name
Core.Name String
"foreignKeys")

-- | A domain-unordered (string-indexed, rather than position-indexed) relation
newtype Relationship v = 
  Relationship {
    forall v. Relationship v -> Set (Map ColumnName v)
unRelationship :: (Set (Map ColumnName v))}
  deriving (Relationship v -> Relationship v -> Bool
(Relationship v -> Relationship v -> Bool)
-> (Relationship v -> Relationship v -> Bool)
-> Eq (Relationship v)
forall v. Eq v => Relationship v -> Relationship v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => Relationship v -> Relationship v -> Bool
== :: Relationship v -> Relationship v -> Bool
$c/= :: forall v. Eq v => Relationship v -> Relationship v -> Bool
/= :: Relationship v -> Relationship v -> Bool
Eq, Eq (Relationship v)
Eq (Relationship v) =>
(Relationship v -> Relationship v -> Ordering)
-> (Relationship v -> Relationship v -> Bool)
-> (Relationship v -> Relationship v -> Bool)
-> (Relationship v -> Relationship v -> Bool)
-> (Relationship v -> Relationship v -> Bool)
-> (Relationship v -> Relationship v -> Relationship v)
-> (Relationship v -> Relationship v -> Relationship v)
-> Ord (Relationship v)
Relationship v -> Relationship v -> Bool
Relationship v -> Relationship v -> Ordering
Relationship v -> Relationship v -> Relationship v
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
forall v. Ord v => Eq (Relationship v)
forall v. Ord v => Relationship v -> Relationship v -> Bool
forall v. Ord v => Relationship v -> Relationship v -> Ordering
forall v.
Ord v =>
Relationship v -> Relationship v -> Relationship v
$ccompare :: forall v. Ord v => Relationship v -> Relationship v -> Ordering
compare :: Relationship v -> Relationship v -> Ordering
$c< :: forall v. Ord v => Relationship v -> Relationship v -> Bool
< :: Relationship v -> Relationship v -> Bool
$c<= :: forall v. Ord v => Relationship v -> Relationship v -> Bool
<= :: Relationship v -> Relationship v -> Bool
$c> :: forall v. Ord v => Relationship v -> Relationship v -> Bool
> :: Relationship v -> Relationship v -> Bool
$c>= :: forall v. Ord v => Relationship v -> Relationship v -> Bool
>= :: Relationship v -> Relationship v -> Bool
$cmax :: forall v.
Ord v =>
Relationship v -> Relationship v -> Relationship v
max :: Relationship v -> Relationship v -> Relationship v
$cmin :: forall v.
Ord v =>
Relationship v -> Relationship v -> Relationship v
min :: Relationship v -> Relationship v -> Relationship v
Ord, ReadPrec [Relationship v]
ReadPrec (Relationship v)
Int -> ReadS (Relationship v)
ReadS [Relationship v]
(Int -> ReadS (Relationship v))
-> ReadS [Relationship v]
-> ReadPrec (Relationship v)
-> ReadPrec [Relationship v]
-> Read (Relationship v)
forall v. (Read v, Ord v) => ReadPrec [Relationship v]
forall v. (Read v, Ord v) => ReadPrec (Relationship v)
forall v. (Read v, Ord v) => Int -> ReadS (Relationship v)
forall v. (Read v, Ord v) => ReadS [Relationship v]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall v. (Read v, Ord v) => Int -> ReadS (Relationship v)
readsPrec :: Int -> ReadS (Relationship v)
$creadList :: forall v. (Read v, Ord v) => ReadS [Relationship v]
readList :: ReadS [Relationship v]
$creadPrec :: forall v. (Read v, Ord v) => ReadPrec (Relationship v)
readPrec :: ReadPrec (Relationship v)
$creadListPrec :: forall v. (Read v, Ord v) => ReadPrec [Relationship v]
readListPrec :: ReadPrec [Relationship v]
Read, Int -> Relationship v -> String -> String
[Relationship v] -> String -> String
Relationship v -> String
(Int -> Relationship v -> String -> String)
-> (Relationship v -> String)
-> ([Relationship v] -> String -> String)
-> Show (Relationship v)
forall v. Show v => Int -> Relationship v -> String -> String
forall v. Show v => [Relationship v] -> String -> String
forall v. Show v => Relationship v -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall v. Show v => Int -> Relationship v -> String -> String
showsPrec :: Int -> Relationship v -> String -> String
$cshow :: forall v. Show v => Relationship v -> String
show :: Relationship v -> String
$cshowList :: forall v. Show v => [Relationship v] -> String -> String
showList :: [Relationship v] -> String -> String
Show)

_Relationship :: Name
_Relationship = (String -> Name
Core.Name String
"hydra/langs/relationalModel.Relationship")

-- | An n-tuple which is an element of a given relation
newtype Row v = 
  Row {
    forall v. Row v -> [v]
unRow :: [v]}
  deriving (Row v -> Row v -> Bool
(Row v -> Row v -> Bool) -> (Row v -> Row v -> Bool) -> Eq (Row v)
forall v. Eq v => Row v -> Row v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => Row v -> Row v -> Bool
== :: Row v -> Row v -> Bool
$c/= :: forall v. Eq v => Row v -> Row v -> Bool
/= :: Row v -> Row v -> Bool
Eq, Eq (Row v)
Eq (Row v) =>
(Row v -> Row v -> Ordering)
-> (Row v -> Row v -> Bool)
-> (Row v -> Row v -> Bool)
-> (Row v -> Row v -> Bool)
-> (Row v -> Row v -> Bool)
-> (Row v -> Row v -> Row v)
-> (Row v -> Row v -> Row v)
-> Ord (Row v)
Row v -> Row v -> Bool
Row v -> Row v -> Ordering
Row v -> Row v -> Row v
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
forall v. Ord v => Eq (Row v)
forall v. Ord v => Row v -> Row v -> Bool
forall v. Ord v => Row v -> Row v -> Ordering
forall v. Ord v => Row v -> Row v -> Row v
$ccompare :: forall v. Ord v => Row v -> Row v -> Ordering
compare :: Row v -> Row v -> Ordering
$c< :: forall v. Ord v => Row v -> Row v -> Bool
< :: Row v -> Row v -> Bool
$c<= :: forall v. Ord v => Row v -> Row v -> Bool
<= :: Row v -> Row v -> Bool
$c> :: forall v. Ord v => Row v -> Row v -> Bool
> :: Row v -> Row v -> Bool
$c>= :: forall v. Ord v => Row v -> Row v -> Bool
>= :: Row v -> Row v -> Bool
$cmax :: forall v. Ord v => Row v -> Row v -> Row v
max :: Row v -> Row v -> Row v
$cmin :: forall v. Ord v => Row v -> Row v -> Row v
min :: Row v -> Row v -> Row v
Ord, ReadPrec [Row v]
ReadPrec (Row v)
Int -> ReadS (Row v)
ReadS [Row v]
(Int -> ReadS (Row v))
-> ReadS [Row v]
-> ReadPrec (Row v)
-> ReadPrec [Row v]
-> Read (Row v)
forall v. Read v => ReadPrec [Row v]
forall v. Read v => ReadPrec (Row v)
forall v. Read v => Int -> ReadS (Row v)
forall v. Read v => ReadS [Row v]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall v. Read v => Int -> ReadS (Row v)
readsPrec :: Int -> ReadS (Row v)
$creadList :: forall v. Read v => ReadS [Row v]
readList :: ReadS [Row v]
$creadPrec :: forall v. Read v => ReadPrec (Row v)
readPrec :: ReadPrec (Row v)
$creadListPrec :: forall v. Read v => ReadPrec [Row v]
readListPrec :: ReadPrec [Row v]
Read, Int -> Row v -> String -> String
[Row v] -> String -> String
Row v -> String
(Int -> Row v -> String -> String)
-> (Row v -> String)
-> ([Row v] -> String -> String)
-> Show (Row v)
forall v. Show v => Int -> Row v -> String -> String
forall v. Show v => [Row v] -> String -> String
forall v. Show v => Row v -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall v. Show v => Int -> Row v -> String -> String
showsPrec :: Int -> Row v -> String -> String
$cshow :: forall v. Show v => Row v -> String
show :: Row v -> String
$cshowList :: forall v. Show v => [Row v] -> String -> String
showList :: [Row v] -> String -> String
Show)

_Row :: Name
_Row = (String -> Name
Core.Name String
"hydra/langs/relationalModel.Row")