src/Gargantext/Database/Flow/List.hs

   1 {-|
   2 Module      : Gargantext.Database.Flow.List
   3 Description : List Flow
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12 {-# OPTIONS_GHC -fno-warn-orphans    #-}
  13
  14 {-# LANGUAGE ConstraintKinds         #-}
  15 {-# LANGUAGE RankNTypes              #-}
  16 {-# LANGUAGE ConstrainedClassMethods #-}
  17 {-# LANGUAGE ConstraintKinds         #-}
  18 {-# LANGUAGE DeriveGeneric           #-}
  19 {-# LANGUAGE FlexibleContexts        #-}
  20 {-# LANGUAGE InstanceSigs            #-}
  21 {-# LANGUAGE NoImplicitPrelude       #-}
  22 {-# LANGUAGE OverloadedStrings       #-}
  23
  24 module Gargantext.Database.Flow.List
  25     where
  26 import Control.Monad (mapM_)
  27 import Data.Map (Map, toList)
  28 import Data.Maybe (Maybe(..))
  29 import Gargantext.API.Ngrams (NgramsElement(..), putListNgrams)
  30 import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsIndexed(..), indexNgrams,  NgramsType(..), text2ngrams, ngramsTypeId)
  31 import Gargantext.Database.Schema.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb)
  32 import Gargantext.Database.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
  33 import Gargantext.Database.Flow.Types
  34 import Gargantext.Prelude
  35 import qualified Data.List as List
  36 import qualified Data.Map  as Map
  37
  38
  39 -- FLOW LIST
  40 -- | TODO check optimization
  41 mapNodeIdNgrams :: [DocumentIdWithNgrams a]
  42                 -> Map Ngrams (Map NgramsType (Map NodeId Int))
  43 mapNodeIdNgrams = Map.unionsWith (Map.unionWith (Map.unionWith (+))) . fmap f
  44   where
  45     f :: DocumentIdWithNgrams a
  46       -> Map Ngrams (Map NgramsType (Map NodeId Int))
  47     f d = fmap (fmap (Map.singleton nId)) $ document_ngrams d
  48       where
  49         nId = documentId $ documentWithId d
  50
  51 ------------------------------------------------------------------------
  52 listInsert :: FlowCmdM env err m
  53              => ListId
  54              -> Map NgramsType [NgramsElement]
  55              -> m ()
  56 listInsert lId ngs = mapM_ (\(typeList, ngElmts)
  57                              -> putListNgrams lId typeList ngElmts
  58                              ) $ toList ngs
  59
  60 toNodeNgramsW :: ListId
  61               -> [(NgramsType, [NgramsElement])]
  62               -> [NodeNgramsW]
  63 toNodeNgramsW l ngs = List.concat $ map (toNodeNgramsW' l) ngs
  64   where
  65     toNodeNgramsW' :: ListId
  66                   -> (NgramsType, [NgramsElement])
  67                   -> [NodeNgramsW]
  68     toNodeNgramsW' l' (ngrams_type, elms) =
  69       [ NodeNgrams Nothing l' list_type ngrams_terms' ngrams_type Nothing Nothing Nothing 0 |
  70        (NgramsElement ngrams_terms' _size list_type _occ _root _parent _children) <- elms
  71       ]
  72
  73 flowList :: FlowCmdM env err m
  74          => ListId
  75          -> Map NgramsType [NgramsElement]
  76          -> m ListId
  77 flowList lId ngs = do
  78   -- printDebug "listId flowList" lId
  79   -- TODO save in database
  80   _r <- listInsertDb lId toNodeNgramsW (Map.toList ngs)
  81   -- printDebug "result " r
  82   listInsert lId ngs
  83   --trace (show $ List.filter (\n -> _ne_ngrams n == "versatile") $ List.concat $ Map.elems ngs) $ listInsert lId ngs
  84   pure lId
  85