NodeNodeNgrams.hs 1.88 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
{-|
Module      : Gargantext.Database.Schema.NodeNodeNgrams
Description : TODO: remove this module and table in database
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}

{-#  OPTIONS_GHC -fno-warn-orphans  #-}

{-# LANGUAGE Arrows                 #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TemplateHaskell        #-}

module Gargantext.Database.Query.Table.NodeNodeNgrams
  ( module Gargantext.Database.Schema.NodeNodeNgrams
  , queryNodeNodeNgramsTable
  , insertNodeNodeNgrams
  )
  where

25
import Gargantext.Database.Admin.Types.Node (pgNodeId)
26
import Gargantext.Database.Prelude (Cmd, mkCmd)
27
import Gargantext.Database.Schema.Ngrams (pgNgramsTypeId)
28
import Gargantext.Database.Schema.NodeNodeNgrams
29 30
import Gargantext.Database.Schema.Prelude
import Prelude
31 32 33


queryNodeNodeNgramsTable :: Query NodeNodeNgramsRead
34
queryNodeNodeNgramsTable = selectTable nodeNodeNgramsTable
35 36 37 38 39 40 41

-- | Insert utils
insertNodeNodeNgrams :: [NodeNodeNgrams] -> Cmd err Int
insertNodeNodeNgrams = insertNodeNodeNgramsW
                     . map (\(NodeNodeNgrams n1 n2 ng nt w) ->
                              NodeNodeNgrams (pgNodeId n1)
                                             (pgNodeId n2)
42
                                             (sqlInt4   ng)
43
                                             (pgNgramsTypeId nt)
44
                                             (sqlDouble w)
45 46 47 48 49 50 51 52 53 54 55 56
                                                  )

insertNodeNodeNgramsW :: [NodeNodeNgramsWrite] -> Cmd err Int
insertNodeNodeNgramsW nnnw =
  mkCmd $ \c -> fromIntegral <$> runInsert_ c insertNothing
    where
      insertNothing = (Insert { iTable = nodeNodeNgramsTable
                              , iRows  = nnnw
                              , iReturning = rCount
                              , iOnConflict = (Just DoNothing)
      })

57 58 59