From d545907b0db1707768e237bcdf56de924f92381d Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Thu, 1 Apr 2021 17:13:43 +0200 Subject: [PATCH 01/16] [FEAT] toTermList function --- src/Gargantext/API/Ngrams/List.hs | 20 +++--- src/Gargantext/API/Ngrams/NgramsTree.hs | 3 +- src/Gargantext/API/Ngrams/Prelude.hs | 71 +++++++++++++++++++ src/Gargantext/API/Ngrams/Tools.hs | 2 + src/Gargantext/API/Ngrams/Types.hs | 11 ++- src/Gargantext/Core/Text/List/Social/Patch.hs | 12 ++-- 6 files changed, 96 insertions(+), 23 deletions(-) create mode 100644 src/Gargantext/API/Ngrams/Prelude.hs diff --git a/src/Gargantext/API/Ngrams/List.hs b/src/Gargantext/API/Ngrams/List.hs index ef8167e5..b5c01c38 100644 --- a/src/Gargantext/API/Ngrams/List.hs +++ b/src/Gargantext/API/Ngrams/List.hs @@ -17,29 +17,27 @@ module Gargantext.API.Ngrams.List import Control.Lens hiding (elements) import Data.Aeson -import Data.Map (Map, toList, fromList) +import Data.Map (toList, fromList) import Data.Swagger (ToSchema, declareNamedSchema, genericDeclareNamedSchema) import Data.Text (Text, concat, pack) import GHC.Generics (Generic) -import Network.HTTP.Media ((//), (/:)) -import Servant -import Servant.Job.Async -import Servant.Job.Utils (jsonOptions) -import Web.FormUrlEncoded (FromForm) - import Gargantext.API.Admin.Orchestrator.Types import Gargantext.API.Ngrams (getNgramsTableMap, setListNgrams) -import Gargantext.API.Ngrams.Types (NgramsTableMap, RepoCmdM, Versioned(..)) +import Gargantext.API.Ngrams.Types (RepoCmdM, Versioned(..), NgramsList) import Gargantext.API.Node.Corpus.New.File (FileType(..)) import Gargantext.API.Prelude (GargServer) import Gargantext.Core.Utils.Prefix (unPrefixSwagger) import Gargantext.Database.Action.Flow.Types (FlowCmdM) import Gargantext.Database.Admin.Types.Node -import Gargantext.Database.Schema.Ngrams (NgramsType(..), ngramsTypes) +import Gargantext.Database.Schema.Ngrams (ngramsTypes) import Gargantext.Prelude - +import Network.HTTP.Media ((//), (/:)) +import Servant +import Servant.Job.Async +import Servant.Job.Utils (jsonOptions) +import Web.FormUrlEncoded (FromForm) ------------------------------------------------------------------------ -type NgramsList = (Map NgramsType (Versioned NgramsTableMap)) + ------------------------------------------------------------------------ type API = Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] NgramsList) -- :<|> ReqBody '[JSON] NgramsList :> Post '[JSON] Bool diff --git a/src/Gargantext/API/Ngrams/NgramsTree.hs b/src/Gargantext/API/Ngrams/NgramsTree.hs index 185af4c2..d48132ff 100644 --- a/src/Gargantext/API/Ngrams/NgramsTree.hs +++ b/src/Gargantext/API/Ngrams/NgramsTree.hs @@ -68,7 +68,8 @@ toTree lt vs m = map toNgramsTree $ unfoldForest buildNode roots $ List.nub $ map (\(c, c') -> case _nre_root c' of Nothing -> Just c - _ -> _nre_root c') (HashMap.toList m) + _ -> _nre_root c' + ) (HashMap.toList m) roots = map fst $ filter (\(_,l) -> l == lt) diff --git a/src/Gargantext/API/Ngrams/Prelude.hs b/src/Gargantext/API/Ngrams/Prelude.hs new file mode 100644 index 00000000..9903b110 --- /dev/null +++ b/src/Gargantext/API/Ngrams/Prelude.hs @@ -0,0 +1,71 @@ +{-| +Module : Gargantext.API.Ngrams.Prelude +Description : Tools to manage Ngrams Elements (from the API) +Copyright : (c) CNRS, 2017-Present +License : AGPL + CECILL v3 +Maintainer : team@gargantext.org +Stability : experimental +Portability : POSIX + +-} + +{-# LANGUAGE TypeFamilies #-} + +module Gargantext.API.Ngrams.Prelude + where + +import Data.Maybe (catMaybes) +import Control.Lens (view) +import Data.Hashable (Hashable) +import Data.Validity +import Gargantext.API.Ngrams.Types +import Gargantext.Core.Types (ListType) +import Gargantext.Database.Schema.Ngrams (NgramsType) +import Gargantext.Prelude +import Gargantext.Core.Text.List.Social.Prelude +import Gargantext.Core.Text.Context (TermList) +import qualified Data.HashMap.Strict as HM +import qualified Data.Map.Strict as Map +import qualified Data.List as List +import qualified Data.Text as Text + +------------------------------------------------------------------------ +-- | Tools +-- Usage example: toTermList MapTerm NgramsTerms ngramsList +toTermList :: ListType -> NgramsType -> NgramsList -> Maybe TermList +toTermList lt nt nl = toTermList' lt <$> Map.lookup nt nl + where + toTermList' :: ListType -> Versioned NgramsTableMap -> TermList + toTermList' lt' = (toTermList'' lt') . Map.toList . view v_data + + toTermList'' :: ListType -> [(NgramsTerm, NgramsRepoElement)] -> TermList + toTermList'' lt'' ns = Map.toList + $ Map.mapKeys toTerm + $ Map.fromListWith (<>) (roots' <> children') + where + toTerm = Text.splitOn " " . unNgramsTerm + + (roots, children) = List.partition (\(_t, nre) -> view nre_root nre == Nothing) + $ List.filter (\(_t,nre) -> view nre_list nre == lt'') ns + + roots' = catMaybes + $ map (\(t,nre) -> (,) <$> Just t + <*> Just (map toTerm $ unMSet + $ view nre_children nre + ) + ) roots + + children' = catMaybes + $ map (\(t,nre) -> (,) <$> view nre_root nre + <*> Just (map toTerm $ [t] + <> (unMSet $ view nre_children nre) + ) + ) children + +------------------------------------------ +patchMSet_toList :: (Ord a, Hashable a) => PatchMSet a -> [(a,AddRem)] +patchMSet_toList = HM.toList . unPatchMapToHashMap . unPatchMSet + +unMSet :: MSet a -> [a] +unMSet (MSet a) = Map.keys a + diff --git a/src/Gargantext/API/Ngrams/Tools.hs b/src/Gargantext/API/Ngrams/Tools.hs index 11c48ae4..7a4afe71 100644 --- a/src/Gargantext/API/Ngrams/Tools.hs +++ b/src/Gargantext/API/Ngrams/Tools.hs @@ -142,3 +142,5 @@ getCoocByNgrams' f (Diagonal diag) m = ] where ks = HM.keys m + +------------------------------------------ diff --git a/src/Gargantext/API/Ngrams/Types.hs b/src/Gargantext/API/Ngrams/Types.hs index 3f002c74..adf88ec1 100644 --- a/src/Gargantext/API/Ngrams/Types.hs +++ b/src/Gargantext/API/Ngrams/Types.hs @@ -55,6 +55,9 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixUntagged, unPrefixSwagger import Gargantext.Database.Prelude (fromField', CmdM', HasConnectionPool, HasConfig) import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams +------------------------------------------------------------------------ + + ------------------------------------------------------------------------ --data FacetFormat = Table | Chart data TabType = Docs | Trash | MoreFav | MoreTrash @@ -218,7 +221,7 @@ instance Arbitrary NgramsElement where newtype NgramsTable = NgramsTable [NgramsElement] deriving (Ord, Eq, Generic, ToJSON, FromJSON, Show) -type NgramsList = NgramsTable +-- type NgramsList = NgramsTable makePrisms ''NgramsTable @@ -753,12 +756,10 @@ instance Arbitrary NgramsRepoElement where where NgramsTable ns = mockTable ---{- instance FromHttpApiData (Map TableNgrams.NgramsType (Versioned NgramsTableMap)) where parseUrlPiece x = maybeToEither x (decode $ cs x) - ngramsTypeFromTabType :: TabType -> TableNgrams.NgramsType ngramsTypeFromTabType tabType = let lieu = "Garg.API.Ngrams: " :: Text in @@ -783,3 +784,7 @@ instance FromJSON UpdateTableNgramsCharts where parseJSON = genericParseJSON $ jsonOptions "_utn_" instance ToSchema UpdateTableNgramsCharts where declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_utn_") + +------------------------------------------------------------------------ +type NgramsList = (Map TableNgrams.NgramsType (Versioned NgramsTableMap)) + diff --git a/src/Gargantext/Core/Text/List/Social/Patch.hs b/src/Gargantext/Core/Text/List/Social/Patch.hs index b08e1076..4ba9ed11 100644 --- a/src/Gargantext/Core/Text/List/Social/Patch.hs +++ b/src/Gargantext/Core/Text/List/Social/Patch.hs @@ -18,6 +18,7 @@ import Data.HashMap.Strict (HashMap) import Data.Monoid import Data.Semigroup import Gargantext.API.Ngrams.Types +import Gargantext.API.Ngrams.Prelude (unMSet, patchMSet_toList) import Gargantext.Core.Text.List.Social.Prelude import Gargantext.Core.Types (ListId) import Gargantext.Database.Schema.Ngrams (NgramsType(..)) @@ -28,9 +29,9 @@ import qualified Data.HashMap.Strict as HashMap import qualified Data.Patch.Class as Patch (Replace(..)) addScorePatches :: NgramsType -> [ListId] - -> FlowCont NgramsTerm FlowListScores - -> Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch]) - -> FlowCont NgramsTerm FlowListScores + -> FlowCont NgramsTerm FlowListScores + -> Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch]) + -> FlowCont NgramsTerm FlowListScores addScorePatches nt listes fl repo = foldl' (addScorePatchesList nt repo) fl listes @@ -136,9 +137,4 @@ score field list n m = (Just mempty <> m) %~ (<> Just n) ------------------------------------------------------------------------ -patchMSet_toList :: (Ord a, Hashable a) => PatchMSet a -> [(a,AddRem)] -patchMSet_toList = HashMap.toList . unPatchMapToHashMap . unPatchMSet - -unMSet :: MSet a -> [a] -unMSet (MSet a) = Map.keys a -- 2.47.0 From 3f9eb4e4f274ca7855af21517ee7929856b82e96 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Fri, 2 Apr 2021 16:13:58 +0200 Subject: [PATCH 02/16] [FIX] should not break the server --- src/Gargantext/Core/Viz/Graph/Tools/IGraph.hs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/Gargantext/Core/Viz/Graph/Tools/IGraph.hs b/src/Gargantext/Core/Viz/Graph/Tools/IGraph.hs index c7be172e..21e6c9e1 100644 --- a/src/Gargantext/Core/Viz/Graph/Tools/IGraph.hs +++ b/src/Gargantext/Core/Viz/Graph/Tools/IGraph.hs @@ -24,6 +24,7 @@ import qualified Data.List as List import qualified IGraph as IG import qualified IGraph.Algorithms.Clique as IG import qualified IGraph.Algorithms.Community as IG +import qualified IGraph.Algorithms.Structure as IG import qualified IGraph.Random as IG import qualified Data.Map as Map @@ -61,11 +62,15 @@ spinglass :: Seed -> Map (Int, Int) Double -> IO [ClusterNode] spinglass s g = toClusterNode <$> map catMaybes <$> map (map (\n -> Map.lookup n fromI)) - <$> partitions_spinglass' s g'' + <$> partitions_spinglass' s g''' where - g'' = mkGraphUfromEdges (Map.keys g') + g' = toIndex toI g + g'' = mkGraphUfromEdges (Map.keys g') + g''' = case IG.isConnected g'' of + True -> g'' + False -> panic "[G.C.V.G.T.Igraph: not connected graph]" + (toI, fromI) = createIndices g - g' = toIndex toI g -- | Tools to analyze graphs partitions_spinglass' :: (Serialize v, Serialize e) -- 2.47.0 From e7d12097461c781f9769a11dbc59ced9f399c1fc Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Fri, 2 Apr 2021 16:48:20 +0200 Subject: [PATCH 03/16] [VERSION] +1 to 0.0.2.9.1 --- package.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/package.yaml b/package.yaml index ca961466..70bffe50 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: gargantext -version: '0.0.2.9' +version: '0.0.2.9.1' synopsis: Search, map, share description: Please see README.md category: Data -- 2.47.0 From 704dc05e16ec4dc2b90f44ebbf867305b33aab05 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Tue, 6 Apr 2021 14:33:27 +0200 Subject: [PATCH 04/16] [CLEAN] install scripts --- devops/debian/install | 61 +------------------------------- devops/debian/install-purescript | 4 +-- 2 files changed, 3 insertions(+), 62 deletions(-) diff --git a/devops/debian/install b/devops/debian/install index 0ae92802..f85c5f35 100755 --- a/devops/debian/install +++ b/devops/debian/install @@ -22,7 +22,7 @@ sudo apt install tmux htop ######################################################################## sudo sed -i "s/stretch/buster/g" /etc/apt/sources.list -#sudo apt update +sudo apt update sudo apt dist-upgrade # sudo reboot #recommended ######################################################################## @@ -75,10 +75,6 @@ if [[ ! -d "deps" ]]; then mkdir -v deps cd deps - if [[ ! -d "clustering-louvain-cplusplus" ]]; then - ../devops/debian/install-clustering-louvain - fi - sudo apt install default-jdk if [[ ! -f "coreNLP.tar.bz2" ]]; then wget https://dl.gargantext.org/coreNLP.tar.bz2 @@ -123,58 +119,3 @@ fi # configure the database with script in devops/postgres # edit gargantext.ini - - - ..........,,;;;;,,,oKXNNNNNNNNNXXXXXKK0OOxdl::ccc:::::;;;;,,,'.. - .........';;;;;;,,,,'''''''''dXNMMMMMMMMMMMMMMMMMMMWWWNNNWNNNNNNXXXXKKK0Oxddlcc::::::::;;;,,,'.... - .........',,,;;;;,,,'''''''''''''''''''oXNMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWWWWWNNNNNNNXXXXKKK0Oxddlcccc::;; - .::cccllc:;''''''''''''''''''''.''''''''oXNMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWNNNXXXXKK0O -...';;;;;;;;;,'''''''''''''''''''''''''''''oXNMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWWWWNNNNNNX0 -;;,,'''''''''''''''''''''''''''''''''''''''oXNMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -'''''''''''''''''''''''''''''''''',;:::cclldkOOOOO00000KKKXXNWWMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMNX -'''''''''''''''''''''''''''';:loodkkOO0KKXXkc:;;;;:::::cccloodxkkO0NMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMNX -''''''''''''''''''','''''',,:okKKNMMMMMMMMMk;,'''''''',''''''',;;cd0MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMNX -''''''''''''''''''''''',:lxxk0KNNWMWWWNXKKKkoooolllcc:;,''''''',,:lOMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -''''''''''''''''''',:llx0XWWMMWWWX0kddolcccx0KXXXXKKK0Okxxo:;'''';:OMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -'''''''''''''''''':oOXXNMMMMNXOddl:,'''''''oXNMMMMMMMMMMWWX0l'''';:kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -'''''''''''''''':lONWMMMMNXXkl:,,''''''''''dXNMMMMMMMMMMMMWWx,,'';:kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -,'''''''''''',::xXNMMMMWWOoo:''''''''''''''dXNMMMMWNNNNWWWMMk:;'';cOMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -,'''''''''''':oo0MMMMMMWXd,,,,''''''''''',,dXNMMMMNXXXXNWWMMOc;'';cOMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -'''''''''''''lOOXMMMMMMXkl'''''''''''''''''dXNMMWNKOOOO0KKNMKxoccod0MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -,'''''''''',:kWWWMMMWWWk:,'''''''''''''''''dXNMMXOkxxxxxxx0NNNXKKKXNMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -,''''''''''cxKMMMMMMNKKo'''''''''''''''''''dXNMMXOkxxxxxxx0NWMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -'''''''''''oKNMMMMMMKddc'''''''''''''''''''dXWMMNX0OOOkO00XWMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -,''''''''''dNWMMMMMM0oo:'''''''''''''''''''oXNMMWWX000OKNNWMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -,'''''''',,xWWMMMMMMOcc;'''''''''''''''''''oXNMMMWNNNXXNWWWMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -,''''''',;;kMMMMMMMMk;;,'''''''''''''''''''dXWMMMMMMMMWMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -,''''''',::kMMMMMMMMk;;,'''''''''''''''''''dXNMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -,''''''';::kMMMMMMMMk;;,'''''''''''''''''''dXNMMNKOkkkkkkkkkkkkkkkkkkkkkOOOXMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -,''''''',;;kMMMMMMMMO::;'''''''''''''''''''dXNMMKxo::::;,,,,,,,,,,,;;;;:cll0MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -,''''''',,,kMMMMMMMMOcc;'''''''''''''''''''oXNMMXkocc::;,,,''''''''',,;:loo0MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -,'''''''',,xWWMMMMMM0ll:'''''''''''''''''''oXNMMNX0OOOkkxxc'''''',,cxxkkO00XMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -,''''''''''oKNMMMMMMKkkc'''''''''''''''''''dXWMMMMMMMMMWWWx,,'''',;kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -,''''''''''cdKMMMMMMNXXo'''''''''''''''''''dXWMMMMMMMMMMMMk,,'''',:kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -,'''''''''',;xWWWMMMMWWk:;'''''''''''''''''dXNMMMMMMMMMMMMk,,'''',:kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMNX -,''''''''''''lkkKMMMMMMX0o'''''''''''''''''dXNMMMMMMMMMMMMx,,'''',:kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -,'''''''''''':llOMMMMMMWWx,,,''''''''''''''dXNWWMMMMMMMMMMk,,'''',:kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -,'''''''''''',::xXNMMMMMW0oo:''''''''''''''dXNMMMMMMMMMMMMk,,'''',;kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX -;,,''''''''''''':lONWMMMMWNNOl:''''''''''''oXNMMMMMMMMMMMMx,,'''',:kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMNX -.';,,,,''''''''''':dONNWMMMMWXOddl:,'''''''dXNMMMMMMMMMMMMk,,'''',:kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMNX - .',,,;,''''',,''',:ookKNMMMMWWWXOxddlc:;;xXNWWWWWWWNXXKKd,,'''',:kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMNX - .'',:;''''''''''''''cxKMMMMMMMMMWNN0xollxKXWWWWNXXK0Okkl,''''';:kWWMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMNX - ....';;,''''''''''';cokk0XWMMMMWWWXK0OOkxxxxdddddoolcc;'''',,:lOMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWNK0 - ...,;,,,,'''',,'',,,:odkkO0KXXNNWWWk:;'''',,,;;:ccclodxkkO0XMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWNNNX0kko:;, - .';;;;,'''''''''''',,;:clloodddxxxxxxxkkkOO000KXNWWMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWNNXX0kocc:;'.. - ....';,''''''''''''''''''''''dXNMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWNNXX0koc:;;'. - ..,;;;,''''''''''''''''''dXNMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWWWNXKOOd::;;'. - .cc:,''''''''''''''''''dXWMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMNXXK0dcc. - ...,;;,,,''''''''''''''dXWMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWNNNNKOdcc::,... - ..'',;,''''''''''''oXNMMMMMMMMMMMMMMMMMMMMMMMMMMWNNNXKOOd::::,.. - ..';;,'''''''''oKNMMMMMMMMMMMMMMMMMMMWWNXXKOd::::,... - ..';;,,,''''oXNMMMMMMMMMMMMWWNXKOOdc:;;,.. TODO, too big, what diet for this ascii art ? - .::;;,''''oXNWWMMMMMMMMMMWNK0d::. - ..',,,,,''oKNMMMMWWWNX0OOdc:;,.. - ....';;o0KXXKOdcc:;,... - .ccdOO00xl. - - diff --git a/devops/debian/install-purescript b/devops/debian/install-purescript index 2957e0cb..3a221c67 100755 --- a/devops/debian/install-purescript +++ b/devops/debian/install-purescript @@ -12,5 +12,5 @@ sudo apt install yarn yarn install && yarn install-ps && yarn build # temporary bug (help welcome) -cp src/index.html dist/index.html -cd .. +#cp src/index.html dist/index.html +#cd .. -- 2.47.0 From bb9f137455d8d298a3d65a3a707aa11e4d5dbb3c Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Tue, 6 Apr 2021 15:01:32 +0200 Subject: [PATCH 05/16] [FIX] removing cLouvain c++ lib --- package.yaml | 1 - src/Gargantext/Core/Viz/Graph/Bridgeness.hs | 4 ---- src/Gargantext/Core/Viz/Graph/Tools.hs | 14 ++++++++++---- src/Gargantext/Core/Viz/Phylo/Cluster.hs | 10 +++++----- stack.yaml | 3 --- 5 files changed, 15 insertions(+), 17 deletions(-) diff --git a/package.yaml b/package.yaml index 70bffe50..9a3d0bd8 100644 --- a/package.yaml +++ b/package.yaml @@ -130,7 +130,6 @@ library: - cassava - cereal # (IGraph) - clock - - clustering-louvain - conduit - conduit-extra - containers diff --git a/src/Gargantext/Core/Viz/Graph/Bridgeness.hs b/src/Gargantext/Core/Viz/Graph/Bridgeness.hs index 90b587dc..6d9205b2 100644 --- a/src/Gargantext/Core/Viz/Graph/Bridgeness.hs +++ b/src/Gargantext/Core/Viz/Graph/Bridgeness.hs @@ -18,7 +18,6 @@ TODO use Map LouvainNodeId (Map LouvainNodeId) module Gargantext.Core.Viz.Graph.Bridgeness -- (bridgeness) where -import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..)) import Data.List (concat, sortOn) import Data.Map (Map, fromListWith, lookup, toList, mapWithKey, elems) import Data.Maybe (catMaybes) @@ -37,9 +36,6 @@ type NodeId = Int type CommunityId = Int ---------------------------------------------------------------------- -instance ToComId LouvainNode where - nodeId2comId (LouvainNode i1 i2) = (i1, i2) - instance ToComId ClusterNode where nodeId2comId (ClusterNode i1 i2) = (i1, i2) diff --git a/src/Gargantext/Core/Viz/Graph/Tools.hs b/src/Gargantext/Core/Viz/Graph/Tools.hs index e9fbeb21..926a2c54 100644 --- a/src/Gargantext/Core/Viz/Graph/Tools.hs +++ b/src/Gargantext/Core/Viz/Graph/Tools.hs @@ -15,7 +15,6 @@ module Gargantext.Core.Viz.Graph.Tools where -- import Data.Graph.Clustering.Louvain (hLouvain, {-iLouvainMap-}) -import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain) import Data.HashMap.Strict (HashMap) import Data.Map (Map) import Data.Text (Text) @@ -28,7 +27,7 @@ import Gargantext.Core.Statistics import Gargantext.Core.Viz.Graph import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, Partitions, ToComId(..)) import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index, MatrixShape(..)) -import Gargantext.Core.Viz.Graph.Tools.IGraph (mkGraphUfromEdges, spinglass) +import Gargantext.Core.Viz.Graph.Tools.IGraph (mkGraphUfromEdges, spinglass, ClusterNode) import Gargantext.Prelude import IGraph.Random -- (Gen(..)) import qualified Data.HashMap.Strict as HashMap @@ -39,8 +38,15 @@ import qualified Data.Vector.Storable as Vec import qualified IGraph as Igraph import qualified IGraph.Algorithms.Layout as Layout -type Threshold = Double +------------------------------------------------------------- + +defaultClustering :: Map (Int, Int) Double -> IO [ClusterNode] +defaultClustering = spinglass 1 + +------------------------------------------------------------- + +type Threshold = Double cooc2graph' :: Ord t => Distance -> Double @@ -68,7 +74,7 @@ cooc2graphWith :: PartitionMethod -> Threshold -> HashMap (NgramsTerm, NgramsTerm) Int -> IO Graph -cooc2graphWith Louvain = cooc2graphWith' (cLouvain "1") +cooc2graphWith Louvain = undefined -- TODO use IGraph bindings cooc2graphWith Spinglass = cooc2graphWith' (spinglass 1) diff --git a/src/Gargantext/Core/Viz/Phylo/Cluster.hs b/src/Gargantext/Core/Viz/Phylo/Cluster.hs index 5a2f324f..0e54005b 100644 --- a/src/Gargantext/Core/Viz/Phylo/Cluster.hs +++ b/src/Gargantext/Core/Viz/Phylo/Cluster.hs @@ -15,11 +15,11 @@ Portability : POSIX module Gargantext.Core.Viz.Phylo.Cluster where import Control.Parallel.Strategies -import Data.Graph.Clustering.Louvain.CplusPlus -import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..)) import Data.List (null,concat,sort,intersect,(++), elemIndex, groupBy, nub, union, (\\), (!!)) import Data.Map (Map, fromList, mapKeys) import Gargantext.Prelude +import Gargantext.Core.Viz.Graph.Tools (defaultClustering) +import Gargantext.Core.Viz.Graph.Tools.IGraph (ClusterNode(..)) import Gargantext.Core.Viz.Phylo import Gargantext.Core.Viz.Phylo.Tools import Gargantext.Core.Viz.Phylo.Metrics @@ -48,9 +48,9 @@ relatedComp graphs = foldl' (\mem groups -> louvain :: ([GroupNode],[GroupEdge]) -> IO [[PhyloGroup]] -louvain (nodes,edges) = map (\community -> map (\node -> nodes !! (l_node_id node)) community) - <$> groupBy (\a b -> (l_community_id a) == (l_community_id b)) - <$> (cLouvain "0.0001" $ mapKeys (\(x,y) -> (idx x, idx y)) $ fromList edges) +louvain (nodes,edges) = map (\community -> map (\node -> nodes !! (cl_node_id node)) community) + <$> groupBy (\a b -> (cl_community_id a) == (cl_community_id b)) + <$> (defaultClustering $ mapKeys (\(x,y) -> (idx x, idx y)) $ fromList edges) where -------------------------------------- idx :: PhyloGroup -> Int diff --git a/stack.yaml b/stack.yaml index 73b3e699..faaf0d6e 100644 --- a/stack.yaml +++ b/stack.yaml @@ -6,7 +6,6 @@ packages: #- 'deps/patches-class' #- 'deps/patches-map' #- 'deps/servant-job' -#- 'deps/clustering-louvain' #- 'deps/accelerate' #- 'deps/accelerate-utility' @@ -71,8 +70,6 @@ extra-deps: # Graph libs - git: https://github.com/kaizhang/haskell-igraph.git commit: 34553acc4ebdcae7065311dcefb426e0fd58c5a0 -- git: https://gitlab.iscpif.fr/gargantext/clustering-louvain.git - commit: 7d74f96dfea8e51fbab1793cc0429b2fe741f73d # Accelerate Linear Algebra and specific instances # (UndecidableInstances for newer GHC version) -- 2.47.0 From 7e6de12a92b34640bee5fe9f3788129c0982aecf Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Tue, 6 Apr 2021 15:02:03 +0200 Subject: [PATCH 06/16] [VERSION] +1 to 0.0.2.9.2 --- package.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/package.yaml b/package.yaml index 9a3d0bd8..72917ae1 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: gargantext -version: '0.0.2.9.1' +version: '0.0.2.9.2' synopsis: Search, map, share description: Please see README.md category: Data -- 2.47.0 From 82dfe4ca5087b048544ac1996d81c3b27c93c621 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Tue, 6 Apr 2021 16:37:31 +0200 Subject: [PATCH 07/16] [FIX] install --- devops/debian/install | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/devops/debian/install b/devops/debian/install index f85c5f35..c2915ef0 100755 --- a/devops/debian/install +++ b/devops/debian/install @@ -28,7 +28,7 @@ sudo apt dist-upgrade ######################################################################## #sudo apt update -sudo apt install liblzma-dev libpcre3-dev libblas-dev liblapack-dev pkg-config libgsl-dev libbz2-dev postgresql postgresql-server-dev-11 nginx libigraph0-dev libgfortran-8-dev +sudo apt install liblzma-dev libpcre3-dev libblas-dev liblapack-dev pkg-config libgsl-dev libbz2-dev postgresql postgresql-server-dev-11 nginx libigraph0-dev libgfortran-9-dev sudo apt install git #git config --global user.email "contact@gargantext.org" -- 2.47.0 From 1c220b97b51ab1eb86927fe46f9012552fccf711 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Wed, 7 Apr 2021 09:14:37 +0200 Subject: [PATCH 08/16] [FEAT] adding docker file --- devops/debian/docker | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) create mode 100755 devops/debian/docker diff --git a/devops/debian/docker b/devops/debian/docker new file mode 100755 index 00000000..7d93278b --- /dev/null +++ b/devops/debian/docker @@ -0,0 +1,27 @@ +#!/bin/bash + +sudo apt-get -y remove --purge docker docker-engine docker.io containerd runc + + +sudo apt-get -y install \ + apt-transport-https \ + ca-certificates \ + curl \ + gnupg-agent \ + software-properties-common + +curl -fsSL https://download.docker.com/linux/debian/gpg | sudo apt-key add - +sudo apt-key fingerprint 0EBFCD88 + +sudo add-apt-repository \ + "deb [arch=amd64] https://download.docker.com/linux/debian \ + $(lsb_release -cs) \ + stable" + +sudo apt update + +sudo apt-get -y install docker-ce docker-ce-cli containerd.io +sudo apt -y install docker-compose + +sudo addgroup gargantua docker + -- 2.47.0 From 3224695087f63c0f505b2ab2c0cff4117b6623eb Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Wed, 7 Apr 2021 09:18:46 +0200 Subject: [PATCH 09/16] [TOOLS] some scripts --- .gitignore | 4 ++++ bin/gargantext-hs.gource | 18 ++++++++++++++ bin/gargantext_stop | 3 +++ bin/gargantext_tmux | 6 +++++ bin/psql | 4 ++++ bin/sql | 52 ++++++++++++++++++++++++++++++++++++++++ 6 files changed, 87 insertions(+) create mode 100755 bin/gargantext-hs.gource create mode 100755 bin/gargantext_stop create mode 100755 bin/gargantext_tmux create mode 100755 bin/psql create mode 100644 bin/sql diff --git a/.gitignore b/.gitignore index 0f676cf3..1ad6c95d 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,7 @@ +*back + +*lock + # Cabal *.cabal diff --git a/bin/gargantext-hs.gource b/bin/gargantext-hs.gource new file mode 100755 index 00000000..4c409a3e --- /dev/null +++ b/bin/gargantext-hs.gource @@ -0,0 +1,18 @@ +#!/bin/bash + +DATE="2018-03-08 07:18:18" + +# record my desktop + title + scp-gargantext +# use tutoriel code + +#tmux -d video +xterm -e "tutoriel" + +gource --start-date $DATE ../gargantext-hs & +gource --start-date $DATE gargantext-hs/purescript-gargantext +#tmux -a video + +# Share video ? + + + diff --git a/bin/gargantext_stop b/bin/gargantext_stop new file mode 100755 index 00000000..21870c8f --- /dev/null +++ b/bin/gargantext_stop @@ -0,0 +1,3 @@ +#!/bin/bash + +tmux kill-session -t gargantext diff --git a/bin/gargantext_tmux b/bin/gargantext_tmux new file mode 100755 index 00000000..f7bf457e --- /dev/null +++ b/bin/gargantext_tmux @@ -0,0 +1,6 @@ +#!/bin/bash + +tmux new -d -s gargantext './server' \; \ + split-window -h -d 'cd ./purescript-gargantext ; ./server' \; \ + select-pane -t 1 \; \ + split-window -d 'cd deps/CoreNLP ; ./startServer.sh' \; \ diff --git a/bin/psql b/bin/psql new file mode 100755 index 00000000..b9951235 --- /dev/null +++ b/bin/psql @@ -0,0 +1,4 @@ +#!/bin/bash + +psql postgresql://gargantua:C8kdcUrAQy66U12341@localhost/gargandbV5 + diff --git a/bin/sql b/bin/sql new file mode 100644 index 00000000..f545a8cf --- /dev/null +++ b/bin/sql @@ -0,0 +1,52 @@ + +SELECT +"result1_0_3" as "result1_4", +"result1_1_3" as "result2_4", +"result1_2_3" as "result3_4", +"result1_3_3" as "result4_4", +"result1_4_3" as "result5_4", +"result1_5_3" as "result6_4", +"result1_6_3" as "result7_4", +"result2_1_3" as "result8_4" +FROM (SELECT + * + FROM (SELECT * + FROM + (SELECT + "id0_1" as "result1_0_3", + "typename1_1" as "result1_1_3", + "user_id2_1" as "result1_2_3", + "parent_id3_1" as "result1_3_3", + "name4_1" as "result1_4_3", + "date5_1" as "result1_5_3", + "hyperdata6_1" as "result1_6_3", + * + FROM (SELECT + * + FROM (SELECT + "id" as "id0_1", + "typename" as "typename1_1", + "user_id" as "user_id2_1", + "parent_id" as "parent_id3_1", + "name" as "name4_1", + "date" as "date5_1", + "hyperdata" as "hyperdata6_1" + FROM "nodes" as "T1") as "T1") as "T1") as "T1" + LEFT OUTER JOIN + (SELECT + "node1_id0_2" as "result2_0_3", + "node2_id1_2" as "result2_1_3", + "score2_2" as "result2_2_3", + "category3_2" as "result2_3_3", + * + FROM (SELECT + * + FROM (SELECT + "node1_id" as "node1_id0_2", + "node2_id" as "node2_id1_2", + "score" as "score2_2", + "category" as "category3_2" + FROM "nodes_nodes" as "T1") as "T1") as "T1") as "T2" + ON + ("node1_id0_2") = ("id0_1")) as "T1" + WHERE (("result1_1_3") = (CAST(22 AS integer)))) as "T1" -- 2.47.0 From a3caa26a9232bea1296d5d16fc20a08395e57e0e Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Wed, 7 Apr 2021 14:32:54 +0200 Subject: [PATCH 10/16] [CLEAN/API] removing unused route --- src/Gargantext/API/Routes.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/Gargantext/API/Routes.hs b/src/Gargantext/API/Routes.hs index ffabd2fe..9bb2b083 100644 --- a/src/Gargantext/API/Routes.hs +++ b/src/Gargantext/API/Routes.hs @@ -95,12 +95,10 @@ type GargPrivateAPI' = :> Capture "node_id" NodeId :> NodeAPI HyperdataAny ---{- -- Corpus endpoints :<|> "corpus" :> Summary "Corpus endpoint" :> Capture "corpus_id" CorpusId :> NodeAPI HyperdataCorpus ---} :<|> "corpus" :> Summary "Corpus endpoint" :> Capture "node1_id" NodeId @@ -154,7 +152,7 @@ type GargPrivateAPI' = -- :<|> New.Upload :<|> New.AddWithForm - :<|> New.AddWithFile +-- :<|> New.AddWithFile :<|> New.AddWithQuery -- :<|> "annuaire" :> Annuaire.AddWithForm @@ -233,7 +231,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid)) <$> PathNode <*> treeAPI -- TODO access :<|> addCorpusWithForm (RootId (NodeId uid)) - :<|> addCorpusWithFile (RootId (NodeId uid)) + -- :<|> addCorpusWithFile (RootId (NodeId uid)) :<|> addCorpusWithQuery (RootId (NodeId uid)) -- :<|> addAnnuaireWithForm -- 2.47.0 From adabce2dcb931a3b24378c892429715595fa1eb7 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Mon, 26 Apr 2021 16:11:59 +0200 Subject: [PATCH 11/16] [ADMIN] LTS stack upgrade --- src/Gargantext/API/Ngrams/List.hs | 4 + src/Gargantext/API/Ngrams/Types.hs | 4 + src/Gargantext/API/Node.hs | 2 + src/Gargantext/API/Node/Corpus/Annuaire.hs | 3 + src/Gargantext/API/Node/Corpus/New.hs | 2 + src/Gargantext/API/Node/Corpus/New/File.hs | 1 + src/Gargantext/API/Node/Types.hs | 6 + src/Gargantext/API/Prelude.hs | 1 + src/Gargantext/API/Server.hs | 2 +- src/Gargantext/API/ThrowAll.hs | 2 +- .../Core/Text/Corpus/Parsers/Date.hs | 5 +- src/Gargantext/Core/Viz/Graph/Tools/IGraph.hs | 2 +- src/Gargantext/Database/Query/Join.hs | 413 ++++++++++-------- stack.yaml | 30 +- 14 files changed, 265 insertions(+), 212 deletions(-) diff --git a/src/Gargantext/API/Ngrams/List.hs b/src/Gargantext/API/Ngrams/List.hs index b5c01c38..c9b6a5ad 100644 --- a/src/Gargantext/API/Ngrams/List.hs +++ b/src/Gargantext/API/Ngrams/List.hs @@ -126,6 +126,10 @@ makeLenses ''WithFile instance FromForm WithFile instance FromJSON WithFile where parseJSON = genericParseJSON $ jsonOptions "_wf_" +instance ToJSON WithFile where + toJSON = genericToJSON $ jsonOptions "_wf_" + + instance ToSchema WithFile where declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_") diff --git a/src/Gargantext/API/Ngrams/Types.hs b/src/Gargantext/API/Ngrams/Types.hs index adf88ec1..ded59274 100644 --- a/src/Gargantext/API/Ngrams/Types.hs +++ b/src/Gargantext/API/Ngrams/Types.hs @@ -782,6 +782,10 @@ data UpdateTableNgramsCharts = UpdateTableNgramsCharts makeLenses ''UpdateTableNgramsCharts instance FromJSON UpdateTableNgramsCharts where parseJSON = genericParseJSON $ jsonOptions "_utn_" + +instance ToJSON UpdateTableNgramsCharts where + toJSON = genericToJSON $ jsonOptions "_utn_" + instance ToSchema UpdateTableNgramsCharts where declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_utn_") diff --git a/src/Gargantext/API/Node.hs b/src/Gargantext/API/Node.hs index ec608a20..88cc5328 100644 --- a/src/Gargantext/API/Node.hs +++ b/src/Gargantext/API/Node.hs @@ -192,6 +192,8 @@ nodeAPI :: forall proxy a. ( JSONB a , FromJSON a , ToJSON a + , MimeRender JSON a + , MimeUnrender JSON a ) => proxy a -> UserId -> NodeId diff --git a/src/Gargantext/API/Node/Corpus/Annuaire.hs b/src/Gargantext/API/Node/Corpus/Annuaire.hs index 069cf3f2..daab5248 100644 --- a/src/Gargantext/API/Node/Corpus/Annuaire.hs +++ b/src/Gargantext/API/Node/Corpus/Annuaire.hs @@ -49,6 +49,9 @@ makeLenses ''AnnuaireWithForm instance FromForm AnnuaireWithForm instance FromJSON AnnuaireWithForm where parseJSON = genericParseJSON $ jsonOptions "_wf_" +instance ToJSON AnnuaireWithForm where + toJSON = genericToJSON $ jsonOptions "_wf_" + instance ToSchema AnnuaireWithForm where declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_") diff --git a/src/Gargantext/API/Node/Corpus/New.hs b/src/Gargantext/API/Node/Corpus/New.hs index 13e6fd5d..ca4ac632 100644 --- a/src/Gargantext/API/Node/Corpus/New.hs +++ b/src/Gargantext/API/Node/Corpus/New.hs @@ -155,6 +155,8 @@ data WithQuery = WithQuery makeLenses ''WithQuery instance FromJSON WithQuery where parseJSON = genericParseJSON $ jsonOptions "_wq_" +instance ToJSON WithQuery where + toJSON = genericToJSON $ jsonOptions "_wq_" instance ToSchema WithQuery where declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wq_") diff --git a/src/Gargantext/API/Node/Corpus/New/File.hs b/src/Gargantext/API/Node/Corpus/New/File.hs index a1649177..f9e092f8 100644 --- a/src/Gargantext/API/Node/Corpus/New/File.hs +++ b/src/Gargantext/API/Node/Corpus/New/File.hs @@ -54,6 +54,7 @@ instance Arbitrary FileType instance ToParamSchema FileType instance FromJSON FileType +instance ToJSON FileType instance ToParamSchema (MultipartData Mem) where toParamSchema _ = toParamSchema (Proxy :: Proxy TODO) diff --git a/src/Gargantext/API/Node/Types.hs b/src/Gargantext/API/Node/Types.hs index fd815488..9ec55268 100644 --- a/src/Gargantext/API/Node/Types.hs +++ b/src/Gargantext/API/Node/Types.hs @@ -33,6 +33,8 @@ makeLenses ''NewWithForm instance FromForm NewWithForm instance FromJSON NewWithForm where parseJSON = genericParseJSON $ jsonOptions "_wf_" +instance ToJSON NewWithForm where + toJSON = genericToJSON $ jsonOptions "_wf_" instance ToSchema NewWithForm where declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_") @@ -48,6 +50,10 @@ makeLenses ''NewWithFile instance FromForm NewWithFile instance FromJSON NewWithFile where parseJSON = genericParseJSON $ jsonOptions "_wfi_" +instance ToJSON NewWithFile where + toJSON = genericToJSON $ jsonOptions "_wfi_" + + instance ToSchema NewWithFile where declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wfi_") diff --git a/src/Gargantext/API/Prelude.hs b/src/Gargantext/API/Prelude.hs index 722ddef4..cc1e0fff 100644 --- a/src/Gargantext/API/Prelude.hs +++ b/src/Gargantext/API/Prelude.hs @@ -71,6 +71,7 @@ type GargServerC env err m = ( CmdRandom env err m , EnvC env , ErrC err + , MimeRender JSON err ) type GargServerT env err m api = GargServerC env err m => ServerT api m diff --git a/src/Gargantext/API/Server.hs b/src/Gargantext/API/Server.hs index 30882a12..7f363834 100644 --- a/src/Gargantext/API/Server.hs +++ b/src/Gargantext/API/Server.hs @@ -37,7 +37,7 @@ import Gargantext.Prelude.Config (gc_url_backend_api) import Gargantext.Database.Prelude (hasConfig) -serverGargAPI :: Text -> GargServerM env err GargAPI +serverGargAPI :: MimeRender JSON err => Text -> GargServerM env err GargAPI serverGargAPI baseUrl -- orchestrator = auth :<|> gargVersion diff --git a/src/Gargantext/API/ThrowAll.hs b/src/Gargantext/API/ThrowAll.hs index fb26fb37..90017568 100644 --- a/src/Gargantext/API/ThrowAll.hs +++ b/src/Gargantext/API/ThrowAll.hs @@ -44,7 +44,7 @@ instance {-# OVERLAPPING #-} ThrowAll' e b => ThrowAll' e (a -> b) where instance {-# OVERLAPPABLE #-} (MonadError e m) => ThrowAll' e (m a) where throwAll' = throwError -serverPrivateGargAPI :: GargServerM env err GargPrivateAPI +serverPrivateGargAPI :: MimeRender JSON err => GargServerM env err GargPrivateAPI serverPrivateGargAPI (Authenticated auser) = serverPrivateGargAPI' auser serverPrivateGargAPI _ = throwAll' (_ServerError # err401) -- Here throwAll' requires a concrete type for the monad. diff --git a/src/Gargantext/Core/Text/Corpus/Parsers/Date.hs b/src/Gargantext/Core/Text/Corpus/Parsers/Date.hs index f29f9007..3164b0b2 100644 --- a/src/Gargantext/Core/Text/Corpus/Parsers/Date.hs +++ b/src/Gargantext/Core/Text/Corpus/Parsers/Date.hs @@ -26,7 +26,8 @@ import Data.Time.Clock (UTCTime(..), getCurrentTime) import Data.Time.LocalTime (utc) import Data.Time.LocalTime.TimeZone.Series (zonedTimeToZoneSeriesTime) import Duckling.Api (analyze) -import Duckling.Core (makeLocale, Some(This), Dimension(Time)) +import Duckling.Core (makeLocale, Dimension(Time)) +import Duckling.Types (Seal(..)) import Duckling.Resolve (fromUTC, Context(Context, referenceTime, locale), DucklingTime(DucklingTime), Options(..)) import Duckling.Types (ResolvedToken(..), ResolvedVal(..)) import Gargantext.Core (Lang(FR,EN)) @@ -128,7 +129,7 @@ parseDateWithDuckling lang input options = do contxt <- localContext lang <$> utcToDucklingTime <$> getCurrentTime --pure $ parseAndResolve (rulesFor (locale ctx) (HashSet.fromList [(This Time)])) input ctx -- TODO check/test Options False or True - pure $ analyze input contxt options $ HashSet.fromList [(This Time)] + pure $ analyze input contxt options $ HashSet.fromList [(Seal Time)] diff --git a/src/Gargantext/Core/Viz/Graph/Tools/IGraph.hs b/src/Gargantext/Core/Viz/Graph/Tools/IGraph.hs index 21e6c9e1..a6f13f5b 100644 --- a/src/Gargantext/Core/Viz/Graph/Tools/IGraph.hs +++ b/src/Gargantext/Core/Viz/Graph/Tools/IGraph.hs @@ -77,7 +77,7 @@ partitions_spinglass' :: (Serialize v, Serialize e) => Seed -> IG.Graph 'U v e -> IO [[Int]] partitions_spinglass' s g = do gen <- IG.withSeed s pure - pure $ IG.findCommunity g Nothing Nothing IG.spinglass gen + IG.findCommunity g Nothing Nothing IG.spinglass gen data ClusterNode = ClusterNode { cl_node_id :: Int diff --git a/src/Gargantext/Database/Query/Join.hs b/src/Gargantext/Database/Query/Join.hs index c97ec1c0..31f7891c 100644 --- a/src/Gargantext/Database/Query/Join.hs +++ b/src/Gargantext/Database/Query/Join.hs @@ -58,42 +58,40 @@ _leftJoin3 :: Query columnsA -> Query columnsB -> Query columnsC _leftJoin3 q1 q2 q3 cond = ((,,) <$> q1 <*> q2 <*> q3) >>> keepWhen cond -leftJoin3 - :: (Default Unpackspec fieldsL1 fieldsL1, - Default Unpackspec fieldsL2 fieldsL2, - Default Unpackspec nullableFieldsR1 nullableFieldsR1, - Default Unpackspec fieldsR fieldsR, - Default NullMaker fieldsR nullableFieldsR1, - Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR2) => - Opaleye.Select fieldsR - -> Opaleye.Select fieldsL2 - -> Opaleye.Select fieldsL1 - -> ((fieldsL2, fieldsR) -> Column PGBool) - -> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool) - -> Opaleye.Select (fieldsL1, nullableFieldsR2) +leftJoin3 :: ( Default Unpackspec b2 b2 + , Default Unpackspec b3 b3 + , Default Unpackspec fieldsL fieldsL + , Default Unpackspec fieldsR fieldsR + , Default NullMaker b3 b4 + , Default NullMaker b2 b5 + , Default NullMaker fieldsR b2) => + Select fieldsR + -> Select b3 + -> Select fieldsL + -> ((b3, fieldsR) -> Column PGBool) + -> ((fieldsL, (b3, b2)) -> Column PGBool) + -> Select (fieldsL, (b4, b5)) + leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 ( leftJoin q2 q1 cond12) cond23 -leftJoin4 - :: (Default Unpackspec fieldsL1 fieldsL1, - Default Unpackspec fieldsL2 fieldsL2, - Default Unpackspec nullableFieldsR1 nullableFieldsR1, - Default Unpackspec fieldsL3 fieldsL3, - Default Unpackspec nullableFieldsR2 nullableFieldsR2, - Default Unpackspec fieldsR fieldsR, - Default NullMaker fieldsR nullableFieldsR2, - Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR3, - Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1) => - Opaleye.Select fieldsR - -> Opaleye.Select fieldsL3 - -> Opaleye.Select fieldsL2 - -> Opaleye.Select fieldsL1 - -> ((fieldsL3, fieldsR) -> Column PGBool) - -> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool) - -> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool) - -> Opaleye.Select (fieldsL1, nullableFieldsR3) +leftJoin4 :: (Default Unpackspec b2 b2, + Default Unpackspec fieldsL fieldsL, Default Unpackspec b3 b3, + Default Unpackspec b4 b4, Default Unpackspec b5 b5, + Default Unpackspec b6 b6, Default Unpackspec fieldsR fieldsR, + Default NullMaker b2 b7, Default NullMaker b5 b8, + Default NullMaker b6 b9, Default NullMaker b3 b5, + Default NullMaker b4 b6, Default NullMaker fieldsR b4) => + Select fieldsR + -> Select b3 + -> Select b2 + -> Select fieldsL + -> ((b3, fieldsR) -> Column PGBool) + -> ((b2, (b3, b4)) -> Column PGBool) + -> ((fieldsL, (b2, (b5, b6))) -> Column PGBool) + -> Select (fieldsL, (b7, (b8, b9))) leftJoin4 q1 q2 q3 q4 cond12 cond23 cond34 = leftJoin q4 ( leftJoin q3 @@ -103,28 +101,27 @@ leftJoin4 q1 q2 q3 q4 ) cond34 -leftJoin5 :: ( Default Unpackspec fieldsL1 fieldsL1, - Default Unpackspec fieldsL2 fieldsL2, - Default Unpackspec nullableFieldsR1 nullableFieldsR1, - Default Unpackspec fieldsL3 fieldsL3, - Default Unpackspec nullableFieldsR2 nullableFieldsR2, - Default Unpackspec fieldsL4 fieldsL4, - Default Unpackspec nullableFieldsR3 nullableFieldsR3, - Default Unpackspec fieldsR fieldsR, - Default NullMaker fieldsR nullableFieldsR3, - Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR4, - Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1, - Default NullMaker (fieldsL4, nullableFieldsR3) nullableFieldsR2) => - Query fieldsR - -> Query fieldsL4 - -> Query fieldsL3 - -> Query fieldsL2 - -> Query fieldsL1 - -> ((fieldsL4, fieldsR) -> Column PGBool) - -> ((fieldsL3, (fieldsL4, nullableFieldsR3)) -> Column PGBool) - -> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool) - -> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool) - -> Query (fieldsL1, nullableFieldsR4) +leftJoin5 :: (Default Unpackspec b2 b2, Default Unpackspec b3 b3, + Default Unpackspec b4 b4, Default Unpackspec b5 b5, + Default Unpackspec b6 b6, Default Unpackspec b7 b7, + Default Unpackspec fieldsL fieldsL, Default Unpackspec b8 b8, + Default Unpackspec b9 b9, Default Unpackspec b10 b10, + Default Unpackspec fieldsR fieldsR, Default NullMaker b7 b6, + Default NullMaker b6 b11, Default NullMaker b8 b12, + Default NullMaker b3 b13, Default NullMaker b2 b14, + Default NullMaker b9 b3, Default NullMaker b10 b2, + Default NullMaker b5 b9, Default NullMaker b4 b10, + Default NullMaker fieldsR b4) => + Select fieldsR + -> Select b5 + -> Select b7 + -> Select b8 + -> Select fieldsL + -> ((b5, fieldsR) -> Column PGBool) + -> ((b7, (b5, b4)) -> Column PGBool) + -> ((b8, (b7, (b9, b10))) -> Column PGBool) + -> ((fieldsL, (b8, (b6, (b3, b2)))) -> Column PGBool) + -> Select (fieldsL, (b12, (b11, (b13, b14)))) leftJoin5 q1 q2 q3 q4 q5 cond12 cond23 cond34 cond45 = leftJoin q5 ( leftJoin q4 @@ -136,32 +133,34 @@ leftJoin5 q1 q2 q3 q4 q5 ) cond45 -leftJoin6 :: ( Default Unpackspec fieldsL1 fieldsL1, - Default Unpackspec fieldsL2 fieldsL2, - Default Unpackspec nullableFieldsR1 nullableFieldsR1, - Default Unpackspec fieldsL3 fieldsL3, - Default Unpackspec nullableFieldsR2 nullableFieldsR2, - Default Unpackspec fieldsL4 fieldsL4, - Default Unpackspec nullableFieldsR3 nullableFieldsR3, - Default Unpackspec fieldsL5 fieldsL5, - Default Unpackspec nullableFieldsR4 nullableFieldsR4, - Default Unpackspec fieldsR fieldsR, - Default NullMaker fieldsR nullableFieldsR4, - Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR5, - Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1, - Default NullMaker (fieldsL4, nullableFieldsR3) nullableFieldsR2, - Default NullMaker (fieldsL5, nullableFieldsR4) nullableFieldsR3) => - Query fieldsR - -> Query fieldsL5 - -> Query fieldsL4 - -> Query fieldsL3 - -> Query fieldsL2 - -> Query fieldsL1 -> ((fieldsL5, fieldsR) -> Column PGBool) - -> ((fieldsL4, (fieldsL5, nullableFieldsR4)) -> Column PGBool) - -> ((fieldsL3, (fieldsL4, nullableFieldsR3)) -> Column PGBool) - -> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool) - -> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool) - -> Query (fieldsL1, nullableFieldsR5) +leftJoin6 :: (Default Unpackspec b2 b2, Default Unpackspec b3 b3, + Default Unpackspec b4 b4, Default Unpackspec b5 b5, + Default Unpackspec fieldsL fieldsL, Default Unpackspec b6 b6, + Default Unpackspec b7 b7, Default Unpackspec b8 b8, + Default Unpackspec b9 b9, Default Unpackspec b10 b10, + Default Unpackspec b11 b11, Default Unpackspec b12 b12, + Default Unpackspec b13 b13, Default Unpackspec b14 b14, + Default Unpackspec b15 b15, Default Unpackspec fieldsR fieldsR, + Default NullMaker b5 b4, Default NullMaker b4 b16, + Default NullMaker b6 b17, Default NullMaker b2 b18, + Default NullMaker b7 b2, Default NullMaker b3 b7, + Default NullMaker b12 b19, Default NullMaker b13 b20, + Default NullMaker b10 b12, Default NullMaker b11 b13, + Default NullMaker b14 b10, Default NullMaker b15 b11, + Default NullMaker b8 b14, Default NullMaker b9 b15, + Default NullMaker fieldsR b9) => + Select fieldsR + -> Select b8 + -> Select b3 + -> Select b5 + -> Select b6 + -> Select fieldsL + -> ((b8, fieldsR) -> Column PGBool) + -> ((b3, (b8, b9)) -> Column PGBool) + -> ((b5, (b3, (b14, b15))) -> Column PGBool) + -> ((b6, (b5, (b7, (b10, b11)))) -> Column PGBool) + -> ((fieldsL, (b6, (b4, (b2, (b12, b13))))) -> Column PGBool) + -> Select (fieldsL, (b17, (b16, (b18, (b19, b20))))) leftJoin6 q1 q2 q3 q4 q5 q6 cond12 cond23 cond34 cond45 cond56 = leftJoin q6 ( leftJoin q5 @@ -175,39 +174,43 @@ leftJoin6 q1 q2 q3 q4 q5 q6 ) cond56 -leftJoin7 - :: (Default Unpackspec fieldsL1 fieldsL1, - Default Unpackspec fieldsL2 fieldsL2, - Default Unpackspec nullableFieldsR1 nullableFieldsR1, - Default Unpackspec fieldsL3 fieldsL3, - Default Unpackspec nullableFieldsR2 nullableFieldsR2, - Default Unpackspec fieldsL4 fieldsL4, - Default Unpackspec nullableFieldsR3 nullableFieldsR3, - Default Unpackspec fieldsL5 fieldsL5, - Default Unpackspec nullableFieldsR4 nullableFieldsR4, - Default Unpackspec fieldsL6 fieldsL6, - Default Unpackspec nullableFieldsR5 nullableFieldsR5, - Default Unpackspec fieldsR fieldsR, - Default NullMaker fieldsR nullableFieldsR5, - Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR6, - Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1, - Default NullMaker (fieldsL4, nullableFieldsR3) nullableFieldsR2, - Default NullMaker (fieldsL5, nullableFieldsR4) nullableFieldsR3, - Default NullMaker (fieldsL6, nullableFieldsR5) nullableFieldsR4) => - Opaleye.Select fieldsR - -> Opaleye.Select fieldsL6 - -> Opaleye.Select fieldsL5 - -> Opaleye.Select fieldsL4 - -> Opaleye.Select fieldsL3 - -> Opaleye.Select fieldsL2 - -> Opaleye.Select fieldsL1 - -> ((fieldsL6, fieldsR) -> Column PGBool) - -> ((fieldsL5, (fieldsL6, nullableFieldsR5)) -> Column PGBool) - -> ((fieldsL4, (fieldsL5, nullableFieldsR4)) -> Column PGBool) - -> ((fieldsL3, (fieldsL4, nullableFieldsR3)) -> Column PGBool) - -> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool) - -> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool) - -> Opaleye.Select (fieldsL1, nullableFieldsR6) +leftJoin7 :: (Default Unpackspec b2 b2, Default Unpackspec b3 b3, + Default Unpackspec b4 b4, Default Unpackspec b5 b5, + Default Unpackspec b6 b6, Default Unpackspec b7 b7, + Default Unpackspec b8 b8, Default Unpackspec b9 b9, + Default Unpackspec b10 b10, Default Unpackspec b11 b11, + Default Unpackspec b12 b12, Default Unpackspec b13 b13, + Default Unpackspec fieldsL fieldsL, Default Unpackspec b14 b14, + Default Unpackspec b15 b15, Default Unpackspec b16 b16, + Default Unpackspec b17 b17, Default Unpackspec b18 b18, + Default Unpackspec b19 b19, Default Unpackspec b20 b20, + Default Unpackspec b21 b21, Default Unpackspec fieldsR fieldsR, + Default NullMaker b11 b8, Default NullMaker b8 b10, + Default NullMaker b10 b9, Default NullMaker b9 b22, + Default NullMaker b16 b12, Default NullMaker b12 b17, + Default NullMaker b17 b23, Default NullMaker b13 b24, + Default NullMaker b15 b25, Default NullMaker b14 b15, + Default NullMaker b3 b26, Default NullMaker b2 b27, + Default NullMaker b18 b3, Default NullMaker b19 b2, + Default NullMaker b5 b18, Default NullMaker b4 b19, + Default NullMaker b20 b5, Default NullMaker b21 b4, + Default NullMaker b7 b20, Default NullMaker b6 b21, + Default NullMaker fieldsR b6) => + Select fieldsR + -> Select b7 + -> Select b11 + -> Select b16 + -> Select b14 + -> Select b13 + -> Select fieldsL + -> ((b7, fieldsR) -> Column PGBool) + -> ((b11, (b7, b6)) -> Column PGBool) + -> ((b16, (b11, (b20, b21))) -> Column PGBool) + -> ((b14, (b16, (b8, (b5, b4)))) -> Column PGBool) + -> ((b13, (b14, (b12, (b10, (b18, b19))))) -> Column PGBool) + -> ((fieldsL, (b13, (b15, (b17, (b9, (b3, b2)))))) + -> Column PGBool) + -> Select (fieldsL, (b24, (b25, (b23, (b22, (b26, b27)))))) leftJoin7 q1 q2 q3 q4 q5 q6 q7 cond12 cond23 cond34 cond45 cond56 cond67 = leftJoin q7 ( leftJoin q6 @@ -223,44 +226,52 @@ leftJoin7 q1 q2 q3 q4 q5 q6 q7 ) cond67 -leftJoin8 - :: (Default Unpackspec fieldsL1 fieldsL1, - Default Unpackspec fieldsL2 fieldsL2, - Default Unpackspec nullableFieldsR1 nullableFieldsR1, - Default Unpackspec fieldsL3 fieldsL3, - Default Unpackspec nullableFieldsR2 nullableFieldsR2, - Default Unpackspec fieldsL4 fieldsL4, - Default Unpackspec nullableFieldsR3 nullableFieldsR3, - Default Unpackspec fieldsL5 fieldsL5, - Default Unpackspec nullableFieldsR4 nullableFieldsR4, - Default Unpackspec fieldsL6 fieldsL6, - Default Unpackspec nullableFieldsR5 nullableFieldsR5, - Default Unpackspec fieldsL7 fieldsL7, - Default Unpackspec nullableFieldsR6 nullableFieldsR6, - Default Unpackspec fieldsR fieldsR, - Default NullMaker fieldsR nullableFieldsR6, - Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR7, - Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1, - Default NullMaker (fieldsL4, nullableFieldsR3) nullableFieldsR2, - Default NullMaker (fieldsL5, nullableFieldsR4) nullableFieldsR3, - Default NullMaker (fieldsL6, nullableFieldsR5) nullableFieldsR4, - Default NullMaker (fieldsL7, nullableFieldsR6) nullableFieldsR5) => - Opaleye.Select fieldsR - -> Opaleye.Select fieldsL7 - -> Opaleye.Select fieldsL6 - -> Opaleye.Select fieldsL5 - -> Opaleye.Select fieldsL4 - -> Opaleye.Select fieldsL3 - -> Opaleye.Select fieldsL2 - -> Opaleye.Select fieldsL1 - -> ((fieldsL7, fieldsR) -> Column PGBool) - -> ((fieldsL6, (fieldsL7, nullableFieldsR6)) -> Column PGBool) - -> ((fieldsL5, (fieldsL6, nullableFieldsR5)) -> Column PGBool) - -> ((fieldsL4, (fieldsL5, nullableFieldsR4)) -> Column PGBool) - -> ((fieldsL3, (fieldsL4, nullableFieldsR3)) -> Column PGBool) - -> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool) - -> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool) - -> Opaleye.Select (fieldsL1, nullableFieldsR7) +leftJoin8 :: (Default Unpackspec b2 b2, Default Unpackspec b3 b3, + Default Unpackspec b4 b4, Default Unpackspec b5 b5, + Default Unpackspec b6 b6, Default Unpackspec b7 b7, + Default Unpackspec b8 b8, Default Unpackspec b9 b9, + Default Unpackspec b10 b10, Default Unpackspec fieldsL fieldsL, + Default Unpackspec b11 b11, Default Unpackspec b12 b12, + Default Unpackspec b13 b13, Default Unpackspec b14 b14, + Default Unpackspec b15 b15, Default Unpackspec b16 b16, + Default Unpackspec b17 b17, Default Unpackspec b18 b18, + Default Unpackspec b19 b19, Default Unpackspec b20 b20, + Default Unpackspec b21 b21, Default Unpackspec b22 b22, + Default Unpackspec b23 b23, Default Unpackspec b24 b24, + Default Unpackspec b25 b25, Default Unpackspec b26 b26, + Default Unpackspec b27 b27, Default Unpackspec b28 b28, + Default Unpackspec fieldsR fieldsR, Default NullMaker b8 b5, + Default NullMaker b5 b7, Default NullMaker b7 b6, + Default NullMaker b6 b29, Default NullMaker b13 b9, + Default NullMaker b9 b14, Default NullMaker b14 b30, + Default NullMaker b10 b31, Default NullMaker b12 b32, + Default NullMaker b11 b12, Default NullMaker b2 b33, + Default NullMaker b15 b2, Default NullMaker b3 b15, + Default NullMaker b16 b3, Default NullMaker b4 b16, + Default NullMaker b23 b34, Default NullMaker b24 b35, + Default NullMaker b21 b23, Default NullMaker b22 b24, + Default NullMaker b25 b21, Default NullMaker b26 b22, + Default NullMaker b19 b25, Default NullMaker b20 b26, + Default NullMaker b27 b19, Default NullMaker b28 b20, + Default NullMaker b17 b27, Default NullMaker b18 b28, + Default NullMaker fieldsR b18) => + Select fieldsR + -> Select b17 + -> Select b4 + -> Select b8 + -> Select b13 + -> Select b11 + -> Select b10 + -> Select fieldsL + -> ((b17, fieldsR) -> Column PGBool) + -> ((b4, (b17, b18)) -> Column PGBool) + -> ((b8, (b4, (b27, b28))) -> Column PGBool) + -> ((b13, (b8, (b16, (b19, b20)))) -> Column PGBool) + -> ((b11, (b13, (b5, (b3, (b25, b26))))) -> Column PGBool) + -> ((b10, (b11, (b9, (b7, (b15, (b21, b22)))))) -> Column PGBool) + -> ((fieldsL, (b10, (b12, (b14, (b6, (b2, (b23, b24))))))) + -> Column PGBool) + -> Select (fieldsL, (b31, (b32, (b30, (b29, (b33, (b34, b35))))))) leftJoin8 q1 q2 q3 q4 q5 q6 q7 q8 cond12 cond23 cond34 cond45 cond56 cond67 cond78 = leftJoin q8 ( leftJoin q7 @@ -278,49 +289,65 @@ leftJoin8 q1 q2 q3 q4 q5 q6 q7 q8 ) cond78 -leftJoin9 - :: (Default Unpackspec fieldsL1 fieldsL1, - Default Unpackspec fieldsL2 fieldsL2, - Default Unpackspec nullableFieldsR1 nullableFieldsR1, - Default Unpackspec fieldsL3 fieldsL3, - Default Unpackspec nullableFieldsR2 nullableFieldsR2, - Default Unpackspec fieldsL4 fieldsL4, - Default Unpackspec nullableFieldsR3 nullableFieldsR3, - Default Unpackspec fieldsL5 fieldsL5, - Default Unpackspec nullableFieldsR4 nullableFieldsR4, - Default Unpackspec fieldsL6 fieldsL6, - Default Unpackspec nullableFieldsR5 nullableFieldsR5, - Default Unpackspec fieldsL7 fieldsL7, - Default Unpackspec nullableFieldsR6 nullableFieldsR6, - Default Unpackspec fieldsL8 fieldsL8, - Default Unpackspec nullableFieldsR7 nullableFieldsR7, - Default Unpackspec fieldsR fieldsR, - Default NullMaker fieldsR nullableFieldsR7, - Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR8, - Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1, - Default NullMaker (fieldsL4, nullableFieldsR3) nullableFieldsR2, - Default NullMaker (fieldsL5, nullableFieldsR4) nullableFieldsR3, - Default NullMaker (fieldsL6, nullableFieldsR5) nullableFieldsR4, - Default NullMaker (fieldsL7, nullableFieldsR6) nullableFieldsR5, - Default NullMaker (fieldsL8, nullableFieldsR7) nullableFieldsR6) => - Opaleye.Select fieldsR - -> Opaleye.Select fieldsL8 - -> Opaleye.Select fieldsL7 - -> Opaleye.Select fieldsL6 - -> Opaleye.Select fieldsL5 - -> Opaleye.Select fieldsL4 - -> Opaleye.Select fieldsL3 - -> Opaleye.Select fieldsL2 - -> Opaleye.Select fieldsL1 - -> ((fieldsL8, fieldsR) -> Column PGBool) - -> ((fieldsL7, (fieldsL8, nullableFieldsR7)) -> Column PGBool) - -> ((fieldsL6, (fieldsL7, nullableFieldsR6)) -> Column PGBool) - -> ((fieldsL5, (fieldsL6, nullableFieldsR5)) -> Column PGBool) - -> ((fieldsL4, (fieldsL5, nullableFieldsR4)) -> Column PGBool) - -> ((fieldsL3, (fieldsL4, nullableFieldsR3)) -> Column PGBool) - -> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool) - -> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool) - -> Opaleye.Select (fieldsL1, nullableFieldsR8) + +leftJoin9 :: (Default Unpackspec b2 b2, Default Unpackspec b3 b3, + Default Unpackspec b4 b4, Default Unpackspec b5 b5, + Default Unpackspec b6 b6, Default Unpackspec b7 b7, + Default Unpackspec b8 b8, Default Unpackspec b9 b9, + Default Unpackspec b10 b10, Default Unpackspec b11 b11, + Default Unpackspec b12 b12, Default Unpackspec b13 b13, + Default Unpackspec b14 b14, Default Unpackspec b15 b15, + Default Unpackspec b16 b16, Default Unpackspec b17 b17, + Default Unpackspec b18 b18, Default Unpackspec b19 b19, + Default Unpackspec b20 b20, Default Unpackspec b21 b21, + Default Unpackspec fieldsL fieldsL, Default Unpackspec b22 b22, + Default Unpackspec b23 b23, Default Unpackspec b24 b24, + Default Unpackspec b25 b25, Default Unpackspec b26 b26, + Default Unpackspec b27 b27, Default Unpackspec b28 b28, + Default Unpackspec b29 b29, Default Unpackspec b30 b30, + Default Unpackspec b31 b31, Default Unpackspec b32 b32, + Default Unpackspec b33 b33, Default Unpackspec b34 b34, + Default Unpackspec b35 b35, Default Unpackspec b36 b36, + Default Unpackspec fieldsR fieldsR, Default NullMaker b15 b10, + Default NullMaker b10 b14, Default NullMaker b14 b11, + Default NullMaker b11 b13, Default NullMaker b13 b12, + Default NullMaker b12 b37, Default NullMaker b28 b16, + Default NullMaker b16 b29, Default NullMaker b29 b17, + Default NullMaker b17 b30, Default NullMaker b30 b38, + Default NullMaker b21 b20, Default NullMaker b20 b39, + Default NullMaker b22 b40, Default NullMaker b18 b41, + Default NullMaker b23 b18, Default NullMaker b19 b23, + Default NullMaker b26 b42, Default NullMaker b25 b26, + Default NullMaker b27 b25, Default NullMaker b24 b27, + Default NullMaker b3 b43, Default NullMaker b2 b44, + Default NullMaker b31 b3, Default NullMaker b32 b2, + Default NullMaker b5 b31, Default NullMaker b4 b32, + Default NullMaker b33 b5, Default NullMaker b34 b4, + Default NullMaker b7 b33, Default NullMaker b6 b34, + Default NullMaker b35 b7, Default NullMaker b36 b6, + Default NullMaker b9 b35, Default NullMaker b8 b36, + Default NullMaker fieldsR b8) => + Select fieldsR + -> Select b9 + -> Select b15 + -> Select b28 + -> Select b24 + -> Select b19 + -> Select b21 + -> Select b22 + -> Select fieldsL + -> ((b9, fieldsR) -> Column PGBool) + -> ((b15, (b9, b8)) -> Column PGBool) + -> ((b28, (b15, (b35, b36))) -> Column PGBool) + -> ((b24, (b28, (b10, (b7, b6)))) -> Column PGBool) + -> ((b19, (b24, (b16, (b14, (b33, b34))))) -> Column PGBool) + -> ((b21, (b19, (b27, (b29, (b11, (b5, b4)))))) -> Column PGBool) + -> ((b22, (b21, (b23, (b25, (b17, (b13, (b31, b32))))))) + -> Column PGBool) + -> ((fieldsL, (b22, (b20, (b18, (b26, (b30, (b12, (b3, b2)))))))) + -> Column PGBool) + -> Select + (fieldsL, (b40, (b39, (b41, (b42, (b38, (b37, (b43, b44)))))))) leftJoin9 q1 q2 q3 q4 q5 q6 q7 q8 q9 cond12 cond23 cond34 cond45 cond56 cond67 cond78 cond89 = leftJoin q9 ( leftJoin q8 diff --git a/stack.yaml b/stack.yaml index faaf0d6e..61d81a98 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,11 +1,11 @@ -resolver: lts-16.26 +resolver: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/10.yaml flags: {} extra-package-dbs: [] packages: - . #- 'deps/patches-class' #- 'deps/patches-map' -#- 'deps/servant-job' #- 'deps/accelerate' #- 'deps/accelerate-utility' @@ -59,7 +59,7 @@ extra-deps: # NP libs #- git: https://github.com/np/servant-job.git # waiting for PR - git: https://github.com/delanoe/servant-job.git - commit: a9d8ec247b60906ae0ad76ea017cacd6ff36a7a1 + commit: 5b15f6ffbff6bc8e26c46206d6d227213fc1821f #- git: https://github.com/np/patches-map - git: https://github.com/delanoe/patches-map commit: 76cae88f367976ff091e661ee69a5c3126b94694 @@ -68,8 +68,9 @@ extra-deps: commit: d3e971d4e78d1dfcc853f2fb86bde1995faf22ae # Graph libs -- git: https://github.com/kaizhang/haskell-igraph.git - commit: 34553acc4ebdcae7065311dcefb426e0fd58c5a0 +#- git: https://github.com/kaizhang/haskell-igraph.git +- git: https://github.com/delanoe/haskell-igraph.git + commit: 3c9dc79ff4de2ad7060ff3a527a774dff3aa6f4a # Accelerate Linear Algebra and specific instances # (UndecidableInstances for newer GHC version) @@ -79,24 +80,25 @@ extra-deps: commit: 83ada76e78ac10d9559af8ed6bd4064ec81308e4 - accelerate-arithmetic-1.0.0.1@sha256:555639232aa5cad411e89247b27871d09352b987a754230a288c690b6de6d888,2096 - # Others dependencies (with stack resolver) + # Others dependencies (using stack resolver) +- constraints-extras-0.3.1.0@sha256:12016ebb91ad5ed2c82bf7e48c6bd6947d164d33c9dca5ac3965de1bb6c780c0,1777 - KMP-0.2.0.0@sha256:6dfbac03ef00ebd9347234732cb86a40f62ab5a80c0cc6bedb8eb51766f7df28,2562 -- Unique-0.4.7.7@sha256:2269d3528271e25d34542e7c24a4e541e27ec33460e1ea00845da95b82eec6fa,2777 -- dependent-sum-0.4@sha256:40c705604f52374fb72616e10234635104a626ede737ddde899777b719df120b,1907 -- duckling-0.1.6.1@sha256:dab60953f405b45fe93e1e745f8cc83e5166e1788b1f4999cc06382e131153d8,47147 -- fclabels-2.0.4@sha256:efcc20c6c903d0a59e36eb1cb547a7bbbbba93b6e20b84b06e919c350891beb2,4492 +- Unique-0.4.7.8@sha256:9661f45aa31dde119a2114566166ea38b011a45653337045ee4ced75636533c0,2067 +- dependent-sum-0.7.1.0@sha256:0e419237f5b86da3659772afff9cab355c0f8d5b3fdb15a5b30e673d8dc83941,2147 +- duckling-0.2.0.0@sha256:84becd4e48ee3676cdd6fe5745a77ee60e365ea730cd759610c8a7738f3eb4a6,60543 +- fclabels-2.0.5@sha256:817006077632bd29e637956154aa33d3c10a59be0791c308cef955eb951b2675,4473 - full-text-search-0.2.1.4@sha256:81f6df3327e5b604f99b15e78635e5d6ca996e504c21d268a6d751d7d131aa36,6032 - fullstop-0.1.4@sha256:80a3e382ef53551bb936e7da8b2825621df0ea169af1212debcb0a90010b30c8,2044 - hgal-2.0.0.2@sha256:13d58afd0668b9cb881c612eff8488a0e289edd4bbffa893df4beee60cfeb73b,653 - json-stream-0.4.2.4@sha256:8b7f17d54a6e1e6311756270f8bcf51e91bab4300945400de66118470dcf51b9,4716 - located-base-0.1.1.1@sha256:7c6395f2b6fbf2d5f76c3514f774423838c0ea94e1c6a5530dd3c94b30c9d1c8,1904 -- logging-effect-1.3.9@sha256:4fd36d7c19f22569d510907c55d6d49cb5d80fb30767c6b3f85736b98f57d7c0,1678 -- probability-0.2.6@sha256:6d85d961d85fd5d1a35b90fe77510f6fcc6a8f20e8ed503219c38378de9cb3cd,2857 +- logging-effect-1.3.12@sha256:72d168dd09887649ba9501627219b6027cbec2d5541931555b7885b133785ce3,1679 +- monoid-extras-0.5.1@sha256:438dbfd7b4dce47d8f0ca577f56caf94bd1e21391afa545cad09fe7cf2e5793d,2333 - rake-0.0.1@sha256:3380f6567fb17505d1095b7f32222c0b631fa04126ad39726c84262da99c08b3,2025 +- servant-cassava-0.10.1@sha256:07e7b6ca67cf57dcb4a0041a399a25d058844505837c6479e01d62be59d01fdf,1665 - servant-flatten-0.2@sha256:276896f7c5cdec5b8f8493f6205fded0cc602d050b58fdb09a6d7c85c3bb0837,1234 -- servant-multipart-0.11.5@sha256:1633f715b5b53d648a1da69839bdc5046599f4f7244944d4bbf852dba38d8f4b,2319 +- servant-mock-0.8.7@sha256:64cb3e52bbd51ab6cb25e3f412a99ea712c6c26f1efd117f01a8d1664df49c67,2306 - servant-xml-1.0.1.4@sha256:6c9f2986ac42e72fe24b794c660763a1966a18d696b34cd4f4ed15165edd4aa0,851 -- smtp-mail-0.2.0.0@sha256:b91c81f6dbb41a9ceee8c443385118684ecec55006b77f7d3c0e49cffd2468cf,1211 - stemmer-0.5.2@sha256:823aec56249ec2619f60a2c0d1384b732894dbbbe642856d337ebfe9629a0efd,4082 - xmlbf-0.6.1@sha256:57867fcb39e0514d17b3328ff5de8d241a18482fc89bb742d9ed820a6a2a5187,1540 - xmlbf-xeno-0.2@sha256:39f70fced6052524c290cf595f114661c721452e65fc3e0953a44e7682a6a6b0,950 -- 2.47.0 From 4edadaee5deb834dc33816fe1654f794a910f2a3 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Mon, 26 Apr 2021 17:46:28 +0200 Subject: [PATCH 12/16] [BIN] run script --- run | 5 +++++ 1 file changed, 5 insertions(+) create mode 100755 run diff --git a/run b/run new file mode 100755 index 00000000..00928ce6 --- /dev/null +++ b/run @@ -0,0 +1,5 @@ +#!/bin/bash + +figlet "GarganText" + +./bin/gargantext_stop; ./bin/gargantext_tmux && tmux a -t gargantext ; ./bin/gargantext_stop -- 2.47.0 From 17f1d540d198c1da00445431c1b77d26faaa0c68 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Tue, 27 Apr 2021 08:29:40 +0200 Subject: [PATCH 13/16] [UPDATE] docker script --- devops/docker/Dockerfile | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/devops/docker/Dockerfile b/devops/docker/Dockerfile index c880305b..cdb13258 100644 --- a/devops/docker/Dockerfile +++ b/devops/docker/Dockerfile @@ -1,11 +1,6 @@ -from fpco/stack-build:lts-16.26 +from fpco/stack-build:lts-17.10 RUN apt-get update && \ apt-get install -y git libigraph0-dev && \ rm -rf /var/lib/apt/lists/* -RUN mkdir -v /deps && \ - cd /deps && \ - git clone https://gitlab.iscpif.fr/gargantext/clustering-louvain-cplusplus && \ - cd clustering-louvain-cplusplus && \ - ./install -- 2.47.0 From 4a25b912d52796b958391eeb8cf3569b1f3465e5 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Tue, 27 Apr 2021 08:54:21 +0200 Subject: [PATCH 14/16] [TYPE] semantics, renaming --- src/Gargantext/API/Ngrams/Tools.hs | 4 ++-- src/Gargantext/Core/Text/Examples.hs | 4 ++-- src/Gargantext/Core/Text/Metrics.hs | 4 ++-- src/Gargantext/Core/Viz/Graph/Index.hs | 10 +++++----- src/Gargantext/Core/Viz/Graph/Tools.hs | 8 ++++---- 5 files changed, 15 insertions(+), 15 deletions(-) diff --git a/src/Gargantext/API/Ngrams/Tools.hs b/src/Gargantext/API/Ngrams/Tools.hs index 7a4afe71..ef75b7ef 100644 --- a/src/Gargantext/API/Ngrams/Tools.hs +++ b/src/Gargantext/API/Ngrams/Tools.hs @@ -91,7 +91,7 @@ filterListWithRootHashMap lt m = snd <$> HM.filter isMapTerm m isMapTerm (l, maybeRoot) = case maybeRoot of Nothing -> l == lt Just r -> case HM.lookup r m of - Nothing -> panic $ "Garg.API.Ngrams.Tools: filterWithRoot, unknown key: " <> unNgramsTerm r + Nothing -> panic $ "[Garg.API.Ngrams.Tools] filterWithRoot, unknown key: " <> unNgramsTerm r Just (l',_) -> l' == lt filterListWithRoot :: ListType @@ -102,7 +102,7 @@ filterListWithRoot lt m = snd <$> HM.filter isMapTerm m isMapTerm (l, maybeRoot) = case maybeRoot of Nothing -> l == lt Just r -> case HM.lookup r m of - Nothing -> panic $ "Garg.API.Ngrams.Tools: filterWithRoot, unknown key: " <> unNgramsTerm r + Nothing -> panic $ "[Garg.API.Ngrams.Tools] filterWithRoot, unknown key: " <> unNgramsTerm r Just (l',_) -> l' == lt groupNodesByNgrams :: ( At root_map diff --git a/src/Gargantext/Core/Text/Examples.hs b/src/Gargantext/Core/Text/Examples.hs index 27ec21f8..febda920 100644 --- a/src/Gargantext/Core/Text/Examples.hs +++ b/src/Gargantext/Core/Text/Examples.hs @@ -112,7 +112,7 @@ ex_cooc_mat :: IO (Map Label Index, Matrix Int, Matrix Double, (DAA.Vector Gener ex_cooc_mat = do m <- ex_cooc let (ti,_) = createIndices m - let mat_cooc = cooc2mat Triangular ti m + let mat_cooc = cooc2mat Triangle ti m pure ( ti , mat_cooc , incExcSpeGen_proba mat_cooc @@ -123,7 +123,7 @@ ex_incExcSpeGen :: IO ([(Label, Double)], [(Label, Double)]) ex_incExcSpeGen = incExcSpeGen_sorted <$> ex_cooc incExcSpeGen_sorted :: Ord t => Map (t,t) Int -> ([(t,Double)],[(t,Double)]) -incExcSpeGen_sorted m = both ordonne (incExcSpeGen $ cooc2mat Triangular ti m) +incExcSpeGen_sorted m = both ordonne (incExcSpeGen $ cooc2mat Triangle ti m) where (ti,fi) = createIndices m ordonne x = sortWith (Down . snd) diff --git a/src/Gargantext/Core/Text/Metrics.hs b/src/Gargantext/Core/Text/Metrics.hs index 287e75e1..032e9ade 100644 --- a/src/Gargantext/Core/Text/Metrics.hs +++ b/src/Gargantext/Core/Text/Metrics.hs @@ -70,7 +70,7 @@ localMetrics' m = Map.fromList $ zipWith (\(_,t) (inc,spe) -> (t, Vec.fromList [ scores where (ti, fi) = createIndices m - (is, ss) = incExcSpeGen $ cooc2mat Triangular ti m + (is, ss) = incExcSpeGen $ cooc2mat Triangle ti m scores = DAA.toList $ DAA.run $ DAA.zip (DAA.use is) (DAA.use ss) @@ -82,7 +82,7 @@ scored' :: Ord t => Map (t,t) Int -> [Scored t] scored' m = zipWith (\(_,t) (inc,spe) -> Scored t inc spe) (Map.toList fi) scores where (ti, fi) = createIndices m - (is, ss) = incExcSpeGen $ cooc2mat Triangular ti m + (is, ss) = incExcSpeGen $ cooc2mat Triangle ti m scores = DAA.toList $ DAA.run $ DAA.zip (DAA.use is) (DAA.use ss) diff --git a/src/Gargantext/Core/Viz/Graph/Index.hs b/src/Gargantext/Core/Viz/Graph/Index.hs index 26dde256..8b71cce4 100644 --- a/src/Gargantext/Core/Viz/Graph/Index.hs +++ b/src/Gargantext/Core/Viz/Graph/Index.hs @@ -60,17 +60,17 @@ cooc2mat sym ti m = map2mat sym 0 n idx n = M.size ti idx = toIndex ti m -- it is important to make sure that toIndex is ran only once. -data MatrixShape = Triangular | Square +data MatrixShape = Triangle | Square map2mat :: Elt a => MatrixShape -> a -> Int -> Map (Index, Index) a -> Matrix a map2mat sym def n m = A.fromFunction shape getData where getData = (\(Z :. x :. y) -> case sym of - Triangular -> fromMaybe def (M.lookup (x,y) m) - Square -> fromMaybe (fromMaybe def $ M.lookup (y,x) m) - $ M.lookup (x, y) m - ) + Triangle -> fromMaybe def (M.lookup (x,y) m) + Square -> fromMaybe (fromMaybe def $ M.lookup (y,x) m) + $ M.lookup (x, y) m + ) shape = (Z :. n :. n) mat2map :: (Elt a, Shape (Z :. Index)) => diff --git a/src/Gargantext/Core/Viz/Graph/Tools.hs b/src/Gargantext/Core/Viz/Graph/Tools.hs index 8d1151ae..7018eb8c 100644 --- a/src/Gargantext/Core/Viz/Graph/Tools.hs +++ b/src/Gargantext/Core/Viz/Graph/Tools.hs @@ -57,8 +57,8 @@ cooc2graph' distance threshold myCooc $ mat2map $ measure distance $ case distance of - Conditional -> map2mat Triangular 0 tiSize - Distributional -> map2mat Square 0 tiSize + Conditional -> map2mat Triangle 0 tiSize + Distributional -> map2mat Square 0 tiSize $ Map.filter (> 1) myCooc' where @@ -85,7 +85,7 @@ cooc2graph'' distance threshold myCooc = neighbouMap where (ti, _) = createIndices myCooc myCooc' = toIndex ti myCooc - matCooc = map2mat Triangular 0 (Map.size ti) $ Map.filter (> 1) myCooc' + matCooc = map2mat Triangle 0 (Map.size ti) $ Map.filter (> 1) myCooc' distanceMat = measure distance matCooc neighbouMap = filterByNeighbours threshold $ mat2map distanceMat @@ -125,7 +125,7 @@ cooc2graphWith' doPartitions distance threshold myCooc = do tiSize = Map.size ti myCooc' = toIndex ti theMatrix matCooc = case distance of -- Shape of the Matrix - Conditional -> map2mat Triangular 0 tiSize + Conditional -> map2mat Triangle 0 tiSize Distributional -> map2mat Square 0 tiSize $ case distance of -- Removing the Diagonal ? Conditional -> Map.filterWithKey (\(a,b) _ -> a /= b) -- 2.47.0 From e55c38aa270fa14cbbc9dcfd46655a1755a48105 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Tue, 27 Apr 2021 09:27:46 +0200 Subject: [PATCH 15/16] [CLEAN] Prelude.Utils clock measures --- src/Gargantext/API/Ngrams.hs | 66 ++++++++++++---------------- src/Gargantext/API/Ngrams/List.hs | 3 -- src/Gargantext/API/Ngrams/Prelude.hs | 14 ++---- src/Gargantext/API/Ngrams/Types.hs | 38 +++++++--------- src/Gargantext/Prelude/Utils.hs | 14 +++++- 5 files changed, 61 insertions(+), 74 deletions(-) diff --git a/src/Gargantext/API/Ngrams.hs b/src/Gargantext/API/Ngrams.hs index 4ad9762e..25a8ae69 100644 --- a/src/Gargantext/API/Ngrams.hs +++ b/src/Gargantext/API/Ngrams.hs @@ -88,56 +88,51 @@ import Control.Concurrent import Control.Lens ((.~), view, (^.), (^..), (+~), (%~), (.~), sumOf, at, _Just, Each(..), (%%~), mapped, ifolded, withIndex) import Control.Monad.Reader import Data.Aeson hiding ((.=)) -import qualified Data.Aeson.Text as DAT import Data.Either (Either(..)) import Data.Foldable -import qualified Data.List as List import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map -import qualified Data.Map.Strict.Patch as PM import Data.Maybe (fromMaybe) import Data.Monoid import Data.Ord (Down(..)) import Data.Patch.Class (Action(act), Transformable(..), ours) -import qualified Data.Set as S -import qualified Data.Set as Set import Data.Swagger hiding (version, patch) import Data.Text (Text, isInfixOf, unpack) import Data.Text.Lazy.IO as DTL import Formatting (hprint, int, (%)) -import Formatting.Clock (timeSpecs) import GHC.Generics (Generic) -import Servant hiding (Patch) -import System.Clock (getTime, TimeSpec, Clock(..)) -import Servant.Job.Async (JobFunction(..), serveJobsAPI) -import System.IO (stderr) -import Test.QuickCheck (elements) -import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) - -import Prelude (error) -import Gargantext.Prelude hiding (log) - import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs) import Gargantext.API.Admin.Types (HasSettings) -import qualified Gargantext.API.Metrics as Metrics import Gargantext.API.Ngrams.Types import Gargantext.API.Prelude import Gargantext.Core.Types (ListType(..), NodeId, ListId, DocId, Limit, Offset, TODO, assertValid) import Gargantext.Core.Utils (something) --- import Gargantext.Core.Viz.Graph.API (recomputeGraph) --- import Gargantext.Core.Viz.Graph.Distances (Distance(Conditional)) import Gargantext.Database.Action.Flow.Types import Gargantext.Database.Action.Metrics.NgramsByNode (getOccByNgramsOnlyFast') import Gargantext.Database.Admin.Config (userMaster) import Gargantext.Database.Admin.Types.Node (NodeType(..)) import Gargantext.Database.Prelude (HasConnectionPool, HasConfig) -import Gargantext.Database.Query.Table.Node.Error (HasNodeError) -import Gargantext.Database.Query.Table.Node.Select import Gargantext.Database.Query.Table.Ngrams hiding (NgramsType(..), ngramsType, ngrams_terms) -import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams import Gargantext.Database.Query.Table.Node (getNode) +import Gargantext.Database.Query.Table.Node.Error (HasNodeError) +import Gargantext.Database.Query.Table.Node.Select import Gargantext.Database.Schema.Node (node_id, node_parentId, node_userId) +import Gargantext.Prelude hiding (log) import Gargantext.Prelude.Job +import Gargantext.Prelude.Utils (hasTime, getTime) +import Prelude (error) +import Servant hiding (Patch) +import Servant.Job.Async (JobFunction(..), serveJobsAPI) +import System.IO (stderr) +import Test.QuickCheck (elements) +import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) +import qualified Data.Aeson.Text as DAT +import qualified Data.List as List +import qualified Data.Map.Strict as Map +import qualified Data.Map.Strict.Patch as PM +import qualified Data.Set as S +import qualified Data.Set as Set +import qualified Gargantext.API.Metrics as Metrics +import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams {- -- TODO sequences of modifications (Patchs) @@ -476,9 +471,6 @@ type MaxSize = Int -- | Table of Ngrams is a ListNgrams formatted (sorted and/or cut). -- TODO: should take only one ListId -getTime' :: MonadBase IO m => m TimeSpec -getTime' = liftBase $ getTime ProcessCPUTime - getTableNgrams :: forall env err m. (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env) @@ -492,7 +484,7 @@ getTableNgrams :: forall env err m. getTableNgrams _nType nId tabType listId limit_ offset listType minSize maxSize orderBy searchQuery = do - t0 <- getTime' + t0 <- getTime -- lIds <- selectNodesWithUsername NodeList userMaster let ngramsType = ngramsTypeFromTabType tabType @@ -546,14 +538,14 @@ getTableNgrams _nType nId tabType listId limit_ offset setScores False table = pure table setScores True table = do let ngrams_terms = table ^.. each . ne_ngrams - t1 <- getTime' + t1 <- getTime occurrences <- getOccByNgramsOnlyFast' nId listId ngramsType ngrams_terms - t2 <- getTime' + t2 <- getTime liftBase $ hprint stderr - ("getTableNgrams/setScores #ngrams=" % int % " time=" % timeSpecs % "\n") + ("getTableNgrams/setScores #ngrams=" % int % " time=" % hasTime % "\n") (length ngrams_terms) t1 t2 {- occurrences <- getOccByNgramsOnlySlow nType nId @@ -574,7 +566,7 @@ getTableNgrams _nType nId tabType listId limit_ offset let scoresNeeded = needsScores orderBy tableMap1 <- getNgramsTableMap listId ngramsType - t1 <- getTime' + t1 <- getTime tableMap2 <- tableMap1 & v_data %%~ setScores scoresNeeded . Map.mapWithKey ngramsElementFromRepo @@ -582,16 +574,16 @@ getTableNgrams _nType nId tabType listId limit_ offset . filteredNodes let fltrCount = length $ fltr ^. v_data . _NgramsTable - t2 <- getTime' + t2 <- getTime tableMap3 <- tableMap2 & v_data %%~ fmap NgramsTable . setScores (not scoresNeeded) . selectAndPaginate - t3 <- getTime' + t3 <- getTime liftBase $ hprint stderr - ("getTableNgrams total=" % timeSpecs - % " map1=" % timeSpecs - % " map2=" % timeSpecs - % " map3=" % timeSpecs + ("getTableNgrams total=" % hasTime + % " map1=" % hasTime + % " map2=" % hasTime + % " map3=" % hasTime % " sql=" % (if scoresNeeded then "map2" else "map3") % "\n" ) t0 t3 t0 t1 t1 t2 t2 t3 diff --git a/src/Gargantext/API/Ngrams/List.hs b/src/Gargantext/API/Ngrams/List.hs index c9b6a5ad..6c9fb292 100644 --- a/src/Gargantext/API/Ngrams/List.hs +++ b/src/Gargantext/API/Ngrams/List.hs @@ -128,8 +128,5 @@ instance FromJSON WithFile where parseJSON = genericParseJSON $ jsonOptions "_wf_" instance ToJSON WithFile where toJSON = genericToJSON $ jsonOptions "_wf_" - - instance ToSchema WithFile where declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_") - diff --git a/src/Gargantext/API/Ngrams/Prelude.hs b/src/Gargantext/API/Ngrams/Prelude.hs index 9903b110..b571dd77 100644 --- a/src/Gargantext/API/Ngrams/Prelude.hs +++ b/src/Gargantext/API/Ngrams/Prelude.hs @@ -48,18 +48,13 @@ toTermList lt nt nl = toTermList' lt <$> Map.lookup nt nl (roots, children) = List.partition (\(_t, nre) -> view nre_root nre == Nothing) $ List.filter (\(_t,nre) -> view nre_list nre == lt'') ns - roots' = catMaybes - $ map (\(t,nre) -> (,) <$> Just t - <*> Just (map toTerm $ unMSet - $ view nre_children nre - ) - ) roots + roots' = map (\(t,nre) -> (t, map toTerm $ unMSet $ view nre_children nre )) roots children' = catMaybes $ map (\(t,nre) -> (,) <$> view nre_root nre - <*> Just (map toTerm $ [t] - <> (unMSet $ view nre_children nre) - ) + <*> Just (map toTerm $ [t] + <> (unMSet $ view nre_children nre) + ) ) children ------------------------------------------ @@ -68,4 +63,3 @@ patchMSet_toList = HM.toList . unPatchMapToHashMap . unPatchMSet unMSet :: MSet a -> [a] unMSet (MSet a) = Map.keys a - diff --git a/src/Gargantext/API/Ngrams/Types.hs b/src/Gargantext/API/Ngrams/Types.hs index ded59274..feba76c2 100644 --- a/src/Gargantext/API/Ngrams/Types.hs +++ b/src/Gargantext/API/Ngrams/Types.hs @@ -20,39 +20,35 @@ import Data.Aeson.TH (deriveJSON) import Data.Either (Either(..)) import Data.Foldable import Data.Hashable (Hashable) -import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap -import qualified Data.List as List import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map -import qualified Data.Map.Strict.Patch as PM import Data.Maybe (fromMaybe) import Data.Monoid -import Data.Patch.Class (Replace, replace, Action(act), Group, Applicable(..), Composable(..), Transformable(..), - PairPatch(..), Patched, ConflictResolution, ConflictResolutionReplace, - MaybePatch(Mod), unMod, old, new) +import Data.Patch.Class (Replace, replace, Action(act), Group, Applicable(..), Composable(..), Transformable(..),PairPatch(..), Patched, ConflictResolution, ConflictResolutionReplace,MaybePatch(Mod), unMod, old, new) import Data.Set (Set) -import qualified Data.Set as Set import Data.String (IsString, fromString) import Data.Swagger hiding (version, patch) import Data.Text (Text, pack, strip) import Data.Validity import Database.PostgreSQL.Simple.FromField (FromField, fromField, ResultError(ConversionFailed), returnError) import GHC.Generics (Generic) -import Servant hiding (Patch) -import Servant.Job.Utils (jsonOptions) -import System.FileLock (FileLock) -import Test.QuickCheck (elements, frequency) -import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) - -import Protolude (maybeToEither) -import Gargantext.Prelude - -import Gargantext.Prelude.Crypto.Hash (IsHashable(..)) import Gargantext.Core.Text (size) import Gargantext.Core.Types (ListType(..), ListId, NodeId) import Gargantext.Core.Types (TODO) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixUntagged, unPrefixSwagger, wellNamedSchema) import Gargantext.Database.Prelude (fromField', CmdM', HasConnectionPool, HasConfig) +import Gargantext.Prelude +import Gargantext.Prelude.Crypto.Hash (IsHashable(..)) +import Protolude (maybeToEither) +import Servant hiding (Patch) +import Servant.Job.Utils (jsonOptions) +import System.FileLock (FileLock) +import Test.QuickCheck (elements, frequency) +import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) +import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap +import qualified Data.List as List +import qualified Data.Map.Strict as Map +import qualified Data.Map.Strict.Patch as PM +import qualified Data.Set as Set import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams ------------------------------------------------------------------------ @@ -87,9 +83,8 @@ instance ToParamSchema TabType instance ToJSON TabType instance FromJSON TabType instance ToSchema TabType -instance Arbitrary TabType - where - arbitrary = elements [minBound .. maxBound] +instance Arbitrary TabType where + arbitrary = elements [minBound .. maxBound] instance FromJSONKey TabType where fromJSONKey = genericFromJSONKey defaultJSONKeyOptions instance ToJSONKey TabType where @@ -130,7 +125,6 @@ instance (ToJSONKey a, ToSchema a) => ToSchema (MSet a) where newtype NgramsTerm = NgramsTerm { unNgramsTerm :: Text } deriving (Ord, Eq, Show, Generic, ToJSONKey, ToJSON, FromJSON, Semigroup, Arbitrary, Serialise, ToSchema, Hashable) - instance IsHashable NgramsTerm where hash (NgramsTerm t) = hash t diff --git a/src/Gargantext/Prelude/Utils.hs b/src/Gargantext/Prelude/Utils.hs index aabd0408..e2c44f77 100644 --- a/src/Gargantext/Prelude/Utils.hs +++ b/src/Gargantext/Prelude/Utils.hs @@ -9,12 +9,13 @@ Portability : POSIX TODO_1: qualitative tests (human) TODO_2: quantitative tests (coded) + + -} module Gargantext.Prelude.Utils where - import Control.Exception import Control.Lens (view) import Control.Monad.Random.Class (MonadRandom) @@ -22,6 +23,8 @@ import Control.Monad.Reader (MonadReader) import Data.Aeson (ToJSON, toJSON) import Data.Text (Text) import Data.Tuple.Extra (both) +import Formatting.Clock (timeSpecs) +import Formatting.Internal (Format(..)) import GHC.IO (FilePath) import Gargantext.Database.Admin.Types.Node (NodeId, NodeType) import Gargantext.Database.Prelude (HasConfig(..)) @@ -32,9 +35,16 @@ import System.Directory (createDirectoryIfMissing) import System.IO.Error import System.Random (newStdGen) import qualified Data.Text as Text -import qualified System.Directory as SD +import qualified System.Clock as Clock (getTime, TimeSpec, Clock(..)) +import qualified System.Directory as SD import qualified System.Random.Shuffle as SRS +------------------------------------------------------------------- +hasTime :: Formatting.Internal.Format r (Clock.TimeSpec -> Clock.TimeSpec -> r) +hasTime = timeSpecs + +getTime :: MonadBase IO m => m Clock.TimeSpec +getTime = liftBase $ Clock.getTime Clock.ProcessCPUTime ------------------------------------------------------------------- -- | Main Class to use (just declare needed functions) class GargDB a where -- 2.47.0 From 8d3ac246ddce3a4d2dc6c48e9cc92d042b3250f6 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Tue, 27 Apr 2021 09:39:12 +0200 Subject: [PATCH 16/16] [CLEAN] split Prelude.Utils --- src/Gargantext/API/Ngrams.hs | 2 +- src/Gargantext/Prelude/Clock.hs | 28 ++++++++++++++++++++++++++++ src/Gargantext/Prelude/Utils.hs | 9 --------- 3 files changed, 29 insertions(+), 10 deletions(-) create mode 100644 src/Gargantext/Prelude/Clock.hs diff --git a/src/Gargantext/API/Ngrams.hs b/src/Gargantext/API/Ngrams.hs index 25a8ae69..55265d6e 100644 --- a/src/Gargantext/API/Ngrams.hs +++ b/src/Gargantext/API/Ngrams.hs @@ -118,7 +118,7 @@ import Gargantext.Database.Query.Table.Node.Select import Gargantext.Database.Schema.Node (node_id, node_parentId, node_userId) import Gargantext.Prelude hiding (log) import Gargantext.Prelude.Job -import Gargantext.Prelude.Utils (hasTime, getTime) +import Gargantext.Prelude.Clock (hasTime, getTime) import Prelude (error) import Servant hiding (Patch) import Servant.Job.Async (JobFunction(..), serveJobsAPI) diff --git a/src/Gargantext/Prelude/Clock.hs b/src/Gargantext/Prelude/Clock.hs new file mode 100644 index 00000000..ab5ac8b8 --- /dev/null +++ b/src/Gargantext/Prelude/Clock.hs @@ -0,0 +1,28 @@ +{-| +Module : Gargantext.Prelude.Clock +Description : Useful Tools near Prelude of the project +Copyright : (c) CNRS, 2017-Present +License : AGPL + CECILL v3 +Maintainer : team@gargantext.org +Stability : experimental +Portability : POSIX + +-} + +module Gargantext.Prelude.Clock + where + +import Data.Aeson (ToJSON, toJSON) +import Formatting.Clock (timeSpecs) +import Formatting.Internal (Format(..)) +import Gargantext.Prelude +import qualified System.Clock as Clock (getTime, TimeSpec, Clock(..)) + +--------------------------------------------------------------------------------- +getTime :: MonadBase IO m => m Clock.TimeSpec +getTime = liftBase $ Clock.getTime Clock.ProcessCPUTime + +hasTime :: Formatting.Internal.Format r (Clock.TimeSpec -> Clock.TimeSpec -> r) +hasTime = timeSpecs + + diff --git a/src/Gargantext/Prelude/Utils.hs b/src/Gargantext/Prelude/Utils.hs index e2c44f77..7cf0f7e3 100644 --- a/src/Gargantext/Prelude/Utils.hs +++ b/src/Gargantext/Prelude/Utils.hs @@ -23,8 +23,6 @@ import Control.Monad.Reader (MonadReader) import Data.Aeson (ToJSON, toJSON) import Data.Text (Text) import Data.Tuple.Extra (both) -import Formatting.Clock (timeSpecs) -import Formatting.Internal (Format(..)) import GHC.IO (FilePath) import Gargantext.Database.Admin.Types.Node (NodeId, NodeType) import Gargantext.Database.Prelude (HasConfig(..)) @@ -35,16 +33,9 @@ import System.Directory (createDirectoryIfMissing) import System.IO.Error import System.Random (newStdGen) import qualified Data.Text as Text -import qualified System.Clock as Clock (getTime, TimeSpec, Clock(..)) import qualified System.Directory as SD import qualified System.Random.Shuffle as SRS -------------------------------------------------------------------- -hasTime :: Formatting.Internal.Format r (Clock.TimeSpec -> Clock.TimeSpec -> r) -hasTime = timeSpecs - -getTime :: MonadBase IO m => m Clock.TimeSpec -getTime = liftBase $ Clock.getTime Clock.ProcessCPUTime ------------------------------------------------------------------- -- | Main Class to use (just declare needed functions) class GargDB a where -- 2.47.0