-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
module Gargantext.API.Ngrams.Tools
where
import Control.Lens (_Just, (^.), at, view)
import Control.Monad.Reader
import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
import Data.Set (Set)
import Data.Text (Text)
import Data.Validity
-import Gargantext.API.Ngrams
+
+import Gargantext.API.Ngrams.Types
import Gargantext.Core.Types (ListType(..), NodeId, ListId)
import Gargantext.Database.Schema.Ngrams (NgramsType)
import Gargantext.Prelude
-import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
+mergeNgramsElement :: NgramsRepoElement -> NgramsRepoElement -> NgramsRepoElement
+mergeNgramsElement _neOld neNew = neNew
type RootTerm = Text
--- TODO-ACCESS: We want to do the security check before entering here.
--- Add a static capability parameter would be nice.
--- Ideally this is the access to `repoVar` which needs to
--- be properly guarded.
-getListNgrams :: RepoCmdM env err m
- => [ListId] -> NgramsType
- -> m (Map Text NgramsRepoElement)
-getListNgrams nodeIds ngramsType = do
- v <- view repoVar
- repo <- liftIO $ readMVar v
+getRepo :: RepoCmdM env err m => m NgramsRepo
+getRepo = do
+ v <- view repoVar
+ liftBase $ readMVar v
- let
+listNgramsFromRepo :: [ListId] -> NgramsType
+ -> NgramsRepo -> Map Text NgramsRepoElement
+listNgramsFromRepo nodeIds ngramsType repo = Map.mapKeys unNgramsTerm ngrams
+ where
ngramsMap = repo ^. r_state . at ngramsType . _Just
ngrams = Map.unionsWith mergeNgramsElement
- [ ngramsMap ^. at nodeId . _Just | nodeId <- nodeIds ]
+ [ ngramsMap ^. at nodeId . _Just | nodeId <- nodeIds ]
+
+
- pure ngrams
+-- TODO-ACCESS: We want to do the security check before entering here.
+-- Add a static capability parameter would be nice.
+-- Ideally this is the access to `repoVar` which needs to
+-- be properly guarded.
+getListNgrams :: RepoCmdM env err m
+ => [ListId] -> NgramsType
+ -> m (Map Text NgramsRepoElement)
+getListNgrams nodeIds ngramsType = listNgramsFromRepo nodeIds ngramsType <$> getRepo
getTermsWith :: (RepoCmdM env err m, Ord a)
=> (Text -> a ) -> [ListId]
<$> Map.toList
<$> Map.filter (\f' -> (fst f') == lt)
<$> mapTermListRoot ls ngt
+ <$> getRepo
where
toTreeWith f'' (t, (_lt, maybeRoot)) = case maybeRoot of
Nothing -> (f'' t, [])
Just r -> (f'' r, map f'' [t])
-mapTermListRoot :: RepoCmdM env err m
- => [ListId] -> NgramsType
- -> m (Map Text (ListType, (Maybe Text)))
-mapTermListRoot nodeIds ngramsType = do
- ngrams <- getListNgrams nodeIds ngramsType
- pure $ Map.fromList [ (t, (_nre_list nre, _nre_root nre))
- | (t, nre) <- Map.toList ngrams
- ]
-
-filterListWithRoot :: ListType -> Map Text (ListType, Maybe Text)
- -> Map Text (Maybe RootTerm)
+mapTermListRoot :: [ListId]
+ -> NgramsType
+ -> NgramsRepo
+ -> Map Text (ListType, (Maybe Text))
+mapTermListRoot nodeIds ngramsType repo =
+ Map.fromList [ (t, (_nre_list nre, unNgramsTerm <$> _nre_root nre))
+ | (t, nre) <- Map.toList ngrams
+ ]
+ where ngrams = listNgramsFromRepo nodeIds ngramsType repo
+
+filterListWithRoot :: ListType
+ -> Map Text (ListType, Maybe Text)
+ -> Map Text (Maybe RootTerm)
filterListWithRoot lt m = Map.fromList
$ map (\(t,(_,r)) -> (t,r))
- $ filter isGraphTerm (Map.toList m)
+ $ filter isMapTerm (Map.toList m)
where
- isGraphTerm (_t,(l, maybeRoot)) = case maybeRoot of
+ isMapTerm (_t,(l, maybeRoot)) = case maybeRoot of
Nothing -> l == lt
Just r -> case Map.lookup r m of
Nothing -> panic $ "Garg.API.Ngrams.Tools: filterWithRoot, unknown key: " <> r