Commit 7ca5c32c authored by david Chavalarias's avatar david Chavalarias

[phylo] filter threshold change

parents b4c2573e 4f134805
...@@ -23,6 +23,8 @@ doc ...@@ -23,6 +23,8 @@ doc
deps deps
_darcs _darcs
*.pdf *.pdf
*.sql
*.ini
# Runtime # Runtime
......
...@@ -13,9 +13,8 @@ Institute of Paris Île-de-France (ISC-PIF) and its partners. ...@@ -13,9 +13,8 @@ Institute of Paris Île-de-France (ISC-PIF) and its partners.
## Installation ## Installation
Disclaimer: this project is still on development, this is work in Disclaimer: this project is still in development, this is work in
progress. Please report and improve this documentation if you encounter progress. Please report and improve this documentation if you encounter issues.
issues.
### Build Core Code ### Build Core Code
...@@ -33,8 +32,7 @@ curl -sSL https://gitlab.iscpif.fr/gargantext/haskell-gargantext/raw/master/devo ...@@ -33,8 +32,7 @@ curl -sSL https://gitlab.iscpif.fr/gargantext/haskell-gargantext/raw/master/devo
### Add dependencies ### Add dependencies
1. CoreNLP is needed (EN and FR); This dependency will not be needed 1. CoreNLP is needed (EN and FR); This dependency will not be needed soon.
soon.
``` sh ``` sh
./devops/install-corenlp ./devops/install-corenlp
...@@ -65,6 +63,18 @@ Initialization schema should be loaded automatically (from `devops/postgres/sche ...@@ -65,6 +63,18 @@ Initialization schema should be loaded automatically (from `devops/postgres/sche
#### Gargantext #### Gargantext
##### Fix the passwords
Change the passwords in gargantext.ini_toModify then move it:
``` sh
mv gargantext.ini_toModify gargantext.ini
```
(`.gitignore` avoids adding this file to the repository by mistake)
##### Run Gargantext
Users have to be created first (`user1` is created as instance): Users have to be created first (`user1` is created as instance):
``` sh ``` sh
...@@ -72,7 +82,14 @@ stack install ...@@ -72,7 +82,14 @@ stack install
~/.local/bin/gargantext-init "gargantext.ini" ~/.local/bin/gargantext-init "gargantext.ini"
``` ```
For Docker env, run: For Docker env, first create the appropriate image:
``` sh
cd devops/docker
docker build -t fpco/stack-build:lts-14.27-garg .
```
then run:
``` sh ``` sh
stack --docker run gargantext-init -- gargantext.ini stack --docker run gargantext-init -- gargantext.ini
...@@ -86,6 +103,15 @@ docker run --rm -it -p 9000:9000 cgenie/corenlp-garg ...@@ -86,6 +103,15 @@ docker run --rm -it -p 9000:9000 cgenie/corenlp-garg
stack exec gargantext-import -- "corpusCsvHal" "user1" "IMT3" gargantext.ini 10000 ./1000.csv stack exec gargantext-import -- "corpusCsvHal" "user1" "IMT3" gargantext.ini 10000 ./1000.csv
``` ```
### Nix
It is also possible to build everything with [Nix](https://nixos.org/) instead of Docker:
``` sh
stack --nix build
stack --nix exec gargantext-import -- "corpusCsvHal" "user1" "IMT3" gargantext.ini 10000 ./1000.csv
stack --nix exec gargantext-server -- --ini gargantext.ini --run Prod
```
## Use Cases ## Use Cases
### Multi-User with Graphical User Interface (Server Mode) ### Multi-User with Graphical User Interface (Server Mode)
...@@ -94,12 +120,23 @@ stack exec gargantext-import -- "corpusCsvHal" "user1" "IMT3" gargantext.ini 100 ...@@ -94,12 +120,23 @@ stack exec gargantext-import -- "corpusCsvHal" "user1" "IMT3" gargantext.ini 100
~/.local/bin/stack --docker exec gargantext-server -- --ini "gargantext.ini" --run Prod ~/.local/bin/stack --docker exec gargantext-server -- --ini "gargantext.ini" --run Prod
``` ```
Then you can log in with `user1:1resu`. Then you can log in with `user1` / `1resu`.
### Command Line Mode tools ### Command Line Mode tools
#### Simple cooccurrences computation and indexation from a list of Ngrams #### Simple cooccurrences computation and indexation from a list of Ngrams
``` sh
stack --docker exec gargantext-cli -- CorpusFromGarg.csv ListFromGarg.csv Ouput.json stack --docker exec gargantext-cli -- CorpusFromGarg.csv ListFromGarg.csv Ouput.json
```
### Analyzing the ngrams table repo
We store the repository in directory `repos` in the [CBOR](https://cbor.io/)
file format. To decode it to JSON and analyze, say, using
[jq](https://shapeshed.com/jq-json/), use the following command:
``` sh
cat repos/repo.cbor.v5 | stack --nix exec gargantext-cbor2json | jq .
```
#!/bin/bash
stack build # --profile # --test # --haddock
...@@ -10,13 +10,8 @@ Portability : POSIX ...@@ -10,13 +10,8 @@ Portability : POSIX
Adaptative Phylo binaries Adaptative Phylo binaries
-} -}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict #-} {-# LANGUAGE Strict #-}
module Main where module Main where
...@@ -29,17 +24,17 @@ import Data.String (String) ...@@ -29,17 +24,17 @@ import Data.String (String)
import Data.Text (Text, unwords, unpack) import Data.Text (Text, unwords, unpack)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Database.Types.Node (HyperdataDocument(..)) import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
import Gargantext.Text.Context (TermList) import Gargantext.Core.Text.Context (TermList)
import Gargantext.Text.Corpus.Parsers.CSV (csv_title, csv_abstract, csv_publication_year) import Gargantext.Core.Text.Corpus.Parsers.CSV (csv_title, csv_abstract, csv_publication_year)
import Gargantext.Text.Corpus.Parsers (FileFormat(..),parseFile) import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..),parseFile)
import Gargantext.Text.List.CSV (csvGraphTermList) import Gargantext.Core.Text.List.CSV (csvMapTermList)
import Gargantext.Text.Terms.WithList (Patterns, buildPatterns, extractTermsWithList) import Gargantext.Core.Text.Terms.WithList (Patterns, buildPatterns, extractTermsWithList)
import Gargantext.Viz.AdaptativePhylo import Gargantext.Core.Viz.AdaptativePhylo
import Gargantext.Viz.Phylo.PhyloMaker (toPhylo) import Gargantext.Core.Viz.Phylo.PhyloMaker (toPhylo)
import Gargantext.Viz.Phylo.PhyloTools (printIOMsg, printIOComment) import Gargantext.Core.Viz.Phylo.PhyloTools (printIOMsg, printIOComment)
import Gargantext.Viz.Phylo.PhyloExport (toPhyloExport, dotToFile) import Gargantext.Core.Viz.Phylo.PhyloExport (toPhyloExport, dotToFile)
-- import Gargantext.Viz.Phylo.SynchronicClustering (synchronicDistance') -- import Gargantext.Core.Viz.Phylo.SynchronicClustering (synchronicDistance')
import GHC.IO (FilePath) import GHC.IO (FilePath)
import Prelude (Either(..)) import Prelude (Either(..))
...@@ -49,7 +44,7 @@ import Control.Concurrent.Async (mapConcurrently) ...@@ -49,7 +44,7 @@ import Control.Concurrent.Async (mapConcurrently)
import qualified Data.ByteString.Lazy as Lazy import qualified Data.ByteString.Lazy as Lazy
import qualified Data.Vector as Vector import qualified Data.Vector as Vector
import qualified Gargantext.Text.Corpus.Parsers.CSV as Csv import qualified Gargantext.Core.Text.Corpus.Parsers.CSV as Csv
--------------- ---------------
...@@ -94,16 +89,16 @@ wosToCorpus :: Int -> FilePath -> IO ([(Int,Text)]) ...@@ -94,16 +89,16 @@ wosToCorpus :: Int -> FilePath -> IO ([(Int,Text)])
wosToCorpus limit path = do wosToCorpus limit path = do
files <- getFilesFromPath path files <- getFilesFromPath path
take limit take limit
<$> map (\d -> let date' = fromJust $ _hyperdataDocument_publication_year d <$> map (\d -> let date' = fromJust $ _hd_publication_year d
title = fromJust $ _hyperdataDocument_title d title = fromJust $ _hd_title d
abstr = if (isJust $ _hyperdataDocument_abstract d) abstr = if (isJust $ _hd_abstract d)
then fromJust $ _hyperdataDocument_abstract d then fromJust $ _hd_abstract d
else "" else ""
in (date', title <> " " <> abstr)) in (date', title <> " " <> abstr))
<$> concat <$> concat
<$> mapConcurrently (\file -> <$> mapConcurrently (\file ->
filter (\d -> (isJust $ _hyperdataDocument_publication_year d) filter (\d -> (isJust $ _hd_publication_year d)
&& (isJust $ _hyperdataDocument_title d)) && (isJust $ _hd_title d))
<$> parseFile WOS (path <> file) ) files <$> parseFile WOS (path <> file) ) files
...@@ -149,7 +144,7 @@ main = do ...@@ -149,7 +144,7 @@ main = do
Right config -> do Right config -> do
printIOMsg "Parse the corpus" printIOMsg "Parse the corpus"
mapList <- csvGraphTermList (listPath config) mapList <- csvMapTermList (listPath config)
corpus <- fileToDocs (corpusParser config) (corpusPath config) mapList corpus <- fileToDocs (corpusParser config) (corpusPath config) mapList
printIOComment (show (length corpus) <> " parsed docs from the corpus") printIOComment (show (length corpus) <> " parsed docs from the corpus")
...@@ -185,4 +180,4 @@ main = do ...@@ -185,4 +180,4 @@ main = do
<> "-sens_" <> sensibility <> "-sens_" <> sensibility
<> ".dot" <> ".dot"
dotToFile output dot dotToFile output dot
\ No newline at end of file
import Prelude (IO, id, (.))
import Codec.Serialise (deserialise)
import Data.Aeson (encode)
import qualified Data.ByteString.Lazy as L
import Gargantext.API.Ngrams (NgramsRepo)
main :: IO ()
main = L.interact (encode . (id :: NgramsRepo -> NgramsRepo) . deserialise)
...@@ -11,7 +11,6 @@ Given a Gargantext CSV File and its Query This script cleans and ...@@ -11,7 +11,6 @@ Given a Gargantext CSV File and its Query This script cleans and
compress the contexts around the main terms of the query. compress the contexts around the main terms of the query.
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
module CleanCsvCorpus where module CleanCsvCorpus where
...@@ -23,8 +22,8 @@ import Data.Vector (Vector) ...@@ -23,8 +22,8 @@ import Data.Vector (Vector)
import qualified Data.Vector as V import qualified Data.Vector as V
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Text.Search import Gargantext.Core.Text.Search
import qualified Gargantext.Text.Corpus.Parsers.CSV as CSV import qualified Gargantext.Core.Text.Corpus.Parsers.CSV as CSV
------------------------------------------------------------------------ ------------------------------------------------------------------------
type Query = [S.Term] type Query = [S.Term]
......
...@@ -11,11 +11,6 @@ Main specifications to index a corpus with a term list ...@@ -11,11 +11,6 @@ Main specifications to index a corpus with a term list
-} -}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Strict #-} {-# LANGUAGE Strict #-}
...@@ -54,13 +49,13 @@ import Prelude ((>>)) ...@@ -54,13 +49,13 @@ import Prelude ((>>))
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Core import Gargantext.Core
import Gargantext.Core.Types import Gargantext.Core.Types
import Gargantext.Text.Terms import Gargantext.Core.Text.Terms
import Gargantext.Text.Context import Gargantext.Core.Text.Context
import Gargantext.Text.Terms.WithList import Gargantext.Core.Text.Terms.WithList
import Gargantext.Text.Corpus.Parsers.CSV (readFile, csv_title, csv_abstract, csv_publication_year) import Gargantext.Core.Text.Corpus.Parsers.CSV (readFile, csv_title, csv_abstract, csv_publication_year)
import Gargantext.Text.List.CSV (csvGraphTermList) import Gargantext.Core.Text.List.CSV (csvMapTermList)
import Gargantext.Text.Terms (terms) import Gargantext.Core.Text.Terms (terms)
import Gargantext.Text.Metrics.Count (coocOnContexts, Coocs) import Gargantext.Core.Text.Metrics.Count (coocOnContexts, Coocs)
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- OUTPUT format -- OUTPUT format
...@@ -108,7 +103,7 @@ main = do ...@@ -108,7 +103,7 @@ main = do
<$> readFile corpusFile <$> readFile corpusFile
-- termListMap :: [Text] -- termListMap :: [Text]
termList <- csvGraphTermList termListFile termList <- csvMapTermList termListFile
putStrLn $ show $ length termList putStrLn $ show $ length termList
......
...@@ -11,33 +11,28 @@ Import a corpus binary. ...@@ -11,33 +11,28 @@ Import a corpus binary.
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Strict #-} {-# LANGUAGE Strict #-}
module Main where module Main where
import Data.Either
import Prelude (read)
import Control.Exception (finally) import Control.Exception (finally)
import Gargantext.Prelude import Data.Either
import Gargantext.Database.Flow (FlowCmdM, flowCorpusFile, flowAnnuaire) import Data.Text (Text)
import Gargantext.Text.Corpus.Parsers (FileFormat(..))
import Gargantext.Database.Utils (Cmd, )
import Gargantext.Database.Types.Node (CorpusId, toHyperdataDocument)
import Gargantext.Database.Schema.User (insertUsersDemo)
import Gargantext.Text.Terms (TermType(..))
import Gargantext.Core (Lang(..))
import Gargantext.API.Types (GargError)
import Gargantext.API.Node () -- instances import Gargantext.API.Node () -- instances
import Gargantext.API.Settings (withDevEnv, runCmdDev, DevEnv) import Gargantext.API.Admin.Settings (withDevEnv, runCmdDev, DevEnv)
import Gargantext.API.Prelude (GargError)
import Gargantext.Core (Lang(..))
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Action.Flow (FlowCmdM, flowCorpusFile, flowAnnuaire, TermType(..))
import Gargantext.Database.Query.Table.User (insertUsersDemo)
import Gargantext.Database.Admin.Types.Hyperdata (toHyperdataDocument)
import Gargantext.Database.Admin.Types.Node (CorpusId)
import Gargantext.Database.Prelude (Cmd)
import Gargantext.Prelude
import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..))
import Prelude (read)
import System.Environment (getArgs) import System.Environment (getArgs)
--import Gargantext.Text.Corpus.Parsers.GrandDebat (readFile, GrandDebatReference(..))
import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import Control.Monad.IO.Class (liftIO)
main :: IO () main :: IO ()
main = do main = do
...@@ -53,14 +48,13 @@ main = do ...@@ -53,14 +48,13 @@ main = do
tt = (Multi EN) tt = (Multi EN)
format = CsvGargV3 -- CsvHal --WOS format = CsvGargV3 -- CsvHal --WOS
corpus :: forall m. FlowCmdM DevEnv GargError m => m CorpusId corpus :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
corpus = flowCorpusFile (cs user) (Left (cs name :: Text)) (read limit :: Int) tt format corpusPath corpus = flowCorpusFile (UserName $ cs user) (Left (cs name :: Text)) (read limit :: Int) tt format corpusPath
corpusCsvHal :: forall m. FlowCmdM DevEnv GargError m => m CorpusId corpusCsvHal :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
corpusCsvHal = flowCorpusFile (cs user) (Left (cs name :: Text)) (read limit :: Int) tt CsvHal corpusPath corpusCsvHal = flowCorpusFile (UserName $ cs user) (Left (cs name :: Text)) (read limit :: Int) tt CsvHal corpusPath
annuaire :: forall m. FlowCmdM DevEnv GargError m => m CorpusId annuaire :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
annuaire = flowAnnuaire (cs user) (Left "Annuaire") (Multi EN) corpusPath annuaire = flowAnnuaire (UserName $ cs user) (Left "Annuaire") (Multi EN) corpusPath
{- {-
let debatCorpus :: forall m. FlowCmdM DevEnv GargError m => m CorpusId let debatCorpus :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
...@@ -86,7 +80,6 @@ main = do ...@@ -86,7 +80,6 @@ main = do
then runCmdDev env corpusCsvHal then runCmdDev env corpusCsvHal
else pure 0 --(cs "false") else pure 0 --(cs "false")
_ <- if fun == "annuaire" _ <- if fun == "annuaire"
then runCmdDev env annuaire then runCmdDev env annuaire
else pure 0 else pure 0
......
...@@ -11,28 +11,32 @@ Import a corpus binary. ...@@ -11,28 +11,32 @@ Import a corpus binary.
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Strict #-} {-# LANGUAGE Strict #-}
module Main where module Main where
import Data.Text (Text)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import System.Environment (getArgs) import Gargantext.API.Admin.Settings (withDevEnv, runCmdDev)
import Gargantext.Prelude import Gargantext.API.Prelude (GargError)
import Gargantext.Database.Flow (getOrMkRoot, getOrMk_RootWithCorpus)
import Gargantext.Database.Schema.Node (getOrMkList)
import Gargantext.Database.Utils (Cmd, )
import Gargantext.Database.Types.Node (CorpusId, RootId, HyperdataCorpus, ListId)
import Gargantext.Database.Schema.User (insertUsersDemo, UserId)
import Gargantext.API.Types (GargError)
import Gargantext.API.Node () -- instances import Gargantext.API.Node () -- instances
import Gargantext.API.Settings (withDevEnv, runCmdDev) import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Config (userMaster, corpusMasterName) import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMk_RootWithCorpus)
import Gargantext.Database.Init (initTriggers) import Gargantext.Database.Query.Table.Node (getOrMkList)
import Gargantext.Database.Query.Table.User (insertUsersDemo)
import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Admin.Trigger.Init (initFirstTriggers, initLastTriggers)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
import Gargantext.Database.Admin.Types.Node (CorpusId, RootId, ListId)
import Gargantext.Database.Prelude (Cmd, )
import Gargantext.Prelude
import System.Environment (getArgs)
secret :: Text
secret = "Database secret to change"
main :: IO () main :: IO ()
main = do main = do
[iniPath] <- getArgs [iniPath] <- getArgs
...@@ -42,20 +46,21 @@ main = do ...@@ -42,20 +46,21 @@ main = do
let let
mkRoots :: Cmd GargError [(UserId, RootId)] mkRoots :: Cmd GargError [(UserId, RootId)]
mkRoots = mapM getOrMkRoot ["gargantua", "user1", "user2"] mkRoots = mapM getOrMkRoot $ map UserName ["gargantua", "user1", "user2", "user3"]
-- TODO create all users roots -- TODO create all users roots
let let
initMaster :: Cmd GargError (UserId, RootId, CorpusId, ListId) initMaster :: Cmd GargError (UserId, RootId, CorpusId, ListId)
initMaster = do initMaster = do
(masterUserId, masterRootId, masterCorpusId) <- getOrMk_RootWithCorpus userMaster (Left corpusMasterName) (Nothing :: Maybe HyperdataCorpus) (masterUserId, masterRootId, masterCorpusId) <- getOrMk_RootWithCorpus (UserName userMaster) (Left corpusMasterName) (Nothing :: Maybe HyperdataCorpus)
masterListId <- getOrMkList masterCorpusId masterUserId masterListId <- getOrMkList masterCorpusId masterUserId
_triggers <- initTriggers masterListId _triggers <- initLastTriggers masterListId
pure (masterUserId, masterRootId, masterCorpusId, masterListId) pure (masterUserId, masterRootId, masterCorpusId, masterListId)
withDevEnv iniPath $ \env -> do withDevEnv iniPath $ \env -> do
_ <- runCmdDev env (initFirstTriggers secret :: Cmd GargError [Int64])
_ <- runCmdDev env createUsers _ <- runCmdDev env createUsers
_ <- runCmdDev env mkRoots
x <- runCmdDev env initMaster x <- runCmdDev env initMaster
_ <- runCmdDev env mkRoots
putStrLn $ show x putStrLn $ show x
pure () pure ()
...@@ -11,53 +11,42 @@ Phylo binaries ...@@ -11,53 +11,42 @@ Phylo binaries
-} -}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Strict #-} {-# LANGUAGE Strict #-}
module Main where module Main where
import System.Directory (doesFileExist) import Control.Concurrent.Async as CCA (mapConcurrently)
import Control.Monad (mapM)
import Data.Aeson import Data.Aeson
import Data.Text (Text, unwords, unlines)
import Data.List ((++),concat) import Data.List ((++),concat)
import Data.Maybe
import Data.Text (Text, unwords, unlines)
import GHC.Generics import GHC.Generics
import GHC.IO (FilePath) import GHC.IO (FilePath)
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Text.List.CSV (csvGraphTermList) import Gargantext.Core.Text.Context (TermList)
import Gargantext.Text.Corpus.Parsers.CSV (csv_title, csv_abstract, csv_publication_year) import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..),parseFile)
import qualified Gargantext.Text.Corpus.Parsers.CSV as CSV import Gargantext.Core.Text.Corpus.Parsers.CSV (csv_title, csv_abstract, csv_publication_year)
import Gargantext.Text.Corpus.Parsers (FileFormat(..),parseFile) import Gargantext.Core.Text.List.CSV (csvMapTermList)
import Gargantext.Text.Terms.WithList import Gargantext.Core.Text.Terms.WithList
import Gargantext.Text.Context (TermList) import Gargantext.Core.Viz.Phylo
import Gargantext.Core.Viz.Phylo.LevelMaker
import Control.Monad (mapM) import Gargantext.Core.Viz.Phylo.Tools
import Gargantext.Core.Viz.Phylo.View.Export
import Gargantext.Core.Viz.Phylo.View.ViewMaker
import System.Directory (doesFileExist)
import System.Environment import System.Environment
import qualified Data.ByteString.Lazy as L
import Gargantext.Viz.Phylo
import Gargantext.Viz.Phylo.Tools
import Gargantext.Viz.Phylo.LevelMaker
import Gargantext.Viz.Phylo.View.Export
import Gargantext.Viz.Phylo.View.ViewMaker
import Gargantext.Database.Types.Node
import Data.Maybe
import Control.Concurrent.Async as CCA (mapConcurrently)
import qualified Data.Map as DM
import qualified Data.Vector as DV
import qualified Data.List as DL import qualified Data.List as DL
import qualified Data.Map as DM
import qualified Data.Text as DT import qualified Data.Text as DT
import qualified Data.Vector as DV
import qualified Gargantext.Core.Text.Corpus.Parsers.CSV as CSV
import qualified Prelude as P import qualified Prelude as P
import qualified Data.ByteString.Lazy as L
-------------- --------------
...@@ -123,7 +112,10 @@ filterTerms patterns (y,d) = (y,termsInText patterns d) ...@@ -123,7 +112,10 @@ filterTerms patterns (y,d) = (y,termsInText patterns d)
where where
-------------------------------------- --------------------------------------
termsInText :: Patterns -> Text -> [Text] termsInText :: Patterns -> Text -> [Text]
termsInText pats txt = DL.nub $ DL.concat $ map (map unwords) $ extractTermsWithList pats txt termsInText pats txt = DL.nub
$ DL.concat
$ map (map unwords)
$ extractTermsWithList pats txt
-------------------------------------- --------------------------------------
...@@ -140,11 +132,11 @@ csvToCorpus limit csv = DV.toList ...@@ -140,11 +132,11 @@ csvToCorpus limit csv = DV.toList
-- | To transform a Wos nfile into a readable corpus -- | To transform a Wos nfile into a readable corpus
wosToCorpus :: Limit -> CorpusPath -> IO ([(Int,Text)]) wosToCorpus :: Limit -> CorpusPath -> IO ([(Int,Text)])
wosToCorpus limit path = DL.take limit wosToCorpus limit path = DL.take limit
. map (\d -> ((fromJust $_hyperdataDocument_publication_year d) . map (\d -> ((fromJust $_hd_publication_year d)
,(fromJust $_hyperdataDocument_title d) <> " " <> (fromJust $_hyperdataDocument_abstract d))) ,(fromJust $_hd_title d) <> " " <> (fromJust $_hd_abstract d)))
. filter (\d -> (isJust $_hyperdataDocument_publication_year d) . filter (\d -> (isJust $_hd_publication_year d)
&& (isJust $_hyperdataDocument_title d) && (isJust $_hd_title d)
&& (isJust $_hyperdataDocument_abstract d)) && (isJust $_hd_abstract d))
. concat . concat
<$> mapConcurrently (\idx -> parseFile WOS (path <> show(idx) <> ".txt")) [1..20] <$> mapConcurrently (\idx -> parseFile WOS (path <> show(idx) <> ".txt")) [1..20]
...@@ -199,7 +191,7 @@ main = do ...@@ -199,7 +191,7 @@ main = do
P.Left err -> putStrLn err P.Left err -> putStrLn err
P.Right conf -> do P.Right conf -> do
termList <- csvGraphTermList (listPath conf) termList <- csvMapTermList (listPath conf)
corpus <- parse (corpusType conf) (limit conf) (corpusPath conf) termList corpus <- parse (corpusType conf) (limit conf) (corpusPath conf) termList
......
...@@ -11,23 +11,21 @@ Script to start gargantext with different modes (Dev, Prod, Mock). ...@@ -11,23 +11,21 @@ Script to start gargantext with different modes (Dev, Prod, Mock).
-} -}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE Strict #-}
{-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Strict #-}
module Main where module Main where
import Data.Version (showVersion)
import Options.Generic
import Data.Text (unpack) import Data.Text (unpack)
import qualified Paths_gargantext as PG -- cabal magic build module
import Options.Generic
import System.Exit (exitSuccess)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.API (startGargantext) -- , startGargantextMock) import Gargantext.API (startGargantext, Mode(..)) -- , startGargantextMock)
-------------------------------------------------------- --------------------------------------------------------
-- Graph Tests -- Graph Tests
...@@ -37,13 +35,10 @@ import Gargantext.API (startGargantext) -- , startGargantextMock) ...@@ -37,13 +35,10 @@ import Gargantext.API (startGargantext) -- , startGargantextMock)
--import qualified Gargantext.Graph.Distances.Matrice as M --import qualified Gargantext.Graph.Distances.Matrice as M
-------------------------------------------------------- --------------------------------------------------------
data Mode = Dev | Mock | Prod
deriving (Show, Read, Generic)
instance ParseRecord Mode instance ParseRecord Mode
instance ParseField Mode instance ParseField Mode
instance ParseFields Mode instance ParseFields Mode
data MyOptions w = data MyOptions w =
MyOptions { run :: w ::: Mode MyOptions { run :: w ::: Mode
<?> "Possible modes: Dev | Mock | Prod" <?> "Possible modes: Dev | Mock | Prod"
...@@ -51,6 +46,8 @@ data MyOptions w = ...@@ -51,6 +46,8 @@ data MyOptions w =
<?> "By default: 8008" <?> "By default: 8008"
, ini :: w ::: Maybe Text , ini :: w ::: Maybe Text
<?> "Ini-file path of gargantext.ini" <?> "Ini-file path of gargantext.ini"
, version :: w ::: Bool
<?> "Show version number and exit"
} }
deriving (Generic) deriving (Generic)
...@@ -60,22 +57,26 @@ deriving instance Show (MyOptions Unwrapped) ...@@ -60,22 +57,26 @@ deriving instance Show (MyOptions Unwrapped)
main :: IO () main :: IO ()
main = do main = do
MyOptions myMode myPort myIniFile <- unwrapRecord MyOptions myMode myPort myIniFile myVersion <- unwrapRecord
"Gargantext server" "Gargantext server"
if myVersion then do
putStrLn $ "Version: " <> showVersion PG.version
System.Exit.exitSuccess
else
return ()
let myPort' = case myPort of let myPort' = case myPort of
Just p -> p Just p -> p
Nothing -> 8008 Nothing -> 8008
let start = case myMode of let start = case myMode of
Prod -> startGargantext myPort' (unpack myIniFile') Mock -> panic "[ERROR] Mock mode unsupported"
_ -> startGargantext myMode myPort' (unpack myIniFile')
where where
myIniFile' = case myIniFile of myIniFile' = case myIniFile of
Nothing -> panic "[ERROR] gargantext.ini needed" Nothing -> panic "[ERROR] gargantext.ini needed"
Just i -> i Just i -> i
Dev -> panic "[ERROR] Dev mode unsupported"
Mock -> panic "[ERROR] Mock mode unsupported"
-- _ -> startGargantextMock myPort'
putStrLn $ "Starting with " <> show myMode <> " mode." putStrLn $ "Starting with " <> show myMode <> " mode."
start start
......
stack ghci --profile
#!/bin/bash
stack install #--profile # --test --haddock
{ghc}: { ghc
with (import <nixpkgs> {}); , pkgs ? import ./pinned.nix {}
}:
haskell.lib.buildStackProject { let
inherit ghc; buildInputs = with pkgs; [
name = "gargantext";
buildInputs = [
docker-compose
blas
bzip2 bzip2
#gfortran git
gfortran.cc.lib
glibc
gmp gmp
gsl gsl
igraph igraph
liblapack liblapack
lzma
pcre pcre
postgresql postgresql
#stack
xz xz
zlib zlib
blas
gfortran7
gfortran7.cc.lib
]; ];
libraryPaths = pkgs.lib.makeLibraryPath buildInputs;
in
pkgs.haskell.lib.buildStackProject rec {
inherit ghc;
inherit buildInputs;
name = "gargantext";
shellHook = ''
export LD_LIBRARY_PATH="${libraryPaths}"
export LIBRARY_PATH="${libraryPaths}"
'';
} }
...@@ -5,14 +5,14 @@ if git --version; ...@@ -5,14 +5,14 @@ if git --version;
then then
echo "git installed, ok" echo "git installed, ok"
else else
sudo apt update && sudo apt install git sudo apt update && sudo apt install -y git
fi fi
sudo apt update sudo apt update
sudo apt install liblzma-dev libpcre3-dev libblas-dev liblapack-dev pkg-config libgsl-dev libbz2-dev postgresql nginx libpq-dev libigraph0-dev sudo apt install -y liblzma-dev libpcre3-dev libblas-dev liblapack-dev pkg-config libgsl-dev libbz2-dev postgresql nginx libpq-dev libigraph0-dev
# Phylo management # Phylo management
sudo apt install graphviz sudo apt install -y graphviz
sudo apt install postgresql-server-dev-11 sudo apt install -y postgresql-server-dev-11
...@@ -6,7 +6,7 @@ cd clustering-louvain-cplusplus ...@@ -6,7 +6,7 @@ cd clustering-louvain-cplusplus
cd .. cd ..
sudo apt install default-jdk sudo apt install -y default-jdk
wget https://dl.gargantext.org/coreNLP.tar.bz2 wget https://dl.gargantext.org/coreNLP.tar.bz2
tar xvjf coreNLP.tar.bz2 tar xvjf coreNLP.tar.bz2
# ./startServer.sh # ./startServer.sh
......
...@@ -26,7 +26,7 @@ tmux ...@@ -26,7 +26,7 @@ tmux
# Open Stack only: attach volumes # Open Stack only: attach volumes
# attach the volume created (OS interface or API) # attach the volume created (OS interface or API)
sudo fdisk -l sudo fdisk -l
sudo fisk /dev/vdb (n,p,t,83,w) sudo fdisk /dev/vdb (n,p,t,83,w)
sudo mkfs.ext4 /dev/vdb1 sudo mkfs.ext4 /dev/vdb1
sudo blkid sudo blkid
...@@ -42,7 +42,7 @@ sudo apt dist-upgrade ...@@ -42,7 +42,7 @@ sudo apt dist-upgrade
######################################################################## ########################################################################
sudo apt update 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 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 git sudo apt install git
......
from fpco/stack-build:lts-14.6 from fpco/stack-build:lts-14.27
RUN apt-get update && \ RUN apt-get update && \
apt-get install -y git libigraph0-dev && \ apt-get install -y git libigraph0-dev && \
......
...@@ -3,6 +3,7 @@ version: '3' ...@@ -3,6 +3,7 @@ version: '3'
services: services:
postgres: postgres:
image: 'postgres:latest' image: 'postgres:latest'
network_mode: host
ports: ports:
- 5432:5432 - 5432:5432
environment: environment:
...@@ -15,6 +16,17 @@ services: ...@@ -15,6 +16,17 @@ services:
- ../dbs:/dbs - ../dbs:/dbs
- ../postgres/schema.sql:/docker-entrypoint-initdb.d/schema.sql:ro - ../postgres/schema.sql:/docker-entrypoint-initdb.d/schema.sql:ro
pgadmin:
image: 'dpage/pgadmin4'
ports:
- 8081:80
environment:
PGADMIN_DEFAULT_EMAIL: admin
PGADMIN_DEFAULT_PASSWORD: admin
depends_on:
- postgres
corenlp: corenlp:
image: 'cgenie/corenlp-garg' image: 'cgenie/corenlp-garg'
ports: ports:
......
CREATE EXTENSION IF NOT EXISTS plpgsql WITH SCHEMA pg_catalog; CREATE EXTENSION IF NOT EXISTS plpgsql WITH SCHEMA pg_catalog;
CREATE EXTENSION IF NOT EXISTS tsm_system_rows;
COMMENT ON EXTENSION plpgsql IS 'PL/pgSQL procedural language'; COMMENT ON EXTENSION plpgsql IS 'PL/pgSQL procedural language';
CREATE EXTENSION IF NOT EXISTS tsm_system_rows;
CREATE EXTENSION pgcrypto;
-----------------------------------------------------------------
CREATE TABLE public.auth_user ( CREATE TABLE public.auth_user (
id SERIAL, id SERIAL,
password CHARACTER varying(128) NOT NULL, password CHARACTER varying(128) NOT NULL,
...@@ -23,6 +26,7 @@ ALTER TABLE public.auth_user OWNER TO gargantua; ...@@ -23,6 +26,7 @@ ALTER TABLE public.auth_user OWNER TO gargantua;
-- TODO typename -> type_id -- TODO typename -> type_id
CREATE TABLE public.nodes ( CREATE TABLE public.nodes (
id SERIAL, id SERIAL,
hash_id CHARACTER varying(66) DEFAULT ''::character varying NOT NULL,
typename INTEGER NOT NULL, typename INTEGER NOT NULL,
user_id INTEGER NOT NULL, user_id INTEGER NOT NULL,
parent_id INTEGER REFERENCES public.nodes(id) ON DELETE CASCADE , parent_id INTEGER REFERENCES public.nodes(id) ON DELETE CASCADE ,
...@@ -92,10 +96,11 @@ CREATE TABLE public.nodes_nodes ( ...@@ -92,10 +96,11 @@ CREATE TABLE public.nodes_nodes (
node2_id INTEGER NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE, node2_id INTEGER NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE,
score REAL, score REAL,
category INTEGER, category INTEGER,
PRIMARY KEY (node1_id,node2_id) PRIMARY KEY (node1_id, node2_id)
); );
ALTER TABLE public.nodes_nodes OWNER TO gargantua; ALTER TABLE public.nodes_nodes OWNER TO gargantua;
--------------------------------------------------------------- ---------------------------------------------------------------
CREATE TABLE public.node_node_ngrams ( CREATE TABLE public.node_node_ngrams (
node1_id INTEGER NOT NULL REFERENCES public.nodes (id) ON DELETE CASCADE, node1_id INTEGER NOT NULL REFERENCES public.nodes (id) ON DELETE CASCADE,
...@@ -107,7 +112,6 @@ PRIMARY KEY (node1_id, node2_id, ngrams_id, ngrams_type) ...@@ -107,7 +112,6 @@ PRIMARY KEY (node1_id, node2_id, ngrams_id, ngrams_type)
); );
ALTER TABLE public.node_node_ngrams OWNER TO gargantua; ALTER TABLE public.node_node_ngrams OWNER TO gargantua;
CREATE TABLE public.node_node_ngrams2 ( CREATE TABLE public.node_node_ngrams2 (
node_id INTEGER NOT NULL REFERENCES public.nodes (id) ON DELETE CASCADE, node_id INTEGER NOT NULL REFERENCES public.nodes (id) ON DELETE CASCADE,
nodengrams_id INTEGER NOT NULL REFERENCES public.node_ngrams (id) ON DELETE CASCADE, nodengrams_id INTEGER NOT NULL REFERENCES public.node_ngrams (id) ON DELETE CASCADE,
...@@ -151,9 +155,10 @@ CREATE INDEX ON public.nodes USING btree (user_id, typename, parent_id); ...@@ -151,9 +155,10 @@ CREATE INDEX ON public.nodes USING btree (user_id, typename, parent_id);
CREATE INDEX ON public.nodes USING btree (id, typename, date ASC); CREATE INDEX ON public.nodes USING btree (id, typename, date ASC);
CREATE INDEX ON public.nodes USING btree (id, typename, date DESC); CREATE INDEX ON public.nodes USING btree (id, typename, date DESC);
CREATE INDEX ON public.nodes USING btree (typename, id); CREATE INDEX ON public.nodes USING btree (typename, id);
CREATE UNIQUE INDEX ON public.nodes USING btree (((hyperdata ->> 'uniqId'::text))); CREATE UNIQUE INDEX ON public.nodes USING btree (hash_id);
CREATE UNIQUE INDEX ON public.nodes USING btree (((hyperdata ->> 'uniqIdBdd'::text))); -- CREATE UNIQUE INDEX ON public.nodes USING btree (((hyperdata ->> 'uniqId'::text)));
CREATE UNIQUE INDEX ON public.nodes USING btree (typename, parent_id, ((hyperdata ->> 'uniqId'::text))); -- CREATE UNIQUE INDEX ON public.nodes USING btree (((hyperdata ->> 'uniqIdBdd'::text)));
-- CREATE UNIQUE INDEX ON public.nodes USING btree (typename, parent_id, ((hyperdata ->> 'uniqId'::text)));
CREATE UNIQUE INDEX ON public.ngrams (terms); -- TEST GIN CREATE UNIQUE INDEX ON public.ngrams (terms); -- TEST GIN
CREATE INDEX ON public.ngrams USING btree (id, terms); CREATE INDEX ON public.ngrams USING btree (id, terms);
......
[gargantext]
MASTER_USER = gargantua
[django]
# SECURITY WARNING: don't run with debug turned on in production!
DEBUG = True
# SECURITY WARNING: keep the secret key used in production secret!
SECRET_KEY = %4{Vs(Pc!GU-]@OaAl0)(*4/yERwU<ct`ncV{1)O%32$6q
# Space-separated list of hosts
ALLOWED_HOSTS = localhost
# Time-zone, possible values here: https://en.wikipedia.org/wiki/List_of_tz_database_time_zones
TIME_ZONE = Europe/Paris
# PostgreSQL access
DB_HOST = 127.0.0.1
DB_PORT = 5432
DB_NAME = gargandbV5
DB_USER = gargantua
DB_PASS = C8kdcUrAQy66U
# Logs
LOG_FILE = /var/log/gargantext/backend/django.log
LOG_LEVEL = DEBUG
LOG_FORMATTER = verbose
# Pidfile of django backend test server
TESTSERVER_PIDFILE = /tmp/gargantext_testserver.pid
# Celery
CELERYD_PID_FILE = /tmp/celery.pid
CELERYD_LOG_FILE = /var/log/gargantext/backend/celery.log
CELERYD_LOG_LEVEL = DEBUG
[uwsgi]
# See: http://uwsgi-docs.readthedocs.io/en/latest/ThingsToKnow.html
# And: http://uwsgi-docs.readthedocs.io/en/latest/articles/TheArtOfGracefulReloading.html
# Tip from: https://serverfault.com/questions/411361/uwsgi-ini-configuration-for-python-apps
if-env = VIRTUAL_ENV
print = [uWSGI] launched from virtualenv %(_)
virtualenv = %(_)
endif =
# needed to run uwsgi when it was not installed with pipenv
plugins = python35
# needed to run uwsgi outside of pipenv shell, because of this virtualenv bug:
# https://github.com/kennethreitz/pipenv/issues/829
home = /home/alexandre/.local/share/virtualenvs/gargantext-ykNZD4Cw
# unix socket is better than TCP one, there is less overhead
socket = /tmp/gargantext.sock
chmod-socket = 664
# user running uwsgi MUST be a member of www-data group
chown-socket = %U:www-data
# wsgi django module
module = gargantext.backend.wsgi:application
# about master: http://uwsgi-docs.readthedocs.io/en/latest/Management.html?highlight=master#reloading-the-server
master = True
# can do: uwsgi --stop /tmp/gargantext.pid
pidfile = /tmp/gargantext.pid
# clear environment on exit
vacuum = True
max-requests = 5000
# background the process & log
daemonize = /var/log/gargantext/uwsgi/@(exec://date +%%Y-%%m-%%d).log
logfile-chmod = 644
# one log file per day
log-reopen = true
# touch /tmp/gargantext.reload to reload configuration (after git pull for instance)
touch-reload = /tmp/gargantext.reload
[gargantext]
# Needed to instantiate the first users and first data
MASTER_USER = gargantua
# SECURITY WARNING: keep the secret key used in production secret!
SECRET_KEY = PASSWORD_TO_CHANGE
# Data path to local files
DATA_FILEPATH = FILEPATH_TO_CHANGE
# [external]
# FRAMES (i.e. iframe sources used in various places on the frontend)
FRAME_WRITE_URL = URL_TO_CHANGE
FRAME_CALC_URL = URL_TO_CHANGE
FRAME_SEARX_URL = URL_TO_CHANGE
FRAME_ISTEX_URL = URL_TO_CHANGE
[server]
# Server config (TODO connect in ReaderMonad)
ALLOWED_ORIGIN = http://localhost
ALLOWED_ORIGIN_PORT = 8008
ALLOWED_HOST = localhost
ALLOWED_HOST_PORT = 3000
JWT_SETTINGS = TODO
[network]
# Emails From address (sent by smtp)
MAIL = username@gargantext.org
HOST = localhost
# if remote smtp host
# HOST_USER = user
# HOST_password = password
[database]
# PostgreSQL access
DB_HOST = 127.0.0.1
DB_PORT = 5432
DB_NAME = gargandbV5
DB_USER = gargantua
DB_PASS = PASSWORD_TO_CHANGE
[logs]
LOG_FILE = /var/log/gargantext/backend.log
LOG_LEVEL = LevelDebug
LOG_FORMATTER = verbose
name: gargantext name: gargantext
version: '0.0.0.4' version: '0.0.1.8.3'
synopsis: Search, map, share synopsis: Search, map, share
description: Please see README.md description: Please see README.md
category: Data category: Data
author: Gargantext Team author: Gargantext Team
maintainer: team@gargantext.org maintainer: team@gargantext.org
copyright: copyright:
- ! 'Copyright: (c) 2017-2018: see git logs and README' - ! 'Copyright: (c) 2017-Present: see git logs and README'
license: BSD3 license: AGPL-3
homepage: https://gargantext.org homepage: https://gargantext.org
ghc-options: -Wall ghc-options: -Wall
extra-libraries:
- gfortran
dependencies: dependencies:
- extra - extra
- text - text
default-extensions:
- DataKinds
- DeriveGeneric
- FlexibleContexts
- FlexibleInstances
- GeneralizedNewtypeDeriving
- MultiParamTypeClasses
- NoImplicitPrelude
- OverloadedStrings
- RankNTypes
library: library:
source-dirs: src source-dirs: src
ghc-options: ghc-options:
...@@ -22,73 +34,79 @@ library: ...@@ -22,73 +34,79 @@ library:
- -Wunused-binds - -Wunused-binds
- -Wunused-imports - -Wunused-imports
- -Werror - -Werror
- -freduction-depth=300
exposed-modules: exposed-modules:
- Gargantext - Gargantext
- Gargantext.API - Gargantext.API
- Gargantext.API.Auth - Gargantext.API.HashedResponse
- Gargantext.API.Count
- Gargantext.API.FrontEnd
- Gargantext.API.Ngrams
- Gargantext.API.Node - Gargantext.API.Node
# - Gargantext.API.Orchestrator - Gargantext.API.Node.File
- Gargantext.API.Search - Gargantext.API.Ngrams
- Gargantext.API.Settings - Gargantext.API.Admin.Settings
- Gargantext.API.Types - Gargantext.API.Prelude
- Gargantext.Core - Gargantext.Core
- Gargantext.Core.Types - Gargantext.Core.Types
- Gargantext.Core.Types.Individu
- Gargantext.Core.Types.Main - Gargantext.Core.Types.Main
- Gargantext.Core.Utils.Prefix - Gargantext.Core.Utils.Prefix
- Gargantext.Database - Gargantext.Database.Action.Flow
- Gargantext.Database.Init - Gargantext.Database.Query.Table.User
- Gargantext.Database.Config - Gargantext.Database.Query.Table.Node
- Gargantext.Database.Flow - Gargantext.Database.Prelude
- Gargantext.Database.Schema.Node - Gargantext.Database.Admin.Trigger.Init
- Gargantext.Database.Tree - Gargantext.Database.Admin.Config
- Gargantext.Database.Types.Node - Gargantext.Database.Admin.Types.Hyperdata
- Gargantext.Database.Utils - Gargantext.Database.Admin.Types.Node
- Gargantext.Database.Schema.User
- Gargantext.Prelude - Gargantext.Prelude
- Gargantext.Text - Gargantext.Prelude.Utils
- Gargantext.Text.Context - Gargantext.Core.Text
- Gargantext.Text.Corpus.Parsers - Gargantext.Core.Text.Context
- Gargantext.Text.Corpus.API - Gargantext.Core.Text.Corpus.Parsers
- Gargantext.Text.Corpus.Parsers.CSV - Gargantext.Core.Text.Corpus.Parsers.Date.Parsec
- Gargantext.Text.Examples - Gargantext.Core.Text.Corpus.API
- Gargantext.Text.List.CSV - Gargantext.Core.Text.Corpus.Parsers.CSV
- Gargantext.Text.Metrics - Gargantext.Core.Text.Examples
- Gargantext.Text.Metrics.TFICF - Gargantext.Core.Text.List.CSV
- Gargantext.Text.Metrics.CharByChar - Gargantext.Core.Text.Metrics
- Gargantext.Text.Metrics.Count - Gargantext.Core.Text.Metrics.TFICF
- Gargantext.Text.Search - Gargantext.Core.Text.Metrics.CharByChar
- Gargantext.Text.Terms - Gargantext.Core.Text.Metrics.Count
- Gargantext.Text.Terms.Mono - Gargantext.Core.Text.Search
- Gargantext.Text.Terms.Multi.Lang.En - Gargantext.Core.Text.Terms
- Gargantext.Text.Terms.Multi.Lang.Fr - Gargantext.Core.Text.Terms.Mono
- Gargantext.Text.Terms.Multi.RAKE - Gargantext.Core.Text.Terms.Multi.Lang.En
- Gargantext.Text.Terms.WithList - Gargantext.Core.Text.Terms.Multi.Lang.Fr
- Gargantext.Text.Flow - Gargantext.Core.Text.Terms.Multi.RAKE
- Gargantext.Viz.Graph - Gargantext.Core.Text.Terms.WithList
- Gargantext.Viz.Graph.Distances.Matrice - Gargantext.Core.Text.Flow
- Gargantext.Viz.Graph.Index - Gargantext.Core.Viz.Graph
- Gargantext.Viz.Phylo - Gargantext.Core.Viz.Graph.Distances.Matrice
- Gargantext.Viz.AdaptativePhylo - Gargantext.Core.Viz.Graph.Index
- Gargantext.Viz.Phylo.PhyloMaker - Gargantext.Core.Viz.Phylo
- Gargantext.Viz.Phylo.Tools - Gargantext.Core.Viz.AdaptativePhylo
- Gargantext.Viz.Phylo.PhyloTools - Gargantext.Core.Viz.Phylo.PhyloMaker
- Gargantext.Viz.Phylo.PhyloExport - Gargantext.Core.Viz.Phylo.Tools
- Gargantext.Viz.Phylo.SynchronicClustering - Gargantext.Core.Viz.Phylo.PhyloTools
- Gargantext.Viz.Phylo.Example - Gargantext.Core.Viz.Phylo.PhyloExport
- Gargantext.Viz.Phylo.LevelMaker - Gargantext.Core.Viz.Phylo.SynchronicClustering
- Gargantext.Viz.Phylo.View.Export - Gargantext.Core.Viz.Phylo.Example
- Gargantext.Viz.Phylo.View.ViewMaker - Gargantext.Core.Viz.Phylo.LevelMaker
- Gargantext.Core.Viz.Phylo.View.Export
- Gargantext.Core.Viz.Phylo.View.ViewMaker
- Gargantext.Core.Viz.Types
dependencies: dependencies:
- array - HSvm
- KMP
- MonadRandom
- QuickCheck - QuickCheck
- SHA
- Unique
- accelerate - accelerate
- aeson - aeson
- aeson-lens - aeson-lens
- aeson-pretty - aeson-pretty
- argon2 - password
- array
- async - async
- attoparsec - attoparsec
- auto-update - auto-update
...@@ -101,53 +119,52 @@ library: ...@@ -101,53 +119,52 @@ library:
- bytestring - bytestring
- case-insensitive - case-insensitive
- cassava - cassava
#- charsetdetect-ae # detect charset - cereal # (IGraph)
- clock - clock
- clustering-louvain - clustering-louvain
- conduit - conduit
- conduit-extra - conduit-extra
- containers - containers
- contravariant - contravariant
- crawlerPubMed
- crawlerIsidore
- crawlerHAL - crawlerHAL
- crawlerISTEX - crawlerISTEX
- crawlerIsidore
- crawlerPubMed
- data-time-segment - data-time-segment
- deepseq - deepseq
- directory - directory
- duckling - duckling
- exceptions - exceptions
- filepath - fast-logger
- formatting
- fullstop
- fclabels - fclabels
- fgl - fgl
- fast-logger
- filelock - filelock
- filepath
- formatting
- full-text-search - full-text-search
- fullstop
- graphviz - graphviz
- haskell-igraph - haskell-igraph
- hlcm
- hsparql
- hstatistics
- http-api-data
- http-client - http-client
- http-client-tls - http-client-tls
- http-conduit - http-conduit
- http-media - http-media
- http-api-data
- http-types - http-types
- hsparql
- hstatistics
- HSvm
- hxt - hxt
- hlcm
- ini - ini
- insert-ordered-containers - insert-ordered-containers
- jose - jose
# - kmeans-vector
- json-stream - json-stream
- KMP
- lens - lens
- located-base - located-base
- logging-effect - logging-effect
- matrix - matrix
- MissingH
- monad-control
- monad-logger - monad-logger
- mtl - mtl
- natural-transformation - natural-transformation
...@@ -166,36 +183,46 @@ library: ...@@ -166,36 +183,46 @@ library:
- profunctors - profunctors
- protolude - protolude
- pureMD5 - pureMD5
- random-shuffle
- MonadRandom
- SHA
- simple-reflect
- cereal # (IGraph)
- singletons # (IGraph)
- quickcheck-instances - quickcheck-instances
- random
- rake - rake
- random
- random-shuffle
- rdf4h
- regex-compat - regex-compat
- resource-pool
- resourcet - resourcet
- rdf4h
- safe - safe
- semigroups - semigroups
- serialise
- servant - servant
- servant-auth - servant-auth
- servant-auth-server >= 0.4.4.0 - servant-auth-server >= 0.4.4.0
- servant-auth-swagger - servant-auth-swagger
- servant-blaze - servant-blaze
- servant-cassava
- servant-client - servant-client
- servant-flatten
- servant-job - servant-job
- servant-mock - servant-mock
- servant-multipart - servant-multipart
- servant-server - servant-server
- servant-static-th
- servant-swagger - servant-swagger
- servant-swagger-ui - servant-swagger-ui
- servant-static-th - servant-xml
- servant-cassava - simple-reflect
- serialise - singletons # (IGraph)
- template-haskell
- wai-app-static
# for mail
- smtp-mail
- mime-mail
# for password generation
- cprng-aes
- binary
- crypto-random
- split - split
- stemmer - stemmer
- string-conversions - string-conversions
...@@ -209,7 +236,6 @@ library: ...@@ -209,7 +236,6 @@ library:
- transformers - transformers
- transformers-base - transformers-base
- unordered-containers - unordered-containers
- Unique
- uuid - uuid
- validity - validity
- vector - vector
...@@ -220,9 +246,12 @@ library: ...@@ -220,9 +246,12 @@ library:
- wreq - wreq
- xml-conduit - xml-conduit
- xml-types - xml-types
- xmlbf
- yaml - yaml
- zip - zip
- zlib - zlib
# - kmeans-vector
#- charsetdetect-ae # detect charset
# - utc # - utc
# API external connections # API external connections
...@@ -237,6 +266,7 @@ executables: ...@@ -237,6 +266,7 @@ executables:
- -rtsopts - -rtsopts
- -threaded - -threaded
- -with-rtsopts=-N - -with-rtsopts=-N
- -fprof-auto
dependencies: dependencies:
- base - base
- containers - containers
...@@ -349,38 +379,76 @@ executables: ...@@ -349,38 +379,76 @@ executables:
- gargantext - gargantext
- base - base
gargantext-cbor2json:
tests:
# garg-test:
# main: Main.hs
# source-dirs: src-test
# ghc-options:
# - -threaded
# - -rtsopts
# - -with-rtsopts=-N
# dependencies:
# - base
# - gargantext
# - hspec
# - QuickCheck
# - quickcheck-instances
# - time
# - parsec
# - duckling
# - text
garg-doctest:
main: Main.hs main: Main.hs
source-dirs: src-doctest source-dirs: bin/gargantext-cbor2json
ghc-options: ghc-options:
- -O2
- -Wcompat
- -Wmissing-signatures
- -rtsopts
- -threaded - -threaded
- -rtsopts
- -with-rtsopts=-N - -with-rtsopts=-N
- -O2
- -Wmissing-signatures
dependencies: dependencies:
- doctest - gargantext
- Glob - base
- QuickCheck - bytestring
- base - aeson
- gargantext - serialise
tests:
garg-test:
main: Main.hs
source-dirs: src-test
default-extensions:
- DataKinds
- DeriveGeneric
- FlexibleContexts
- FlexibleInstances
- GeneralizedNewtypeDeriving
- MultiParamTypeClasses
- NoImplicitPrelude
- OverloadedStrings
- RankNTypes
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-N
dependencies:
- base
- gargantext
- hspec
- QuickCheck
- quickcheck-instances
- time
- parsec
- duckling
- text
# garg-doctest:
# main: Main.hs
# source-dirs: src-doctest
# ghc-options:
# - -O2
# - -Wcompat
# - -Wmissing-signatures
# - -rtsopts
# - -threaded
# - -with-rtsopts=-N
# dependencies:
# - doctest
# - Glob
# - QuickCheck
# - base
# - gargantext
# default-extensions:
# - DataKinds
# - DeriveGeneric
# - FlexibleContexts
# - FlexibleInstances
# - GeneralizedNewtypeDeriving
# - MultiParamTypeClasses
# - NoImplicitPrelude
# - OverloadedStrings
# - RankNTypes
#
# this version of nixpkgs contains liblapack at 3.8.0
# this version of nixpkgs contains gsl at 2.5.0
import (
builtins.fetchTarball {
url = "https://github.com/NixOS/nixpkgs/archive/19.09.tar.gz";
sha256 = "0mhqhq21y5vrr1f30qd2bvydv4bbbslvyzclhw0kdxmkgg3z4c92";
}
)
# this version of nixpkgs contains liblapack at 3.8.0
# this version of nixpkgs contains gsl at 2.5.0
import (
builtins.fetchTarball {
url = "https://github.com/NixOS/nixpkgs/archive/18.09.tar.gz";
sha256 = "1ib96has10v5nr6bzf7v8kw7yzww8zanxgw2qi1ll1sbv6kj6zpd";
}
)
~/.local/bin/gargantext-server --ini gargantext.ini --run Dev +RTS # -p
with (import <nixpkgs> {}); { pkgs ? import ./pinned-19.09.nix {} }:
stdenv.mkDerivation rec {
name = "env"; pkgs.mkShell {
env = buildEnv { buildInputs = with pkgs; [
name = name;
paths = buildInputs;
};
buildInputs = [
docker-compose docker-compose
#glibc #glibc
#gmp #gmp
...@@ -16,8 +12,4 @@ stdenv.mkDerivation rec { ...@@ -16,8 +12,4 @@ stdenv.mkDerivation rec {
#stack #stack
#xz #xz
]; ];
builder = builtins.toFile "builder.sh" ''
source $stdenv/setup
touch $out
'';
} }
import System.FilePath.Glob import System.FilePath.Glob
import Test.DocTest import Test.DocTest
import Gargantext.Prelude
main :: IO () main :: IO ()
main = glob "src/Gargantext/" >>= doctest main = glob "src/Gargantext/" >>= doctest
......
{-|
Module : Graph.Distance
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
Here is a longer description of this module, containing some
commentary with @some markup@.
-}
module Graph.Distance where
import Test.Hspec
import Gargantext.Viz.Graph.Distances.Matrice
import Gargantext.Prelude
test :: IO ()
test = hspec $ do
describe "Cross" $ do
let result = cross' $ matrix 3 ([1,1..] :: [Double])
it "compare" $ do
shouldBe result (matrix 3 ([2,2..] :: [Double]))
...@@ -8,20 +8,23 @@ Stability : experimental ...@@ -8,20 +8,23 @@ Stability : experimental
Portability : POSIX Portability : POSIX
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Core (Lang(..)) import Gargantext.Core (Lang(..))
--import qualified Ngrams.Lang.Fr as Fr --import qualified Ngrams.Lang.Fr as Fr
import qualified Ngrams.Lang as Lang --import qualified Ngrams.Lang as Lang
import qualified Ngrams.Lang.Occurrences as Occ import qualified Ngrams.Lang.Occurrences as Occ
import qualified Ngrams.Metrics as Metrics import qualified Ngrams.Metrics as Metrics
import qualified Parsers.Date as PD import qualified Parsers.Date as PD
import qualified Graph.Distance as GD
import qualified Utils.Crypto as Crypto
main :: IO () main :: IO ()
main = do main = do
Occ.parsersTest -- Occ.parsersTest
Lang.ngramsExtractionTest FR -- Lang.ngramsExtractionTest FR
Lang.ngramsExtractionTest EN -- Lang.ngramsExtractionTest EN
Metrics.main -- Metrics.main
PD.testFromRFC3339 PD.testFromRFC3339
-- GD.test
Crypto.test
...@@ -12,10 +12,10 @@ Here is a longer description of this module, containing some ...@@ -12,10 +12,10 @@ Here is a longer description of this module, containing some
commentary with @some markup@. commentary with @some markup@.
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
module Ngrams.Lang where module Ngrams.Lang where
{-
import Gargantext.Prelude (IO()) import Gargantext.Prelude (IO())
import Gargantext.Core (Lang(..)) import Gargantext.Core (Lang(..))
...@@ -25,4 +25,4 @@ import qualified Ngrams.Lang.En as En ...@@ -25,4 +25,4 @@ import qualified Ngrams.Lang.En as En
ngramsExtractionTest :: Lang -> IO () ngramsExtractionTest :: Lang -> IO ()
ngramsExtractionTest FR = Fr.ngramsExtractionTest ngramsExtractionTest FR = Fr.ngramsExtractionTest
ngramsExtractionTest EN = En.ngramsExtractionTest ngramsExtractionTest EN = En.ngramsExtractionTest
-}
...@@ -11,12 +11,11 @@ Here is a longer description of this module, containing some ...@@ -11,12 +11,11 @@ Here is a longer description of this module, containing some
commentary with @some markup@. commentary with @some markup@.
-} -}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Ngrams.Lang.En where module Ngrams.Lang.En where
{-
import Data.List ((!!)) import Data.List ((!!))
import Data.Text (Text) import Data.Text (Text)
...@@ -24,8 +23,11 @@ import Test.Hspec ...@@ -24,8 +23,11 @@ import Test.Hspec
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Core (Lang(..)) import Gargantext.Core (Lang(..))
import Gargantext.Text.Ngrams.PosTagging.Parser (extractNgrams, selectNgrams)
-- TODO this import is not used anymore
import Gargantext.Text.Ngrams.PosTagging.Parser (extractNgrams, selectNgrams)
-- use instead
-- import Gargantext.Text.Terms (extractNgramsT)
ngramsExtractionTest :: IO () ngramsExtractionTest :: IO ()
ngramsExtractionTest = hspec $ do ngramsExtractionTest = hspec $ do
...@@ -45,4 +47,4 @@ ngramsExtractionTest = hspec $ do ...@@ -45,4 +47,4 @@ ngramsExtractionTest = hspec $ do
t2 <- map (selectNgrams EN) <$> extractNgrams EN t t2 <- map (selectNgrams EN) <$> extractNgrams EN t
t2 `shouldBe` [[("Donald Trump","NNP","PERSON"),("president of the United-States of America","NN","LOCATION")]] t2 `shouldBe` [[("Donald Trump","NNP","PERSON"),("president of the United-States of America","NN","LOCATION")]]
-}
...@@ -11,18 +11,19 @@ Here is a longer description of this module, containing some ...@@ -11,18 +11,19 @@ Here is a longer description of this module, containing some
commentary with @some markup@. commentary with @some markup@.
-} -}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Ngrams.Lang.Fr where module Ngrams.Lang.Fr where
{-
import Test.Hspec import Test.Hspec
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Core (Lang(..)) import Gargantext.Core (Lang(..))
-- TODO this import is not used anymore
import Gargantext.Text.Ngrams.PosTagging.Parser (extractNgrams, selectNgrams) import Gargantext.Text.Ngrams.PosTagging.Parser (extractNgrams, selectNgrams)
-- use instead
-
ngramsExtractionTest :: IO () ngramsExtractionTest :: IO ()
ngramsExtractionTest = hspec $ do ngramsExtractionTest = hspec $ do
describe "Behavioral tests: ngrams extraction in French Language" $ do describe "Behavioral tests: ngrams extraction in French Language" $ do
...@@ -63,4 +64,4 @@ ngramsExtractionTest = hspec $ do ...@@ -63,4 +64,4 @@ ngramsExtractionTest = hspec $ do
let textFr1 = "L'heure d'arrivée des coureurs dépend de la météo du jour." let textFr1 = "L'heure d'arrivée des coureurs dépend de la météo du jour."
testFr1 <- map (selectNgrams FR) <$> (extractNgrams FR) textFr1 testFr1 <- map (selectNgrams FR) <$> (extractNgrams FR) textFr1
testFr1 `shouldBe` [[("heure d' arrivée des coureurs","NC","O"),("météo du jour","NC","O")]] testFr1 `shouldBe` [[("heure d' arrivée des coureurs","NC","O"),("météo du jour","NC","O")]]
-}
...@@ -11,12 +11,11 @@ Here is a longer description of this module, containing some ...@@ -11,12 +11,11 @@ Here is a longer description of this module, containing some
commentary with @some markup@. commentary with @some markup@.
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
module Ngrams.Lang.Occurrences where module Ngrams.Lang.Occurrences where
{-
import Test.Hspec import Test.Hspec
import Data.Either (Either(Right)) import Data.Either (Either(Right))
...@@ -61,4 +60,4 @@ parsersTest = hspec $ do ...@@ -61,4 +60,4 @@ parsersTest = hspec $ do
-- describe "Parser for nodes" $ do -- describe "Parser for nodes" $ do
-- it "returns the result of one parsing after space" $ do -- it "returns the result of one parsing after space" $ do
-- occOfCorpus 249509 "sciences" `shouldReturn` 7 -- occOfCorpus 249509 "sciences" `shouldReturn` 7
-}
...@@ -14,11 +14,11 @@ commentary with @some markup@. ...@@ -14,11 +14,11 @@ commentary with @some markup@.
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Ngrams.Metrics (main) where --module Ngrams.Metrics (main) where
module Ngrams.Metrics where
{-
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Ratio import Data.Ratio
...@@ -141,3 +141,5 @@ testPair :: (Eq a, Show a) ...@@ -141,3 +141,5 @@ testPair :: (Eq a, Show a)
-> SpecWith () -> SpecWith ()
testPair f a b r = it ("‘" <> T.unpack a <> "’ and ‘" <> T.unpack b <> "’") $ testPair f a b r = it ("‘" <> T.unpack a <> "’ and ‘" <> T.unpack b <> "’") $
f a b `shouldBe` r f a b `shouldBe` r
-}
...@@ -11,7 +11,6 @@ Here is a longer description of this module, containing some ...@@ -11,7 +11,6 @@ Here is a longer description of this module, containing some
commentary with @some markup@. commentary with @some markup@.
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
module Parsers.Date where module Parsers.Date where
...@@ -29,7 +28,7 @@ import Duckling.Time.Types (toRFC3339) ...@@ -29,7 +28,7 @@ import Duckling.Time.Types (toRFC3339)
----------------------------------------------------------- -----------------------------------------------------------
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Text.Parsers.Date (fromRFC3339) import Gargantext.Text.Corpus.Parsers.Date.Parsec (fromRFC3339)
import Parsers.Types import Parsers.Types
----------------------------------------------------------- -----------------------------------------------------------
......
...@@ -13,7 +13,6 @@ commentary with @some markup@. ...@@ -13,7 +13,6 @@ commentary with @some markup@.
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
module Parsers.Types where module Parsers.Types where
......
...@@ -11,6 +11,5 @@ Here is a longer description of this module, containing some ...@@ -11,6 +11,5 @@ Here is a longer description of this module, containing some
commentary with @some markup@. commentary with @some markup@.
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
module Parsers.WOS where module Parsers.WOS where
{-|
Module : Utils.Crypto
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
module Utils.Crypto where
import Data.Text (Text)
import Test.Hspec
import Gargantext.Prelude
import Gargantext.Prelude.Utils
-- | Crypto Hash tests
test :: IO ()
test = hspec $ do
describe "Hash String with frontend works" $ do
let text = "To hash with backend" :: Text
let hashed = "8a69a94d164279af2b7d1443ce08da6184b3d7e815406076e148159c284b53c3" :: Hash
-- ^ hash from fronted with text above
it "compare" $ do
hash text `shouldBe` hashed
describe "Hash List with backend works" $ do
let list = ["a","b"] :: [Text]
let hashed = "ab19ec537f09499b26f0f62eed7aefad46ab9f498e06a7328ce8e8ef90da6d86" :: Hash
-- ^ hash from frontend with text above
it "compare" $ do
hash list `shouldBe` hashed
------------------------------------------------------------------------
-- | TODO property based tests
describe "Hash works with any order of list" $ do
let hash1 = hash (["a","b"] :: [Text])
let hash2 = hash (["b","a"] :: [Text])
it "compare" $ do
hash1 `shouldBe` hash2
...@@ -10,19 +10,16 @@ Portability : POSIX ...@@ -10,19 +10,16 @@ Portability : POSIX
@Gargantext@: search, map, share @Gargantext@: search, map, share
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
module Gargantext ( module Gargantext.API module Gargantext ( module Gargantext.API
, module Gargantext.Core , module Gargantext.Core
, module Gargantext.Database , module Gargantext.Database
, module Gargantext.Prelude , module Gargantext.Prelude
, module Gargantext.Text -- , module Gargantext.Core.Viz
-- , module Gargantext.Viz
) where ) where
import Gargantext.API import Gargantext.API
import Gargantext.Core import Gargantext.Core
import Gargantext.Database import Gargantext.Database
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Text --import Gargantext.Core.Viz
--import Gargantext.Viz
This diff is collapsed.
{-| {-|
Module : Gargantext.API.Auth Module : Gargantext.API.Admin.Auth
Description : Server API Auth Module Description : Server API Auth Module
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
...@@ -20,47 +20,41 @@ TODO-ACCESS Critical ...@@ -20,47 +20,41 @@ TODO-ACCESS Critical
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.API.Auth module Gargantext.API.Admin.Auth
where where
import Control.Lens (view) import Control.Lens (view)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson.TH (deriveJSON) import Data.Aeson.TH (deriveJSON)
import Data.List (elem)
import Data.Swagger import Data.Swagger
import Data.Text (Text, reverse) import Data.Text (Text)
import Data.Text.Lazy (toStrict) import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Encoding (decodeUtf8) import Data.Text.Lazy.Encoding (decodeUtf8)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Servant import Gargantext.API.Admin.Settings
import Servant.Auth.Server import Gargantext.API.Prelude (HasJoseError(..), joseError, HasServerError, GargServerC)
import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..), arbitraryUsername, arbitraryPassword)
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.API.Settings import Gargantext.Database.Query.Tree (isDescendantOf, isIn)
import Gargantext.API.Types (HasJoseError(..), joseError, HasServerError, GargServerC) import Gargantext.Database.Query.Tree.Root (getRoot)
--import Gargantext.API.Types (HasJoseError(..), joseError, HasServerError, serverError, GargServerC) import Gargantext.Database.Schema.Node (NodePoly(_node_id))
import Gargantext.Database.Root (getRoot) import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId, ListId, DocId)
import Gargantext.Database.Tree (isDescendantOf, isIn) import Gargantext.Database.Prelude (Cmd', CmdM, HasConnectionPool, HasConfig)
import Gargantext.Database.Types.Node (NodePoly(_node_id), NodeId(..), UserId, ListId, DocId)
import Gargantext.Database.Utils (Cmd', CmdM, HasConnection)
import Gargantext.Prelude hiding (reverse) import Gargantext.Prelude hiding (reverse)
import Gargantext.Database.Query.Table.User
import Servant
import Servant.Auth.Server
import Test.QuickCheck (elements, oneof) import Test.QuickCheck (elements, oneof)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import Gargantext.Core.Types.Individu (Username, Password, arbitraryUsername, arbitraryPassword) import qualified Gargantext.Prelude.Crypto.Auth as Auth
--------------------------------------------------- ---------------------------------------------------
-- | Main types for AUTH API -- | Main types for AUTH API
data AuthRequest = AuthRequest { _authReq_username :: Username data AuthRequest = AuthRequest { _authReq_username :: Username
, _authReq_password :: Password , _authReq_password :: GargPassword
} }
deriving (Generic) deriving (Generic)
...@@ -91,25 +85,31 @@ makeTokenForUser :: (HasSettings env, HasJoseError err) ...@@ -91,25 +85,31 @@ makeTokenForUser :: (HasSettings env, HasJoseError err)
=> NodeId -> Cmd' env err Token => NodeId -> Cmd' env err Token
makeTokenForUser uid = do makeTokenForUser uid = do
jwtS <- view $ settings . jwtSettings jwtS <- view $ settings . jwtSettings
e <- liftIO $ makeJWT (AuthenticatedUser uid) jwtS Nothing e <- liftBase $ makeJWT (AuthenticatedUser uid) jwtS Nothing
-- TODO-SECURITY here we can implement token expiration ^^. -- TODO-SECURITY here we can implement token expiration ^^.
either joseError (pure . toStrict . decodeUtf8) e either joseError (pure . toStrict . decodeUtf8) e
-- TODO not sure about the encoding... -- TODO not sure about the encoding...
checkAuthRequest :: (HasSettings env, HasConnection env, HasJoseError err) checkAuthRequest :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env)
=> Username -> Password -> Cmd' env err CheckAuth => Username
checkAuthRequest u p -> GargPassword
| not (u `elem` arbitraryUsername) = pure InvalidUser -> Cmd' env err CheckAuth
| u /= reverse p = pure InvalidPassword checkAuthRequest u (GargPassword p) = do
| otherwise = do candidate <- head <$> getUsersWith u
muId <- head <$> getRoot u case candidate of
case _node_id <$> muId of Nothing -> pure InvalidUser
Nothing -> pure InvalidUser Just (UserLight _id _u _email h) ->
Just uid -> do case Auth.checkPassword (Auth.mkPassword p) (Auth.PasswordHash h) of
token <- makeTokenForUser uid Auth.PasswordCheckFail -> pure InvalidPassword
pure $ Valid token uid Auth.PasswordCheckSuccess -> do
muId <- head <$> getRoot (UserName u)
auth :: (HasSettings env, HasConnection env, HasJoseError err) case _node_id <$> muId of
Nothing -> pure InvalidUser
Just uid -> do
token <- makeTokenForUser uid
pure $ Valid token uid
auth :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env)
=> AuthRequest -> Cmd' env err AuthResponse => AuthRequest -> Cmd' env err AuthResponse
auth (AuthRequest u p) = do auth (AuthRequest u p) = do
checkAuthRequest' <- checkAuthRequest u p checkAuthRequest' <- checkAuthRequest u p
...@@ -123,8 +123,10 @@ newtype AuthenticatedUser = AuthenticatedUser ...@@ -123,8 +123,10 @@ newtype AuthenticatedUser = AuthenticatedUser
} deriving (Generic) } deriving (Generic)
$(deriveJSON (unPrefix "_authUser_") ''AuthenticatedUser) $(deriveJSON (unPrefix "_authUser_") ''AuthenticatedUser)
instance ToSchema AuthenticatedUser where instance ToSchema AuthenticatedUser where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authUser_") declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authUser_")
instance ToJWT AuthenticatedUser instance ToJWT AuthenticatedUser
instance FromJWT AuthenticatedUser instance FromJWT AuthenticatedUser
...@@ -199,8 +201,7 @@ withAccessM uId (PathNodeNode cId docId) m = do ...@@ -199,8 +201,7 @@ withAccessM uId (PathNodeNode cId docId) m = do
withAccess :: forall env err m api. withAccess :: forall env err m api.
(GargServerC env err m, HasServer api '[]) => (GargServerC env err m, HasServer api '[]) =>
Proxy api -> Proxy m -> Proxy api -> Proxy m -> UserId -> PathId ->
UserId -> PathId ->
ServerT api m -> ServerT api m ServerT api m -> ServerT api m
withAccess p _ uId id = hoistServer p f withAccess p _ uId id = hoistServer p f
where where
......
{-| {-|
Module : Gargantext.API.FrontEnd Module : Gargantext.API.Admin.FrontEnd
Description : Server FrontEnd API Description : Server FrontEnd API
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
...@@ -11,12 +11,10 @@ Loads all static file for the front-end. ...@@ -11,12 +11,10 @@ Loads all static file for the front-end.
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
--------------------------------------------------------------------- ---------------------------------------------------------------------
module Gargantext.API.FrontEnd where module Gargantext.API.Admin.FrontEnd where
import Servant import Servant
import Servant.Server.StaticFiles (serveDirectoryFileServer) import Servant.Server.StaticFiles (serveDirectoryFileServer)
......
{-# LANGUAGE DataKinds #-} {-|
{-# LANGUAGE OverloadedStrings #-} Module : Gargantext.API.Admin.Orchestrator
{-# LANGUAGE FlexibleContexts #-} Description : Jobs Orchestrator
{-# LANGUAGE FlexibleInstances #-} Copyright : (c) CNRS, 2017-Present
{-# LANGUAGE DeriveGeneric #-} License : AGPL + CECILL v3
{-# LANGUAGE RankNTypes #-} Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Gargantext.API.Orchestrator where module Gargantext.API.Admin.Orchestrator where
import Gargantext.Prelude
import Gargantext.API.Settings
import Gargantext.API.Orchestrator.Types
import Gargantext.API.Orchestrator.Scrapy.Schedule
import Control.Lens hiding (elements) import Control.Lens hiding (elements)
import Data.Aeson import Data.Aeson
import qualified Data.ByteString.Lazy.Char8 as LBS import Data.Text
import Gargantext.API.Admin.Orchestrator.Scrapy.Schedule
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Admin.Settings
import Gargantext.Prelude
import Servant import Servant
import Servant.Job.Async import Servant.Job.Async
import Servant.Job.Client import Servant.Job.Client
import Servant.Job.Server import Servant.Job.Server
import Servant.Job.Utils (extendBaseUrl) import Servant.Job.Utils (extendBaseUrl)
import qualified Data.ByteString.Lazy.Char8 as LBS
callJobScrapy :: (ToJSON e, FromJSON e, FromJSON o, MonadClientJob m) callJobScrapy :: (ToJSON e, FromJSON e, FromJSON o, MonadClientJob m)
=> JobServerURL e Schedule o => JobServerURL e Schedule o
...@@ -37,7 +43,7 @@ callJobScrapy jurl schedule = do ...@@ -37,7 +43,7 @@ callJobScrapy jurl schedule = do
logConsole :: ToJSON a => a -> IO () logConsole :: ToJSON a => a -> IO ()
logConsole = LBS.putStrLn . encode logConsole = LBS.putStrLn . encode
callScraper :: MonadClientJob m => URL -> ScraperInput -> m ScraperStatus callScraper :: MonadClientJob m => URL -> ScraperInput -> m JobLog
callScraper url input = callScraper url input =
callJobScrapy jurl $ \cb -> callJobScrapy jurl $ \cb ->
Schedule Schedule
...@@ -57,11 +63,11 @@ callScraper url input = ...@@ -57,11 +63,11 @@ callScraper url input =
,("callback", [toUrlPiece cb])] ,("callback", [toUrlPiece cb])]
} }
where where
jurl :: JobServerURL ScraperStatus Schedule ScraperStatus jurl :: JobServerURL JobLog Schedule JobLog
jurl = JobServerURL url Callback jurl = JobServerURL url Callback
pipeline :: FromJSON e => URL -> ClientEnv -> ScraperInput pipeline :: FromJSON e => URL -> ClientEnv -> ScraperInput
-> (e -> IO ()) -> IO ScraperStatus -> (e -> IO ()) -> IO JobLog
pipeline scrapyurl client_env input log_status = do pipeline scrapyurl client_env input log_status = do
e <- runJobMLog client_env log_status $ callScraper scrapyurl input e <- runJobMLog client_env log_status $ callScraper scrapyurl input
either (panic . cs . show) pure e -- TODO throwError either (panic . cs . show) pure e -- TODO throwError
...@@ -73,7 +79,7 @@ pipeline scrapyurl client_env input log_status = do ...@@ -73,7 +79,7 @@ pipeline scrapyurl client_env input log_status = do
scrapyOrchestrator :: Env -> IO (Server (WithCallbacks ScraperAPI)) scrapyOrchestrator :: Env -> IO (Server (WithCallbacks ScraperAPI))
scrapyOrchestrator env = do scrapyOrchestrator env = do
apiWithCallbacksServer (Proxy :: Proxy ScraperAPI) apiWithCallbacksServer (Proxy :: Proxy ScraperAPI)
defaultSettings (extendBaseUrl ("scraper" :: String) $ env ^. env_self_url) defaultSettings (extendBaseUrl ("scraper" :: Text) $ env ^. env_self_url)
(env ^. env_manager) (LogEvent logConsole) $ (env ^. env_manager) (LogEvent logConsole) $
simpleServeJobsAPI (env ^. env_scrapers) . simpleServeJobsAPI (env ^. env_scrapers) .
simpleJobFunction . pipeline (URL $ env ^. env_settings . scrapydUrl) simpleJobFunction . pipeline (URL $ env ^. env_settings . scrapydUrl)
{-# LANGUAGE DataKinds #-} {-|
{-# LANGUAGE DeriveGeneric #-} Module : Gargantext.API.Admin.Orchestartor.Scrapy.Schedule
{-# LANGUAGE OverloadedStrings #-} Description : Server API Auth Module
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Gargantext.API.Orchestrator.Scrapy.Schedule where
module Gargantext.API.Admin.Orchestrator.Scrapy.Schedule
where
import Control.Lens import Control.Lens
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Strict as H
import Data.Text (Text) import Data.Text (Text)
import GHC.Generics import GHC.Generics
import Protolude
import Servant import Servant
import Servant.Job.Utils (jsonOptions)
import Servant.Client import Servant.Client
import Servant.Job.Utils (jsonOptions)
import Web.FormUrlEncoded hiding (parseMaybe) import Web.FormUrlEncoded hiding (parseMaybe)
import qualified Data.HashMap.Strict as H
------------------------------------------------------------------------
data Schedule = Schedule data Schedule = Schedule
{ s_project :: !Text { s_project :: !Text
......
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Gargantext.API.Orchestrator.Types where module Gargantext.API.Admin.Orchestrator.Types
where
import Gargantext.Prelude
import Control.Lens hiding (elements) import Control.Lens hiding (elements)
import Data.Aeson import Data.Aeson
import Data.Proxy import Data.Proxy
import Data.Text (Text)
import Data.Swagger hiding (URL, url, port) import Data.Swagger hiding (URL, url, port)
import Data.Text (Text)
import GHC.Generics hiding (to) import GHC.Generics hiding (to)
import Servant
import Servant.Job.Async import Servant.Job.Async
import Servant.Job.Types import Servant.Job.Types
import Servant.Job.Utils (jsonOptions) import Servant.Job.Utils (jsonOptions)
import Test.QuickCheck (elements) import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary import Test.QuickCheck.Arbitrary
import Gargantext.Core.Types (TODO(..)) import Gargantext.Core.Types (TODO(..))
import Gargantext.Prelude
------------------------------------------------------------------------
instance Arbitrary a => Arbitrary (JobStatus 'Safe a) where instance Arbitrary a => Arbitrary (JobStatus 'Safe a) where
arbitrary = panic "TODO" arbitrary = panic "TODO"
...@@ -30,18 +29,12 @@ instance Arbitrary a => Arbitrary (JobOutput a) where ...@@ -30,18 +29,12 @@ instance Arbitrary a => Arbitrary (JobOutput a) where
arbitrary = JobOutput <$> arbitrary arbitrary = JobOutput <$> arbitrary
-- | Main Types -- | Main Types
-- TODO IsidoreAuth
data ExternalAPIs = All data ExternalAPIs = All
| PubMed | PubMed
| HAL
| HAL_EN | IsTex
| HAL_FR | Isidore
| IsTex_EN
| IsTex_FR
| Isidore_EN
| Isidore_FR
-- | IsidoreAuth
deriving (Show, Eq, Enum, Bounded, Generic) deriving (Show, Eq, Enum, Bounded, Generic)
...@@ -85,7 +78,7 @@ data ScraperEvent = ScraperEvent ...@@ -85,7 +78,7 @@ data ScraperEvent = ScraperEvent
, _scev_level :: !(Maybe Text) , _scev_level :: !(Maybe Text)
, _scev_date :: !(Maybe Text) , _scev_date :: !(Maybe Text)
} }
deriving Generic deriving (Show, Generic)
instance Arbitrary ScraperEvent where instance Arbitrary ScraperEvent where
arbitrary = ScraperEvent <$> elements [Nothing, Just "test message"] arbitrary = ScraperEvent <$> elements [Nothing, Just "test message"]
...@@ -98,28 +91,30 @@ instance ToJSON ScraperEvent where ...@@ -98,28 +91,30 @@ instance ToJSON ScraperEvent where
instance FromJSON ScraperEvent where instance FromJSON ScraperEvent where
parseJSON = genericParseJSON $ jsonOptions "_scev_" parseJSON = genericParseJSON $ jsonOptions "_scev_"
data ScraperStatus = ScraperStatus
data JobLog = JobLog
{ _scst_succeeded :: !(Maybe Int) { _scst_succeeded :: !(Maybe Int)
, _scst_failed :: !(Maybe Int) , _scst_failed :: !(Maybe Int)
, _scst_remaining :: !(Maybe Int) , _scst_remaining :: !(Maybe Int)
, _scst_events :: !(Maybe [ScraperEvent]) , _scst_events :: !(Maybe [ScraperEvent])
} }
deriving Generic deriving (Show, Generic)
instance Arbitrary ScraperStatus where instance Arbitrary JobLog where
arbitrary = ScraperStatus arbitrary = JobLog
<$> arbitrary <$> arbitrary
<*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary
instance ToJSON ScraperStatus where instance ToJSON JobLog where
toJSON = genericToJSON $ jsonOptions "_scst_" toJSON = genericToJSON $ jsonOptions "_scst_"
instance FromJSON ScraperStatus where instance FromJSON JobLog where
parseJSON = genericParseJSON $ jsonOptions "_scst_" parseJSON = genericParseJSON $ jsonOptions "_scst_"
instance ToSchema ScraperStatus -- TODO _scst_ prefix instance ToSchema JobLog -- TODO _scst_ prefix
instance ToSchema ScraperInput -- TODO _scin_ prefix instance ToSchema ScraperInput -- TODO _scin_ prefix
instance ToSchema ScraperEvent -- TODO _scev_ prefix instance ToSchema ScraperEvent -- TODO _scev_ prefix
...@@ -130,6 +125,10 @@ instance ToParamSchema Offset -- where ...@@ -130,6 +125,10 @@ instance ToParamSchema Offset -- where
instance ToParamSchema Limit -- where instance ToParamSchema Limit -- where
-- toParamSchema = panic "TODO" -- toParamSchema = panic "TODO"
type ScrapersEnv = JobEnv ScraperStatus ScraperStatus type ScrapersEnv = JobEnv JobLog JobLog
type ScraperAPI = AsyncJobsAPI JobLog ScraperInput JobLog
type ScraperAPI = AsyncJobsAPI ScraperStatus ScraperInput ScraperStatus ------------------------------------------------------------------------
type AsyncJobs event ctI input output =
AsyncJobsAPI' 'Unsafe 'Safe ctI '[JSON] Maybe event input output
{-| {-|
Module : Gargantext.API.Utils Module : Gargantext.API.Admin.Utils
Description : Server API main Types Description : Server API main Types
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : BSD3 License : BSD3
...@@ -11,10 +11,8 @@ Mainly copied from Servant.Job.Utils (Thanks) ...@@ -11,10 +11,8 @@ Mainly copied from Servant.Job.Utils (Thanks)
-} -}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Gargantext.API.Utils module Gargantext.API.Admin.Utils
where where
import Gargantext.Prelude import Gargantext.Prelude
......
...@@ -12,13 +12,9 @@ Count API part of Gargantext. ...@@ -12,13 +12,9 @@ Count API part of Gargantext.
{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
module Gargantext.API.Count module Gargantext.API.Count
where where
......
{-|
Module : Gargantext.API.Flow
Description : Main Flow API DataTypes
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
module Gargantext.API.Flow
where
-- import Gargantext.API.Prelude
import Gargantext.Prelude
data InputFlow = TextsInput
| NgramsInput
| ListInput
data Flow = EndFlow
| Texts InputFlow [Flow]
| Ngrams InputFlow [Flow]
| Lists InputFlow [Flow]
data OutputFlow
flow :: Flow -> OutputFlow
flow = undefined
{-|
Module : Gargantext.API.HashedResponse
Description :
Copyright : (c) CNRS, 2020-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
module Gargantext.API.HashedResponse where
import Data.Aeson
import Data.Swagger
import Data.Text (Text)
import GHC.Generics (Generic)
import Gargantext.Prelude
import qualified Gargantext.Prelude.Crypto.Hash as Crypto (hash)
data HashedResponse a = HashedResponse { hash :: Text, value :: a }
deriving (Generic)
instance ToSchema a => ToSchema (HashedResponse a)
instance ToJSON a => ToJSON (HashedResponse a) where
toJSON = genericToJSON defaultOptions
constructHashedResponse :: ToJSON a => a -> HashedResponse a
constructHashedResponse v = HashedResponse { hash = Crypto.hash $ encode v, value = v }
This diff is collapsed.
This diff is collapsed.
{-|
Module : Gargantext.API.Ngrams.List
Description : Get Ngrams (lists)
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
module Gargantext.API.Ngrams.List
where
import Control.Lens hiding (elements)
import Data.Aeson
import Data.List (zip)
import Data.Map (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.Prelude
import Gargantext.API.Node.Corpus.New.File (FileType(..))
import Gargantext.API.Ngrams
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Prelude (GargServer)
import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
import Gargantext.Database.Action.Flow (FlowCmdM)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Schema.Ngrams (NgramsType(..), ngramsTypes)
------------------------------------------------------------------------
type NgramsList = (Map NgramsType (Versioned NgramsTableMap))
------------------------------------------------------------------------
type API = Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
-- :<|> ReqBody '[JSON] NgramsList :> Post '[JSON] Bool
:<|> PostAPI
api :: ListId -> GargServer API
api l = get l :<|> postAsync l
data HTML
instance Accept HTML where
contentType _ = "text" // "html" /: ("charset", "utf-8")
instance ToJSON a => MimeRender HTML a where
mimeRender _ = encode
------------------------------------------------------------------------
get :: RepoCmdM env err m =>
ListId -> m (Headers '[Header "Content-Disposition" Text] NgramsList)
get lId = do
lst <- get' lId
let (NodeId id) = lId
return $ addHeader (concat [ "attachment; filename=GarganText_NgramsList-"
, pack $ show id
, ".json"
]
) lst
get' :: RepoCmdM env err m
=> ListId -> m NgramsList
get' lId = fromList
<$> zip ngramsTypes
<$> mapM (getNgramsTableMap lId) ngramsTypes
------------------------------------------------------------------------
-- TODO : purge list
post :: FlowCmdM env err m
=> ListId
-> NgramsList
-> m Bool
post l m = do
-- TODO check with Version for optim
_ <- mapM (\(nt, Versioned _v ns) -> setListNgrams l nt ns) $ toList m
-- TODO reindex
pure True
------------------------------------------------------------------------
------------------------------------------------------------------------
type PostAPI = Summary "Update List"
:> "add"
:> "form"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] WithFile JobLog
postAsync :: ListId -> GargServer PostAPI
postAsync lId =
serveJobsAPI $
JobFunction (\f log' -> postAsync' lId f (liftBase . log'))
postAsync' :: FlowCmdM env err m
=> ListId
-> WithFile
-> (JobLog -> m ())
-> m JobLog
postAsync' l (WithFile _ m _) logStatus = do
logStatus JobLog { _scst_succeeded = Just 0
, _scst_failed = Just 0
, _scst_remaining = Just 1
, _scst_events = Just []
}
_r <- post l m
pure JobLog { _scst_succeeded = Just 1
, _scst_failed = Just 0
, _scst_remaining = Just 0
, _scst_events = Just []
}
data WithFile = WithFile
{ _wf_filetype :: !FileType
, _wf_data :: !NgramsList
, _wf_name :: !Text
} deriving (Eq, Show, Generic)
makeLenses ''WithFile
instance FromForm WithFile
instance FromJSON WithFile where
parseJSON = genericParseJSON $ jsonOptions "_wf_"
instance ToSchema WithFile where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")
...@@ -9,11 +9,6 @@ Portability : POSIX ...@@ -9,11 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.API.Ngrams.NTree module Gargantext.API.Ngrams.NTree
......
...@@ -9,9 +9,6 @@ Portability : POSIX ...@@ -9,9 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.API.Ngrams.Tools module Gargantext.API.Ngrams.Tools
where where
...@@ -30,13 +27,12 @@ import Gargantext.Prelude ...@@ -30,13 +27,12 @@ import Gargantext.Prelude
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import qualified Data.Set as Set import qualified Data.Set as Set
type RootTerm = Text type RootTerm = Text
getRepo :: RepoCmdM env err m => m NgramsRepo getRepo :: RepoCmdM env err m => m NgramsRepo
getRepo = do getRepo = do
v <- view repoVar v <- view repoVar
liftIO $ readMVar v liftBase $ readMVar v
listNgramsFromRepo :: [ListId] -> NgramsType listNgramsFromRepo :: [ListId] -> NgramsType
-> NgramsRepo -> Map Text NgramsRepoElement -> NgramsRepo -> Map Text NgramsRepoElement
...@@ -71,21 +67,24 @@ getTermsWith f ls ngt lt = Map.fromListWith (<>) ...@@ -71,21 +67,24 @@ getTermsWith f ls ngt lt = Map.fromListWith (<>)
Nothing -> (f'' t, []) Nothing -> (f'' t, [])
Just r -> (f'' r, map f'' [t]) Just r -> (f'' r, map f'' [t])
mapTermListRoot :: [ListId] -> NgramsType mapTermListRoot :: [ListId]
-> NgramsRepo -> Map Text (ListType, (Maybe Text)) -> NgramsType
-> NgramsRepo
-> Map Text (ListType, (Maybe Text))
mapTermListRoot nodeIds ngramsType repo = mapTermListRoot nodeIds ngramsType repo =
Map.fromList [ (t, (_nre_list nre, _nre_root nre)) Map.fromList [ (t, (_nre_list nre, _nre_root nre))
| (t, nre) <- Map.toList ngrams | (t, nre) <- Map.toList ngrams
] ]
where ngrams = listNgramsFromRepo nodeIds ngramsType repo where ngrams = listNgramsFromRepo nodeIds ngramsType repo
filterListWithRoot :: ListType -> Map Text (ListType, Maybe Text) filterListWithRoot :: ListType
-> Map Text (Maybe RootTerm) -> Map Text (ListType, Maybe Text)
-> Map Text (Maybe RootTerm)
filterListWithRoot lt m = Map.fromList filterListWithRoot lt m = Map.fromList
$ map (\(t,(_,r)) -> (t,r)) $ map (\(t,(_,r)) -> (t,r))
$ filter isGraphTerm (Map.toList m) $ filter isMapTerm (Map.toList m)
where where
isGraphTerm (_t,(l, maybeRoot)) = case maybeRoot of isMapTerm (_t,(l, maybeRoot)) = case maybeRoot of
Nothing -> l == lt Nothing -> l == lt
Just r -> case Map.lookup r m of Just r -> case Map.lookup r m of
Nothing -> panic $ "Garg.API.Ngrams.Tools: filterWithRoot, unknown key: " <> r Nothing -> panic $ "Garg.API.Ngrams.Tools: filterWithRoot, unknown key: " <> r
......
This diff is collapsed.
{-|
Module : Gargantext.API.Node.Contact
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Gargantext.API.Node.Contact
where
import Data.Aeson
import Data.Either (Either(Right))
import Data.Maybe (Maybe(..))
import Data.Swagger
import Data.Text (Text)
import GHC.Generics (Generic)
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Settings (HasSettings)
import Gargantext.API.Node
import Gargantext.API.Prelude (GargServer, simuLogs)
import Gargantext.Core (Lang(..))
import Gargantext.Core.Text.Terms (TermType(..))
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Action.Flow (flow)
import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAnnuaire(..), HyperdataContact)
import Gargantext.Database.Admin.Types.Hyperdata.Contact (hyperdataContact)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Prelude (($), liftBase, (.), printDebug, pure)
import Servant
import Servant.Job.Async (JobFunction(..), serveJobsAPI)
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
------------------------------------------------------------------------
type API = "contact" :> Summary "Contact endpoint"
:> API_Async
:<|> Capture "contact_id" NodeId
:> NodeNodeAPI HyperdataContact
api :: UserId -> CorpusId -> GargServer API
api uid cid = (api_async (RootId (NodeId uid)) cid)
:<|> (nodeNodeAPI (Proxy :: Proxy HyperdataContact) uid cid)
type API_Async = AsyncJobs JobLog '[JSON] AddContactParams JobLog
------------------------------------------------------------------------
data AddContactParams = AddContactParams { firstname :: !Text, lastname :: !Text }
| AddContactParamsAdvanced { firstname :: !Text
, lastname :: !Text
-- TODO add others fields
}
deriving (Generic)
----------------------------------------------------------------------
api_async :: User -> NodeId -> GargServer API_Async
api_async u nId =
serveJobsAPI $
JobFunction (\p log ->
let
log' x = do
printDebug "addContact" x
liftBase $ log x
in addContact u nId p (liftBase . log')
)
addContact :: (HasSettings env, FlowCmdM env err m)
=> User
-> NodeId
-> AddContactParams
-> (JobLog -> m ())
-> m JobLog
addContact u nId (AddContactParams fn ln) logStatus = do
logStatus JobLog { _scst_succeeded = Just 1
, _scst_failed = Just 0
, _scst_remaining = Just 1
, _scst_events = Just []
}
_ <- flow (Nothing :: Maybe HyperdataAnnuaire) u (Right [nId]) (Multi EN) [[hyperdataContact fn ln]]
pure JobLog { _scst_succeeded = Just 2
, _scst_failed = Just 0
, _scst_remaining = Just 0
, _scst_events = Just []
}
addContact _uId _nId _p logStatus = do
simuLogs logStatus 10
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON AddContactParams where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToJSON AddContactParams where
toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToSchema AddContactParams
instance Arbitrary AddContactParams where
arbitrary = elements [AddContactParams "Pierre" "Dupont"]
------------------------------------------------------------------------
This diff is collapsed.
{-|
Module : Gargantext.API.Node.Get
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
Polymorphic Get Node API
-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Gargantext.API.Node.Get
where
-- import Gargantext.API.Admin.Settings (HasSettings)
-- import Servant.Job.Async (JobFunction(..), serveJobsAPI)
-- import Test.QuickCheck (elements)
-- import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Data.Aeson
import Data.Swagger
import GHC.Generics (Generic)
import Gargantext.API.Prelude
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Query.Table.Node (JSONB{-, getNodeWith-})
import Gargantext.Prelude
import Servant
import Test.QuickCheck.Arbitrary
------------------------------------------------------------------------
type API a = Summary "Polymorphic Get Node Endpoint"
:> ReqBody '[JSON] GetNodeParams
:> Get '[JSON] (Node a)
------------------------------------------------------------------------
data GetNodeParams = GetNodeParams { node_id :: NodeId
, nodetype :: NodeType
}
deriving (Generic)
----------------------------------------------------------------------
api :: forall proxy a.
( JSONB a
, FromJSON a
, ToJSON a
) => proxy a -> UserId -> NodeId -> GargServer (API a)
api _p _uId _nId (GetNodeParams _nId' _nt) = undefined
------------------------------------------------------------------------
instance FromJSON GetNodeParams where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToJSON GetNodeParams where
toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToSchema GetNodeParams
instance Arbitrary GetNodeParams where
arbitrary = GetNodeParams <$> arbitrary <*> arbitrary
------------------------------------------------------------------------
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment