-- | Combinators and types specific to relationships.
--
--   These types and functions correspond with the relationships section in the
--   <https://haskell-beam.github.io/beam/user-guide/queries/relationships/ user guide>.
module Database.Beam.Query.Relationships
  ( -- * Relationships

    -- ** Many-to-many relationships
    ManyToMany, ManyToManyThrough
  , manyToMany_, manyToManyPassthrough_

    -- ** One-to-many relationships
  , OneToMany, OneToManyOptional
  , oneToMany_, oneToManyOptional_

    -- ** One-to-one relationshships
  , OneToOne, OneToMaybe
  , oneToOne_, oneToMaybe_ ) where

import Database.Beam.Query.Combinators
import Database.Beam.Query.Operator
import Database.Beam.Query.Internal
import Database.Beam.Query.Ord

import Database.Beam.Schema

import Database.Beam.Backend.SQL


-- | Synonym of 'OneToMany'. Useful for giving more meaningful types, when the
--   relationship is meant to be one-to-one.
type OneToOne be db s one many = OneToMany be db s one many

-- | Convenience type to declare one-to-many relationships. See the manual
--   section on
--   <https://haskell-beam.github.io/beam/user-guide/queries/relationships/ relationships>
--   for more information
type OneToMany be db s one many =
  ( BeamSqlBackend be, BeamSqlBackendCanSerialize be Bool ) =>
  one (QExpr be s) -> Q be db s (many (QExpr be s))

-- | Synonym of 'OneToManyOptional'. Useful for giving more meaningful types,
--   when the relationship is meant to be one-to-one.
type OneToMaybe be db s tbl rel = OneToManyOptional be db s tbl rel

-- | Convenience type to declare one-to-many relationships with a nullable
--   foreign key. See the manual section on
--   <https://haskell-beam.github.io/beam/user-guide/queries/relationships/ relationships>
--   for more information
type OneToManyOptional be db s tbl rel =
  ( BeamSqlBackend be, BeamSqlBackendCanSerialize be Bool
  , BeamSqlBackendCanSerialize be SqlNull ) =>
  tbl (QExpr be s) -> Q be db s (rel (Nullable (QExpr be s)))

-- | Used to define one-to-many (or one-to-one) relationships. Takes the table
--   to fetch, a way to extract the foreign key from that table, and the table to
--   relate to.
oneToMany_, oneToOne_
  :: ( Database be db, BeamSqlBackend be
     , HasTableEquality be (PrimaryKey tbl)
     , Table tbl, Table rel )
  => DatabaseEntity be db (TableEntity rel) {-^ Table to fetch (many) -}
  -> (rel (QExpr be s) -> PrimaryKey tbl (QExpr be s))
     {-^ Foreign key -}
  -> tbl (QExpr be s)
  -> Q be db s (rel (QExpr be s))
oneToMany_ :: DatabaseEntity be db (TableEntity rel)
-> (rel (QExpr be s) -> PrimaryKey tbl (QExpr be s))
-> tbl (QExpr be s)
-> Q be db s (rel (QExpr be s))
oneToMany_ DatabaseEntity be db (TableEntity rel)
rel rel (QExpr be s) -> PrimaryKey tbl (QExpr be s)
getKey tbl (QExpr be s)
tbl =
  DatabaseEntity be db (TableEntity rel)
-> (rel (QExpr be s) -> QExpr be s Bool)
-> Q be db s (rel (QExpr be s))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, Table table, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> (table (QExpr be s) -> QExpr be s Bool)
-> Q be db s (table (QExpr be s))
join_ DatabaseEntity be db (TableEntity rel)
rel (\rel (QExpr be s)
rel' -> rel (QExpr be s) -> PrimaryKey tbl (QExpr be s)
getKey rel (QExpr be s)
rel' PrimaryKey tbl (QExpr be s)
-> PrimaryKey tbl (QExpr be s) -> QExpr be s Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. tbl (QExpr be s) -> PrimaryKey tbl (QExpr be s)
forall (t :: (* -> *) -> *) (f :: * -> *).
Table t =>
t f -> PrimaryKey t f
pk tbl (QExpr be s)
tbl)
oneToOne_ :: DatabaseEntity be db (TableEntity rel)
-> (rel (QExpr be s) -> PrimaryKey tbl (QExpr be s))
-> tbl (QExpr be s)
-> Q be db s (rel (QExpr be s))
oneToOne_ = DatabaseEntity be db (TableEntity rel)
-> (rel (QExpr be s) -> PrimaryKey tbl (QExpr be s))
-> tbl (QExpr be s)
-> Q be db s (rel (QExpr be s))
forall be (db :: (* -> *) -> *) (tbl :: (* -> *) -> *)
       (rel :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be,
 HasTableEquality be (PrimaryKey tbl), Table tbl, Table rel) =>
