src/Gargantext/Database/Ngram.hs

   1 {-|
   2 Module      : Gargantext.Database.Ngram
   3 Description : Ngram connection to the 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 Ngrams connection to the Database.
  11
  12 -}
  13
  14 {-# LANGUAGE Arrows                 #-}
  15 {-# LANGUAGE DeriveGeneric          #-}
  16 {-# LANGUAGE FlexibleInstances      #-}
  17 {-# LANGUAGE FunctionalDependencies #-}
  18 {-# LANGUAGE MultiParamTypeClasses  #-}
  19 {-# LANGUAGE NoImplicitPrelude      #-}
  20 {-# LANGUAGE OverloadedStrings      #-}
  21 {-# LANGUAGE QuasiQuotes            #-}
  22 {-# LANGUAGE TemplateHaskell        #-}
  23
  24 module Gargantext.Database.Ngram where
  25
  26 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  27 import Data.List (find)
  28 import Data.Maybe (Maybe)
  29 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  30 import GHC.Generics (Generic)
  31 import Data.ByteString.Internal (ByteString)
  32 import Data.Text (Text)
  33 import Database.PostgreSQL.Simple.FromRow (fromRow, field)
  34 import Database.PostgreSQL.Simple.SqlQQ
  35 import Gargantext.Database.Node (mkCmd, Cmd(..))
  36 -- import Opaleye
  37 import Prelude
  38
  39 import qualified Database.PostgreSQL.Simple as DPS
  40 import Database.PostgreSQL.Simple.FromField ( FromField, fromField)
  41 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
  42
  43
  44 --data NgramPoly id terms n = NgramDb { ngram_id    :: id
  45 --                                    , ngram_terms :: terms
  46 --                                    , ngram_n     :: n
  47 --                                    } deriving (Show)
  48 --
  49 --type NgramWrite = NgramPoly (Maybe (Column PGInt4))
  50 --                                   (Column PGText)
  51 --                                   (Column PGInt4)
  52 --
  53 --type NgramRead  = NgramPoly        (Column PGInt4)
  54 --                                   (Column PGText)
  55 --                                   (Column PGInt4)
  56 --
  57 ----type Ngram = NgramPoly Int Text Int
  58 --
  59 -- $(makeAdaptorAndInstance "pNgram"    ''NgramPoly)
  60 -- $(makeLensesWith abbreviatedFields   ''NgramPoly)
  61 --
  62 --ngramTable :: Table NgramWrite NgramRead
  63 --ngramTable = Table "ngrams" (pNgram NgramDb { ngram_id    = optional "id"
  64 --                                            , ngram_terms = required "terms"
  65 --                                            , ngram_n     = required "n"
  66 --                                            }
  67 --                                )
  68 --
  69 --queryNgramTable :: Query NgramRead
  70 --queryNgramTable = queryTable ngramTable
  71 --
  72 --dbGetNgrams :: PGS.Connection -> IO [NgramDb]
  73 --dbGetNgrams conn = runQuery conn queryNgramTable
  74
  75 type Ngram = Text
  76 type NgramId = Int
  77 type Size = Int
  78
  79 data NgramIds = NgramIds { ngramId    :: Int
  80                          , ngramTerms :: Text
  81      } deriving (Show, Generic)
  82
  83 instance DPS.FromRow NgramIds where
  84   fromRow = NgramIds <$> field <*> field
  85
  86 ----------------------
  87 insertNgrams :: [(Ngram, Size)] -> Cmd [NgramIds]
  88 insertNgrams ns = mkCmd $ \conn -> DPS.query conn queryInsertNgrams (DPS.Only $ Values fields ns)
  89   where
  90     fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"]
  91
  92
  93 insertNgrams_Debug :: [(Ngram, Size)] -> Cmd ByteString
  94 insertNgrams_Debug ns = mkCmd $ \conn -> DPS.formatQuery conn queryInsertNgrams (DPS.Only $ Values fields ns)
  95   where
  96     fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"]
  97
  98 ----------------------
  99 queryInsertNgrams :: DPS.Query
 100 queryInsertNgrams = [sql|
 101     WITH input_rows(terms,n) AS (?)
 102     , ins AS (
 103        INSERT INTO ngrams (terms,n)
 104        SELECT * FROM input_rows
 105        ON CONFLICT (terms) DO NOTHING -- unique index created here
 106        RETURNING id,terms
 107        )
 108
 109     SELECT id, terms
 110     FROM   ins
 111     UNION  ALL
 112     SELECT c.id, terms
 113     FROM   input_rows
 114     JOIN   ngrams c USING (terms);     -- columns of unique index
 115            |]