-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
module Gargantext.API.Ngrams.Tools
where
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
-
type RootTerm = Text
+getRepo :: RepoCmdM env err m => m NgramsRepo
+getRepo = do
+ v <- view repoVar
+ liftBase $ readMVar v
-getListNgrams :: RepoCmdM env err m
- => [ListId] -> NgramsType
- -> m (Map Text NgramsRepoElement)
-getListNgrams nodeIds ngramsType = do
- v <- view repoVar
- repo <- liftIO $ readMVar v
-
- let
+listNgramsFromRepo :: [ListId] -> NgramsType
+ -> NgramsRepo -> Map Text NgramsRepoElement
+listNgramsFromRepo nodeIds ngramsType repo = ngrams
+ where
ngramsMap = repo ^. r_state . at ngramsType . _Just
ngrams = Map.unionsWith mergeNgramsElement
[ 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, _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
getCoocByNgrams' :: (Ord a, Ord c) => (b -> Set c) -> Diagonal -> Map a b -> Map (a, a) Int
getCoocByNgrams' f (Diagonal diag) m =
- Map.fromList [((t1,t2)
- ,maybe 0 Set.size $ Set.intersection
- <$> (fmap f $ Map.lookup t1 m)
- <*> (fmap f $ Map.lookup t2 m)
+ Map.fromList [( (t1,t2)
+ , maybe 0 Set.size $ Set.intersection
+ <$> (fmap f $ Map.lookup t1 m)
+ <*> (fmap f $ Map.lookup t2 m)
) | (t1,t2) <- case diag of
True -> [ (x,y) | x <- Map.keys m, y <- Map.keys m, x <= y]
False -> listToCombi identity (Map.keys m)
]
-
-