[REFACT] HasDBid instance for ListType

src/Gargantext/Core/Text/List/Learn.hs

@@ -24,8 +24,9 @@ import qualified Data.Map    as Map
 import qualified Data.SVM    as SVM
 import qualified Data.Vector as Vec
 
+import Gargantext.Core
 import Gargantext.Core.Text.Metrics.Count (occurrencesWith)
-import Gargantext.Core.Types.Main (ListType(..), listTypeId, fromListTypeId)
+import Gargantext.Core.Types.Main (ListType(..))
 import Gargantext.Prelude
 import Gargantext.Prelude.Utils
 
@@ -43,7 +44,7 @@ trainList :: Double -> Double -> Map ListType [Vec.Vector Double] -> IO SVM.Mode
 trainList x y = (train x y) . trainList'
   where
     trainList' :: Map ListType [Vec.Vector Double] -> SVM.Problem
-    trainList' = mapVec2problem . (Map.mapKeys (fromIntegral . listTypeId))
+    trainList' = mapVec2problem . (Map.mapKeys (fromIntegral . toDBid))
 
     mapVec2problem :: Map Double [Vec.Vector Double] -> SVM.Problem
     mapVec2problem = List.concat . (map (\(a,as) -> zip (repeat a) as)) . Map.toList . (Map.map vecs2maps)
@@ -53,7 +54,7 @@ trainList x y = (train x y) . trainList'
 
 
 predictList :: Model -> [Vec.Vector Double] -> IO [Maybe ListType]
-predictList (ModelSVM m _ _) vs = map (fromListTypeId . round) <$> predict m vs
+predictList (ModelSVM m _ _) vs = map (Just . fromDBid . round) <$> predict m vs
 
 ------------------------------------------------------------------------
 data Model = ModelSVM { modelSVM :: SVM.Model

src/Gargantext/Core/Types/Main.hs

@@ -22,10 +22,12 @@ import Data.Aeson.TH (deriveJSON)
 import Data.Either (Either(..))
 import Data.Hashable (Hashable)
 import Data.Map (fromList, lookup)
+import Data.Maybe (fromMaybe)
 import Data.Semigroup (Semigroup(..))
 import Data.Swagger
 import Data.Text (Text, unpack)
 import GHC.Generics (Generic)
+import Gargantext.Core
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
 import Gargantext.Database.Admin.Types.Node  -- (NodeType(..), Node, Hyperdata(..))
 import Gargantext.Prelude
@@ -76,6 +78,10 @@ instance FromHttpApiData ListType where
 
 type ListTypeId = Int
 
+instance HasDBid ListType where
+  toDBid   = listTypeId
+  fromDBid = (fromMaybe (panic "Instance HasDBid fromDBid ListType")) .  fromListTypeId
+
 -- FIXME Candidate: 0 and Stop : 1
 listTypeId :: ListType -> ListTypeId
 listTypeId StopTerm      = 0

src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs

@@ -18,7 +18,7 @@ module Gargantext.Database.Admin.Trigger.NodeNodeNgrams
 
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Gargantext.Core
-import Gargantext.Core.Types.Main (listTypeId, ListType(CandidateTerm))
+import Gargantext.Core.Types.Main (ListType(CandidateTerm))
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
 import Gargantext.Database.Prelude (Cmd, execPGSQuery)
 import Gargantext.Prelude
@@ -108,8 +108,8 @@ triggerCoocInsert :: HasDBid NodeType => Cmd err Int64
 triggerCoocInsert = execPGSQuery query ( toDBid NodeCorpus
                                        , toDBid NodeDocument
                                        , toDBid NodeList
-                                       , listTypeId CandidateTerm
-                                       , listTypeId CandidateTerm
+                                       , toDBid CandidateTerm
+                                       , toDBid CandidateTerm
                                        )
   where
     query :: DPS.Query

src/Gargantext/Database/Admin/Trigger/NodesNodes.hs

@@ -21,7 +21,7 @@ import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Gargantext.Core
 import Gargantext.Database.Admin.Config
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
-import Gargantext.Core.Types.Main (listTypeId, ListType(CandidateTerm))
+import Gargantext.Core.Types.Main (ListType(CandidateTerm))
 import Gargantext.Database.Prelude (Cmd, execPGSQuery)
 import Gargantext.Prelude
 import qualified Database.PostgreSQL.Simple as DPS
@@ -162,8 +162,8 @@ triggerCoocInsert lid = execPGSQuery query ( lid
                                            -- , nodeTypeId NodeCorpus
                                            -- , nodeTypeId NodeDocument
                                            -- , nodeTypeId NodeList
-                                           , listTypeId CandidateTerm
-                                           , listTypeId CandidateTerm
+                                           , toDBid CandidateTerm
+                                           , toDBid CandidateTerm
                                            )
   where
     query :: DPS.Query

src/Gargantext/Database/Query/Table/NodeNgrams.hs

@@ -34,6 +34,7 @@ import Database.PostgreSQL.Simple.FromRow (fromRow, field)
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Database.PostgreSQL.Simple.ToField (toField)
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
+import Gargantext.Core
 import Gargantext.Core.Types
 import Gargantext.Database.Prelude
 import Gargantext.Database.Schema.Ngrams (NgramsType, ngramsTypeId, fromNgramsTypeId)
@@ -82,7 +83,7 @@ insertNodeNgrams nns = runPGSQuery query (PGS.Only $ Values fields nns')
     -- nns' :: [(Int, ListTypeId, NgramsText, NgramsTypeId ,NgramsField, NgramsTag, NgramsClass, Double)]
     nns' = map (\(NodeNgrams _id (NodeId node_id'') node_subtype ngrams_terms ngrams_type ngrams_field ngrams_tag ngrams_class weight)
                               -> [ toField node_id''
-                                 , toField $ listTypeId node_subtype
+                                 , toField $ toDBid node_subtype
                                  , toField $ ngrams_terms
                                  , toField $ ngramsTypeId ngrams_type
                                  , toField $ fromMaybe 0 ngrams_field