Commit 9d45859a authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into dev-list-charts

parents 69ea610b 4ba1e15d
...@@ -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
......
...@@ -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
......
...@@ -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 #-}
......
...@@ -11,10 +11,6 @@ Import a corpus binary. ...@@ -11,10 +11,6 @@ Import a corpus binary.
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Strict #-} {-# LANGUAGE Strict #-}
module Main where module Main where
...@@ -60,7 +56,6 @@ main = do ...@@ -60,7 +56,6 @@ main = do
annuaire :: forall m. FlowCmdM DevEnv GargError m => m CorpusId annuaire :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
annuaire = flowAnnuaire (UserName $ 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
debatCorpus = do debatCorpus = do
...@@ -85,7 +80,6 @@ main = do ...@@ -85,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,10 +11,6 @@ Import a corpus binary. ...@@ -11,10 +11,6 @@ Import a corpus binary.
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Strict #-} {-# LANGUAGE Strict #-}
module Main where module Main where
......
...@@ -11,11 +11,6 @@ Phylo binaries ...@@ -11,11 +11,6 @@ Phylo binaries
-} -}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Strict #-} {-# LANGUAGE Strict #-}
......
...@@ -11,11 +11,6 @@ Script to start gargantext with different modes (Dev, Prod, Mock). ...@@ -11,11 +11,6 @@ Script to start gargantext with different modes (Dev, Prod, Mock).
-} -}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Strict #-} {-# LANGUAGE Strict #-}
......
[gargantext] [gargantext]
MASTER_USER = gargantua 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! # SECURITY WARNING: keep the secret key used in production secret!
SECRET_KEY = PASSWORD_TO_CHANGE SECRET_KEY = PASSWORD_TO_CHANGE
# Space-separated list of hosts
ALLOWED_HOSTS = localhost [database]
# Time-zone, possible values here: https://en.wikipedia.org/wiki/List_of_tz_database_time_zones
TIME_ZONE = Europe/Paris
# PostgreSQL access # PostgreSQL access
DB_HOST = 127.0.0.1 DB_HOST = 127.0.0.1
DB_PORT = 5432 DB_PORT = 5432
...@@ -18,13 +12,6 @@ DB_NAME = gargandbV5 ...@@ -18,13 +12,6 @@ DB_NAME = gargandbV5
DB_USER = gargantua DB_USER = gargantua
DB_PASS = PASSWORD_TO_CHANGE DB_PASS = PASSWORD_TO_CHANGE
# Logs # Logs
LOG_FILE = /var/log/gargantext/backend/django.log LOG_FILE = /var/log/gargantext/backend.log
LOG_LEVEL = DEBUG LOG_LEVEL = DEBUG
LOG_FORMATTER = verbose 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
name: gargantext name: gargantext
version: '0.0.1.4.2' version: '0.0.1.5.1'
synopsis: Search, map, share synopsis: Search, map, share
description: Please see README.md description: Please see README.md
category: Data category: Data
...@@ -15,6 +15,16 @@ extra-libraries: ...@@ -15,6 +15,16 @@ extra-libraries:
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:
......
...@@ -8,7 +8,6 @@ Stability : experimental ...@@ -8,7 +8,6 @@ Stability : experimental
Portability : POSIX Portability : POSIX
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Core (Lang(..)) import Gargantext.Core (Lang(..))
......
...@@ -12,7 +12,6 @@ Here is a longer description of this module, containing some ...@@ -12,7 +12,6 @@ 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
......
...@@ -11,9 +11,7 @@ Here is a longer description of this module, containing some ...@@ -11,9 +11,7 @@ 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
......
...@@ -11,9 +11,7 @@ Here is a longer description of this module, containing some ...@@ -11,9 +11,7 @@ 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
......
...@@ -11,8 +11,6 @@ Here is a longer description of this module, containing some ...@@ -11,8 +11,6 @@ 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
......
...@@ -14,8 +14,6 @@ commentary with @some markup@. ...@@ -14,8 +14,6 @@ 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
......
...@@ -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
......
...@@ -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
...@@ -10,7 +10,6 @@ Portability : POSIX ...@@ -10,7 +10,6 @@ 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
......
...@@ -29,16 +29,9 @@ Pouillard (who mainly made it). ...@@ -29,16 +29,9 @@ Pouillard (who mainly made it).
{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE KindSignatures #-} {-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
...@@ -88,7 +81,6 @@ import qualified Paths_gargantext as PG -- cabal magic build module ...@@ -88,7 +81,6 @@ import qualified Paths_gargantext as PG -- cabal magic build module
data Mode = Dev | Mock | Prod data Mode = Dev | Mock | Prod
deriving (Show, Read, Generic) deriving (Show, Read, Generic)
-- | startGargantext takes as parameters port number and Ini file. -- | startGargantext takes as parameters port number and Ini file.
startGargantext :: Mode -> PortNumber -> FilePath -> IO () startGargantext :: Mode -> PortNumber -> FilePath -> IO ()
startGargantext mode port file = do startGargantext mode port file = do
...@@ -110,7 +102,6 @@ stopGargantext env = do ...@@ -110,7 +102,6 @@ stopGargantext env = do
T.putStrLn "----- Stopping gargantext -----" T.putStrLn "----- Stopping gargantext -----"
runReaderT saveRepo env runReaderT saveRepo env
-- | Output generated @swagger.json@ file for the @'TodoAPI'@. -- | Output generated @swagger.json@ file for the @'TodoAPI'@.
swaggerWriteJSON :: IO () swaggerWriteJSON :: IO ()
swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc) swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
......
...@@ -20,12 +20,6 @@ TODO-ACCESS Critical ...@@ -20,12 +20,6 @@ TODO-ACCESS Critical
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
......
...@@ -11,8 +11,6 @@ Loads all static file for the front-end. ...@@ -11,8 +11,6 @@ Loads all static file for the front-end.
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
--------------------------------------------------------------------- ---------------------------------------------------------------------
......
...@@ -9,30 +9,26 @@ Portability : POSIX ...@@ -9,30 +9,26 @@ Portability : POSIX
-} -}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Gargantext.API.Admin.Orchestrator where module Gargantext.API.Admin.Orchestrator where
import Gargantext.Prelude
import Gargantext.API.Admin.Settings
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Admin.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 qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Text
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 Gargantext.Prelude
import Gargantext.API.Admin.Settings
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Admin.Orchestrator.Scrapy.Schedule
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
-> (URL -> Schedule) -> (URL -> Schedule)
...@@ -84,7 +80,7 @@ pipeline scrapyurl client_env input log_status = do ...@@ -84,7 +80,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)
...@@ -9,9 +9,6 @@ Portability : POSIX ...@@ -9,9 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Gargantext.API.Admin.Orchestrator.Scrapy.Schedule module Gargantext.API.Admin.Orchestrator.Scrapy.Schedule
...@@ -21,6 +18,7 @@ import Control.Lens ...@@ -21,6 +18,7 @@ import Control.Lens
import Data.Aeson import Data.Aeson
import Data.Text (Text) import Data.Text (Text)
import GHC.Generics import GHC.Generics
import Protolude
import Servant import Servant
import Servant.Client import Servant.Client
import Servant.Job.Utils (jsonOptions) import Servant.Job.Utils (jsonOptions)
......
{-# 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 #-}
......
...@@ -12,14 +12,6 @@ TODO-SECURITY: Critical ...@@ -12,14 +12,6 @@ TODO-SECURITY: Critical
{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
...@@ -318,6 +310,7 @@ withDevEnv iniPath k = do ...@@ -318,6 +310,7 @@ withDevEnv iniPath k = do
} }
-- | Run Cmd Sugar for the Repl (GHCI) -- | Run Cmd Sugar for the Repl (GHCI)
runCmdRepl :: Show err => Cmd' DevEnv err a -> IO a runCmdRepl :: Show err => Cmd' DevEnv err a -> IO a
runCmdRepl f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f runCmdRepl f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f
......
...@@ -11,8 +11,6 @@ Mainly copied from Servant.Job.Utils (Thanks) ...@@ -11,8 +11,6 @@ Mainly copied from Servant.Job.Utils (Thanks)
-} -}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Gargantext.API.Admin.Utils module Gargantext.API.Admin.Utils
where where
......
...@@ -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
......
...@@ -13,12 +13,6 @@ Metrics API ...@@ -13,12 +13,6 @@ Metrics API
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
......
...@@ -17,18 +17,9 @@ add get ...@@ -17,18 +17,9 @@ add get
-} -}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# OPTIONS -fno-warn-orphans #-} {-# OPTIONS -fno-warn-orphans #-}
......
...@@ -9,14 +9,6 @@ Portability : POSIX ...@@ -9,14 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
......
...@@ -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,10 +9,6 @@ Portability : POSIX ...@@ -9,10 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.API.Ngrams.Tools module Gargantext.API.Ngrams.Tools
where where
......
...@@ -23,13 +23,6 @@ Node API ...@@ -23,13 +23,6 @@ Node API
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
...@@ -53,6 +46,9 @@ import Gargantext.API.Metrics ...@@ -53,6 +46,9 @@ import Gargantext.API.Metrics
import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, apiNgramsTableCorpus, QueryParamR) import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, apiNgramsTableCorpus, QueryParamR)
import Gargantext.API.Ngrams.NTree (MyTree) import Gargantext.API.Ngrams.NTree (MyTree)
import Gargantext.API.Node.New import Gargantext.API.Node.New
import qualified Gargantext.API.Node.Share as Share
import qualified Gargantext.API.Node.Update as Update
import Gargantext.API.Search (SearchDocsAPI, searchDocs, SearchPairsAPI, searchPairs) import Gargantext.API.Search (SearchDocsAPI, searchDocs, SearchPairsAPI, searchPairs)
import Gargantext.API.Table import Gargantext.API.Table
import Gargantext.Core.Types (NodeTableResult) import Gargantext.Core.Types (NodeTableResult)
...@@ -60,27 +56,29 @@ import Gargantext.Core.Types.Main (Tree, NodeTree, ListType) ...@@ -60,27 +56,29 @@ import Gargantext.Core.Types.Main (Tree, NodeTree, ListType)
import Gargantext.Database.Action.Flow.Pairing (pairing) import Gargantext.Database.Action.Flow.Pairing (pairing)
import Gargantext.Database.Admin.Types.Metrics (ChartMetrics) import Gargantext.Database.Admin.Types.Metrics (ChartMetrics)
import Gargantext.Database.Query.Facet (FacetDoc, OrderBy(..)) import Gargantext.Database.Query.Facet (FacetDoc, OrderBy(..))
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Query.Table.Node import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Children (getChildren) import Gargantext.Database.Query.Table.Node.Children (getChildren)
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata) import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Query.Table.Node.User import Gargantext.Database.Query.Table.Node.User
import Gargantext.Database.Query.Tree (treeDB) import Gargantext.Database.Query.Tree (tree, TreeMode(..))
import Gargantext.Database.Admin.Config (nodeTypeId)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..)) import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude -- (Cmd, CmdM) import Gargantext.Database.Prelude -- (Cmd, CmdM)
import Gargantext.Database.Schema.Node (_node_typename)
import Gargantext.Database.Query.Table.NodeNode import Gargantext.Database.Query.Table.NodeNode
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Viz.Phylo.API (PhyloAPI, phyloAPI) import Gargantext.Viz.Phylo.API (PhyloAPI, phyloAPI)
import Gargantext.Viz.Types import Gargantext.Viz.Types
import qualified Gargantext.Database.Query.Table.Node.Update as U (update, Update(..)) import qualified Gargantext.Database.Query.Table.Node.Update as U (update, Update(..))
import qualified Gargantext.Database.Action.Delete as Action (deleteNode)
{- {-
import qualified Gargantext.Text.List.Learn as Learn import qualified Gargantext.Text.List.Learn as Learn
import qualified Data.Vector as Vec import qualified Data.Vector as Vec
--} --}
-- | Admin NodesAPI
-- TODO
type NodesAPI = Delete '[JSON] Int type NodesAPI = Delete '[JSON] Int
-- | Delete Nodes -- | Delete Nodes
...@@ -129,11 +127,12 @@ type NodeAPI a = Get '[JSON] (Node a) ...@@ -129,11 +127,12 @@ type NodeAPI a = Get '[JSON] (Node a)
:<|> "children" :> ChildrenApi a :<|> "children" :> ChildrenApi a
-- TODO gather it -- TODO gather it
:<|> "table" :> TableApi :<|> "table" :> TableApi
:<|> "ngrams" :> TableNgramsApi :<|> "ngrams" :> TableNgramsApi
:<|> "category" :> CatApi :<|> "category" :> CatApi
:<|> "search" :> SearchDocsAPI :<|> "search" :> SearchDocsAPI
:<|> "share" :> Share.API
-- Pairing utilities -- Pairing utilities
:<|> "pairwith" :> PairWith :<|> "pairwith" :> PairWith
...@@ -148,6 +147,7 @@ type NodeAPI a = Get '[JSON] (Node a) ...@@ -148,6 +147,7 @@ type NodeAPI a = Get '[JSON] (Node a)
:<|> "tree" :> TreeApi :<|> "tree" :> TreeApi
:<|> "phylo" :> PhyloAPI :<|> "phylo" :> PhyloAPI
-- :<|> "add" :> NodeAddAPI -- :<|> "add" :> NodeAddAPI
:<|> "update" :> Update.API
-- TODO-ACCESS: check userId CanRenameNode nodeId -- TODO-ACCESS: check userId CanRenameNode nodeId
-- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited... -- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
...@@ -198,16 +198,16 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode ...@@ -198,16 +198,16 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
:<|> postNode uId id' :<|> postNode uId id'
:<|> postNodeAsyncAPI uId id' :<|> postNodeAsyncAPI uId id'
:<|> putNode id' :<|> putNode id'
:<|> deleteNodeApi id' :<|> Action.deleteNode (RootId $ NodeId uId) id'
:<|> getChildren id' p :<|> getChildren id' p
-- TODO gather it -- TODO gather it
:<|> tableApi id' :<|> tableApi id'
:<|> apiNgramsTableCorpus id' :<|> apiNgramsTableCorpus id'
:<|> catApi id' :<|> catApi id'
:<|> searchDocs id' :<|> searchDocs id'
:<|> Share.api id'
-- Pairing Tools -- Pairing Tools
:<|> pairWith id' :<|> pairWith id'
:<|> pairs id' :<|> pairs id'
...@@ -221,12 +221,7 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode ...@@ -221,12 +221,7 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
:<|> phyloAPI id' uId :<|> phyloAPI id' uId
-- :<|> nodeAddAPI id' -- :<|> nodeAddAPI id'
-- :<|> postUpload id' -- :<|> postUpload id'
:<|> Update.api uId id'
deleteNodeApi id'' = do
node' <- getNode id''
if _node_typename node' == nodeTypeId NodeUser
then panic "not allowed" -- TODO add proper Right Management Type
else deleteNode id''
scatterApi :: NodeId -> GargServer ScatterAPI scatterApi :: NodeId -> GargServer ScatterAPI
scatterApi id' = getScatter id' scatterApi id' = getScatter id'
...@@ -328,11 +323,10 @@ type TreeApi = Summary " Tree API" ...@@ -328,11 +323,10 @@ type TreeApi = Summary " Tree API"
-- :<|> "process" :> MultipartForm MultipartData :> Post '[JSON] Text -- :<|> "process" :> MultipartForm MultipartData :> Post '[JSON] Text
------------------------------------------------------------------------ ------------------------------------------------------------------------
type TreeAPI = QueryParams "type" NodeType :> Get '[JSON] (Tree NodeTree) type TreeAPI = QueryParams "type" NodeType :> Get '[JSON] (Tree NodeTree)
treeAPI :: NodeId -> GargServer TreeAPI treeAPI :: NodeId -> GargServer TreeAPI
treeAPI = treeDB treeAPI = tree Advanced
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Check if the name is less than 255 char -- | Check if the name is less than 255 char
......
...@@ -8,14 +8,8 @@ Stability : experimental ...@@ -8,14 +8,8 @@ Stability : experimental
Portability : POSIX Portability : POSIX
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.API.Node.Corpus.Annuaire module Gargantext.API.Node.Corpus.Annuaire
where where
...@@ -44,17 +38,17 @@ type Api = Summary "New Annuaire endpoint" ...@@ -44,17 +38,17 @@ type Api = Summary "New Annuaire endpoint"
------------------------------------------------------------------------ ------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
data WithForm = WithForm data AnnuaireWithForm = AnnuaireWithForm
{ _wf_filetype :: !NewFile.FileType { _wf_filetype :: !NewFile.FileType
, _wf_data :: !Text , _wf_data :: !Text
, _wf_lang :: !(Maybe Lang) , _wf_lang :: !(Maybe Lang)
} deriving (Eq, Show, Generic) } deriving (Eq, Show, Generic)
makeLenses ''WithForm makeLenses ''AnnuaireWithForm
instance FromForm WithForm instance FromForm AnnuaireWithForm
instance FromJSON WithForm where instance FromJSON AnnuaireWithForm where
parseJSON = genericParseJSON $ jsonOptions "_wf_" parseJSON = genericParseJSON $ jsonOptions "_wf_"
instance ToSchema WithForm where instance ToSchema AnnuaireWithForm where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_") declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -68,15 +62,15 @@ type AddWithForm = Summary "Add with FormUrlEncoded to annuaire endpoint" ...@@ -68,15 +62,15 @@ type AddWithForm = Summary "Add with FormUrlEncoded to annuaire endpoint"
:> "add" :> "add"
:> "form" :> "form"
:> "async" :> "async"
:> AsyncJobs ScraperStatus '[FormUrlEncoded] WithForm ScraperStatus :> AsyncJobs ScraperStatus '[FormUrlEncoded] AnnuaireWithForm ScraperStatus
------------------------------------------------------------------------ ------------------------------------------------------------------------
addToAnnuaireWithForm :: FlowCmdM env err m addToAnnuaireWithForm :: FlowCmdM env err m
=> AnnuaireId => AnnuaireId
-> WithForm -> AnnuaireWithForm
-> (ScraperStatus -> m ()) -> (ScraperStatus -> m ())
-> m ScraperStatus -> m ScraperStatus
addToAnnuaireWithForm _cid (WithForm ft _d _l) logStatus = do addToAnnuaireWithForm _cid (AnnuaireWithForm ft _d _l) logStatus = do
printDebug "ft" ft printDebug "ft" ft
......
...@@ -13,12 +13,6 @@ Main exports of Gargantext: ...@@ -13,12 +13,6 @@ Main exports of Gargantext:
- lists - lists
-} -}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
......
...@@ -12,14 +12,8 @@ New corpus means either: ...@@ -12,14 +12,8 @@ New corpus means either:
- new data in existing corpus - new data in existing corpus
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Gargantext.API.Node.Corpus.New module Gargantext.API.Node.Corpus.New
...@@ -158,18 +152,18 @@ instance ToSchema WithQuery where ...@@ -158,18 +152,18 @@ instance ToSchema WithQuery where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wq_") declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wq_")
------------------------------------------------------- -------------------------------------------------------
data WithForm = WithForm data NewWithForm = NewWithForm
{ _wf_filetype :: !FileType { _wf_filetype :: !FileType
, _wf_data :: !Text , _wf_data :: !Text
, _wf_lang :: !(Maybe Lang) , _wf_lang :: !(Maybe Lang)
, _wf_name :: !Text , _wf_name :: !Text
} deriving (Eq, Show, Generic) } deriving (Eq, Show, Generic)
makeLenses ''WithForm makeLenses ''NewWithForm
instance FromForm WithForm instance FromForm NewWithForm
instance FromJSON WithForm where instance FromJSON NewWithForm where
parseJSON = genericParseJSON $ jsonOptions "_wf_" parseJSON = genericParseJSON $ jsonOptions "_wf_"
instance ToSchema WithForm where instance ToSchema NewWithForm where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_") declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -201,7 +195,7 @@ type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint" ...@@ -201,7 +195,7 @@ type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint"
:> "add" :> "add"
:> "form" :> "form"
:> "async" :> "async"
:> AsyncJobs ScraperStatus '[FormUrlEncoded] WithForm ScraperStatus :> AsyncJobs ScraperStatus '[FormUrlEncoded] NewWithForm ScraperStatus
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -237,10 +231,10 @@ addToCorpusWithQuery u cid (WithQuery q dbs l _nid) logStatus = do ...@@ -237,10 +231,10 @@ addToCorpusWithQuery u cid (WithQuery q dbs l _nid) logStatus = do
addToCorpusWithForm :: FlowCmdM env err m addToCorpusWithForm :: FlowCmdM env err m
=> User => User
-> CorpusId -> CorpusId
-> WithForm -> NewWithForm
-> (ScraperStatus -> m ()) -> (ScraperStatus -> m ())
-> m ScraperStatus -> m ScraperStatus
addToCorpusWithForm user cid (WithForm ft d l _n) logStatus = do addToCorpusWithForm user cid (NewWithForm ft d l _n) logStatus = do
let let
parse = case ft of parse = case ft of
......
...@@ -11,13 +11,6 @@ Portability : POSIX ...@@ -11,13 +11,6 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
......
...@@ -12,14 +12,8 @@ Async new node feature ...@@ -12,14 +12,8 @@ Async new node feature
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Gargantext.API.Node.New module Gargantext.API.Node.New
......
{-|
Module : Gargantext.API.Node.Share
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Gargantext.API.Node.Share
where
import Data.Aeson
import Data.Swagger
import Data.Text (Text)
import GHC.Generics (Generic)
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Action.Share (shareNodeWith)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Prelude
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
------------------------------------------------------------------------
data ShareNode = ShareNode { username :: Text }
deriving (Generic)
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON ShareNode
instance ToJSON ShareNode
instance ToSchema ShareNode
instance Arbitrary ShareNode where
arbitrary = elements [ ShareNode "user1"
, ShareNode "user2"
]
------------------------------------------------------------------------
-- TODO permission
api :: HasNodeError err
=> NodeId
-> ShareNode
-> Cmd err Int
api nId (ShareNode user) =
fromIntegral <$> shareNodeWith nId (UserName user)
------------------------------------------------------------------------
type API = Summary " Share Node with username"
:> ReqBody '[JSON] ShareNode
:> Post '[JSON] Int
{-|
Module : Gargantext.API.Node.Update
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Gargantext.API.Node.Update
where
import Data.Aeson
import Data.Swagger
import GHC.Generics (Generic)
import Gargantext.API.Admin.Orchestrator.Types (ScraperStatus(..))
import Gargantext.API.Node.Corpus.New (AsyncJobs)
import Gargantext.API.Prelude (GargServer, simuLogs)
import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Prelude (Ord, Eq, (<$>), ($), liftBase, (.))
import Prelude (Enum, Bounded, minBound, maxBound)
import Servant
import Servant.Job.Async (JobFunction(..), serveJobsAPI)
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
------------------------------------------------------------------------
data UpdateNodeParams = UpdateNodeParamsList { methodList :: Method }
| UpdateNodeParamsGraph { methodGraph :: GraphMetric }
| UpdateNodeParamsTexts { methodTexts :: Granularity }
| UpdateNodeParamsBoard { methodBoard :: Charts }
deriving (Generic)
----------------------------------------------------------------------
data Method = Basic | Advanced | WithModel
deriving (Generic, Eq, Ord, Enum, Bounded)
----------------------------------------------------------------------
data GraphMetric = Order1 | Order2
deriving (Generic, Eq, Ord, Enum, Bounded)
----------------------------------------------------------------------
data Granularity = NewNgrams | NewTexts | Both
deriving (Generic, Eq, Ord, Enum, Bounded)
----------------------------------------------------------------------
data Charts = Sources | Authors | Institutes | Ngrams | All
deriving (Generic, Eq, Ord, Enum, Bounded)
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON UpdateNodeParams
instance ToJSON UpdateNodeParams
instance ToSchema UpdateNodeParams
instance Arbitrary UpdateNodeParams where
arbitrary = do
l <- UpdateNodeParamsList <$> arbitrary
g <- UpdateNodeParamsGraph <$> arbitrary
t <- UpdateNodeParamsTexts <$> arbitrary
b <- UpdateNodeParamsBoard <$> arbitrary
elements [l,g,t,b]
instance FromJSON Method
instance ToJSON Method
instance ToSchema Method
instance Arbitrary Method where
arbitrary = elements [ minBound .. maxBound ]
instance FromJSON GraphMetric
instance ToJSON GraphMetric
instance ToSchema GraphMetric
instance Arbitrary GraphMetric where
arbitrary = elements [ minBound .. maxBound ]
instance FromJSON Granularity
instance ToJSON Granularity
instance ToSchema Granularity
instance Arbitrary Granularity where
arbitrary = elements [ minBound .. maxBound ]
instance FromJSON Charts
instance ToJSON Charts
instance ToSchema Charts
instance Arbitrary Charts where
arbitrary = elements [ minBound .. maxBound ]
------------------------------------------------------------------------
api :: UserId -> NodeId -> GargServer API
api uId nId =
serveJobsAPI $
JobFunction (\p logs -> updateNode uId nId p (liftBase . logs))
updateNode :: FlowCmdM env err m
=> UserId
-> NodeId
-> UpdateNodeParams
-> (ScraperStatus -> m ())
-> m ScraperStatus
updateNode _uId _nId _ logStatus = do
simuLogs logStatus 100
------------------------------------------------------------------------
type API = Summary " Share Node with username"
:> AsyncJobs ScraperStatus '[JSON] UpdateNodeParams ScraperStatus
...@@ -10,13 +10,7 @@ Portability : POSIX ...@@ -10,13 +10,7 @@ Portability : POSIX
-} -}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
...@@ -28,6 +22,7 @@ module Gargantext.API.Prelude ...@@ -28,6 +22,7 @@ module Gargantext.API.Prelude
) )
where where
import Control.Concurrent (threadDelay)
import Control.Exception (Exception) import Control.Exception (Exception)
import Control.Lens (Prism', (#)) import Control.Lens (Prism', (#))
import Control.Lens.TH (makePrisms) import Control.Lens.TH (makePrisms)
...@@ -42,9 +37,9 @@ import Gargantext.API.Admin.Orchestrator.Types ...@@ -42,9 +37,9 @@ import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Admin.Settings import Gargantext.API.Admin.Settings
import Gargantext.API.Ngrams import Gargantext.API.Ngrams
import Gargantext.Core.Types import Gargantext.Core.Types
import Gargantext.Database.Query.Tree
import Gargantext.Database.Query.Table.Node.Error (NodeError(..), HasNodeError(..))
import Gargantext.Database.Prelude import Gargantext.Database.Prelude
import Gargantext.Database.Query.Table.Node.Error (NodeError(..), HasNodeError(..))
import Gargantext.Database.Query.Tree
import Gargantext.Prelude import Gargantext.Prelude
import Servant import Servant
import Servant.Job.Async (HasJobEnv) import Servant.Job.Async (HasJobEnv)
...@@ -106,7 +101,9 @@ type EnvC env = ...@@ -106,7 +101,9 @@ type EnvC env =
, HasJobEnv env ScraperStatus ScraperStatus , HasJobEnv env ScraperStatus ScraperStatus
) )
-------------------------------------------------------------------
runCmdReplEasy :: Cmd' DevEnv GargError a -> IO a
runCmdReplEasy f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f
------------------------------------------------------------------- -------------------------------------------------------------------
-- | This Type is needed to prepare the function before the GargServer -- | This Type is needed to prepare the function before the GargServer
...@@ -150,3 +147,45 @@ instance HasServerError GargError where ...@@ -150,3 +147,45 @@ instance HasServerError GargError where
instance HasJoseError GargError where instance HasJoseError GargError where
_JoseError = _GargJoseError _JoseError = _GargJoseError
------------------------------------------------------------------------
-- | Utils
-- | Simulate logs
simuLogs :: MonadBase IO m
=> (ScraperStatus -> m a)
-> Int
-> m ScraperStatus
simuLogs logStatus t = do
let task = ScraperStatus { _scst_succeeded = Just 0
, _scst_failed = Just 0
, _scst_remaining = Just 0
, _scst_events = Just []
}
f <- foldM' (\status n -> simuTask logStatus status n t) task $ take t [1..]
pure f
simuTask :: MonadBase IO m
=> (ScraperStatus -> m a)
-> ScraperStatus
-> Int
-> Int
-> m ScraperStatus
simuTask logStatus (ScraperStatus s f _r e) n t = do
let
m = (10 :: Int) ^ (6 :: Int)
_ <- liftBase $ threadDelay ( m * 10)
let status = ScraperStatus { _scst_succeeded = (+) <$> s <*> Just n
, _scst_failed = f
, _scst_remaining = (-) <$> Just t <*> s
, _scst_events = e
}
printDebug "status" status
_ <- logStatus status
pure status
...@@ -13,16 +13,9 @@ Portability : POSIX ...@@ -13,16 +13,9 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE KindSignatures #-} {-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
......
...@@ -12,15 +12,9 @@ Count API part of Gargantext. ...@@ -12,15 +12,9 @@ Count API part of Gargantext.
{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.API.Search module Gargantext.API.Search
where where
......
...@@ -24,13 +24,6 @@ Node API ...@@ -24,13 +24,6 @@ Node API
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
......
...@@ -9,10 +9,7 @@ Portability : POSIX ...@@ -9,10 +9,7 @@ Portability : POSIX
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module Gargantext.Core module Gargantext.Core
where where
......
...@@ -9,8 +9,6 @@ Portability : POSIX ...@@ -9,8 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Gargantext.Core.Auth ( createPasswordHash module Gargantext.Core.Auth ( createPasswordHash
, checkPassword , checkPassword
......
...@@ -10,8 +10,6 @@ Portability : POSIX ...@@ -10,8 +10,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ConstrainedClassMethods #-} {-# LANGUAGE ConstrainedClassMethods #-}
module Gargantext.Core.Flow.Ngrams where module Gargantext.Core.Flow.Ngrams where
......
...@@ -10,9 +10,6 @@ Portability : POSIX ...@@ -10,9 +10,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ConstrainedClassMethods #-} {-# LANGUAGE ConstrainedClassMethods #-}
module Gargantext.Core.Flow.Types where module Gargantext.Core.Flow.Types where
......
...@@ -9,7 +9,6 @@ Portability : POSIX ...@@ -9,7 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
module Gargantext.Core.Statistics module Gargantext.Core.Statistics
where where
......
...@@ -12,8 +12,6 @@ commentary with @some markup@. ...@@ -12,8 +12,6 @@ commentary with @some markup@.
-} -}
------------------------------------------------------------------------ ------------------------------------------------------------------------
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Core.Types ( module Gargantext.Core.Types.Main module Gargantext.Core.Types ( module Gargantext.Core.Types.Main
......
...@@ -11,10 +11,6 @@ Individu defintions ...@@ -11,10 +11,6 @@ Individu defintions
-} -}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Gargantext.Core.Types.Individu module Gargantext.Core.Types.Individu
where where
......
...@@ -11,10 +11,6 @@ Portability : POSIX ...@@ -11,10 +11,6 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
----------------------------------------------------------------------- -----------------------------------------------------------------------
......
...@@ -19,8 +19,6 @@ Phylomemy was first described in Chavalarias, D., Cointet, J.-P., 2013. Phylomem ...@@ -19,8 +19,6 @@ Phylomemy was first described in Chavalarias, D., Cointet, J.-P., 2013. Phylomem
. .
-} -}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Core.Types.Phylo where module Gargantext.Core.Types.Phylo where
......
...@@ -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 Gargantext.Core.Utils ( module Gargantext.Core.Utils (
-- module Gargantext.Utils.Chronos -- module Gargantext.Utils.Chronos
......
...@@ -14,10 +14,8 @@ Inspired from Gabriel Gonzales, "beautiful folds" talk. ...@@ -14,10 +14,8 @@ Inspired from Gabriel Gonzales, "beautiful folds" talk.
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.Core.Utils.Count (head, last, all, any, sum, product, length) module Gargantext.Core.Utils.Count (head, last, all, any, sum, product, length)
where where
......
...@@ -8,7 +8,6 @@ Stability : experimental ...@@ -8,7 +8,6 @@ Stability : experimental
Portability : POSIX Portability : POSIX
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
module Gargantext.Core.Utils.DateUtils where module Gargantext.Core.Utils.DateUtils where
......
...@@ -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 Gargantext.Core.Utils.Prefix where module Gargantext.Core.Utils.Prefix where
......
...@@ -14,7 +14,6 @@ Gargantext's database. ...@@ -14,7 +14,6 @@ Gargantext's database.
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
module Gargantext.Database ( module Gargantext.Database.Prelude module Gargantext.Database ( module Gargantext.Database.Prelude
-- , module Gargantext.Database.Bashql -- , module Gargantext.Database.Bashql
...@@ -23,3 +22,6 @@ module Gargantext.Database ( module Gargantext.Database.Prelude ...@@ -23,3 +22,6 @@ module Gargantext.Database ( module Gargantext.Database.Prelude
import Gargantext.Database.Prelude (connectGargandb) import Gargantext.Database.Prelude (connectGargandb)
-- import Gargantext.Database.Bashql -- import Gargantext.Database.Bashql
{-|
Module : Gargantext.Database.Action.Delete
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
TODO: right managements of nodes children of node Team
-- TODO add proper Right Management Type
TODO: NodeError
-}
module Gargantext.Database.Action.Delete
where
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Action.Flow.Utils (getUserId)
import Gargantext.Database.Admin.Config (hasNodeType)
import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Database.Admin.Types.Node -- (NodeType(..))
import Gargantext.Database.Prelude (Cmd)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Schema.Node
import Gargantext.Prelude
import qualified Gargantext.Database.Query.Table.Node as N (getNode, deleteNode)
import Gargantext.Database.Action.Share (delFolderTeam)
deleteNode :: HasNodeError err
=> User
-> NodeId
-> Cmd err Int
deleteNode u nodeId = do
node' <- N.getNode nodeId
if hasNodeType node' NodeUser
then panic "Not allowed to delete NodeUser (yet)"
else if hasNodeType node' NodeTeam
then do
uId <- getUserId u
if _node_userId node' == uId
then N.deleteNode nodeId
else delFolderTeam u nodeId
else N.deleteNode nodeId
...@@ -18,14 +18,9 @@ Portability : POSIX ...@@ -18,14 +18,9 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ConstrainedClassMethods #-} {-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Action.Flow -- (flowDatabase, ngrams2list) module Gargantext.Database.Action.Flow -- (flowDatabase, ngrams2list)
......
...@@ -10,11 +10,6 @@ Portability : POSIX ...@@ -10,11 +10,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
module Gargantext.Database.Action.Flow.Annuaire module Gargantext.Database.Action.Flow.Annuaire
where where
......
...@@ -12,14 +12,9 @@ Portability : POSIX ...@@ -12,14 +12,9 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ConstrainedClassMethods #-} {-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Gargantext.Database.Action.Flow.List module Gargantext.Database.Action.Flow.List
where where
......
...@@ -9,11 +9,7 @@ Portability : POSIX ...@@ -9,11 +9,7 @@ Portability : POSIX
-} -}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
-- {-# LANGUAGE Arrows #-} -- {-# LANGUAGE Arrows #-}
module Gargantext.Database.Action.Flow.Pairing module Gargantext.Database.Action.Flow.Pairing
......
...@@ -12,14 +12,9 @@ Portability : POSIX ...@@ -12,14 +12,9 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ConstrainedClassMethods #-} {-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Gargantext.Database.Action.Flow.Types module Gargantext.Database.Action.Flow.Types
where where
......
...@@ -9,10 +9,6 @@ Portability : POSIX ...@@ -9,10 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.Database.Action.Flow.Utils module Gargantext.Database.Action.Flow.Utils
where where
......
...@@ -9,11 +9,7 @@ Portability : POSIX ...@@ -9,11 +9,7 @@ Portability : POSIX
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE MonoLocalBinds #-}
module Gargantext.Database.Action.Learn module Gargantext.Database.Action.Learn
......
...@@ -11,9 +11,6 @@ Node API ...@@ -11,9 +11,6 @@ Node API
-} -}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
module Gargantext.Database.Action.Metrics module Gargantext.Database.Action.Metrics
where where
......
...@@ -12,15 +12,8 @@ Portability : POSIX ...@@ -12,15 +12,8 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Action.Metrics.Lists module Gargantext.Database.Action.Metrics.Lists
......
...@@ -11,11 +11,7 @@ Ngrams by node enable contextual metrics. ...@@ -11,11 +11,7 @@ Ngrams by node enable contextual metrics.
-} -}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.Database.Action.Metrics.NgramsByNode module Gargantext.Database.Action.Metrics.NgramsByNode
where where
......
...@@ -12,15 +12,8 @@ Portability : POSIX ...@@ -12,15 +12,8 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
......
...@@ -9,10 +9,6 @@ Portability : POSIX ...@@ -9,10 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.Database.Action.Search where module Gargantext.Database.Action.Search where
......
{-|
Module : Gargantext.Database.Action.Share
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
module Gargantext.Database.Action.Share
where
import Control.Lens (view)
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Action.Flow.Utils (getUserId)
import Gargantext.Database.Admin.Config (hasNodeType)
import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Database.Admin.Types.Node -- (NodeType(..))
import Gargantext.Database.Prelude (Cmd)
import Gargantext.Database.Query.Table.Node (getNode, getNodesWith)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.NodeNode (insertNodeNode, deleteNodeNode)
import Gargantext.Database.Query.Tree.Root (getRootId)
import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.NodeNode (NodeNodePoly(..))
import Gargantext.Prelude
------------------------------------------------------------------------
shareNodeWith :: HasNodeError err
=> NodeId
-> User
-> Cmd err Int64
shareNodeWith n u = do
nodeToCheck <- getNode n
userIdCheck <- getUserId u
if not (hasNodeType nodeToCheck NodeTeam)
then panic "Can share node Team only"
else if (view node_userId nodeToCheck == userIdCheck)
then panic "Can share to others only"
else do
folderSharedId <- getFolderSharedId u
insertNodeNode [NodeNode folderSharedId n Nothing Nothing]
------------------------------------------------------------------------
getFolderSharedId :: User -> Cmd err NodeId
getFolderSharedId u = do
rootId <- getRootId u
s <- getNodesWith rootId HyperdataAny (Just NodeFolderShared) Nothing Nothing
case head s of
Nothing -> panic "No folder shared found"
Just f -> pure (_node_id f)
type TeamId = NodeId
delFolderTeam :: User -> TeamId -> Cmd err Int
delFolderTeam u nId = do
folderSharedId <- getFolderSharedId u
deleteNodeNode folderSharedId nId
...@@ -10,7 +10,6 @@ Portability : POSIX ...@@ -10,7 +10,6 @@ Portability : POSIX
TODO-SECURITY review purpose of this module TODO-SECURITY review purpose of this module
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
module Gargantext.Database.Admin.Access where module Gargantext.Database.Admin.Access where
......
...@@ -60,9 +60,6 @@ TODO-ACCESS: should the checks be done here or before. ...@@ -60,9 +60,6 @@ TODO-ACCESS: should the checks be done here or before.
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.Database.Admin.Bashql () {-( get module Gargantext.Database.Admin.Bashql () {-( get
, ls , ls
......
...@@ -13,17 +13,17 @@ Gargantext's database. ...@@ -13,17 +13,17 @@ Gargantext's database.
TODO: configure nodes table in Haskell (Config typenames etc.) TODO: configure nodes table in Haskell (Config typenames etc.)
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Gargantext.Database.Admin.Config module Gargantext.Database.Admin.Config
where where
import Control.Lens (view)
import Data.List (lookup) import Data.List (lookup)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Text (Text,pack) import Data.Text (Text,pack)
import Data.Tuple.Extra (swap) import Data.Tuple.Extra (swap)
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Schema.Node
import Gargantext.Prelude import Gargantext.Prelude
-- TODO put this in config.ini file -- TODO put this in config.ini file
...@@ -82,6 +82,9 @@ nodeTypeId n = ...@@ -82,6 +82,9 @@ nodeTypeId n =
-- NodeFavorites -> 15 -- NodeFavorites -> 15
hasNodeType :: forall a. Node a -> NodeType -> Bool
hasNodeType n nt = (view node_typename n) == (nodeTypeId nt)
-- --
-- | Nodes are typed in the database according to a specific ID -- | Nodes are typed in the database according to a specific ID
-- --
......
...@@ -11,11 +11,7 @@ Ngrams by node enable contextual metrics. ...@@ -11,11 +11,7 @@ Ngrams by node enable contextual metrics.
-} -}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.Database.Admin.Trigger.Init module Gargantext.Database.Admin.Trigger.Init
where where
......
...@@ -11,11 +11,7 @@ Triggers on NodeNodeNgrams table. ...@@ -11,11 +11,7 @@ Triggers on NodeNodeNgrams table.
-} -}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.Database.Admin.Trigger.NodeNodeNgrams module Gargantext.Database.Admin.Trigger.NodeNodeNgrams
where where
......
...@@ -11,11 +11,7 @@ Triggers on Nodes table. ...@@ -11,11 +11,7 @@ Triggers on Nodes table.
-} -}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.Database.Admin.Trigger.Nodes module Gargantext.Database.Admin.Trigger.Nodes
where where
......
...@@ -11,11 +11,7 @@ Triggers on NodesNodes table. ...@@ -11,11 +11,7 @@ Triggers on NodesNodes table.
-} -}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.Database.Admin.Trigger.NodesNodes module Gargantext.Database.Admin.Trigger.NodesNodes
where where
......
...@@ -12,12 +12,6 @@ Portability : POSIX ...@@ -12,12 +12,6 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
-- {-# LANGUAGE DuplicateRecordFields #-} -- {-# LANGUAGE DuplicateRecordFields #-}
......
...@@ -10,12 +10,6 @@ Portability : POSIX ...@@ -10,12 +10,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.Database.Prelude where module Gargantext.Database.Prelude where
...@@ -127,7 +121,7 @@ databaseParameters fp = do ...@@ -127,7 +121,7 @@ databaseParameters fp = do
Left e -> panic (pack $ "No ini file error" <> show e) Left e -> panic (pack $ "No ini file error" <> show e)
Right ini' -> ini' Right ini' -> ini'
let val x = case (lookupValue (pack "django") (pack x) ini'') of let val x = case (lookupValue (pack "database") (pack x) ini'') of
Left _ -> panic (pack $ "no" <> x) Left _ -> panic (pack $ "no" <> x)
Right p' -> unpack p' Right p' -> unpack p'
......
...@@ -12,16 +12,9 @@ Portability : POSIX ...@@ -12,16 +12,9 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
------------------------------------------------------------------------ ------------------------------------------------------------------------
......
...@@ -11,11 +11,7 @@ Portability : POSIX ...@@ -11,11 +11,7 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
......
...@@ -15,15 +15,9 @@ Multiple Join functions with Opaleye. ...@@ -15,15 +15,9 @@ Multiple Join functions with Opaleye.
{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
------------------------------------------------------------------------ ------------------------------------------------------------------------
......
...@@ -10,11 +10,7 @@ Portability : POSIX ...@@ -10,11 +10,7 @@ Portability : POSIX
-} -}
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Table.Ngrams module Gargantext.Database.Query.Table.Ngrams
......
...@@ -13,15 +13,8 @@ Portability : POSIX ...@@ -13,15 +13,8 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
...@@ -161,6 +154,7 @@ getNodeWith nId _ = do ...@@ -161,6 +154,7 @@ getNodeWith nId _ = do
Nothing -> nodeError (DoesNotExist nId) Nothing -> nodeError (DoesNotExist nId)
Just r -> pure r Just r -> pure r
------------------------------------------------------------------------ ------------------------------------------------------------------------
nodeContactW :: Maybe Name -> Maybe HyperdataContact nodeContactW :: Maybe Name -> Maybe HyperdataContact
-> AnnuaireId -> UserId -> NodeWrite -> AnnuaireId -> UserId -> NodeWrite
......
...@@ -12,9 +12,6 @@ Portability : POSIX ...@@ -12,9 +12,6 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.Database.Query.Table.Node.Children module Gargantext.Database.Query.Table.Node.Children
where where
...@@ -22,6 +19,7 @@ module Gargantext.Database.Query.Table.Node.Children ...@@ -22,6 +19,7 @@ module Gargantext.Database.Query.Table.Node.Children
import Control.Arrow (returnA) import Control.Arrow (returnA)
import Data.Proxy import Data.Proxy
import Opaleye import Opaleye
import Protolude
import Gargantext.Core.Types import Gargantext.Core.Types
import Gargantext.Database.Admin.Config (nodeTypeId) import Gargantext.Database.Admin.Config (nodeTypeId)
......
...@@ -9,12 +9,7 @@ Portability : POSIX ...@@ -9,12 +9,7 @@ Portability : POSIX
-} -}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Table.Node.Contact module Gargantext.Database.Query.Table.Node.Contact
......
...@@ -12,14 +12,7 @@ Add Documents/Contact to a Corpus/Annuaire. ...@@ -12,14 +12,7 @@ Add Documents/Contact to a Corpus/Annuaire.
-} -}
------------------------------------------------------------------------ ------------------------------------------------------------------------
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
------------------------------------------------------------------------ ------------------------------------------------------------------------
......
...@@ -48,13 +48,7 @@ the concatenation of the parameters defined by @shaParameters@. ...@@ -48,13 +48,7 @@ the concatenation of the parameters defined by @shaParameters@.
-} -}
------------------------------------------------------------------------ ------------------------------------------------------------------------
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
------------------------------------------------------------------------ ------------------------------------------------------------------------
module Gargantext.Database.Query.Table.Node.Document.Insert module Gargantext.Database.Query.Table.Node.Document.Insert
......
...@@ -12,15 +12,8 @@ Portability : POSIX ...@@ -12,15 +12,8 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
......
...@@ -10,14 +10,14 @@ Portability : POSIX ...@@ -10,14 +10,14 @@ Portability : POSIX
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.Database.Query.Table.Node.Select module Gargantext.Database.Query.Table.Node.Select
where where
import Control.Arrow (returnA) import Control.Arrow (returnA)
import Opaleye
import Protolude
import Gargantext.Core.Types import Gargantext.Core.Types
import Gargantext.Core.Types.Individu (Username) import Gargantext.Core.Types.Individu (Username)
import Gargantext.Database.Admin.Config import Gargantext.Database.Admin.Config
...@@ -25,19 +25,18 @@ import Gargantext.Database.Prelude ...@@ -25,19 +25,18 @@ import Gargantext.Database.Prelude
import Gargantext.Database.Schema.Node import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.User import Gargantext.Database.Schema.User
import Gargantext.Database.Query.Table.User import Gargantext.Database.Query.Table.User
import Opaleye
selectNodesWithUsername :: NodeType -> Username -> Cmd err [NodeId] selectNodesWithUsername :: NodeType -> Username -> Cmd err [NodeId]
selectNodesWithUsername nt u = runOpaQuery (q u) selectNodesWithUsername nt u = runOpaQuery (q u)
where where
q u' = proc () -> do q u' = proc () -> do
(n,usrs) <- join -< () (n,usrs) <- join' -< ()
restrict -< user_username usrs .== (toNullable $ pgStrictText u') restrict -< user_username usrs .== (toNullable $ pgStrictText u')
restrict -< _node_typename n .== (pgInt4 $ nodeTypeId nt) restrict -< _node_typename n .== (pgInt4 $ nodeTypeId nt)
returnA -< _node_id n returnA -< _node_id n
join :: Query (NodeRead, UserReadNull) join' :: Query (NodeRead, UserReadNull)
join = leftJoin queryNodeTable queryUserTable on1 join' = leftJoin queryNodeTable queryUserTable on1
where where
on1 (n,us) = _node_userId n .== user_id us on1 (n,us) = _node_userId n .== user_id us
...@@ -9,11 +9,7 @@ Portability : POSIX ...@@ -9,11 +9,7 @@ Portability : POSIX
-} -}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.Database.Query.Table.Node.Update (Update(..), update) module Gargantext.Database.Query.Table.Node.Update (Update(..), update)
where where
......
...@@ -9,11 +9,7 @@ Portability : POSIX ...@@ -9,11 +9,7 @@ Portability : POSIX
-} -}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.Database.Query.Table.Node.UpdateOpaleye module Gargantext.Database.Query.Table.Node.UpdateOpaleye
......
...@@ -9,14 +9,7 @@ Portability : POSIX ...@@ -9,14 +9,7 @@ Portability : POSIX
-} -}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Table.Node.User module Gargantext.Database.Query.Table.Node.User
......
...@@ -14,14 +14,8 @@ NodeNgrams register Context of Ngrams (named Cgrams then) ...@@ -14,14 +14,8 @@ NodeNgrams register Context of Ngrams (named Cgrams then)
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Table.NodeNgrams module Gargantext.Database.Query.Table.NodeNgrams
......
...@@ -14,14 +14,8 @@ commentary with @some markup@. ...@@ -14,14 +14,8 @@ commentary with @some markup@.
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Table.NodeNode module Gargantext.Database.Query.Table.NodeNode
...@@ -33,6 +27,7 @@ module Gargantext.Database.Query.Table.NodeNode ...@@ -33,6 +27,7 @@ module Gargantext.Database.Query.Table.NodeNode
, nodeNodesCategory , nodeNodesCategory
, getNodeNode , getNodeNode
, insertNodeNode , insertNodeNode
, deleteNodeNode
) )
where where
...@@ -74,9 +69,10 @@ getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n) ...@@ -74,9 +69,10 @@ getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
restrict -< _nn_node1_id ns .== n' restrict -< _nn_node1_id ns .== n'
returnA -< ns returnA -< ns
------------------------- ------------------------------------------------------------------------
insertNodeNode :: [NodeNode] -> Cmd err Int64 insertNodeNode :: [NodeNode] -> Cmd err Int64
insertNodeNode ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeNodeTable ns' rCount Nothing insertNodeNode ns = mkCmd $ \conn -> runInsert_ conn
$ Insert nodeNodeTable ns' rCount Nothing
where where
ns' :: [NodeNodeWrite] ns' :: [NodeNodeWrite]
ns' = map (\(NodeNode n1 n2 x y) ns' = map (\(NodeNode n1 n2 x y)
...@@ -86,7 +82,17 @@ insertNodeNode ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeNodeTable ns' ...@@ -86,7 +82,17 @@ insertNodeNode ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeNodeTable ns'
(pgInt4 <$> y) (pgInt4 <$> y)
) ns ) ns
------------------------------------------------------------------------
type Node1_Id = NodeId
type Node2_Id = NodeId
deleteNodeNode :: Node1_Id -> Node2_Id -> Cmd err Int
deleteNodeNode n1 n2 = mkCmd $ \conn ->
fromIntegral <$> runDelete conn nodeNodeTable
(\(NodeNode n1_id n2_id _ _) -> n1_id .== pgNodeId n1
.&& n2_id .== pgNodeId n2 )
------------------------------------------------------------------------
-- | Favorite management -- | Favorite management
_nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int] _nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
_nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId) _nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)
......
...@@ -12,12 +12,7 @@ Portability : POSIX ...@@ -12,12 +12,7 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Table.NodeNodeNgrams module Gargantext.Database.Query.Table.NodeNodeNgrams
......
...@@ -12,12 +12,7 @@ Portability : POSIX ...@@ -12,12 +12,7 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Table.NodeNodeNgrams2 module Gargantext.Database.Query.Table.NodeNodeNgrams2
......
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.
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