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