src/Gargantext/API/Ngrams/Prelude.hs

   1 {-|
   2 Module      : Gargantext.API.Ngrams.Prelude
   3 Description : Tools to manage Ngrams Elements (from the API)
   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 {-# LANGUAGE TypeFamilies #-}
  13
  14 module Gargantext.API.Ngrams.Prelude
  15   where
  16
  17 import Data.Maybe (catMaybes)
  18 import Control.Lens (view)
  19 import Data.Map (fromList)
  20 import Data.Hashable (Hashable)
  21 import Data.Validity
  22 import Gargantext.API.Ngrams.Types
  23 import Gargantext.Core.Types (ListType)
  24 import Gargantext.Database.Schema.Ngrams (NgramsType, ngramsTypes)
  25 import Gargantext.Prelude
  26 import Gargantext.Core.Text.List.Social.Prelude
  27 import Gargantext.API.Ngrams (getNgramsTableMap)
  28 import Gargantext.Core.Text.Context (TermList)
  29 import Gargantext.Core.NodeStory (HasNodeStory)
  30 import Gargantext.Database.Admin.Types.Node (ListId)
  31 import qualified Data.HashMap.Strict as HM
  32 import qualified Data.Map.Strict as Map
  33 import qualified Data.List as List
  34 import qualified Data.Text as Text
  35
  36
  37 ------------------------------------------------------------------------
  38 getNgramsList :: HasNodeStory env err m
  39     => ListId -> m NgramsList
  40 getNgramsList lId = fromList
  41        <$> zip ngramsTypes
  42        <$> mapM (getNgramsTableMap lId) ngramsTypes
  43
  44 getTermList :: HasNodeStory env err m
  45             => ListId -> ListType -> NgramsType -> m (Maybe TermList)
  46 getTermList lId listType ngramsType = do
  47   ngramsList <- getNgramsList lId
  48   pure $ toTermList listType ngramsType ngramsList
  49
  50
  51 ------------------------------------------------------------------------
  52 -- | Tools
  53 -- Usage example: toTermList MapTerm NgramsTerms ngramsList
  54 toTermList :: ListType -> NgramsType -> NgramsList -> Maybe TermList
  55 toTermList lt nt nl = toTermList' lt <$> Map.lookup nt nl
  56   where
  57     toTermList' :: ListType -> Versioned NgramsTableMap -> TermList
  58     toTermList' lt' = (toTermList'' lt') . Map.toList . view v_data
  59
  60     toTermList'' :: ListType -> [(NgramsTerm, NgramsRepoElement)] -> TermList
  61     toTermList'' lt'' ns = Map.toList
  62                        $ Map.mapKeys toTerm
  63                        $ Map.fromListWith (<>) (roots' <> children')
  64       where
  65         toTerm = Text.splitOn " " . unNgramsTerm
  66
  67         (roots, children) = List.partition (\(_t, nre) -> view nre_root nre == Nothing)
  68                           $ List.filter (\(_t,nre) -> view nre_list nre == lt'') ns
  69
  70         roots'    = map (\(t,nre) -> (t, map toTerm $ unMSet $ view nre_children nre )) roots
  71
  72         children' = catMaybes
  73                   $ map (\(t,nre) -> (,) <$> view nre_root nre
  74                                          <*> Just (map toTerm $ [t]
  75                                                              <> (unMSet $ view nre_children nre)
  76                                                   )
  77                         ) children
  78
  79 ------------------------------------------
  80 patchMSet_toList :: (Ord a, Hashable a) => PatchMSet a -> [(a,AddRem)]
  81 patchMSet_toList = HM.toList . unPatchMapToHashMap . unPatchMSet
  82
  83 unMSet :: MSet a -> [a]
  84 unMSet (MSet a) = Map.keys a