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