src/Gargantext/Database/Query/Join.hs

   1 {-|
   2 Module      : Gargantext.Database.Query.Join
   3 Description : Main Join queries (using Opaleye)
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 Multiple Join functions with Opaleye.
  11
  12 -}
  13
  14 {-# OPTIONS_GHC -fno-warn-orphans        #-}
  15 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  16
  17 {-# LANGUAGE Arrows                    #-}
  18 {-# LANGUAGE FunctionalDependencies    #-}
  19 {-# LANGUAGE QuasiQuotes               #-}
  20 {-# LANGUAGE NoMonomorphismRestriction #-}
  21 {-# LANGUAGE TemplateHaskell           #-}
  22
  23 ------------------------------------------------------------------------
  24
  25 module Gargantext.Database.Query.Join
  26   where
  27
  28 import Control.Applicative ((<*>))
  29 import Control.Arrow ((>>>))
  30 import Data.Profunctor.Product.Default
  31 import Gargantext.Prelude
  32 import Opaleye
  33 import Opaleye.Internal.Join (NullMaker(..))
  34 import qualified Opaleye.Internal.Unpackspec()
  35
  36 --leftJoin3 :: Query columnsL1 -> Query columnsR -> Query columnsL
  37 --     -> ((columnsL1, columnsR) -> Column PGBool)
  38 --     -> ((columnsL, (columnsL1, nullableColumnsR1)) -> Column PGBool)
  39 --     -> Query (columnsL, nullableColumnsR)
  40 --leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q1 q2 cond12) cond23
  41 join3 :: Query columnsA -> Query columnsB -> Query columnsC
  42       -> ((columnsA, columnsB, columnsC) -> Column PGBool)
  43       -> Query (columnsA, columnsB, columnsC)
  44 join3 q1 q2 q3 cond = ((,,) <$> q1 <*> q2 <*> q3) >>> keepWhen cond
  45
  46 ------------------------------------------------------------------------
  47 leftJoin3
  48   :: (Default Unpackspec fieldsL1 fieldsL1,
  49       Default Unpackspec fieldsL2 fieldsL2,
  50       Default Unpackspec nullableFieldsR1 nullableFieldsR1,
  51       Default Unpackspec fieldsR fieldsR,
  52       Default NullMaker fieldsR nullableFieldsR1,
  53       Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR2) =>
  54      Opaleye.Select fieldsR
  55      -> Opaleye.Select fieldsL2
  56      -> Opaleye.Select fieldsL1
  57      -> ((fieldsL2, fieldsR) -> Column PGBool)
  58      -> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool)
  59      -> Opaleye.Select (fieldsL1, nullableFieldsR2)
  60 leftJoin3 q1 q2     q3
  61          cond12 cond23 =
  62   leftJoin q3 ( leftJoin q2 q1 cond12) cond23
  63
  64
  65 leftJoin4
  66   :: (Default Unpackspec fieldsL1 fieldsL1,
  67       Default Unpackspec fieldsL2 fieldsL2,
  68       Default Unpackspec nullableFieldsR1 nullableFieldsR1,
  69       Default Unpackspec fieldsL3 fieldsL3,
  70       Default Unpackspec nullableFieldsR2 nullableFieldsR2,
  71       Default Unpackspec fieldsR fieldsR,
  72       Default NullMaker fieldsR nullableFieldsR2,
  73       Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR3,
  74       Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1) =>
  75      Opaleye.Select fieldsR
  76      -> Opaleye.Select fieldsL3
  77      -> Opaleye.Select fieldsL2
  78      -> Opaleye.Select fieldsL1
  79      -> ((fieldsL3, fieldsR) -> Column PGBool)
  80      -> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool)
  81      -> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool)
  82      -> Opaleye.Select (fieldsL1, nullableFieldsR3)
  83 leftJoin4 q1 q2     q3     q4
  84          cond12 cond23 cond34 =
  85   leftJoin q4 ( leftJoin q3
  86                 ( leftJoin q2 q1
  87                     cond12
  88                 ) cond23
  89               ) cond34
  90
  91
  92 leftJoin5 :: ( Default Unpackspec fieldsL1 fieldsL1,
  93                Default Unpackspec fieldsL2 fieldsL2,
  94                Default Unpackspec nullableFieldsR1 nullableFieldsR1,
  95                Default Unpackspec fieldsL3 fieldsL3,
  96                Default Unpackspec nullableFieldsR2 nullableFieldsR2,
  97                Default Unpackspec fieldsL4 fieldsL4,
  98                Default Unpackspec nullableFieldsR3 nullableFieldsR3,
  99                Default Unpackspec fieldsR fieldsR,
 100                Default NullMaker fieldsR nullableFieldsR3,
 101                Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR4,
 102                Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1,
 103                Default NullMaker (fieldsL4, nullableFieldsR3) nullableFieldsR2) =>
 104                Query fieldsR
 105                -> Query fieldsL4
 106                -> Query fieldsL3
 107                -> Query fieldsL2
 108                -> Query fieldsL1
 109                -> ((fieldsL4, fieldsR) -> Column PGBool)
 110                -> ((fieldsL3, (fieldsL4, nullableFieldsR3)) -> Column PGBool)
 111                -> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool)
 112                -> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool)
 113                -> Query (fieldsL1, nullableFieldsR4)
 114 leftJoin5 q1 q2     q3     q4     q5
 115          cond12 cond23 cond34 cond45 =
 116   leftJoin q5 ( leftJoin q4
 117                 ( leftJoin q3
 118                   ( leftJoin q2 q1
 119                        cond12
 120                    ) cond23
 121                  ) cond34
 122                ) cond45
 123
 124
 125 leftJoin6 :: ( Default Unpackspec fieldsL1 fieldsL1,
 126                Default Unpackspec fieldsL2 fieldsL2,
 127                Default Unpackspec nullableFieldsR1 nullableFieldsR1,
 128                Default Unpackspec fieldsL3 fieldsL3,
 129                Default Unpackspec nullableFieldsR2 nullableFieldsR2,
 130                Default Unpackspec fieldsL4 fieldsL4,
 131                Default Unpackspec nullableFieldsR3 nullableFieldsR3,
 132                Default Unpackspec fieldsL5 fieldsL5,
 133                Default Unpackspec nullableFieldsR4 nullableFieldsR4,
 134                Default Unpackspec fieldsR fieldsR,
 135                Default NullMaker fieldsR nullableFieldsR4,
 136                Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR5,
 137                Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1,
 138                Default NullMaker (fieldsL4, nullableFieldsR3) nullableFieldsR2,
 139                Default NullMaker (fieldsL5, nullableFieldsR4) nullableFieldsR3) =>
 140      Query fieldsR
 141      -> Query fieldsL5
 142      -> Query fieldsL4
 143      -> Query fieldsL3
 144      -> Query fieldsL2
 145      -> Query fieldsL1 -> ((fieldsL5, fieldsR) -> Column PGBool)
 146      -> ((fieldsL4, (fieldsL5, nullableFieldsR4)) -> Column PGBool)
 147      -> ((fieldsL3, (fieldsL4, nullableFieldsR3)) -> Column PGBool)
 148      -> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool)
 149      -> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool)
 150      -> Query (fieldsL1, nullableFieldsR5)
 151 leftJoin6 q1 q2     q3     q4     q5     q6
 152          cond12 cond23 cond34 cond45 cond56 =
 153   leftJoin q6 ( leftJoin q5
 154                 ( leftJoin q4
 155                   ( leftJoin q3
 156                     ( leftJoin q2 q1
 157                          cond12
 158                      ) cond23
 159                   ) cond34
 160                 ) cond45
 161               ) cond56
 162
 163
 164 leftJoin7
 165   :: (Default Unpackspec fieldsL1 fieldsL1,
 166       Default Unpackspec fieldsL2 fieldsL2,
 167       Default Unpackspec nullableFieldsR1 nullableFieldsR1,
 168       Default Unpackspec fieldsL3 fieldsL3,
 169       Default Unpackspec nullableFieldsR2 nullableFieldsR2,
 170       Default Unpackspec fieldsL4 fieldsL4,
 171       Default Unpackspec nullableFieldsR3 nullableFieldsR3,
 172       Default Unpackspec fieldsL5 fieldsL5,
 173       Default Unpackspec nullableFieldsR4 nullableFieldsR4,
 174       Default Unpackspec fieldsL6 fieldsL6,
 175       Default Unpackspec nullableFieldsR5 nullableFieldsR5,
 176       Default Unpackspec fieldsR fieldsR,
 177       Default NullMaker fieldsR nullableFieldsR5,
 178       Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR6,
 179       Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1,
 180       Default NullMaker (fieldsL4, nullableFieldsR3) nullableFieldsR2,
 181       Default NullMaker (fieldsL5, nullableFieldsR4) nullableFieldsR3,
 182       Default NullMaker (fieldsL6, nullableFieldsR5) nullableFieldsR4) =>
 183      Opaleye.Select fieldsR
 184      -> Opaleye.Select fieldsL6
 185      -> Opaleye.Select fieldsL5
 186      -> Opaleye.Select fieldsL4
 187      -> Opaleye.Select fieldsL3
 188      -> Opaleye.Select fieldsL2
 189      -> Opaleye.Select fieldsL1
 190      -> ((fieldsL6, fieldsR) -> Column PGBool)
 191      -> ((fieldsL5, (fieldsL6, nullableFieldsR5)) -> Column PGBool)
 192      -> ((fieldsL4, (fieldsL5, nullableFieldsR4)) -> Column PGBool)
 193      -> ((fieldsL3, (fieldsL4, nullableFieldsR3)) -> Column PGBool)
 194      -> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool)
 195      -> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool)
 196      -> Opaleye.Select (fieldsL1, nullableFieldsR6)
 197 leftJoin7 q1 q2     q3     q4     q5     q6     q7
 198          cond12 cond23 cond34 cond45 cond56 cond67 =
 199   leftJoin q7 ( leftJoin q6
 200                 ( leftJoin q5
 201                   ( leftJoin q4
 202                     ( leftJoin q3
 203                       ( leftJoin q2 q1
 204                        cond12
 205                     ) cond23
 206                    ) cond34
 207                   ) cond45
 208                  ) cond56
 209                 ) cond67
 210
 211
 212 leftJoin8
 213   :: (Default Unpackspec fieldsL1 fieldsL1,
 214       Default Unpackspec fieldsL2 fieldsL2,
 215       Default Unpackspec nullableFieldsR1 nullableFieldsR1,
 216       Default Unpackspec fieldsL3 fieldsL3,
 217       Default Unpackspec nullableFieldsR2 nullableFieldsR2,
 218       Default Unpackspec fieldsL4 fieldsL4,
 219       Default Unpackspec nullableFieldsR3 nullableFieldsR3,
 220       Default Unpackspec fieldsL5 fieldsL5,
 221       Default Unpackspec nullableFieldsR4 nullableFieldsR4,
 222       Default Unpackspec fieldsL6 fieldsL6,
 223       Default Unpackspec nullableFieldsR5 nullableFieldsR5,
 224       Default Unpackspec fieldsL7 fieldsL7,
 225       Default Unpackspec nullableFieldsR6 nullableFieldsR6,
 226       Default Unpackspec fieldsR fieldsR,
 227       Default NullMaker fieldsR nullableFieldsR6,
 228       Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR7,
 229       Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1,
 230       Default NullMaker (fieldsL4, nullableFieldsR3) nullableFieldsR2,
 231       Default NullMaker (fieldsL5, nullableFieldsR4) nullableFieldsR3,
 232       Default NullMaker (fieldsL6, nullableFieldsR5) nullableFieldsR4,
 233       Default NullMaker (fieldsL7, nullableFieldsR6) nullableFieldsR5) =>
 234      Opaleye.Select fieldsR
 235      -> Opaleye.Select fieldsL7
 236      -> Opaleye.Select fieldsL6
 237      -> Opaleye.Select fieldsL5
 238      -> Opaleye.Select fieldsL4
 239      -> Opaleye.Select fieldsL3
 240      -> Opaleye.Select fieldsL2
 241      -> Opaleye.Select fieldsL1
 242      -> ((fieldsL7, fieldsR) -> Column PGBool)
 243      -> ((fieldsL6, (fieldsL7, nullableFieldsR6)) -> Column PGBool)
 244      -> ((fieldsL5, (fieldsL6, nullableFieldsR5)) -> Column PGBool)
 245      -> ((fieldsL4, (fieldsL5, nullableFieldsR4)) -> Column PGBool)
 246      -> ((fieldsL3, (fieldsL4, nullableFieldsR3)) -> Column PGBool)
 247      -> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool)
 248      -> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool)
 249      -> Opaleye.Select (fieldsL1, nullableFieldsR7)
 250 leftJoin8 q1 q2     q3     q4     q5     q6     q7     q8
 251          cond12 cond23 cond34 cond45 cond56 cond67 cond78 =
 252   leftJoin q8 ( leftJoin q7
 253                 ( leftJoin q6
 254                   ( leftJoin q5
 255                     ( leftJoin q4
 256                       ( leftJoin q3
 257                         ( leftJoin q2 q1
 258                              cond12
 259                         ) cond23
 260                       ) cond34
 261                     ) cond45
 262                   ) cond56
 263                 ) cond67
 264               ) cond78
 265
 266
 267 leftJoin9
 268   :: (Default Unpackspec fieldsL1 fieldsL1,
 269       Default Unpackspec fieldsL2 fieldsL2,
 270       Default Unpackspec nullableFieldsR1 nullableFieldsR1,
 271       Default Unpackspec fieldsL3 fieldsL3,
 272       Default Unpackspec nullableFieldsR2 nullableFieldsR2,
 273       Default Unpackspec fieldsL4 fieldsL4,
 274       Default Unpackspec nullableFieldsR3 nullableFieldsR3,
 275       Default Unpackspec fieldsL5 fieldsL5,
 276       Default Unpackspec nullableFieldsR4 nullableFieldsR4,
 277       Default Unpackspec fieldsL6 fieldsL6,
 278       Default Unpackspec nullableFieldsR5 nullableFieldsR5,
 279       Default Unpackspec fieldsL7 fieldsL7,
 280       Default Unpackspec nullableFieldsR6 nullableFieldsR6,
 281       Default Unpackspec fieldsL8 fieldsL8,
 282       Default Unpackspec nullableFieldsR7 nullableFieldsR7,
 283       Default Unpackspec fieldsR fieldsR,
 284       Default NullMaker fieldsR nullableFieldsR7,
 285       Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR8,
 286       Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1,
 287       Default NullMaker (fieldsL4, nullableFieldsR3) nullableFieldsR2,
 288       Default NullMaker (fieldsL5, nullableFieldsR4) nullableFieldsR3,
 289       Default NullMaker (fieldsL6, nullableFieldsR5) nullableFieldsR4,
 290       Default NullMaker (fieldsL7, nullableFieldsR6) nullableFieldsR5,
 291       Default NullMaker (fieldsL8, nullableFieldsR7) nullableFieldsR6) =>
 292      Opaleye.Select fieldsR
 293      -> Opaleye.Select fieldsL8
 294      -> Opaleye.Select fieldsL7
 295      -> Opaleye.Select fieldsL6
 296      -> Opaleye.Select fieldsL5
 297      -> Opaleye.Select fieldsL4
 298      -> Opaleye.Select fieldsL3
 299      -> Opaleye.Select fieldsL2
 300      -> Opaleye.Select fieldsL1
 301      -> ((fieldsL8, fieldsR) -> Column PGBool)
 302      -> ((fieldsL7, (fieldsL8, nullableFieldsR7)) -> Column PGBool)
 303      -> ((fieldsL6, (fieldsL7, nullableFieldsR6)) -> Column PGBool)
 304      -> ((fieldsL5, (fieldsL6, nullableFieldsR5)) -> Column PGBool)
 305      -> ((fieldsL4, (fieldsL5, nullableFieldsR4)) -> Column PGBool)
 306      -> ((fieldsL3, (fieldsL4, nullableFieldsR3)) -> Column PGBool)
 307      -> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool)
 308      -> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool)
 309      -> Opaleye.Select (fieldsL1, nullableFieldsR8)
 310 leftJoin9   q1 q2    q3     q4     q5     q6      q7    q8     q9
 311           cond12 cond23 cond34 cond45 cond56 cond67 cond78 cond89 =
 312   leftJoin q9 ( leftJoin q8
 313                 ( leftJoin q7
 314                   ( leftJoin q6
 315                     ( leftJoin q5
 316                       ( leftJoin q4
 317                         ( leftJoin q3
 318                           ( leftJoin q2 q1
 319                               cond12
 320                           ) cond23
 321                         ) cond34
 322                       ) cond45
 323                     ) cond56
 324                   ) cond67
 325                 ) cond78
 326               ) cond89
 327