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
  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 ( leftJoin2
  26                                       , leftJoin3
  27                                       , leftJoin3'
  28                                       , leftJoin4
  29                                       , leftJoin4'
  30                                       , leftJoin5
  31                                       , leftJoin6
  32                                       , leftJoin7
  33                                       , leftJoin8
  34                                       , leftJoin9
  35                                       )
  36   where
  37
  38 import Control.Arrow ((>>>), returnA)
  39 import Data.Profunctor.Product.Default
  40 import Gargantext.Prelude
  41 import Opaleye hiding (keepWhen)
  42 import Opaleye.Internal.Join (NullMaker(..))
  43 import qualified Opaleye.Internal.Unpackspec()
  44
  45
  46 keepWhen :: (a -> Field SqlBool) -> SelectArr a a
  47 keepWhen p = proc a -> do
  48   restrict  -< p a
  49   returnA -< a
  50
  51 ------------------------------------------------------------------------
  52 leftJoin2 :: (Default Unpackspec fieldsL fieldsL,
  53               Default Unpackspec fieldsR fieldsR,
  54               Default NullMaker fieldsR nullableFieldsR) =>
  55              Select fieldsL
  56              -> Select fieldsR
  57              -> ((fieldsL, fieldsR) -> Column SqlBool)
  58              -> Select (fieldsL, nullableFieldsR)
  59 leftJoin2 = leftJoin
  60
  61 ------------------------------------------------------------------------
  62 -- | LeftJoin3 in two ways to write it
  63 leftJoin3 :: Select columnsA -> Select columnsB -> Select columnsC
  64       -> ((columnsA, columnsB, columnsC) -> Column SqlBool)
  65       -> Select (columnsA, columnsB, columnsC)
  66 leftJoin3 q1 q2 q3 cond = ((,,) <$> q1 <*> q2 <*> q3) >>> keepWhen cond
  67
  68
  69 leftJoin3' :: (Default Unpackspec b2 b2, Default Unpackspec b3 b3,
  70                Default Unpackspec fieldsL fieldsL,
  71                Default Unpackspec fieldsR fieldsR, Default NullMaker b3 b4,
  72                Default NullMaker b2 b5, Default NullMaker fieldsR b2) =>
  73               Select fieldsL
  74               -> Select b3
  75               -> Select fieldsR
  76               -> ((fieldsL, (b3, b2)) -> Column SqlBool)
  77               -> ((b3, fieldsR) -> Column SqlBool)
  78               -> Select (fieldsL, (b4, b5))
  79 leftJoin3' q1 q2 q3 cond12 cond23 = leftJoin q1 (leftJoin q2 q3 cond23) cond12
  80
  81 leftJoin4' :: Select columnsA
  82            -> Select columnsB
  83            -> Select columnsC
  84            -> Select columnsD
  85       -> ((columnsA, columnsB, columnsC, columnsD) -> Column SqlBool)
  86       -> Select (columnsA, columnsB, columnsC, columnsD)
  87 leftJoin4' q1 q2 q3 q4 cond = ((,,,) <$> q1 <*> q2 <*> q3 <*> q4) >>> keepWhen cond
  88
  89
  90 leftJoin4 :: (Default Unpackspec b2 b2,
  91               Default Unpackspec fieldsL fieldsL, Default Unpackspec b3 b3,
  92               Default Unpackspec b4 b4, Default Unpackspec b5 b5,
  93               Default Unpackspec b6 b6, Default Unpackspec fieldsR fieldsR,
  94               Default NullMaker b2 b7, Default NullMaker b5 b8,
  95               Default NullMaker b6 b9, Default NullMaker b3 b5,
  96               Default NullMaker b4 b6, Default NullMaker fieldsR b4) =>
  97              Select fieldsR
  98              -> Select b3
  99              -> Select b2
 100              -> Select fieldsL
 101              -> ((b3, fieldsR) -> Column SqlBool)
 102              -> ((b2, (b3, b4)) -> Column SqlBool)
 103              -> ((fieldsL, (b2, (b5, b6))) -> Column SqlBool)
 104              -> Select (fieldsL, (b7, (b8, b9)))
 105 leftJoin4 q1 q2     q3     q4
 106          cond12 cond23 cond34 =
 107   leftJoin q4 ( leftJoin q3
 108                 ( leftJoin q2 q1
 109                     cond12
 110                 ) cond23
 111               ) cond34
 112
 113
 114 leftJoin5 :: (Default Unpackspec b2 b2, Default Unpackspec b3 b3,
 115             Default Unpackspec b4 b4, Default Unpackspec b5 b5,
 116             Default Unpackspec b6 b6, Default Unpackspec b7 b7,
 117             Default Unpackspec fieldsL fieldsL, Default Unpackspec b8 b8,
 118             Default Unpackspec b9 b9, Default Unpackspec b10 b10,
 119             Default Unpackspec fieldsR fieldsR, Default NullMaker b7 b6,
 120             Default NullMaker b6 b11, Default NullMaker b8 b12,
 121             Default NullMaker b3 b13, Default NullMaker b2 b14,
 122             Default NullMaker b9 b3, Default NullMaker b10 b2,
 123             Default NullMaker b5 b9, Default NullMaker b4 b10,
 124             Default NullMaker fieldsR b4) =>
 125            Select fieldsR
 126            -> Select b5
 127            -> Select b7
 128            -> Select b8
 129            -> Select fieldsL
 130            -> ((b5, fieldsR) -> Column SqlBool)
 131            -> ((b7, (b5, b4)) -> Column SqlBool)
 132            -> ((b8, (b7, (b9, b10))) -> Column SqlBool)
 133            -> ((fieldsL, (b8, (b6, (b3, b2)))) -> Column SqlBool)
 134            -> Select (fieldsL, (b12, (b11, (b13, b14))))
 135 leftJoin5 q1 q2     q3     q4     q5
 136          cond12 cond23 cond34 cond45 =
 137   leftJoin q5 ( leftJoin q4
 138                 ( leftJoin q3
 139                   ( leftJoin q2 q1
 140                        cond12
 141                    ) cond23
 142                  ) cond34
 143                ) cond45
 144
 145
 146 leftJoin6 :: (Default Unpackspec b2 b2, Default Unpackspec b3 b3,
 147               Default Unpackspec b4 b4, Default Unpackspec b5 b5,
 148               Default Unpackspec fieldsL fieldsL, Default Unpackspec b6 b6,
 149               Default Unpackspec b7 b7, Default Unpackspec b8 b8,
 150               Default Unpackspec b9 b9, Default Unpackspec b10 b10,
 151               Default Unpackspec b11 b11, Default Unpackspec b12 b12,
 152               Default Unpackspec b13 b13, Default Unpackspec b14 b14,
 153               Default Unpackspec b15 b15, Default Unpackspec fieldsR fieldsR,
 154               Default NullMaker b5 b4, Default NullMaker b4 b16,
 155               Default NullMaker b6 b17, Default NullMaker b2 b18,
 156               Default NullMaker b7 b2, Default NullMaker b3 b7,
 157               Default NullMaker b12 b19, Default NullMaker b13 b20,
 158               Default NullMaker b10 b12, Default NullMaker b11 b13,
 159               Default NullMaker b14 b10, Default NullMaker b15 b11,
 160               Default NullMaker b8 b14, Default NullMaker b9 b15,
 161               Default NullMaker fieldsR b9) =>
 162              Select fieldsR
 163              -> Select b8
 164              -> Select b3
 165              -> Select b5
 166              -> Select b6
 167              -> Select fieldsL
 168              -> ((b8, fieldsR) -> Column SqlBool)
 169              -> ((b3, (b8, b9)) -> Column SqlBool)
 170              -> ((b5, (b3, (b14, b15))) -> Column SqlBool)
 171              -> ((b6, (b5, (b7, (b10, b11)))) -> Column SqlBool)
 172              -> ((fieldsL, (b6, (b4, (b2, (b12, b13))))) -> Column SqlBool)
 173              -> Select (fieldsL, (b17, (b16, (b18, (b19, b20)))))
 174 leftJoin6 q1 q2     q3     q4     q5     q6
 175          cond12 cond23 cond34 cond45 cond56 =
 176   leftJoin q6 ( leftJoin q5
 177                 ( leftJoin q4
 178                   ( leftJoin q3
 179                     ( leftJoin q2 q1
 180                          cond12
 181                      ) cond23
 182                   ) cond34
 183                 ) cond45
 184               ) cond56
 185
 186
 187 leftJoin7 :: (Default Unpackspec b2 b2, Default Unpackspec b3 b3,
 188               Default Unpackspec b4 b4, Default Unpackspec b5 b5,
 189               Default Unpackspec b6 b6, Default Unpackspec b7 b7,
 190               Default Unpackspec b8 b8, Default Unpackspec b9 b9,
 191               Default Unpackspec b10 b10, Default Unpackspec b11 b11,
 192               Default Unpackspec b12 b12, Default Unpackspec b13 b13,
 193               Default Unpackspec fieldsL fieldsL, Default Unpackspec b14 b14,
 194               Default Unpackspec b15 b15, Default Unpackspec b16 b16,
 195               Default Unpackspec b17 b17, Default Unpackspec b18 b18,
 196               Default Unpackspec b19 b19, Default Unpackspec b20 b20,
 197               Default Unpackspec b21 b21, Default Unpackspec fieldsR fieldsR,
 198               Default NullMaker b11 b8, Default NullMaker b8 b10,
 199               Default NullMaker b10 b9, Default NullMaker b9 b22,
 200               Default NullMaker b16 b12, Default NullMaker b12 b17,
 201               Default NullMaker b17 b23, Default NullMaker b13 b24,
 202               Default NullMaker b15 b25, Default NullMaker b14 b15,
 203               Default NullMaker b3 b26, Default NullMaker b2 b27,
 204               Default NullMaker b18 b3, Default NullMaker b19 b2,
 205               Default NullMaker b5 b18, Default NullMaker b4 b19,
 206               Default NullMaker b20 b5, Default NullMaker b21 b4,
 207               Default NullMaker b7 b20, Default NullMaker b6 b21,
 208               Default NullMaker fieldsR b6) =>
 209              Select fieldsR
 210              -> Select b7
 211              -> Select b11
 212              -> Select b16
 213              -> Select b14
 214              -> Select b13
 215              -> Select fieldsL
 216              -> ((b7, fieldsR) -> Column SqlBool)
 217              -> ((b11, (b7, b6)) -> Column SqlBool)
 218              -> ((b16, (b11, (b20, b21))) -> Column SqlBool)
 219              -> ((b14, (b16, (b8, (b5, b4)))) -> Column SqlBool)
 220              -> ((b13, (b14, (b12, (b10, (b18, b19))))) -> Column SqlBool)
 221              -> ((fieldsL, (b13, (b15, (b17, (b9, (b3, b2))))))
 222                  -> Column SqlBool)
 223              -> Select (fieldsL, (b24, (b25, (b23, (b22, (b26, b27))))))
 224 leftJoin7 q1 q2     q3     q4     q5     q6     q7
 225          cond12 cond23 cond34 cond45 cond56 cond67 =
 226   leftJoin q7 ( leftJoin q6
 227                 ( leftJoin q5
 228                   ( leftJoin q4
 229                     ( leftJoin q3
 230                       ( leftJoin q2 q1
 231                        cond12
 232                     ) cond23
 233                    ) cond34
 234                   ) cond45
 235                  ) cond56
 236                 ) cond67
 237
 238
 239 leftJoin8 :: (Default Unpackspec b2 b2, Default Unpackspec b3 b3,
 240               Default Unpackspec b4 b4, Default Unpackspec b5 b5,
 241               Default Unpackspec b6 b6, Default Unpackspec b7 b7,
 242               Default Unpackspec b8 b8, Default Unpackspec b9 b9,
 243               Default Unpackspec b10 b10, Default Unpackspec fieldsL fieldsL,
 244               Default Unpackspec b11 b11, Default Unpackspec b12 b12,
 245               Default Unpackspec b13 b13, Default Unpackspec b14 b14,
 246               Default Unpackspec b15 b15, Default Unpackspec b16 b16,
 247               Default Unpackspec b17 b17, Default Unpackspec b18 b18,
 248               Default Unpackspec b19 b19, Default Unpackspec b20 b20,
 249               Default Unpackspec b21 b21, Default Unpackspec b22 b22,
 250               Default Unpackspec b23 b23, Default Unpackspec b24 b24,
 251               Default Unpackspec b25 b25, Default Unpackspec b26 b26,
 252               Default Unpackspec b27 b27, Default Unpackspec b28 b28,
 253               Default Unpackspec fieldsR fieldsR, Default NullMaker b8 b5,
 254               Default NullMaker b5 b7, Default NullMaker b7 b6,
 255               Default NullMaker b6 b29, Default NullMaker b13 b9,
 256               Default NullMaker b9 b14, Default NullMaker b14 b30,
 257               Default NullMaker b10 b31, Default NullMaker b12 b32,
 258               Default NullMaker b11 b12, Default NullMaker b2 b33,
 259               Default NullMaker b15 b2, Default NullMaker b3 b15,
 260               Default NullMaker b16 b3, Default NullMaker b4 b16,
 261               Default NullMaker b23 b34, Default NullMaker b24 b35,
 262               Default NullMaker b21 b23, Default NullMaker b22 b24,
 263               Default NullMaker b25 b21, Default NullMaker b26 b22,
 264               Default NullMaker b19 b25, Default NullMaker b20 b26,
 265               Default NullMaker b27 b19, Default NullMaker b28 b20,
 266               Default NullMaker b17 b27, Default NullMaker b18 b28,
 267               Default NullMaker fieldsR b18) =>
 268              Select fieldsR
 269              -> Select b17
 270              -> Select b4
 271              -> Select b8
 272              -> Select b13
 273              -> Select b11
 274              -> Select b10
 275              -> Select fieldsL
 276              -> ((b17, fieldsR) -> Column SqlBool)
 277              -> ((b4, (b17, b18)) -> Column SqlBool)
 278              -> ((b8, (b4, (b27, b28))) -> Column SqlBool)
 279              -> ((b13, (b8, (b16, (b19, b20)))) -> Column SqlBool)
 280              -> ((b11, (b13, (b5, (b3, (b25, b26))))) -> Column SqlBool)
 281              -> ((b10, (b11, (b9, (b7, (b15, (b21, b22)))))) -> Column SqlBool)
 282              -> ((fieldsL, (b10, (b12, (b14, (b6, (b2, (b23, b24)))))))
 283                  -> Column SqlBool)
 284              -> Select (fieldsL, (b31, (b32, (b30, (b29, (b33, (b34, b35)))))))
 285 leftJoin8 q1 q2     q3     q4     q5     q6     q7     q8
 286          cond12 cond23 cond34 cond45 cond56 cond67 cond78 =
 287   leftJoin q8 ( leftJoin q7
 288                 ( leftJoin q6
 289                   ( leftJoin q5
 290                     ( leftJoin q4
 291                       ( leftJoin q3
 292                         ( leftJoin q2 q1
 293                              cond12
 294                         ) cond23
 295                       ) cond34
 296                     ) cond45
 297                   ) cond56
 298                 ) cond67
 299               ) cond78
 300
 301
 302
 303 leftJoin9 :: (Default Unpackspec b2 b2, Default Unpackspec b3 b3,
 304             Default Unpackspec b4 b4, Default Unpackspec b5 b5,
 305             Default Unpackspec b6 b6, Default Unpackspec b7 b7,
 306             Default Unpackspec b8 b8, Default Unpackspec b9 b9,
 307             Default Unpackspec b10 b10, Default Unpackspec b11 b11,
 308             Default Unpackspec b12 b12, Default Unpackspec b13 b13,
 309             Default Unpackspec b14 b14, Default Unpackspec b15 b15,
 310             Default Unpackspec b16 b16, Default Unpackspec b17 b17,
 311             Default Unpackspec b18 b18, Default Unpackspec b19 b19,
 312             Default Unpackspec b20 b20, Default Unpackspec b21 b21,
 313             Default Unpackspec fieldsL fieldsL, Default Unpackspec b22 b22,
 314             Default Unpackspec b23 b23, Default Unpackspec b24 b24,
 315             Default Unpackspec b25 b25, Default Unpackspec b26 b26,
 316             Default Unpackspec b27 b27, Default Unpackspec b28 b28,
 317             Default Unpackspec b29 b29, Default Unpackspec b30 b30,
 318             Default Unpackspec b31 b31, Default Unpackspec b32 b32,
 319             Default Unpackspec b33 b33, Default Unpackspec b34 b34,
 320             Default Unpackspec b35 b35, Default Unpackspec b36 b36,
 321             Default Unpackspec fieldsR fieldsR, Default NullMaker b15 b10,
 322             Default NullMaker b10 b14, Default NullMaker b14 b11,
 323             Default NullMaker b11 b13, Default NullMaker b13 b12,
 324             Default NullMaker b12 b37, Default NullMaker b28 b16,
 325             Default NullMaker b16 b29, Default NullMaker b29 b17,
 326             Default NullMaker b17 b30, Default NullMaker b30 b38,
 327             Default NullMaker b21 b20, Default NullMaker b20 b39,
 328             Default NullMaker b22 b40, Default NullMaker b18 b41,
 329             Default NullMaker b23 b18, Default NullMaker b19 b23,
 330             Default NullMaker b26 b42, Default NullMaker b25 b26,
 331             Default NullMaker b27 b25, Default NullMaker b24 b27,
 332             Default NullMaker b3 b43, Default NullMaker b2 b44,
 333             Default NullMaker b31 b3, Default NullMaker b32 b2,
 334             Default NullMaker b5 b31, Default NullMaker b4 b32,
 335             Default NullMaker b33 b5, Default NullMaker b34 b4,
 336             Default NullMaker b7 b33, Default NullMaker b6 b34,
 337             Default NullMaker b35 b7, Default NullMaker b36 b6,
 338             Default NullMaker b9 b35, Default NullMaker b8 b36,
 339             Default NullMaker fieldsR b8) =>
 340            Select fieldsR
 341            -> Select b9
 342            -> Select b15
 343            -> Select b28
 344            -> Select b24
 345            -> Select b19
 346            -> Select b21
 347            -> Select b22
 348            -> Select fieldsL
 349            -> ((b9, fieldsR) -> Column SqlBool)
 350            -> ((b15, (b9, b8)) -> Column SqlBool)
 351            -> ((b28, (b15, (b35, b36))) -> Column SqlBool)
 352            -> ((b24, (b28, (b10, (b7, b6)))) -> Column SqlBool)
 353            -> ((b19, (b24, (b16, (b14, (b33, b34))))) -> Column SqlBool)
 354            -> ((b21, (b19, (b27, (b29, (b11, (b5, b4)))))) -> Column SqlBool)
 355            -> ((b22, (b21, (b23, (b25, (b17, (b13, (b31, b32)))))))
 356                -> Column SqlBool)
 357            -> ((fieldsL, (b22, (b20, (b18, (b26, (b30, (b12, (b3, b2))))))))
 358                -> Column SqlBool)
 359            -> Select
 360                 (fieldsL, (b40, (b39, (b41, (b42, (b38, (b37, (b43, b44))))))))
 361 leftJoin9   q1 q2    q3     q4     q5     q6      q7    q8     q9
 362           cond12 cond23 cond34 cond45 cond56 cond67 cond78 cond89 =
 363   leftJoin q9 ( leftJoin q8
 364                 ( leftJoin q7
 365                   ( leftJoin q6
 366                     ( leftJoin q5
 367                       ( leftJoin q4
 368                         ( leftJoin q3
 369                           ( leftJoin q2 q1
 370                               cond12
 371                           ) cond23
 372                         ) cond34
 373                       ) cond45
 374                     ) cond56
 375                   ) cond67
 376                 ) cond78
 377               ) cond89
 378