DatabaseEntity be db (TableEntity rel)
-> (rel (QExpr be s) -> PrimaryKey tbl (QExpr be s))
-> tbl (QExpr be s)
-> Q be db s (rel (QExpr be s))
oneToMany_

-- | Used to define one-to-many (or one-to-one) relationships with a nullable
--   foreign key. Takes the table to fetch, a way to extract the foreign key
--   from that table, and the table to relate to.
oneToManyOptional_, oneToMaybe_
  :: ( BeamSqlBackend be, Database be db
     , Table tbl, Table rel
     , HasTableEqualityNullable be (PrimaryKey tbl) )
  => DatabaseEntity be db (TableEntity rel) {-^ Table to fetch -}
  -> (rel (QExpr be s) -> PrimaryKey tbl (Nullable (QExpr be s)))
     {-^ Foreign key -}
  -> tbl (QExpr be s)
  -> Q be db s (rel (Nullable (QExpr be s)))
oneToManyOptional_ :: DatabaseEntity be db (TableEntity rel)
-> (rel (QExpr be s) -> PrimaryKey tbl (Nullable (QExpr be s)))
-> tbl (QExpr be s)
-> Q be db s (rel (Nullable (QExpr be s)))
oneToManyOptional_ DatabaseEntity be db (TableEntity rel)
rel rel (QExpr be s) -> PrimaryKey tbl (Nullable (QExpr be s))
getKey tbl (QExpr be s)
tbl =
  Q be db (QNested s) (rel (QExpr be (QNested s)))
-> (WithRewrittenThread (QNested s) s (rel (QExpr be (QNested s)))
    -> QExpr be s Bool)
-> Q be
     db
     s
     (Retag
        Nullable
        (WithRewrittenThread (QNested s) s (rel (QExpr be (QNested s)))))
forall s r be (db :: (* -> *) -> *).
(BeamSqlBackend be, Projectible be r,
 ThreadRewritable (QNested s) r,
 Retaggable (QExpr be s) (WithRewrittenThread (QNested s) s r)) =>
Q be db (QNested s) r
-> (WithRewrittenThread (QNested s) s r -> QExpr be s Bool)
-> Q be db s (Retag Nullable (WithRewrittenThread (QNested s) s r))
leftJoin_ (DatabaseEntity be db (TableEntity rel)
-> Q be db (QNested s) (rel (QExpr be (QNested s)))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ DatabaseEntity be db (TableEntity rel)
rel) (\WithRewrittenThread (QNested s) s (rel (QExpr be (QNested s)))
rel' -> rel (QExpr be s) -> PrimaryKey tbl (Nullable (QExpr be s))
getKey rel (QExpr be s)
WithRewrittenThread (QNested s) s (rel (QExpr be (QNested s)))
rel' PrimaryKey tbl (Nullable (QExpr be s))
-> PrimaryKey tbl (Nullable (QExpr be s)) -> QExpr be s Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. PrimaryKey tbl (QExpr be s)
-> PrimaryKey tbl (Nullable (QExpr be s))
forall a b. SqlJustable a b => a -> b
just_ (tbl (QExpr be s) -> PrimaryKey tbl (QExpr be s)
forall (t :: (* -> *) -> *) (f :: * -> *).
Table t =>
t f -> PrimaryKey t f
pk tbl (QExpr be s)
tbl))
oneToMaybe_ :: DatabaseEntity be db (TableEntity rel)
-> (rel (QExpr be s) -> PrimaryKey tbl (Nullable (QExpr be s)))
-> tbl (QExpr be s)
-> Q be db s (rel (Nullable (QExpr be s)))
oneToMaybe_ = DatabaseEntity be db (TableEntity rel)
-> (rel (QExpr be s) -> PrimaryKey tbl (Nullable (QExpr be s)))
-> tbl (QExpr be s)
-> Q be db s (rel (Nullable (QExpr be s)))
forall be (db :: (* -> *) -> *) (tbl :: (* -> *) -> *)
       (rel :: (* -> *) -> *) s.
(BeamSqlBackend be, Database be db, Table tbl, Table rel,
 HasTableEqualityNullable be (PrimaryKey tbl)) =>
DatabaseEntity be db (TableEntity rel)
-> (rel (QExpr be s) -> PrimaryKey tbl (Nullable (QExpr be s)))
-> tbl (QExpr be s)
-> Q be db s (rel (Nullable (QExpr be s)))
oneToManyOptional_

-- ** Many-to-many relationships

