[NgramsTable] WIP adding NgramsTypeId newtype.

src/Gargantext/API/Ngrams.hs

@@ -268,7 +268,7 @@ ngramError nne = throwError $ _NgramError # nne
 -- `GraphList` and that the patch is `Replace CandidateList StopList` then
 -- the list is going to be `StopList` while it should keep `GraphList`.
 -- However this should not happen in non conflicting situations.
-mkListsUpdate :: ListId -> NgramsTablePatch -> [(ListId, NgramsTerm, ListTypeId)]
+mkListsUpdate :: ListId -> NgramsTablePatch -> [(ListId, NgramsTypeId, NgramsTerm, ListTypeId)]
 mkListsUpdate lId patches =
   [ (lId, ng, listTypeId lt)
   | (ng, patch) <- patches ^.. ntp_ngrams_patches . ifolded . withIndex

src/Gargantext/Database/Schema/Ngrams.hs

@@ -15,6 +15,7 @@ Ngrams connection to the Database.
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE FunctionalDependencies     #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses  #-}
 {-# LANGUAGE NoImplicitPrelude      #-}
 {-# LANGUAGE OverloadedStrings      #-}
@@ -26,6 +27,7 @@ module Gargantext.Database.Schema.Ngrams where
 
 
 import Control.Lens (makeLenses, view)
+import Control.Monad (mzero)
 import Data.ByteString.Internal (ByteString)
 import Data.Map (Map, fromList, lookup, fromListWith)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
@@ -34,7 +36,8 @@ import Data.Text (Text, splitOn)
 import Database.PostgreSQL.Simple ((:.)(..))
 import Database.PostgreSQL.Simple.FromRow (fromRow, field)
 import Database.PostgreSQL.Simple.SqlQQ (sql)
-import Database.PostgreSQL.Simple.ToField (toField)
+import Database.PostgreSQL.Simple.ToField (toField, ToField)
+import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 import Database.PostgreSQL.Simple.ToRow   (toRow)
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 --import Debug.Trace (trace)
@@ -46,7 +49,7 @@ import Gargantext.Database.Types.Node (NodeType)
 import Gargantext.Database.Schema.Node (getListsWithParentId, getCorporaWithParentId)
 import Gargantext.Database.Utils (Cmd, runPGSQuery, runOpaQuery, formatPGSQuery)
 import Gargantext.Prelude
-import Opaleye
+import Opaleye hiding (FromField)
 import Prelude (Enum, Bounded, minBound, maxBound)
 import qualified Data.Set as DS
 import qualified Database.PostgreSQL.Simple as PGS
@@ -99,13 +102,29 @@ dbGetNgramsDb = runOpaQuery queryNgramsTable
 data NgramsType = Authors | Institutes | Sources | NgramsTerms
   deriving (Eq, Show, Ord, Enum, Bounded)
 
-ngramsTypeId :: NgramsType -> Int
+newtype NgramsTypeId = NgramsTypeId Int
+  deriving (Eq, Show, Ord, Num)
+
+instance ToField NgramsTypeId where
+  toField (NgramsTypeId n) = toField n
+
+instance FromField NgramsTypeId where
+  fromField field mdata = do
+    n <- fromField field mdata
+    if (n :: Int) > 0 then return $ NgramsTypeId n
+                      else mzero
+
+pgNgramsTypeId :: NgramsTypeId -> Column PGInt4
+pgNgramsTypeId (NgramsTypeId n) = pgInt4 n
+
+
+ngramsTypeId :: NgramsType -> NgramsTypeId
 ngramsTypeId Authors     = 1
 ngramsTypeId Institutes  = 2
 ngramsTypeId Sources     = 3
 ngramsTypeId NgramsTerms = 4
 
-fromNgramsTypeId :: Int -> Maybe NgramsType
+fromNgramsTypeId :: NgramsTypeId -> Maybe NgramsType
 fromNgramsTypeId id = lookup id $ fromList [(ngramsTypeId nt,nt) | nt <- [minBound .. maxBound] :: [NgramsType]]
 
 type NgramsTerms = Text

src/Gargantext/Database/Schema/NodeNgram.hs

@@ -41,6 +41,7 @@ import Gargantext.Core.Types.Main (ListTypeId)
 import Gargantext.Database.Utils (mkCmd, Cmd, execPGSQuery)
 import Gargantext.Database.Types.Node (NodeId, ListId)
 import Gargantext.Database.Schema.Node (pgNodeId)
+import Gargantext.Database.Schema.Ngrams (NgramsTypeId, pgNgramsTypeId)
 import Gargantext.Database.Schema.NodeNgramsNgrams (NgramsChild, NgramsParent, ngramsGroup, Action(..))
 import Gargantext.Prelude
 import Gargantext.Database.Utils (formatPGSQuery)
@@ -81,12 +82,11 @@ type NodeNgramReadNull =
        (Column (Nullable PGFloat8))
 
 type NodeNgram =
-     NodeNgramPoly NodeId Int Int Int Double
+     NodeNgramPoly NodeId Int NgramsTypeId Int Double
 
 $(makeAdaptorAndInstance "pNodeNgram" ''NodeNgramPoly)
 makeLenses ''NodeNgramPoly
 
-
 nodeNgramTable :: Table NodeNgramWrite NodeNgramRead
 nodeNgramTable  = Table "nodes_ngrams"
   ( pNodeNgram NodeNgram
@@ -106,7 +106,7 @@ insertNodeNgrams = insertNodeNgramW
                  . map (\(NodeNgram n g ngt lt w) ->
                           NodeNgram (pgNodeId n)
                                     (pgInt4 g)
-                                    (pgInt4 ngt)
+                                    (pgNgramsTypeId ngt)
                                     (pgInt4 lt)
                                     (pgDouble w)
                         )
@@ -123,27 +123,27 @@ insertNodeNgramW nns =
 
 type NgramsText = Text
 
-updateNodeNgrams' :: [(ListId, NgramsText, ListTypeId)] -> Cmd err ()
+updateNodeNgrams' :: [(ListId, NgramsTypeId, NgramsText, ListTypeId)] -> Cmd err ()
 updateNodeNgrams' [] = pure ()
 updateNodeNgrams' input = void $ execPGSQuery updateQuery (PGS.Only $ Values fields input)
   where
     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","text","int4"]
 
-updateNodeNgrams'' :: [(ListId, NgramsText, ListTypeId)] -> Cmd err ByteString
+updateNodeNgrams'' :: [(ListId, NgramsTypeId, NgramsText, ListTypeId)] -> Cmd err ByteString
 updateNodeNgrams'' input = formatPGSQuery updateQuery (PGS.Only $ Values fields input)
   where
-    fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","text","int4"]
+    fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","text","int4"]
 
 updateQuery :: PGS.Query
 updateQuery = [sql|
-WITH new(node_id,terms,typeList) as (?)
+WITH new(node_id,ngrams_type,terms,typeList) as (?)
 
 INSERT into nodes_ngrams (node_id,ngrams_id,ngrams_type,list_type,weight)
 
-SELECT node_id,ngrams.id,4,typeList,1 FROM new
+SELECT node_id,ngrams.id,ngrams_type,typeList,1 FROM new
 JOIN ngrams ON ngrams.terms = new.terms
 ON CONFLICT (node_id, ngrams_id, ngrams_type) DO
--- DO NOTHING-
+-- DO NOTHING
 
 UPDATE SET list_type = excluded.list_type
 ;
@@ -153,7 +153,7 @@ UPDATE SET list_type = excluded.list_type
 
 
 data NodeNgramsUpdate = NodeNgramsUpdate
-  { _nnu_lists_update :: [(ListId, NgramsText, ListTypeId)]
+  { _nnu_lists_update :: [(ListId, NgramsTypeId, NgramsText, ListTypeId)]
   , _nnu_add_children :: [(ListId, NgramsParent, NgramsChild, Maybe Double)]
   , _nnu_rem_children :: [(ListId, NgramsParent, NgramsChild, Maybe Double)]
   }