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.Hashable (Hashable)
  20 import Data.Validity
  21 import Gargantext.API.Ngrams.Types
  22 import Gargantext.Core.Types (ListType)
  23 import Gargantext.Database.Schema.Ngrams (NgramsType)
  24 import Gargantext.Prelude
  25 import Gargantext.Core.Text.List.Social.Prelude
  26 import Gargantext.Core.Text.Context (TermList)
  27 import qualified Data.HashMap.Strict as HM
  28 import qualified Data.Map.Strict as Map
  29 import qualified Data.List as List
  30 import qualified Data.Text as Text
  31
  32 ------------------------------------------------------------------------
  33 -- | Tools
  34 -- Usage example: toTermList MapTerm NgramsTerms ngramsList
  35 toTermList :: ListType -> NgramsType -> NgramsList -> Maybe TermList
  36 toTermList lt nt nl = toTermList' lt <$> Map.lookup nt nl
  37   where
  38     toTermList' :: ListType -> Versioned NgramsTableMap -> TermList
  39     toTermList' lt' = (toTermList'' lt') . Map.toList . view v_data
  40
  41     toTermList'' :: ListType -> [(NgramsTerm, NgramsRepoElement)] -> TermList
  42     toTermList'' lt'' ns = Map.toList
  43                        $ Map.mapKeys toTerm
  44                        $ Map.fromListWith (<>) (roots' <> children')
  45       where
  46         toTerm = Text.splitOn " " . unNgramsTerm
  47
  48         (roots, children) = List.partition (\(_t, nre) -> view nre_root nre == Nothing)
  49                           $ List.filter (\(_t,nre) -> view nre_list nre == lt'') ns
  50
  51         roots'    = map (\(t,nre) -> (t, map toTerm $ unMSet $ view nre_children nre )) roots
  52
  53         children' = catMaybes
  54                   $ map (\(t,nre) -> (,) <$> view nre_root nre
  55                                          <*> Just (map toTerm $ [t]
  56                                                              <> (unMSet $ view nre_children nre)
  57                                                   )
  58                         ) children
  59
  60 ------------------------------------------
  61 patchMSet_toList :: (Ord a, Hashable a) => PatchMSet a -> [(a,AddRem)]
  62 patchMSet_toList = HM.toList . unPatchMapToHashMap . unPatchMSet
  63
  64 unMSet :: MSet a -> [a]
  65 unMSet (MSet a) = Map.keys a