-- | Convenience type to declare many-to-many relationships. See the manual
--   section on
--   <https://haskell-beam.github.io/beam/user-guide/queries/relationships/ relationships>
--   for more information
type ManyToMany be db left right =
  forall s.
  ( BeamSqlBackend be

  , SqlEq (QExpr be s) (PrimaryKey left (QExpr be s))
  , SqlEq (QExpr be s) (PrimaryKey right (QExpr be s)) ) =>
  Q be db s (left (QExpr be s)) -> Q be db s (right (QExpr be s)) ->
  Q be db s (left (QExpr be s), right (QExpr be s))

-- | Convenience type to declare many-to-many relationships with additional
--   data. See the manual section on
--   <https://haskell-beam.github.io/beam/user-guide/queries/relationships/ relationships>
--   for more information
type ManyToManyThrough be db through left right =
  forall s.
  ( BeamSqlBackend be

  , SqlEq (QExpr be s) (PrimaryKey left (QExpr be s))
  , SqlEq (QExpr be s) (PrimaryKey right (QExpr be s)) ) =>
  Q be db s (left (QExpr be s)) -> Q be db s (right (QExpr be s)) ->
  Q be db s ( through (QExpr be s), left (QExpr be s), right (QExpr be s) )

-- | Used to define many-to-many relationships without any additional data.
--   Takes the join table and two key extraction functions from that table to the
--   related tables. Also takes two `Q`s representing the table sources to relate.
--
--   See <https://haskell-beam.github.io/beam/user-guide/queries/relationships/ the manual>
--   for more information.
manyToMany_
  :: ( Database be db
     , Table joinThrough, Table left, Table right
     , BeamSqlBackend be

     , SqlEq (QExpr be s) (PrimaryKey left (QExpr be s))
     , SqlEq (QExpr be s) (PrimaryKey right (QExpr be s)) )
  => DatabaseEntity be db (TableEntity joinThrough)
  -> (joinThrough (QExpr be s) -> PrimaryKey left (QExpr be s))
  -> (joinThrough (QExpr be s) -> PrimaryKey right (QExpr be s))
  -> Q be db s (left (QExpr be s)) -> Q be db s (right (QExpr be s))
  -> Q be db s (left (QExpr be s), right (QExpr be s))
manyToMany_ :: DatabaseEntity be db (TableEntity joinThrough)
-> (joinThrough (QExpr be s) -> PrimaryKey left (QExpr be s))
-> (joinThrough (QExpr be s) -> PrimaryKey right (QExpr be s))
-> Q be db s (left (QExpr be s))
-> Q be db s (right (QExpr be s))
-> Q be db s (left (QExpr be s), right (QExpr be s))
manyToMany_ DatabaseEntity be db (TableEntity joinThrough)
joinTbl joinThrough (QExpr be s) -> PrimaryKey left (QExpr be s)
leftKey joinThrough (QExpr be s) -> PrimaryKey right (QExpr be s)
rightKey Q be db s (left (QExpr be s))
left Q be db s (right (QExpr be s))
right = ((joinThrough (QExpr be s), left (QExpr be s), right (QExpr be s))
 -> (left (QExpr be s), right (QExpr be s)))
-> Q be
     db
     s
     (joinThrough (QExpr be s), left (QExpr be s), right (QExpr be s))
