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