[NGRAMS] Table queries ready (qualitative tests, needs more tests)

src/Gargantext/Core/Types/Main.hs

@@ -21,9 +21,12 @@ Portability : POSIX
 module Gargantext.Core.Types.Main where
 ------------------------------------------------------------------------
 
+
+import Prelude (Enum, Bounded, minBound, maxBound)
 import Data.Aeson (FromJSON, ToJSON, toJSON)
 import Data.Aeson as A
 import Data.Aeson.TH (deriveJSON)
+import Data.Map (fromList, lookup)
 import Data.Eq (Eq())
 import Data.Monoid ((<>))
 import Data.Text (Text)
@@ -80,7 +83,7 @@ corpusTree nId t  = TreeN (NodeTree ("Corpus " <> t)  NodeCorpus nId) (  [ leafT
 
 -- TODO multiple ListType declaration, remove it
 data ListType  =  Stop  | Candidate | Map
-  deriving (Generic, Eq, Ord, Show)
+  deriving (Generic, Eq, Ord, Show, Enum, Bounded)
 
 instance ToJSON   ListType
 instance FromJSON ListType
@@ -90,6 +93,9 @@ listId Stop      = 0
 listId Candidate = 1
 listId Map       = 2
 
+fromListTypeId :: Int -> Maybe ListType
+fromListTypeId i = lookup i $ fromList [ (listId l, l) | l <- [minBound..maxBound]]
+
 -- data Metrics = Occurrences | Cooccurrences | Specclusion | Genclusion | Cvalue
 --              | TfidfCorpus | TfidfGlobal   | TirankLocal | TirankGlobal
 

src/Gargantext/Database/Config.hs

@@ -73,6 +73,6 @@ nodeTypeInv = map swap nodeTypes
 nodeTypes :: [(NodeType, NodeTypeId)]
 nodeTypes = [ (n, nodeTypeId n) | n <- allNodeTypes ]
 
-typeId2node :: NodeTypeId -> NodeType
-typeId2node tId = fromMaybe (panic $ pack $ "Type Id " <> show tId <> " does not exist")
+fromNodeTypeId :: NodeTypeId -> NodeType
+fromNodeTypeId tId = fromMaybe (panic $ pack $ "Type Id " <> show tId <> " does not exist")
                             (lookup tId nodeTypeInv)

src/Gargantext/Database/Ngrams.hs

@@ -24,6 +24,7 @@ Ngrams connection to the Database.
 module Gargantext.Database.Ngrams where
 
 -- import Opaleye
+import Prelude (Enum, Bounded, minBound, maxBound)
 import Control.Lens (makeLenses)
 import Data.ByteString.Internal (ByteString)
 import Data.Map (Map, fromList, lookup)
@@ -34,6 +35,7 @@ import Database.PostgreSQL.Simple.ToField (toField)
 import Database.PostgreSQL.Simple.ToRow   (toRow)
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import GHC.Generics (Generic)
+import Gargantext.Core.Types (fromListTypeId, ListType)
 import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Types.Node (NodeType)
 import Gargantext.Database.Node (mkCmd, Cmd(..))
@@ -79,7 +81,7 @@ import qualified Database.PostgreSQL.Simple as DPS
 -- ngrams in authors field of document has Authors Type
 -- ngrams in text (title or abstract) of documents has Terms Type
 data NgramsType = Authors | Institutes | Sources | Terms
-  deriving (Eq, Show, Ord)
+  deriving (Eq, Show, Ord, Enum, Bounded)
 
 ngramsTypeId :: NgramsType -> Int
 ngramsTypeId Authors    = 1
@@ -87,6 +89,9 @@ ngramsTypeId Institutes = 2
 ngramsTypeId Sources    = 3
 ngramsTypeId Terms      = 4
 
+fromNgramsTypeId :: Int -> Maybe NgramsType
+fromNgramsTypeId id = lookup id $ fromList [(ngramsTypeId nt,nt) | nt <- [minBound .. maxBound] :: [NgramsType]]
+
 type NgramsTerms = Text
 type NgramsId    = Int
 type Size        = Int
@@ -187,13 +192,13 @@ type NgramsTableParamMaster = NgramsTableParam
 
 data NgramsTableData = NgramsTableData { _ntd_terms :: Text
                                        , _ntd_n     :: Int
-                                       , _ntd_ngramsType :: Int
+                                       , _ntd_listType :: Maybe ListType
                                        , _ntd_weight :: Double
     } deriving (Show)
 
-getTableNgrams :: NodeType -> NgramsType -> NgramsTableParamUser -> NgramsTableParamMaster -> Cmd [(Text, Int, Int, Double)]
+getTableNgrams :: NodeType -> NgramsType -> NgramsTableParamUser -> NgramsTableParamMaster -> Cmd [NgramsTableData]
 getTableNgrams nodeT ngrmT (NgramsTableParam ul uc) (NgramsTableParam ml mc) =
-  mkCmd $ \conn -> DPS.query conn querySelectTableNgrams (ul,uc,nodeTId,ngrmTId,ml,mc,nodeTId,ngrmTId)
+  mkCmd $ \conn -> map (\(t,n,nt,w) -> NgramsTableData t n (fromListTypeId nt) w) <$> DPS.query conn querySelectTableNgrams (ul,uc,nodeTId,ngrmTId,ml,mc,nodeTId,ngrmTId)
     where
       nodeTId = nodeTypeId   nodeT
       ngrmTId = ngramsTypeId ngrmT
@@ -233,7 +238,6 @@ querySelectTableNgrams = [sql|
 type ListIdUser   = Int
 type ListIdMaster = Int
 
-
 getNgramsGroup :: ListIdUser -> ListIdMaster -> Cmd [(Text, Text)]
 getNgramsGroup lu lm = mkCmd $ \conn -> DPS.query conn querySelectNgramsGroup (lu,lm)
 

src/Gargantext/Database/Tree.hs

@@ -27,7 +27,7 @@ import Database.PostgreSQL.Simple.SqlQQ
 
 import Gargantext.Prelude
 import Gargantext.Core.Types.Main (NodeTree(..), Tree(..))
-import Gargantext.Database.Config (typeId2node)
+import Gargantext.Database.Config (fromNodeTypeId)
 ------------------------------------------------------------------------
 -- import Gargantext (connectGargandb)
 -- import Control.Monad ((>>=))
@@ -70,7 +70,7 @@ toTree' m n =
 toNodeTree :: DbTreeNode -> NodeTree
 toNodeTree (DbTreeNode nId tId _ n) = NodeTree n nodeType nId
   where
-    nodeType = typeId2node tId
+    nodeType = fromNodeTypeId tId
 ------------------------------------------------------------------------
 toTreeParent :: [DbTreeNode] -> Map (Maybe ParentId) [DbTreeNode]
 toTreeParent = fromListWith (<>) . map (\n -> (dt_parentId n, [n]))