[WIP] [Forgot password] render in FE
[gargantext.git] / src / Gargantext / Database / Action / Flow / Utils.hs
index 7088901360a7a722dd083df0c578907d7bc73fd7..f7f0c08b94384570a86d523945b6df7591e81579 100644 (file)
@@ -9,104 +9,44 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes        #-}
 
 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.Admin.Types.Errors
+import Data.HashMap.Strict (HashMap)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (Cmd)
+import Gargantext.Database.Query.Table.ContextNodeNgrams
 import Gargantext.Database.Schema.Ngrams
-import Gargantext.Database.Schema.Node
-import Gargantext.Database.Query.Table.NodeNodeNgrams
+import Gargantext.Database.Types
 import Gargantext.Prelude
+import Control.Lens ((^.))
 import qualified Data.Map as DM
+import qualified Data.HashMap.Strict as HashMap
 
-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
-       => (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, document_ngrams 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)
-
-
-data DocumentIdWithNgrams a =
+data DocumentIdWithNgrams a b =
      DocumentIdWithNgrams
-     { documentWithId  :: DocumentWithId a
-     , document_ngrams :: Map (NgramsT Ngrams) Int
+     { documentWithId :: Indexed NodeId a
+     , documentNgrams :: HashMap b (Map NgramsType Int)
      } deriving (Show)
 
+insertDocNgrams :: ListId
+                -> HashMap (Indexed NgramsId Ngrams) (Map NgramsType (Map DocId Int))
+                -> Cmd err Int
+insertDocNgrams lId m = insertContextNodeNgrams ns
+  where
+    ns = [ ContextNodeNgrams docId lId (ng^.index)
+                                   (ngramsTypeId t)
+                                   (fromIntegral i)
+         | (ng, t2n2i) <- HashMap.toList m
+         , (t,  n2i)   <- DM.toList t2n2i
+         , (docId,  i)     <- DM.toList n2i
+         ]
+
 
-docNgrams2nodeNodeNgrams :: CorpusId
-                         -> DocNgrams
-                         -> NodeNodeNgrams
-docNgrams2nodeNodeNgrams cId (DocNgrams d n nt w) =
-  NodeNodeNgrams cId d n nt w
 
-data DocNgrams = DocNgrams { dn_doc_id :: DocId
-                           , dn_ngrams_id :: Int
-                           , dn_ngrams_type :: NgramsTypeId
-                           , dn_weight  :: Double
-                           }
 
-insertDocNgramsOn :: CorpusId
-                  -> [DocNgrams]
-                  -> Cmd err Int
-insertDocNgramsOn cId dn =
-  insertNodeNodeNgrams
-  $ (map (docNgrams2nodeNodeNgrams cId) dn)
 
-insertDocNgrams :: CorpusId
-                -> Map NgramsIndexed (Map NgramsType (Map NodeId Int))
-                -> Cmd err Int
-insertDocNgrams cId m =
-  insertDocNgramsOn cId [ DocNgrams n (_ngramsId ng) (ngramsTypeId t) (fromIntegral i)
-                          | (ng, t2n2i) <- DM.toList m
-                          , (t,  n2i)   <- DM.toList t2n2i
-                          , (n,  i)     <- DM.toList n2i
-                        ]