src/Gargantext/Database/Queries/Join.hs

   1 {-|
   2 Module      : Gargantext.Database.Queries.Join
   3 Description : Main requests of Node to the database
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9 -}
  10
  11 {-# OPTIONS_GHC -fno-warn-orphans        #-}
  12 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  13
  14 {-# LANGUAGE Arrows                    #-}
  15 {-# LANGUAGE DeriveGeneric             #-}
  16 {-# LANGUAGE FlexibleContexts          #-}
  17 {-# LANGUAGE FlexibleInstances         #-}
  18 {-# LANGUAGE FunctionalDependencies    #-}
  19 {-# LANGUAGE MultiParamTypeClasses     #-}
  20 {-# LANGUAGE QuasiQuotes               #-}
  21 {-# LANGUAGE NoImplicitPrelude         #-}
  22 {-# LANGUAGE NoMonomorphismRestriction #-}
  23 {-# LANGUAGE OverloadedStrings         #-}
  24 {-# LANGUAGE TemplateHaskell           #-}
  25 ------------------------------------------------------------------------
  26 module Gargantext.Database.Queries.Join
  27   where
  28 ------------------------------------------------------------------------
  29
  30 import Control.Applicative ((<*>))
  31 import Control.Arrow ((>>>))
  32 import Data.Profunctor.Product.Default
  33 import Gargantext.Database.Schema.Ngrams
  34 import Gargantext.Database.Schema.Node
  35 import Gargantext.Database.Schema.NodeNode
  36 import Gargantext.Prelude
  37 import Opaleye
  38 import Opaleye.Internal.Join (NullMaker(..))
  39 import qualified Opaleye.Internal.Unpackspec()
  40
  41
  42 --leftJoin3 :: Query columnsL1 -> Query columnsR -> Query columnsL
  43 --     -> ((columnsL1, columnsR) -> Column PGBool)
  44 --     -> ((columnsL, (columnsL1, nullableColumnsR1)) -> Column PGBool)
  45 --     -> Query (columnsL, nullableColumnsR)
  46 --leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q1 q2 cond12) cond23
  47 join3 :: Query columnsA -> Query columnsB -> Query columnsC
  48       -> ((columnsA, columnsB, columnsC) -> Column PGBool)
  49       -> Query (columnsA, columnsB, columnsC)
  50 join3 q1 q2 q3 cond = ((,,) <$> q1 <*> q2 <*> q3) >>> keepWhen cond
  51
  52 ------------------------------------------------------------------------
  53
  54 leftJoin3' :: Query (NodeRead, (NodeNodeReadNull, NodeReadNull))
  55 leftJoin3' = leftJoin3 queryNodeNodeTable queryNodeTable queryNodeTable cond12 cond23
  56     where
  57          cond12 = undefined
  58          cond23 :: (NodeRead, (NodeNodeRead, NodeReadNull)) -> Column PGBool
  59          cond23 = undefined
  60
  61
  62 leftJoin3 :: ( Default Unpackspec columnsL1 columnsL1
  63              , Default Unpackspec columnsL2 columnsL2
  64              , Default Unpackspec columnsL3 columnsL3
  65
  66              , Default Unpackspec nullableColumnsL2 nullableColumnsL2
  67
  68              , Default NullMaker  columnsL2  nullableColumnsL2
  69              , Default NullMaker (columnsL1, nullableColumnsL2) nullableColumnsL3
  70              )
  71              =>
  72               Query columnsL1 -> Query columnsL2 -> Query columnsL3
  73                 -> ((columnsL1, columnsL2) -> Column PGBool)
  74                 -> ((columnsL3, (columnsL1, nullableColumnsL2)) -> Column PGBool)
  75                 -> Query (columnsL3, nullableColumnsL3)
  76 leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q1 q2 cond12) cond23
  77
  78 --{-
  79 leftJoin4' :: Query (NodeRead, (NodeReadNull, (NgramsReadNull, NodeReadNull)))
  80 leftJoin4' = leftJoin4 queryNgramsTable queryNodeTable queryNodeTable queryNodeTable cond12 cond23 cond34
  81     where
  82          cond12 :: (NgramsRead, NodeRead) -> Column PGBool
  83          cond12 = undefined
  84
  85          cond23 :: (NodeRead, (NgramsRead, NodeReadNull)) -> Column PGBool
  86          cond23 = undefined
  87
  88          cond34 :: (NodeRead, (NodeRead, (NgramsReadNull, NodeReadNull))) -> Column PGBool
  89          cond34 = undefined
  90
  91 {-
  92 rightJoin4' :: Query (((NodeReadNull, NodeReadNull), NodeReadNull), NodeRead)
  93 rightJoin4' = rightJoin4 queryNodeTable queryNodeTable queryNodeTable queryNodeTable cond12 cond23 cond34
  94     where
  95          cond12 :: (NodeRead, NodeRead) -> Column PGBool
  96          cond12 = undefined
  97
  98          cond23 :: ((NodeReadNull, NodeRead), NodeRead) -> Column PGBool
  99          cond23 = undefined
 100
 101          cond34 :: (((NodeReadNull, NodeReadNull), NodeRead), NodeRead) -> Column PGBool
 102          cond34 = undefined
 103
 104 --}
 105
 106
 107 leftJoin4
 108   :: (Default Unpackspec fieldsL1 fieldsL1,
 109       Default Unpackspec fieldsL2 fieldsL2,
 110       Default Unpackspec nullableFieldsR1 nullableFieldsR1,
 111       Default Unpackspec fieldsL3 fieldsL3,
 112       Default Unpackspec nullableFieldsR2 nullableFieldsR2,
 113       Default Unpackspec fieldsR fieldsR,
 114       Default NullMaker fieldsR nullableFieldsR2,
 115       Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR3,
 116       Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1) =>
 117      Opaleye.Select fieldsL3
 118      -> Opaleye.Select fieldsR
 119      -> Opaleye.Select fieldsL2
 120      -> Opaleye.Select fieldsL1
 121      -> ((fieldsL3, fieldsR) -> Column PGBool)
 122      -> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool)
 123      -> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool)
 124      -> Opaleye.Select (fieldsL1, nullableFieldsR3)
 125 leftJoin4 q1 q2 q3 q4 cond12 cond23 cond34 = leftJoin q4 (leftJoin q3 (leftJoin q1 q2 cond12) cond23) cond34
 126
 127
 128 -- rightJoin4 q1 q2 q3 q4 cond12 cond23 cond34 = rightJoin q4 (rightJoin q3 (rightJoin q1 q2 cond12) cond23) cond34
 129
 130
 131 leftJoin5' :: Query (NodeRead, (NodeReadNull, (NodeReadNull, (NodeReadNull, NodeReadNull))))
 132 leftJoin5' = leftJoin5 queryNodeTable queryNodeTable queryNodeTable queryNodeTable queryNodeTable cond12 cond23 cond34 cond45
 133     where
 134          cond12 :: (NodeRead, NodeRead) -> Column PGBool
 135          cond12 = undefined
 136
 137          cond23 :: (NodeRead, (NodeRead, NodeReadNull)) -> Column PGBool
 138          cond23 = undefined
 139
 140          cond34 :: (NodeRead, (NodeRead, (NodeReadNull, NodeReadNull))) -> Column PGBool
 141          cond34 = undefined
 142
 143          cond45 :: (NodeRead, (NodeRead, (NodeReadNull, (NodeReadNull, NodeReadNull)))) -> Column PGBool
 144          cond45 = undefined
 145
 146
 147 leftJoin5 :: ( Default Unpackspec fieldsL1 fieldsL1,
 148                Default Unpackspec fieldsL2 fieldsL2,
 149                Default Unpackspec nullableFieldsR1 nullableFieldsR1,
 150                Default Unpackspec fieldsL3 fieldsL3,
 151                Default Unpackspec nullableFieldsR2 nullableFieldsR2,
 152                Default Unpackspec fieldsL4 fieldsL4,
 153                Default Unpackspec nullableFieldsR3 nullableFieldsR3,
 154                Default Unpackspec fieldsR fieldsR,
 155                Default NullMaker fieldsR nullableFieldsR3,
 156                Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR4,
 157                Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1,
 158                Default NullMaker (fieldsL4, nullableFieldsR3) nullableFieldsR2) =>
 159                Query fieldsR
 160                -> Query fieldsL4
 161                -> Query fieldsL3
 162                -> Query fieldsL2
 163                -> Query fieldsL1
 164                -> ((fieldsL4, fieldsR) -> Column PGBool)
 165                -> ((fieldsL3, (fieldsL4, nullableFieldsR3)) -> Column PGBool)
 166                -> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool)
 167                -> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool)
 168                -> Query (fieldsL1, nullableFieldsR4)
 169 leftJoin5 q1 q2 q3 q4 q5 cond12 cond23 cond34 cond45 = leftJoin q5 (leftJoin q4 (leftJoin q3 (leftJoin q2 q1 cond12) cond23) cond34) cond45
 170
 171
 172 leftJoin6 :: ( Default Unpackspec fieldsL1 fieldsL1,
 173                Default Unpackspec fieldsL2 fieldsL2,
 174                Default Unpackspec nullableFieldsR1 nullableFieldsR1,
 175                Default Unpackspec fieldsL3 fieldsL3,
 176                Default Unpackspec nullableFieldsR2 nullableFieldsR2,
 177                Default Unpackspec fieldsL4 fieldsL4,
 178                Default Unpackspec nullableFieldsR3 nullableFieldsR3,
 179                Default Unpackspec fieldsL5 fieldsL5,
 180                Default Unpackspec nullableFieldsR4 nullableFieldsR4,
 181                Default Unpackspec fieldsR fieldsR,
 182                Default NullMaker fieldsR nullableFieldsR4,
 183                Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR5,
 184                Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1,
 185                Default NullMaker (fieldsL4, nullableFieldsR3) nullableFieldsR2,
 186                Default NullMaker (fieldsL5, nullableFieldsR4) nullableFieldsR3) =>
 187      Query fieldsR
 188      -> Query fieldsL5
 189      -> Query fieldsL4
 190      -> Query fieldsL3
 191      -> Query fieldsL2
 192      -> Query fieldsL1 -> ((fieldsL5, fieldsR) -> Column PGBool)
 193      -> ((fieldsL4, (fieldsL5, nullableFieldsR4)) -> Column PGBool)
 194      -> ((fieldsL3, (fieldsL4, nullableFieldsR3)) -> Column PGBool)
 195      -> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool)
 196      -> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool)
 197      -> Query (fieldsL1, nullableFieldsR5)
 198 leftJoin6 q1 q2 q3 q4 q5 q6 cond12 cond23 cond34 cond45 cond56 =
 199   leftJoin q6 (leftJoin q5 (leftJoin q4 (leftJoin q3 (leftJoin q2 q1 cond12) cond23) cond34) cond45) cond56
 200
 201