-> Q be db s (left (QExpr be s), right (QExpr be s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(joinThrough (QExpr be s)
_, left (QExpr be s)
l, right (QExpr be s)
r) -> (left (QExpr be s)
l, right (QExpr be s)
r)) (Q be
   db
   s
   (joinThrough (QExpr be s), left (QExpr be s), right (QExpr be s))
 -> Q be db s (left (QExpr be s), right (QExpr be s)))
-> Q be
     db
     s
     (joinThrough (QExpr be s), left (QExpr be s), right (QExpr be s))
-> Q be db s (left (QExpr be s), right (QExpr be s))
forall a b. (a -> b) -> a -> b
$
                                                  DatabaseEntity be db (TableEntity joinThrough)
-> (joinThrough (QExpr be s) -> PrimaryKey left (QExpr be s))
-> (joinThrough (QExpr be s) -> PrimaryKey right (QExpr be s))
-> Q be db s (left (QExpr be s))
-> Q be db s (right (QExpr be s))
-> Q be
     db
     s
     (joinThrough (QExpr be s), left (QExpr be s), right (QExpr be s))
forall be (db :: (* -> *) -> *) (joinThrough :: (* -> *) -> *)
       (left :: (* -> *) -> *) (right :: (* -> *) -> *) s.
(Database be db, Table joinThrough, Table left, Table right,
 BeamSqlBackend be,
 SqlEq (QExpr be s) (PrimaryKey left (QExpr be s)),
 SqlEq (QExpr be s) (PrimaryKey right (QExpr be s))) =>
DatabaseEntity be db (TableEntity joinThrough)
-> (joinThrough (QExpr be s) -> PrimaryKey left (QExpr be s))
-> (joinThrough (QExpr be s) -> PrimaryKey right (QExpr be s))
-> Q be db s (left (QExpr be s))
-> Q be db s (right (QExpr be s))
-> Q be
     db
     s
     (joinThrough (QExpr be s), left (QExpr be s), right (QExpr be s))
manyToManyPassthrough_ DatabaseEntity be db (TableEntity joinThrough)
joinTbl joinThrough (QExpr be s) -> PrimaryKey left (QExpr be s)
leftKey joinThrough (QExpr be s) -> PrimaryKey right (QExpr be s)
rightKey Q be db s (left (QExpr be s))
left Q be db s (right (QExpr be s))
right

-- | Used to define many-to-many relationships with additional data. Takes the
--   join table and two key extraction functions from that table to the related
--   tables. Also takes two `Q`s representing the table sources to relate.
--
--   See <https://haskell-beam.github.io/beam/user-guide/queries/relationships/ the manual>
--   for more information.
manyToManyPassthrough_
  :: ( Database be db
     , Table joinThrough, Table left, Table right

     , BeamSqlBackend be

     , SqlEq (QExpr be s) (PrimaryKey left (QExpr be s))
     , SqlEq (QExpr be s) (PrimaryKey right (QExpr be s)) )
  => DatabaseEntity be db (TableEntity joinThrough)
  -> (joinThrough (QExpr be s) -> PrimaryKey left (QExpr be s))
  -> (joinThrough (QExpr be s) -> PrimaryKey right (QExpr be s))
  -> Q be db s (left (QExpr be s))
  -> Q be db s (right (QExpr be s))
  -> Q be db s ( joinThrough (QExpr be s)
               , left (QExpr be s)
               , right (QExpr be s))
manyToManyPassthrough_ :: DatabaseEntity be db (TableEntity joinThrough)
-> (joinThrough (QExpr be s) -> PrimaryKey left (QExpr be s))
-> (joinThrough (QExpr be s) -> PrimaryKey right (QExpr be s))
-> Q be db s (left (QExpr be s))
-> Q be db s (right (QExpr be s))
-> Q be
     db
     s
     (joinThrough (QExpr be s), left (QExpr be s), right (QExpr be s))
manyToManyPassthrough_ DatabaseEntity be db (TableEntity joinThrough)
joinTbl joinThrough (QExpr be s) -> PrimaryKey left (QExpr be s)
leftKey joinThrough (QExpr be s) -> PrimaryKey right (QExpr be s)
rightKey Q be db s (left (QExpr be s))
left Q be db s (right (QExpr be s))
right =
  do left (QExpr be s)
left_ <- Q be db s (left (QExpr be s))
left
     right (QExpr be s)
right_ <- Q be db s (right (QExpr be s))
right
     joinThrough (QExpr be s)
joinTbl_ <- DatabaseEntity be db (TableEntity joinThrough)
-> (joinThrough (QExpr be s) -> QExpr be s Bool)
-> Q be db s (joinThrough (QExpr be s))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, Table table, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> (table (QExpr be s) -> QExpr be s Bool)
-> Q be db s (table (QExpr be s))
join_ DatabaseEntity be db (TableEntity joinThrough)
joinTbl (\joinThrough (QExpr be s)
joinTbl_ -> joinThrough (QExpr be s) -> PrimaryKey left (QExpr be s)
leftKey joinThrough (QExpr be s)
joinTbl_ PrimaryKey left (QExpr be s)
-> PrimaryKey left (QExpr be s) -> QExpr be s Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. left (QExpr be s) -> PrimaryKey left (QExpr be s)
forall (table :: (* -> *) -> *) (column :: * -> *).
Table table =>
table column -> PrimaryKey table column
primaryKey left (QExpr be s)
left_ QExpr be s Bool -> QExpr be s Bool -> QExpr be s Bool
forall be context s.
BeamSqlBackend be =>
QGenExpr context be s Bool
-> QGenExpr context be s Bool -> QGenExpr context be s Bool
&&.
                                             joinThrough (QExpr be s) -> PrimaryKey right (QExpr be s)
rightKey joinThrough (QExpr be s)
joinTbl_ PrimaryKey right (QExpr be s)
-> PrimaryKey right (QExpr be s) -> QExpr be s Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. right (QExpr be s) -> PrimaryKey right (QExpr be s)
forall (table :: (* -> *) -> *) (column :: * -> *).
Table table =>
table column -> PrimaryKey table column
primaryKey right (QExpr be s)
right_)
     (joinThrough (QExpr be s), left (QExpr be s), right (QExpr be s))
-> Q be
     db
     s
     (joinThrough (QExpr be s), left (QExpr be s), right (QExpr be s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (joinThrough (QExpr be s)
joinTbl_, left (QExpr be s)
left_, right (QExpr be s)
right_)