[FEAT][PHYLO] corpusId to Documents function

bin/gargantext-phylo/Main.hs

@@ -49,6 +49,8 @@ import Gargantext.Core.Viz.Phylo.PhyloMaker  (toPhylo, toPhyloStep)
 import Gargantext.Core.Viz.Phylo.PhyloTools  (printIOMsg, printIOComment, setConfig)
 import Gargantext.Core.Viz.Phylo.PhyloExport (toPhyloExport, dotToFile)
 -- import Gargantext.API.Ngrams.Prelude (toTermList)
+import Gargantext.Core.Viz.Phylo.API (toPhyloDate, toPhyloDate')
+
 
 -- import Debug.Trace (trace)
 
@@ -66,32 +68,6 @@ getFilesFromPath path = do
     then (listDirectory path)
     else return [path]
 
----------------
--- | Dates | --
----------------
-toMonths :: Integer -> Int -> Int -> Date
-toMonths y m d = fromIntegral $ cdMonths
-               $ diffGregorianDurationClip (fromGregorian y m d) (fromGregorian 0000 0 0)
-
-
-toDays :: Integer -> Int -> Int -> Date
-toDays y m d = fromIntegral
-             $ diffDays (fromGregorian y m d) (fromGregorian 0000 0 0)
-
-
-toPhyloDate :: Int -> Int -> Int -> TimeUnit -> Date
-toPhyloDate y m d tu = case tu of
-  Year  _ _ _ -> y
-  Month _ _ _ -> toMonths (Prelude.toInteger y) m d
-  Week  _ _ _ -> div (toDays (Prelude.toInteger y) m d) 7
-  Day   _ _ _ -> toDays (Prelude.toInteger y) m d
-
-
--- Function to use in Database export
-toPhyloDate' :: Int -> Int -> Int -> Text
-toPhyloDate' y m d = pack $ showGregorian $ fromGregorian (Prelude.toInteger y) m d
-
-
 --------------
 -- | Json | --
 --------------

package.yaml

@@ -101,6 +101,7 @@ library:
   - Gargantext.Core.Viz.Graph.Tools.IGraph
   - Gargantext.Core.Viz.Graph.Index
   - Gargantext.Core.Viz.Phylo
+  - Gargantext.Core.Viz.Phylo.API
   - Gargantext.Core.Viz.Phylo.PhyloMaker
   - Gargantext.Core.Viz.Phylo.PhyloTools
   - Gargantext.Core.Viz.Phylo.PhyloExport

src/Gargantext/API/Node/Corpus/Export.hs

@@ -67,7 +67,7 @@ getCorpus cId lId nt' = do
        <$> selectDocNodes cId
 
   repo <- getRepo' [listId]
-  ngs  <- getContextNgrams cId listId nt repo
+  ngs  <- getContextNgrams cId listId MapTerm nt repo
   let  -- uniqId is hash computed already for each document imported in database
     r = Map.intersectionWith
         (\a b -> DocumentExport.Document { _d_document = context2node a
@@ -85,16 +85,17 @@ getCorpus cId lId nt' = do
 getContextNgrams :: HasNodeError err
         => CorpusId
         -> ListId
+        -> ListType
         -> NgramsType
         -> NodeListStory
         -> Cmd err (Map ContextId (Set NgramsTerm))
-getContextNgrams cId lId nt repo = do
+getContextNgrams cId lId listType nt repo = do
 --  lId <- case lId' of
 --    Nothing -> defaultList cId
 --    Just  l -> pure l
 
   lIds <- selectNodesWithUsername NodeList userMaster
-  let ngs = filterListWithRoot MapTerm $ mapTermListRoot [lId] nt repo
+  let ngs = filterListWithRoot listType $ mapTermListRoot [lId] nt repo
   -- TODO HashMap
   r <- getNgramsByContextOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
   pure r

src/Gargantext/Core/Viz/Phylo/API.hs

+{-|
+Module      : Gargantext.Core.Viz.Phylo.API
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+
+module Gargantext.Core.Viz.Phylo.API
+  where
+
+import Data.Map (Map)
+import Data.Maybe (catMaybes)
+import Data.Text (Text, pack)
+import Data.Set (Set)
+import Data.Time.Calendar (fromGregorian, diffGregorianDurationClip, cdMonths, diffDays, showGregorian)
+import Gargantext.API.Ngrams.Tools (getRepo')
+import Gargantext.API.Node.Corpus.Export (getContextNgrams)
+import Gargantext.API.Prelude (GargNoServer)
+import Gargantext.Core.Types (Context)
+import Gargantext.Core.Types.Main (ListType(MapTerm))
+import Gargantext.Core.Viz.Phylo (TimeUnit(..), Date, Document(..))
+import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..))
+import Gargantext.Database.Admin.Types.Node (CorpusId, ContextId)
+import Gargantext.Database.Query.Table.Node (defaultList)
+import Gargantext.Database.Query.Table.NodeContext (selectDocNodes)
+import Gargantext.Database.Schema.Context
+import Gargantext.Database.Schema.Ngrams (NgramsType(..))
+import Gargantext.Prelude
+import Prelude as Prelude
+import Gargantext.API.Ngrams.Types (NgramsTerm(..))
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified Data.List as List
+
+corpusIdtoDocuments :: TimeUnit -> CorpusId -> GargNoServer [Document]
+corpusIdtoDocuments timeUnit corpusId = do
+  docs <- selectDocNodes corpusId
+
+  lId  <- defaultList corpusId
+  repo <- getRepo' [lId]
+
+  ngs_terms    <- getContextNgrams corpusId lId MapTerm NgramsTerms repo
+  ngs_sources  <- getContextNgrams corpusId lId MapTerm Sources repo
+
+  pure $ catMaybes
+       $ List.map (\doc
+                    -> context2phyloDocument timeUnit doc (ngs_terms, ngs_sources)
+                  ) docs
+
+
+context2phyloDocument :: TimeUnit
+                      -> Context HyperdataDocument
+                      -> (Map ContextId (Set NgramsTerm), Map ContextId (Set NgramsTerm))
+                      -> Maybe Document
+context2phyloDocument timeUnit context (ngs_terms, ngs_sources) = do
+  let contextId = _context_id context
+  (date, date') <- context2date context timeUnit
+  text          <- Map.lookup contextId ngs_terms
+  sources       <- Map.lookup contextId ngs_sources
+  pure $ Document date date'
+                  (toText text)
+                   Nothing
+                  (toText sources)
+    where
+      toText x = Set.toList $ Set.map unNgramsTerm x
+
+
+context2date :: Context HyperdataDocument -> TimeUnit -> Maybe (Date, Text)
+context2date context timeUnit = do
+  let hyperdata =  _context_hyperdata context
+  year  <- _hd_publication_year  hyperdata
+  month <- _hd_publication_month hyperdata
+  day   <- _hd_publication_day   hyperdata
+  pure (toPhyloDate year month day timeUnit, toPhyloDate' year month day)
+
+
+---------------
+-- | Dates | --
+---------------
+toMonths :: Integer -> Int -> Int -> Date
+toMonths y m d = fromIntegral $ cdMonths
+               $ diffGregorianDurationClip (fromGregorian y    m d)
+                                           (fromGregorian 0000 0 0)
+
+
+toDays :: Integer -> Int -> Int -> Date
+toDays y m d = fromIntegral
+             $ diffDays (fromGregorian y m d) (fromGregorian 0000 0 0)
+
+
+toPhyloDate :: Int -> Int -> Int -> TimeUnit -> Date
+toPhyloDate y m d tu = case tu of
+  Year  _ _ _ -> y
+  Month _ _ _ -> toMonths (Prelude.toInteger y) m d
+  Week  _ _ _ -> div (toDays (Prelude.toInteger y) m d) 7
+  Day   _ _ _ -> toDays (Prelude.toInteger y) m d
+
+
+-- Function to use in Database export
+toPhyloDate' :: Int -> Int -> Int -> Text
+toPhyloDate' y m d = pack
+                   $ showGregorian
+                   $ fromGregorian (Prelude.toInteger y) m d

src/Gargantext/Database/Action/Metrics/NgramsByContext.hs

@@ -60,7 +60,6 @@ countContextsByNgramsWith f m = (total, m')
                            $ HM.toList m''
 
 ------------------------------------------------------------------------
-
 getContextsByNgramsUser ::  HasDBid NodeType
                         => CorpusId
                         -> NgramsType
@@ -191,7 +190,6 @@ queryNgramsOccurrencesOnlyByContextUser_withSample = [sql|
 
 
 ------------------------------------------------------------------------
-
 getContextsByNgramsOnlyUser :: HasDBid NodeType
                          => CorpusId
                          -> [ListId]
@@ -221,7 +219,6 @@ getNgramsByContextOnlyUser cId ls nt ngs =
            (splitEvery 1000 ngs)
 
 ------------------------------------------------------------------------
--- used in G.Core.Text.List
 selectNgramsOnlyByContextUser :: HasDBid NodeType
                            => CorpusId
                            -> [ListId]