[mail] some small refactoring
[gargantext.git] / src / Gargantext / API / Ngrams / List.hs
index 83671cdc82b30e36d576e23183302a32a5d0b291..8d35826ad58c880cd8538f46056ac5fbd1def39b 100644 (file)
@@ -9,7 +9,6 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE MonoLocalBinds #-}
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE TypeOperators     #-}
 
@@ -18,53 +17,93 @@ module Gargantext.API.Ngrams.List
 
 import Control.Lens hiding (elements, Indexed)
 import Data.Aeson
-import qualified Data.ByteString.Lazy as BSL
-import qualified Data.Csv as Csv
 import Data.Either (Either(..))
 import Data.HashMap.Strict (HashMap)
-import qualified Data.HashMap.Strict as HashMap
-import qualified Data.List           as List
-import Data.Map (Map, toList, fromList)
-import qualified Data.Map            as Map
-import Data.Maybe (catMaybes)
+import Data.Map (Map, toList)
+import Data.Maybe (catMaybes, fromMaybe)
 import Data.Set (Set)
-import Data.Text (Text, concat, pack)
-import qualified Data.Text           as Text
+import Data.Text (Text, concat, pack, splitOn)
 import Data.Vector (Vector)
-import qualified Data.Vector as Vec
-import Network.HTTP.Media ((//), (/:))
-import qualified Prelude as Prelude
-import Servant
-import Servant.Job.Async
-
-import qualified Protolude as P
-
 import Gargantext.API.Admin.Orchestrator.Types
-import Gargantext.API.Ngrams (getNgramsTableMap, setListNgrams)
+import Gargantext.API.Ngrams (setListNgrams)
 import Gargantext.API.Ngrams.List.Types
+import Gargantext.API.Ngrams.Prelude (getNgramsList)
 import Gargantext.API.Ngrams.Tools (getTermsWith)
 import Gargantext.API.Ngrams.Types
 import Gargantext.API.Prelude (GargServer)
+import Gargantext.Core.NodeStory
 import Gargantext.Core.Text.Terms (ExtractedNgrams(..))
 import Gargantext.Core.Text.Terms.WithList (buildPatterns, termsInText)
 import Gargantext.Core.Types.Main (ListType(..))
 import Gargantext.Database.Action.Flow (saveDocNgramsWith)
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
-import Gargantext.Database.Action.Metrics.NgramsByNode (getOccByNgramsOnlyFast')
+import Gargantext.Database.Action.Metrics.NgramsByContext (getOccByNgramsOnlyFast')
 import Gargantext.Database.Admin.Types.Hyperdata.Document
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Query.Table.NodeNode (selectDocNodes)
+import Gargantext.Database.Query.Table.Node (getNode)
+import Gargantext.Database.Query.Table.NodeContext (selectDocNodes)
+import Gargantext.Database.Schema.Context
 import Gargantext.Database.Schema.Ngrams
-import Gargantext.Database.Schema.Node
+import Gargantext.Database.Schema.Node (_node_parent_id)
 import Gargantext.Database.Types (Indexed(..))
 import Gargantext.Prelude
+import Network.HTTP.Media ((//), (/:))
+import Servant
+import Servant.Job.Async
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.Csv as Csv
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.List           as List
+import qualified Data.Map            as Map
+import qualified Data.Set            as Set
+import qualified Data.Text           as Text
+import qualified Data.Vector         as Vec
+import qualified Prelude
+import qualified Protolude           as P
+------------------------------------------------------------------------
+type GETAPI = Summary "Get List"
+            :> "lists"
+              :> Capture "listId" ListId
+            :> Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
+getApi :: GargServer GETAPI
+getApi = get
+
+data HTML
+instance Accept HTML where
+  contentType _ = "text" // "html" /: ("charset", "utf-8")
+instance ToJSON a => MimeRender HTML a where
+  mimeRender _ = encode
 
+----------------------
+type JSONAPI = Summary "Update List"
+          :> "lists"
+            :> Capture "listId" ListId
+          :> "add"
+          :> "form"
+          :> "async"
+            :> AsyncJobs JobLog '[FormUrlEncoded] WithFile JobLog
+
+jsonApi :: GargServer JSONAPI
+jsonApi = postAsync
+
+----------------------
+type CSVAPI = Summary "Update List (legacy v3 CSV)"
+          :> "lists"
+            :> Capture "listId" ListId
+          :> "csv"
+          :> "add"
+          :> "form"
+          :> "async"
+            :> AsyncJobs JobLog '[FormUrlEncoded] WithTextFile JobLog
+
+csvApi :: GargServer CSVAPI
+csvApi = csvPostAsync
 
 ------------------------------------------------------------------------
-get :: RepoCmdM env err m =>
+get :: HasNodeStory env err m =>
        ListId -> m (Headers '[Header "Content-Disposition" Text] NgramsList)
 get lId = do
-  lst <- get' lId
+  lst <- getNgramsList lId
   let (NodeId id') = lId
   return $ addHeader (concat [ "attachment; filename=GarganText_NgramsList-"
                              , pack $ show id'
@@ -72,30 +111,24 @@ get lId = do
                              ]
                      ) lst
 
-get' :: RepoCmdM env err m
-    => ListId -> m NgramsList
-get' lId = fromList
-       <$> zip ngramsTypes
-       <$> mapM (getNgramsTableMap lId) ngramsTypes
-
 ------------------------------------------------------------------------
 -- TODO : purge list
 -- TODO talk
-post :: FlowCmdM env err m
+setList :: FlowCmdM env err m
     => ListId
     -> NgramsList
     -> m Bool
-post l m  = do
+setList l m  = do
   -- TODO check with Version for optim
+  printDebug "New list as file" l
   _ <- mapM (\(nt, Versioned _v ns) -> setListNgrams l nt ns) $ toList m
   -- TODO reindex
   pure True
 
-
------------------------------------------------------------------------------
+------------------------------------------------------------------------
 -- | Re-index documents of a corpus with new ngrams (called orphans here)
-reIndexWith :: ( HasRepo env
-               , FlowCmdM env err m
+reIndexWith :: ( HasNodeStory env err m
+               , FlowCmdM     env err m
                )
             => CorpusId
             -> ListId
@@ -108,7 +141,7 @@ reIndexWith cId lId nt lts = do
      <$> map (\(k,vs) -> k:vs)
      <$> HashMap.toList
      <$> getTermsWith identity [lId] nt lts
-  
+
   -- printDebug "ts" ts
 
   -- Taking the ngrams with 0 occurrences only (orphans)
@@ -133,14 +166,14 @@ reIndexWith cId lId nt lts = do
   let
     ngramsByDoc = map (HashMap.fromList)
                 $ map (map (\(k,v) -> (SimpleNgrams (text2ngrams k), v)))
-                $  map (\doc -> List.zip
+                $ map (\doc -> List.zip
                                 (termsInText (buildPatterns $ map (\k -> (Text.splitOn " " $ unNgramsTerm k, [])) orphans)
                                              $ Text.unlines $ catMaybes
-                                               [ doc ^. node_hyperdata . hd_title
-                                               , doc ^. node_hyperdata . hd_abstract
+                                               [ doc ^. context_hyperdata . hd_title
+                                               , doc ^. context_hyperdata . hd_abstract
                                                ]
                                  )
-                                (List.cycle [Map.fromList $ [(nt, Map.singleton (doc ^. node_id) 1 )]])
+                                (List.cycle [Map.fromList $ [(nt, Map.singleton (doc ^. context_id) 1 )]])
                         ) docs
 
   -- printDebug "ngramsByDoc" ngramsByDoc
@@ -163,10 +196,15 @@ type PostAPI = Summary "Update List"
         :> "async"
         :> AsyncJobs JobLog '[FormUrlEncoded] WithFile JobLog
 
-postAsync :: ListId -> GargServer PostAPI
+postAsync :: GargServer JSONAPI
 postAsync lId =
   serveJobsAPI $
-    JobFunction (\f log' -> postAsync' lId f (liftBase . log'))
+    JobFunction (\f log' ->
+      let
+        log'' x = do
+          -- printDebug "postAsync ListId" x
+          liftBase $ log' x
+      in postAsync' lId f log'')
 
 postAsync' :: FlowCmdM env err m
           => ListId
@@ -177,17 +215,39 @@ postAsync' l (WithFile _ m _) logStatus = do
 
   logStatus JobLog { _scst_succeeded = Just 0
                    , _scst_failed    = Just 0
-                   , _scst_remaining = Just 1
+                   , _scst_remaining = Just 2
                    , _scst_events    = Just []
                    }
-  _r <- post l m
+  printDebug "New list as file" l
+  _ <- setList l m
+  -- printDebug "Done" r
 
-  pure JobLog { _scst_succeeded = Just 1
+  logStatus JobLog { _scst_succeeded = Just 1
+              , _scst_failed    = Just 0
+              , _scst_remaining = Just 1
+              , _scst_events    = Just []
+              }
+
+
+  corpus_node <- getNode l -- (Proxy :: Proxy HyperdataList)
+  let corpus_id = fromMaybe (panic "") (_node_parent_id corpus_node)
+  _ <- reIndexWith corpus_id l NgramsTerms (Set.fromList [MapTerm, CandidateTerm])
+
+  pure JobLog { _scst_succeeded = Just 2
               , _scst_failed    = Just 0
               , _scst_remaining = Just 0
               , _scst_events    = Just []
               }
+
+
 ------------------------------------------------------------------------
+type CSVPostAPI = Summary "Update List (legacy v3 CSV)"
+        :> "csv"
+        :> "add"
+        :> "form"
+        :> "async"
+        :> AsyncJobs JobLog '[FormUrlEncoded] WithFile JobLog
+
 readCsvText :: Text -> [(Text, Text, Text)]
 readCsvText t = case eDec of
   Left _ -> []
@@ -201,12 +261,22 @@ readCsvText t = case eDec of
 parseCsvData :: [(Text, Text, Text)] -> Map NgramsTerm NgramsRepoElement
 parseCsvData lst = Map.fromList $ conv <$> lst
   where
-    conv (_status, label, _forms) =
+    conv (status, label, forms) =
         (NgramsTerm label, NgramsRepoElement { _nre_size = 1
-                                             , _nre_list = CandidateTerm
+                                             , _nre_list = case status == "map" of
+                                                             True  -> MapTerm
+                                                             False -> case status == "main" of
+                                                                True  -> CandidateTerm
+                                                                False -> StopTerm
                                              , _nre_root = Nothing
                                              , _nre_parent = Nothing
-                                             , _nre_children = MSet Map.empty })
+                                             , _nre_children = MSet
+                                                             $ Map.fromList
+                                                             $ map (\form -> (NgramsTerm form, ()))
+                                                             $ filter (/= "")
+                                                             $ splitOn "|&|" forms
+                                             }
+         )
 
 csvPost :: FlowCmdM env err m
         => ListId
@@ -219,18 +289,17 @@ csvPost l m  = do
   let lst = readCsvText m
   let p = parseCsvData lst
   --printDebug "[csvPost] lst" lst
-  --printDebug "[csvPost] p" p
+  printDebug "[csvPost] p" p
   _ <- setListNgrams l NgramsTerms p
+  printDebug "ReIndexing List" l
+  corpus_node <- getNode l -- (Proxy :: Proxy HyperdataList)
+  let corpus_id = fromMaybe (panic "") (_node_parent_id corpus_node)
+  _ <- reIndexWith corpus_id l NgramsTerms (Set.fromList [MapTerm, CandidateTerm])
+
   pure True
-------------------------------------------------------------------------
-type CSVPostAPI = Summary "Update List (legacy v3 CSV)"
-        :> "csv"
-        :> "add"
-        :> "form"
-        :> "async"
-        :> AsyncJobs JobLog '[FormUrlEncoded] WithTextFile JobLog
 
-csvPostAsync :: ListId -> GargServer CSVPostAPI
+------------------------------------------------------------------------
+csvPostAsync :: GargServer CSVAPI
 csvPostAsync lId =
   serveJobsAPI $
     JobFunction $ \f@(WithTextFile ft _ n) log' -> do
@@ -240,6 +309,7 @@ csvPostAsync lId =
             liftBase $ log' x
       csvPostAsync' lId f log''
 
+
 csvPostAsync' :: FlowCmdM env err m
              => ListId
              -> WithTextFile
@@ -258,18 +328,4 @@ csvPostAsync' l (WithTextFile _ m _) logStatus = do
               , _scst_remaining = Just 0
               , _scst_events    = Just []
               }
-
 ------------------------------------------------------------------------
-type API =  Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
-       -- :<|> ReqBody '[JSON] NgramsList :> Post '[JSON] Bool
-       :<|> PostAPI
-       :<|> CSVPostAPI
-
-api :: ListId -> GargServer API
-api l = get l :<|> postAsync l :<|> csvPostAsync l
-
-data HTML
-instance Accept HTML where
-  contentType _ = "text" // "html" /: ("charset", "utf-8")
-instance ToJSON a => MimeRender HTML a where
-  mimeRender _ = encode