src/Gargantext/Database/Schema/NodeNodeNgrams.hs

   1 {-|
   2 Module      : Gargantext.Database.Schema.NodeNodeNgrams
   3 Description : TODO: remove this module and table in 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
  12 {-# OPTIONS_GHC -fno-warn-orphans #-}
  13
  14 {-# LANGUAGE Arrows                 #-}
  15 {-# LANGUAGE FlexibleInstances      #-}
  16 {-# LANGUAGE FunctionalDependencies #-}
  17 {-# LANGUAGE MultiParamTypeClasses  #-}
  18 {-# LANGUAGE NoImplicitPrelude      #-}
  19 {-# LANGUAGE RankNTypes             #-}
  20 {-# LANGUAGE TemplateHaskell        #-}
  21
  22 module Gargantext.Database.Schema.NodeNodeNgrams
  23   where
  24
  25 import Prelude
  26 import Data.Maybe (Maybe)
  27 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  28 import Control.Lens.TH (makeLenses)
  29 import Gargantext.Database.Utils (Cmd, mkCmd)
  30 import Gargantext.Database.Schema.Ngrams (NgramsTypeId, pgNgramsTypeId, NgramsId)
  31 import Gargantext.Database.Schema.Node (pgNodeId)
  32 import Gargantext.Database.Types.Node
  33 import Opaleye
  34
  35
  36
  37 data NodeNodeNgramsPoly id' n1 n2 ngrams_id ngt w
  38    = NodeNodeNgrams { _nnng_id         :: id'
  39                     , _nnng_node1_id   :: n1
  40                     , _nnng_node2_id   :: n2
  41                     , _nnng_ngrams_id  :: ngrams_id
  42                     , _nnng_ngramsType :: ngt
  43                     , _nnng_weight     :: w
  44                     } deriving (Show)
  45
  46
  47 type NodeNodeNgramsWrite =
  48      NodeNodeNgramsPoly (Maybe (Column PGInt4  ))
  49                         (Column PGInt4  )
  50                         (Column PGInt4  )
  51                         (Column PGInt4  )
  52                         (Column PGInt4  )
  53                         (Column PGFloat8)
  54
  55 type NodeNodeNgramsRead  =
  56      NodeNodeNgramsPoly (Column PGInt4  )
  57                         (Column PGInt4  )
  58                         (Column PGInt4  )
  59                         (Column PGInt4  )
  60                         (Column PGInt4  )
  61                         (Column PGFloat8)
  62
  63 type NodeNodeNgramsReadNull =
  64      NodeNodeNgramsPoly (Column (Nullable PGInt4  ))
  65                         (Column (Nullable PGInt4  ))
  66                         (Column (Nullable PGInt4  ))
  67                         (Column (Nullable PGInt4  ))
  68                         (Column (Nullable PGInt4  ))
  69                         (Column (Nullable PGFloat8))
  70
  71 type NodeNodeNgrams =
  72   NodeNodeNgramsPoly (Maybe Int) CorpusId DocId NgramsId NgramsTypeId Double
  73
  74 $(makeAdaptorAndInstance "pNodeNodeNgrams" ''NodeNodeNgramsPoly)
  75 makeLenses ''NodeNodeNgramsPoly
  76
  77
  78 nodeNodeNgramsTable :: Table NodeNodeNgramsWrite NodeNodeNgramsRead
  79 nodeNodeNgramsTable  = Table "node_node_ngrams"
  80                           ( pNodeNodeNgrams NodeNodeNgrams
  81                                { _nnng_id         = optional "id"
  82                                , _nnng_node1_id   = required "node1_id"
  83                                , _nnng_node2_id   = required "node2_id"
  84                                , _nnng_ngrams_id  = required "ngrams_id"
  85                                , _nnng_ngramsType = required "ngrams_type"
  86                                , _nnng_weight     = required "weight"
  87                                }
  88                           )
  89
  90 queryNodeNodeNgramsTable :: Query NodeNodeNgramsRead
  91 queryNodeNodeNgramsTable = queryTable nodeNodeNgramsTable
  92
  93
  94 -- | Insert utils
  95 insertNodeNodeNgrams :: [NodeNodeNgrams] -> Cmd err Int
  96 insertNodeNodeNgrams = insertNodeNodeNgramsW
  97                      . map (\(NodeNodeNgrams id'' n1 n2 ng nt w) ->
  98                               NodeNodeNgrams (pgInt4 <$> id'')
  99                                              (pgNodeId n1)
 100                                              (pgNodeId n2)
 101                                              (pgInt4   ng)
 102                                              (pgNgramsTypeId nt)
 103                                              (pgDouble w)
 104                                                   )
 105
 106 insertNodeNodeNgramsW :: [NodeNodeNgramsWrite] -> Cmd err Int
 107 insertNodeNodeNgramsW nnnw =
 108   mkCmd $ \c -> fromIntegral <$> runInsert_ c insertNothing
 109     where
 110       insertNothing = (Insert { iTable = nodeNodeNgramsTable
 111                               , iRows  = nnnw
 112                               , iReturning = rCount
 113                               , iOnConflict = (Just DoNothing)
 114       })
 115
 116