[REFACT/CLEAN] TextFlow

src/Gargantext/Core/Flow/Types.hs

@@ -14,14 +14,13 @@ Portability : POSIX
 
 module Gargantext.Core.Flow.Types where
 
-import Control.Lens -- (Lens')
+import Control.Lens
 import Data.Map (Map)
-
 import Gargantext.Core.Text (HasText(..))
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Schema.Node (node_hash_id)
 import Gargantext.Database.Schema.Ngrams (Ngrams, NgramsType)
+import Gargantext.Database.Schema.Node (node_hash_id)
 import Gargantext.Prelude
 import Gargantext.Prelude.Crypto.Hash (Hash)
 
@@ -41,17 +40,10 @@ instance UniqId (Node a)
   where
     uniqId = node_hash_id
 
+
+{-
 data DocumentIdWithNgrams a = DocumentIdWithNgrams
-  { documentWithId  :: !(DocumentWithId a)
+  { documentWithId  :: !(Indexed NodeId a)
   , documentNgrams :: !(Map Ngrams (Map NgramsType Int))
   } deriving (Show)
-
-data DocumentWithId a = DocumentWithId
-  { documentId   :: !NodeId
-  , documentData :: !a
-  } deriving (Show)
-
-instance HasText a => HasText (DocumentWithId a)
-  where
-    hasText (DocumentWithId _ a) = hasText a
-
+-}

src/Gargantext/Core/Text/Terms.hs

@@ -91,9 +91,9 @@ extractTerms termTypeLang xs = mapM (terms termTypeLang) xs
 
 
 ------------------------------------------------------------------------
-withLang :: HasText a
+withLang :: (Foldable t, Functor t, HasText h)
          => TermType Lang
-         -> [DocumentWithId a]
+         -> t h
          -> TermType Lang
 withLang (Unsupervised l n s m) ns = Unsupervised l n s m'
   where

src/Gargantext/Database/Action/Flow.hs

@@ -75,7 +75,7 @@ import Gargantext.Core.Types.Main
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Action.Flow.List
 import Gargantext.Database.Action.Flow.Types
-import Gargantext.Database.Action.Flow.Utils (insertDocNgrams)
+import Gargantext.Database.Action.Flow.Utils (insertDocNgrams, DocumentIdWithNgrams(..))
 import Gargantext.Database.Action.Search (searchDocInDatabase)
 import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
 import Gargantext.Database.Admin.Types.Hyperdata
@@ -89,6 +89,7 @@ import Gargantext.Database.Query.Table.NodeNgrams (listInsertDb , getCgramsId)
 import Gargantext.Database.Query.Table.NodeNodeNgrams2
 import Gargantext.Database.Query.Tree.Root (getOrMkRoot, getOrMk_RootWithCorpus)
 import Gargantext.Database.Schema.Node (NodePoly(..))
+import Gargantext.Database.Types
 import Gargantext.Prelude
 import Gargantext.Prelude.Crypto.Hash (Hash)
 import qualified Gargantext.Core.Text.Corpus.API as API
@@ -258,7 +259,8 @@ insertMasterDocs c lang hs  =  do
   -- this will enable global database monitoring
 
   -- maps :: IO Map Ngrams (Map NgramsType (Map NodeId Int))
-  mapNgramsDocs <- mapNodeIdNgrams
+  mapNgramsDocs :: Map Ngrams (Map NgramsType (Map NodeId Int))
+                <- mapNodeIdNgrams
                 <$> documentIdWithNgrams
                     (extractNgramsT $ withLang lang documentsWithId)
                     documentsWithId
@@ -296,7 +298,7 @@ insertDocs :: ( FlowCmdM env err m
               => UserId
               -> CorpusId
               -> [a]
-              -> m ([DocId], [DocumentWithId a])
+              -> m ([DocId], [Indexed NodeId a])
 insertDocs uId cId hs = do
   let docs = map addUniqId hs
   newIds <- insertDb uId cId docs
@@ -325,12 +327,12 @@ toInserted =
 
 mergeData :: Map Hash ReturnId
           -> Map Hash a
-          -> [DocumentWithId a]
+          -> [Indexed NodeId a]
 mergeData rs = catMaybes . map toDocumentWithId . Map.toList
   where
     toDocumentWithId (sha,hpd) =
-      DocumentWithId <$> fmap reId (lookup sha rs)
-                     <*> Just hpd
+      Indexed <$> fmap reId (lookup sha rs)
+              <*> Just hpd
 
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
@@ -338,12 +340,12 @@ mergeData rs = catMaybes . map toDocumentWithId . Map.toList
 documentIdWithNgrams :: HasNodeError err
                      => (a
                      -> Cmd err (Map Ngrams (Map NgramsType Int)))
-                     -> [DocumentWithId a]
+                     -> [Indexed NodeId a]
                      -> Cmd err [DocumentIdWithNgrams a]
 documentIdWithNgrams f = traverse toDocumentIdWithNgrams
   where
     toDocumentIdWithNgrams d = do
-      e <- f $ documentData         d
+      e <- f $ _unIndex         d
       pure   $ DocumentIdWithNgrams d e
 
 ------------------------------------------------------------------------

src/Gargantext/Database/Action/Flow/List.hs

@@ -20,25 +20,25 @@ module Gargantext.Database.Action.Flow.List
 import Control.Concurrent
 import Control.Lens (view, (^.), (+~), (%~), at)
 import Control.Monad.Reader
-import qualified Data.List as List
-import qualified Data.Map  as Map
 import Data.Map (Map, toList)
-import qualified Data.Map.Strict.Patch as PM
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
-
 import Gargantext.API.Ngrams.Types (HasRepoSaver(..), NgramsElement(..), NgramsPatch(..), NgramsRepoElement(..), NgramsTablePatch(..), NgramsTerm(..), RepoCmdM, ne_ngrams, ngramsElementToRepo, r_history, r_state, r_version, repoVar)
-import Gargantext.Core.Flow.Types
 import Gargantext.Core.Types (HasInvalidError(..), assertValid)
 import Gargantext.Core.Types.Main (ListType(CandidateTerm))
 import Gargantext.Core.Utils (something)
 import Gargantext.Database.Action.Flow.Types
-import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
+import Gargantext.Database.Action.Flow.Utils (DocumentIdWithNgrams(..))
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Query.Table.Node_NodeNgramsNodeNgrams
 import Gargantext.Database.Query.Table.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb, getCgramsId)
+import Gargantext.Database.Query.Table.Node_NodeNgramsNodeNgrams
 import Gargantext.Database.Schema.Ngrams (Ngrams(..), NgramsType(..))
+import Gargantext.Database.Types
 import Gargantext.Prelude
+import qualified Data.List as List
+import qualified Data.Map  as Map
+import qualified Data.Map.Strict.Patch as PM
+import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
 
 -- FLOW LIST
 -- 1. select specific terms of the corpus when compared with others langs
@@ -84,14 +84,17 @@ flowList_Tficf' u m nt f = do
 
 -- | TODO check optimization
 mapNodeIdNgrams :: [DocumentIdWithNgrams a]
-                -> Map Ngrams (Map NgramsType (Map NodeId Int))
+                -> Map Ngrams
+                       (Map NgramsType 
+                            (Map NodeId Int)
+                       )
 mapNodeIdNgrams = Map.unionsWith (Map.unionWith (Map.unionWith (+))) . fmap f
   where
     f :: DocumentIdWithNgrams a
       -> Map Ngrams (Map NgramsType (Map NodeId Int))
     f d = fmap (fmap (Map.singleton nId)) $ documentNgrams d
       where
-        nId = documentId $ documentWithId d
+        nId = _index $ documentWithId d
 
 ------------------------------------------------------------------------
 flowList_DbRepo :: FlowCmdM env err m

src/Gargantext/Database/Action/Flow/Utils.hs

@@ -14,51 +14,20 @@ module Gargantext.Database.Action.Flow.Utils
     where
 
 import Data.Map (Map)
-import Gargantext.Database.Admin.Types.Hyperdata (Hyperdata)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Database.Query.Table.NodeNodeNgrams
 import Gargantext.Database.Schema.Ngrams
-import Gargantext.Database.Schema.Node
 import Gargantext.Database.Types
 import Gargantext.Prelude
 import qualified Data.Map as DM
 
-
-toMaps :: Hyperdata a
-       => (a -> Map (NgramsT Ngrams) Int)
-       -> [Node a]
-       -> Map (NgramsT Ngrams) (Map NodeId Int)
-toMaps fun ns = mapNodeIdNgrams $ documentIdWithNgrams fun ns'
-  where
-    ns' = map (\(Node nId _ _ _ _ _ _ json) -> DocumentWithId nId json) ns
-
-mapNodeIdNgrams :: Hyperdata a
-                => [DocumentIdWithNgrams a]
-                -> Map (NgramsT Ngrams) (Map NodeId Int)
-mapNodeIdNgrams ds = DM.map (DM.fromListWith (+)) $ DM.fromListWith (<>) xs
-  where
-    xs  = [(ng, [(nId, i)]) | (nId, n2i') <- n2i ds, (ng, i) <- DM.toList n2i']
-    n2i = map (\d -> ((documentId . documentWithId) d, documentNgrams d))
-
-
-documentIdWithNgrams :: Hyperdata a
-                     => (a -> Map (NgramsT Ngrams) Int)
-                     -> [DocumentWithId a]
-                     -> [DocumentIdWithNgrams a]
-documentIdWithNgrams f = map (\d -> DocumentIdWithNgrams d ((f . documentData) d))
-
-
-data DocumentWithId a =
-     DocumentWithId { documentId   :: NodeId
-                    , documentData :: a
-                    } deriving (Show)
-
+type DocumentWithId a = Indexed NodeId a
 
 data DocumentIdWithNgrams a =
      DocumentIdWithNgrams
      { documentWithId  :: DocumentWithId a
-     , documentNgrams :: Map (NgramsT Ngrams) Int
+     , documentNgrams :: Map Ngrams (Map NgramsType Int)
      } deriving (Show)
 
 

src/Gargantext/Database/Admin/Types/Hyperdata/Prelude.hs

@@ -33,7 +33,7 @@ module Gargantext.Database.Admin.Types.Hyperdata.Prelude
   )
   where
 
-import Control.Lens hiding (elements, (&), (.=))
+import Control.Lens hiding (elements, (&), (.=), Indexed)
 import Data.Aeson
 import Data.Aeson.TH (deriveJSON)
 import Data.Aeson.Types (emptyObject)

src/Gargantext/Database/Types.hs

@@ -14,20 +14,27 @@ Portability : POSIX
 module Gargantext.Database.Types
   where
 
-import Gargantext.Prelude
+import Gargantext.Core.Text (HasText(..))
 import Gargantext.Database.Schema.Prelude
+import Gargantext.Prelude
 import qualified Database.PostgreSQL.Simple as PGS
 
 
 -- | Index memory of any type in Gargantext
 data Indexed i a =
-  Indexed { _index     :: i
-          , _unIndex   :: a
+  Indexed { _index     :: !i
+          , _unIndex   :: !a
           }
   deriving (Show, Generic, Eq, Ord)
 
 makeLenses ''Indexed
 
+----------------------------------------------------------------------
+-- | Main instances
 instance (FromField i, FromField a) => PGS.FromRow (Indexed i a) where
   fromRow = Indexed <$> field <*> field
 
+instance HasText a => HasText (Indexed i a)
+  where
+    hasText (Indexed _ a) = hasText a
+