[FIX] email model
[gargantext.git] / src / Gargantext / Database / Action / Flow / Utils.hs
index e16fbd0ef59a6a884ec748441d9c570911021f54..9c295afab2a916162a331d13452ed8eca1bbe6fb 100644 (file)
@@ -14,30 +14,15 @@ module Gargantext.Database.Action.Flow.Utils
     where
 
 import Data.Map (Map)
-import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Database.Query.Table.Node
-import Gargantext.Database.Query.Table.User
-import Gargantext.Database.Query.Table.Node.Error
+import qualified Data.Map as DM
+
 import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Admin.Types.Hyperdata (Hyperdata)
 import Gargantext.Database.Prelude (Cmd)
+import Gargantext.Database.Query.Table.NodeNodeNgrams
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Schema.Node
-import Gargantext.Database.Query.Table.NodeNodeNgrams
 import Gargantext.Prelude
-import qualified Data.Map as DM
-
-getUserId :: HasNodeError err
-          => User
-          -> Cmd err UserId
-getUserId (UserDBId uid) = pure uid
-getUserId (RootId   rid) = do
-  n <- getNode rid
-  pure $ _node_userId n
-getUserId (UserName u  ) = do
-  muser <- getUser u
-  case muser of
-    Just user -> pure $ userLight_id user
-    Nothing   -> nodeError NoUserFound
 
 
 toMaps :: Hyperdata a
@@ -46,7 +31,7 @@ toMaps :: Hyperdata a
        -> Map (NgramsT Ngrams) (Map NodeId Int)
 toMaps fun ns = mapNodeIdNgrams $ documentIdWithNgrams fun ns'
   where
-    ns' = map (\(Node nId _ _ _ _ _ json) -> DocumentWithId nId json) ns
+    ns' = map (\(Node nId _ _ _ _ _ json) -> DocumentWithId nId json) ns
 
 mapNodeIdNgrams :: Hyperdata a
                 => [DocumentIdWithNgrams a]
@@ -54,7 +39,7 @@ mapNodeIdNgrams :: Hyperdata a
 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, document_ngrams d))
+    n2i = map (\d -> ((documentId . documentWithId) d, documentNgrams d))
 
 
 documentIdWithNgrams :: Hyperdata a
@@ -73,7 +58,7 @@ data DocumentWithId a =
 data DocumentIdWithNgrams a =
      DocumentIdWithNgrams
      { documentWithId  :: DocumentWithId a
-     , document_ngrams :: Map (NgramsT Ngrams) Int
+     , documentNgrams :: Map (NgramsT Ngrams) Int
      } deriving (Show)