Merge branch 'dev-phylo' of https://gitlab.iscpif.fr/gargantext/haskell-gargantext into dev-phylo

README.md

@@ -21,13 +21,19 @@ progress. Please report and improve this documentation if you encounter issues.
 #### Docker
 
 ``` sh
-curl -sSL https://gitlab.iscpif.fr/gargantext/haskell-gargantext/raw/master/devops/docker/docker-install | sh
+curl -sSL https://gitlab.iscpif.fr/gargantext/haskell-gargantext/raw/dev/devops/docker/docker-install | sh
 ```
 
 #### Debian
 
 ``` sh
-curl -sSL https://gitlab.iscpif.fr/gargantext/haskell-gargantext/raw/master/devops/debian/install | sh
+curl -sSL https://gitlab.iscpif.fr/gargantext/haskell-gargantext/raw/dev/devops/debian/install | sh
+```
+
+#### Ubuntu
+
+``` sh
+curl -sSL https://gitlab.iscpif.fr/gargantext/haskell-gargantext/raw/dev/devops/ubuntu/install | sh
 ```
 
 ### Add dependencies

bin/build

 #!/bin/bash
 
-stack build # --profile # --test # --haddock
+stack build --profile --test # --haddock

bin/gargantext-admin/Main.hs

+{-|
+Module      : Main.hs
+Description : Gargantext Admin tools
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+
+
+ -}
+
+{-# LANGUAGE Strict            #-}
+
+module Main where
+
+import Gargantext.API.Dev (withDevEnv, runCmdDev)
+import Gargantext.API.Prelude (GargError)
+import Gargantext.Database.Action.User.New (newUsers)
+import Gargantext.Database.Prelude (Cmd'')
+import Gargantext.Prelude
+import System.Environment (getArgs)
+import Gargantext.API.Admin.EnvTypes (DevEnv)
+
+main :: IO ()
+main = do
+  (iniPath:mails) <- getArgs
+
+  withDevEnv iniPath $ \env -> do
+    x <- runCmdDev env ((newUsers $ map cs mails) :: Cmd'' DevEnv GargError Int64)
+    putStrLn $ show x
+  pure ()

bin/gargantext-cbor2json/Main.hs

 import Prelude (IO, id, (.))
-import Codec.Serialise (deserialise)
 import Data.Aeson (encode)
+import Codec.Serialise (deserialise)
 import qualified Data.ByteString.Lazy as L
-import Gargantext.API.Ngrams (NgramsRepo)
+
+import Gargantext.API.Ngrams.Types (NgramsRepo)
 
 main :: IO ()
 main = L.interact (encode . (id :: NgramsRepo -> NgramsRepo) . deserialise)

bin/gargantext-import/Main.hs

@@ -18,8 +18,13 @@ module Main where
 import Control.Exception (finally)
 import Data.Either
 import Data.Text (Text)
+import Prelude (read)
+import System.Environment (getArgs)
+import qualified Data.Text as Text
+
+import Gargantext.API.Dev (withDevEnv, runCmdDev)
+import Gargantext.API.Admin.EnvTypes (DevEnv(..))
 import Gargantext.API.Node () -- instances
-import Gargantext.API.Admin.Settings (withDevEnv, runCmdDev, DevEnv)
 import Gargantext.API.Prelude (GargError)
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Types.Individu (User(..))
@@ -30,9 +35,6 @@ 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 qualified Data.Text as Text
 
 main :: IO ()
 main = do

bin/gargantext-init/Main.hs

@@ -17,10 +17,9 @@ module Main where
 
 import Data.Text (Text)
 import Data.Either (Either(..))
-import Data.Maybe (Maybe(..))
-import Gargantext.API.Admin.Settings (withDevEnv, runCmdDev)
+import Gargantext.API.Dev (withDevEnv, runCmdDev)
 import Gargantext.API.Prelude (GargError)
-import Gargantext.API.Node () -- instances
+import Gargantext.API.Node () -- instances only
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMk_RootWithCorpus)
 import Gargantext.Database.Query.Table.Node (getOrMkList)
@@ -29,11 +28,11 @@ 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)
 
+-- TODO put this in gargantext.ini
 secret :: Text
 secret = "Database secret to change"
 
@@ -52,9 +51,12 @@ main = do
   let
     initMaster :: Cmd GargError (UserId, RootId, CorpusId, ListId)
     initMaster = do
-      (masterUserId, masterRootId, masterCorpusId) <- getOrMk_RootWithCorpus (UserName userMaster) (Left corpusMasterName) (Nothing :: Maybe HyperdataCorpus)
+      (masterUserId, masterRootId, masterCorpusId)
+                  <- getOrMk_RootWithCorpus (UserName userMaster)
+                                            (Left corpusMasterName)
+                                            (Nothing :: Maybe HyperdataCorpus)
       masterListId <- getOrMkList masterCorpusId masterUserId
-      _triggers <- initLastTriggers masterListId
+      _triggers    <- initLastTriggers masterListId
       pure (masterUserId, masterRootId, masterCorpusId, masterListId)
 
   withDevEnv iniPath $ \env -> do

bin/gargantext-upgrade/Main.hs

+{-|
+Module      : Main.hs
+Description : Gargantext Import Corpus
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Import a corpus binary.
+
+ -}
+
+{-# LANGUAGE Strict            #-}
+
+module Main where
+
+import Gargantext.API.Dev (withDevEnv, runCmdDev)
+import Gargantext.API.Prelude (GargError)
+import Gargantext.API.Node () -- instances only
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Admin.Types.Hyperdata
+import Gargantext.Database.Query.Table.Node.UpdateOpaleye
+import Gargantext.Database.Prelude (Cmd, )
+import Gargantext.Prelude
+import System.Environment (getArgs)
+
+
+main :: IO ()
+main = do
+  [iniPath] <- getArgs
+
+  let
+    updateNodes :: Cmd GargError [Int64]
+    updateNodes = updateNodesWithType_
+                    NodeList
+                    defaultHyperdataList
+
+  withDevEnv iniPath $ \env -> do
+    x <- runCmdDev env updateNodes
+    putStrLn $ show x
+  pure ()

bin/haddock

+#!/bin/bash
+
+#stack haddock --no-haddock-deps --verbose
+
+# if fails, take the command and remove the --hoogle option to get a better message error
+
+/home/alexandre/.stack/setup-exe-cache/x86_64-linux-tinfo6/Cabal-simple_mPHDZzAJ_3.0.1.0_ghc-8.8.4 --builddir=.stack-work/dist/x86_64-linux-tinfo6/Cabal-3.0.1.0 haddock --html --hoogle --html-location=../$pkg-$version/ --haddock-option=--hyperlinked-source --haddock-option=--quickjump

bin/install

 #!/bin/bash
 
-stack install #--profile # --test --haddock
+stack install --profile --test # --haddock

devops/debian/install

@@ -21,45 +21,30 @@ sudo apt upgrade
 sudo apt install tmux htop
 
 ########################################################################
-tmux
-########################################################################
-# Open Stack only: attach volumes
-# attach the volume created (OS interface or API)
-sudo fdisk -l
-sudo fdisk /dev/vdb (n,p,t,83,w)
-sudo mkfs.ext4 /dev/vdb1
-
-sudo blkid
-# copy UUID in fstab (same parameters)
-sudo vim /etc/fstab 
-
-########################################################################
-
 sudo sed -i "s/stretch/buster/g" /etc/apt/sources.list
-sudo apt update
+#sudo apt update
 sudo apt dist-upgrade
 # sudo reboot #recommended
 ########################################################################
 
-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 libgfortran-8-dev
 
-
 sudo apt install git
-git config --global user.email "contact@gargantext.org"
-git config --global user.name "Gargantua"
+#git config --global user.email "contact@gargantext.org"
+#git config --global user.name "Gargantua"
 
 
 ########################################################################
-
 echo "Which user?"
-read USER
+#read USER
 USER="gargantua"
 sudo adduser --disabled-password --gecos "" $USER
 
-cd /home
-sudo mv -if /home/$USER /srv/
-sudo ln -s /srv/$USER
+########################################################################
+#cd /home
+#sudo mv -if /home/$USER /srv/
+#sudo ln -s /srv/$USER
 
 curl -sSL https://get.haskellstack.org/ | sh
 
@@ -68,23 +53,14 @@ sudo su $USER
 stack update
 stack upgrade
 
-git clone https://gitlab.iscpif.fr/gargantext/haskell-gargantext.git
+#git clone https://gitlab.iscpif.fr/gargantext/haskell-gargantext.git
 
-cd haskell-gargantext
+#cd haskell-gargantext
 ##########
-git clone https://gitlab.iscpif.fr/gargantext/purescript-gargantext
-cd purescript-gargantext
 
-# as sudoer
-curl -sS https://dl.yarnpkg.com/debian/pubkey.gpg | sudo apt-key add -
-echo "deb https://dl.yarnpkg.com/debian/ stable main" | sudo tee /etc/apt/sources.list.d/yarn.list
-sudo apt update
-sudo apt install yarn
-# as user
-yarn install && yarn install-ps && yarn build
-
-# temporary bug (help welcome)
-cp src/index.html dist/index.html
+if [[ ! -d "purescript-gargantext" ]]; then
+  ./devops/debian/install-purescript
+fi
 
 #########################################################################
 
@@ -95,21 +71,26 @@ stack setup && stack build && stack install
 # build deps
 
 
-#!/bin/bash
-mkdir deps
-cd deps
+if [[ ! -d "deps" ]]; then
+  mkdir -v deps
+  cd deps
 
-git clone https://gitlab.iscpif.fr/gargantext/clustering-louvain-cplusplus.git
-cd clustering-louvain-cplusplus
-./install
-cd ..
+  if [[ ! -d "clustering-louvain-cplusplus" ]]; then
+    ../devops/debian/install-clustering-louvain
+  fi
 
-sudo apt install default-jdk
-wget https://dl.gargantext.org/coreNLP.tar.bz2
-tar xvjf coreNLP.tar.bz2
-# CoreNLP needs to be started
-# ./startServer.sh
+  sudo apt install default-jdk
+  if [[ ! -f "coreNLP.tar.bz2" ]]; then
+    wget https://dl.gargantext.org/coreNLP.tar.bz2
+  fi
+  if [[ ! -d "home" ]]; then
+    tar xvjf coreNLP.tar.bz2
+  fi
+  # CoreNLP needs to be started
+  # ./startServer.sh
 
+  cd ..
+fi
 
 
 # Specific to our servers
@@ -137,12 +118,7 @@ tar xvjf coreNLP.tar.bz2
 ## POSTGRESQL DATA (as ROOT)
 #######################################################################
 
-PGVersion = 11
-GARGDATA = "/srv/gargantua/gargandata"
-mkdir $GARGDATA
-sudo apt install rsync
-sudo sed -iP "s%^data_directory.*%data_directory = \'$GARGADATA\'%" /etc/postgresql/$PGVersion/main/postgresql.conf
-sudo rsync -av /var/lib/postgresql/$PGVersion/main $GARGDATA
+./devops/debian/install-postgres
 
 # configure the database with script in devops/postgres
 # edit gargantext.ini

devops/debian/install-clustering-louvain

+#!/bin/bash
+
+git clone https://gitlab.iscpif.fr/gargantext/clustering-louvain-cplusplus.git
+cd clustering-louvain-cplusplus
+./install
+cd ..

devops/debian/install-postgres

+#!/bin/bash
+
+PGVersion=11
+GARGDATA=/srv/gargantua/gargandata
+sudo mkdir -vp ${GARGDATA}
+sudo apt install rsync
+sudo sed -iP "s%^data_directory.*%data_directory = \'${GARGDATA}\'%" /etc/postgresql/${PGVersion}/main/postgresql.conf
+sudo rsync -av /var/lib/postgresql/${PGVersion}/main ${GARGDATA}
+sudo chown -R postgres:postgres ${GARGDATA}

devops/debian/install-purescript

+#!/bin/bash
+
+git clone https://gitlab.iscpif.fr/gargantext/purescript-gargantext
+cd purescript-gargantext
+
+# as sudoer
+curl -sS https://dl.yarnpkg.com/debian/pubkey.gpg | sudo apt-key add -
+echo "deb https://dl.yarnpkg.com/debian/ stable main" | sudo tee /etc/apt/sources.list.d/yarn.list
+#sudo apt update
+sudo apt install yarn
+# as user
+yarn install && yarn install-ps && yarn build
+
+# temporary bug (help welcome)
+cp src/index.html dist/index.html
+cd ..

devops/misc/check-repo-cycles.jq

+.state |
+to_entries[] | .key as $ty     | .value |
+to_entries[] | .key as $list   | .value as $m | .value |
+("\($list): \($m|length) size" | debug) as $_ |
+to_entries[] | .key as $ngram  | .value |
+select(.root) | debug |
+select(                        # We keep only records with errors
+  .root and                    # We need .root
+  (
+    $m[.root].root != null or  # A root should have no root itself
+    .parent != .root and       # We need .parent different .root
+    $m[.parent].root != .root  # The parent's root should the same root.
+  )
+) |
+{$ty, $list, $ngram, data: .}
\ No newline at end of file

devops/openStack/install

+#!/bin/bash
+
+########################################################################
+# Open Stack only: attach volumes
+# attach the volume created (OS interface or API)
+sudo fdisk -l
+sudo fdisk /dev/vdb (n,p,t,83,w)
+sudo mkfs.ext4 /dev/vdb1
+
+sudo blkid
+# copy UUID in fstab (same parameters)
+sudo vim /etc/fstab 
+
+########################################################################
+
+sudo sed -i "s/stretch/buster/g" /etc/apt/sources.list
+sudo apt update
+sudo apt dist-upgrade
+# sudo reboot #recommended
+########################################################################

devops/tmux.sh

+#!/bin/bash
+
+tmux new -d -s gargantext './server' \; \
+            split-window -h -d 'cd ./purescript-gargantext ; ./server' \; \
+            select-pane -t 1 \; \
+            split-window -d    'cd deps/CoreNLP ; ./startServer.sh' \; \

gargantext.ini_toModify

 [gargantext]
+
+# Main url serving the FrontEnd
+URL = http://localhost
+
+# Main API url serving the BackEnd
+URL_BACKEND_API = http://localhost:8008/api/v1.0
+
 # Needed to instantiate the first users and first data
 MASTER_USER = gargantua
 
@@ -9,6 +16,14 @@ SECRET_KEY      = PASSWORD_TO_CHANGE
 # Data path to local files
 DATA_FILEPATH = FILEPATH_TO_CHANGE
 
+# Data path to local files
+DATA_FILEPATH = FILEPATH_TO_CHANGE
+
+# Data path to local files (do not use quotes)
+REPO_FILEPATH = FILEPATH_TO_CHANGE
+
+
+
 # [external]
 # FRAMES (i.e. iframe sources used in various places on the frontend)
 FRAME_WRITE_URL = URL_TO_CHANGE
@@ -17,6 +32,8 @@ FRAME_CALC_URL  = URL_TO_CHANGE
 FRAME_SEARX_URL  = URL_TO_CHANGE
 FRAME_ISTEX_URL  = URL_TO_CHANGE
 
+MAX_DOCS_SCRAPERS = 10000
+
 [server]
 # Server config (TODO connect in ReaderMonad)
 ALLOWED_ORIGIN = http://localhost

package.yaml

 name: gargantext
-version: '0.0.1.8.3'
+version: '0.0.1.91.3'
 synopsis: Search, map, share
 description: Please see README.md
 category: Data
@@ -38,11 +38,15 @@ library:
   exposed-modules:
   - Gargantext
   - Gargantext.API
+  - Gargantext.API.Dev
   - Gargantext.API.HashedResponse
   - Gargantext.API.Node
   - Gargantext.API.Node.File
   - Gargantext.API.Ngrams
+  - Gargantext.API.Ngrams.Types
   - Gargantext.API.Admin.Settings
+  - Gargantext.API.Admin.EnvTypes
+  - Gargantext.API.Admin.Types
   - Gargantext.API.Prelude
   - Gargantext.Core
   - Gargantext.Core.Types
@@ -50,14 +54,17 @@ library:
   - Gargantext.Core.Types.Main
   - Gargantext.Core.Utils.Prefix
   - Gargantext.Database.Action.Flow
+  - Gargantext.Database.Action.User.New
   - Gargantext.Database.Query.Table.User
   - Gargantext.Database.Query.Table.Node
+  - Gargantext.Database.Query.Table.Node.UpdateOpaleye
   - Gargantext.Database.Prelude
   - Gargantext.Database.Admin.Trigger.Init
   - Gargantext.Database.Admin.Config
   - Gargantext.Database.Admin.Types.Hyperdata
   - Gargantext.Database.Admin.Types.Node
   - Gargantext.Prelude
+  - Gargantext.Prelude.Crypto.Pass.User
   - Gargantext.Prelude.Utils
   - Gargantext.Core.Text
   - Gargantext.Core.Text.Context
@@ -379,6 +386,32 @@ executables:
       - gargantext
       - base
 
+  gargantext-upgrade:
+    main: Main.hs
+    source-dirs: bin/gargantext-upgrade
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    - -O2
+    - -Wmissing-signatures
+    dependencies:
+      - gargantext
+      - base
+
+  gargantext-admin:
+    main: Main.hs
+    source-dirs: bin/gargantext-admin
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    - -O2
+    - -Wmissing-signatures
+    dependencies:
+      - gargantext
+      - base
+
   gargantext-cbor2json:
     main: Main.hs
     source-dirs: bin/gargantext-cbor2json

src/Gargantext/API.hs

@@ -26,15 +26,7 @@ Pouillard (who mainly made it).
 
 -}
 
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-
-{-# LANGUAGE ConstraintKinds      #-}
-{-# LANGUAGE TemplateHaskell      #-}
-{-# LANGUAGE TypeOperators        #-}
-{-# LANGUAGE KindSignatures       #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
-{-# LANGUAGE TypeFamilies         #-}
-{-# LANGUAGE UndecidableInstances #-}
 
 ---------------------------------------------------------------------
 module Gargantext.API
@@ -42,41 +34,30 @@ module Gargantext.API
 ---------------------------------------------------------------------
 import Control.Exception (finally)
 import Control.Lens
-import Control.Monad.Except (withExceptT)
 import Control.Monad.Reader (runReaderT)
-import Data.Aeson.Encode.Pretty (encodePretty)
 import Data.List (lookup)
-import Data.Swagger
-import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8)
 import Data.Validity
-import Data.Version (showVersion)
 import GHC.Base (Applicative)
-import GHC.Generics (D1, Meta (..), Rep, Generic)
-import GHC.TypeLits (AppendSymbol, Symbol)
-import Gargantext.API.Admin.Auth (AuthContext, auth)
-import Gargantext.API.Admin.FrontEnd (frontEndServer)
-import Gargantext.API.Admin.Settings
-import Gargantext.API.Ngrams (HasRepoSaver(..), saveRepo)
-import Gargantext.API.Prelude
-import Gargantext.API.Routes
-import Gargantext.Prelude
+import GHC.Generics (Generic)
 import Network.HTTP.Types hiding (Query)
 import Network.Wai
-import Network.Wai (Request, requestHeaders)
 import Network.Wai.Handler.Warp hiding (defaultSettings)
 import Network.Wai.Middleware.Cors
 import Network.Wai.Middleware.RequestLogger
 import Servant
-import Servant.Auth.Server (AuthResult(..))
-import Servant.Auth.Swagger ()
-import Servant.Swagger
-import Servant.Swagger.UI
 import System.IO (FilePath)
-import qualified Data.ByteString.Lazy.Char8 as BL8
-import qualified Data.Text.IO               as T
-import qualified Paths_gargantext           as PG -- cabal magic build module
-import qualified Gargantext.API.Public      as Public
+import Data.Text.IO (putStrLn)
+
+import Gargantext.API.Admin.Auth (AuthContext)
+import Gargantext.API.Admin.Settings (newEnv)
+import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings)
+import Gargantext.API.Ngrams (saveRepo)
+import Gargantext.API.Ngrams.Types (HasRepoSaver(..))
+import Gargantext.API.Prelude
+import Gargantext.API.Routes
+import Gargantext.API.Server (server)
+import Gargantext.Prelude hiding (putStrLn)
 
 
 data Mode = Dev | Mock | Prod 
@@ -93,34 +74,16 @@ startGargantext mode port file = do
 
 portRouteInfo :: PortNumber -> IO ()
 portRouteInfo port = do
-  T.putStrLn "      ----Main Routes-----      "
-  T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
-  T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
+  putStrLn "      ----Main Routes-----      "
+  putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
+  putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
 
 -- TODO clean this Monad condition (more generic) ?
 stopGargantext :: HasRepoSaver env => env -> IO ()
 stopGargantext env = do
-  T.putStrLn "----- Stopping gargantext -----"
+  putStrLn "----- Stopping gargantext -----"
   runReaderT saveRepo env
 
--- | Output generated @swagger.json@ file for the @'TodoAPI'@.
-swaggerWriteJSON :: IO ()
-swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
-
--- | Swagger Specifications
-swaggerDoc :: Swagger
-swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
-  & info.title       .~ "Gargantext"
-  & info.version     .~ (cs $ showVersion PG.version)
-  -- & info.base_url     ?~ (URL "http://gargantext.org/")
-  & info.description ?~ "REST API specifications"
-  -- & tags             .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
-  & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI)) 
-                 ["Gargantext" & description ?~ "Main operations"]
-  & info.license     ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
-    where
-        urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
-
 {-
 startGargantextMock :: PortNumber -> IO ()
 startGargantextMock port = do
@@ -181,9 +144,8 @@ makeMockApp env = do
 
 makeDevMiddleware :: Mode -> IO Middleware
 makeDevMiddleware mode = do
-
-    -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
-    --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
+-- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
+-- logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
 --    let checkOriginAndHost app req resp = do
 --            blocking <- fireWall req (env ^. menv_firewall)
 --            case blocking  of
@@ -215,45 +177,9 @@ makeDevMiddleware mode = do
 ---------------------------------------------------------------------
 -- | API Global
 ---------------------------------------------------------------------
--- | Server declarations
-server :: forall env. EnvC env => env -> IO (Server API)
-server env = do
-  -- orchestrator <- scrapyOrchestrator env
-  pure $  schemaUiServer swaggerDoc
-     :<|> hoistServerWithContext
-            (Proxy :: Proxy GargAPI)
-            (Proxy :: Proxy AuthContext)
-            transform
-            serverGargAPI
-     :<|> frontEndServer
-  where
-    transform :: forall a. GargServerM env GargError a -> Handler a
-    transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
-
-showAsServantErr :: GargError -> ServerError
-showAsServantErr (GargServerError err) = err
-showAsServantErr a = err500 { errBody = BL8.pack $ show a }
 
 ---------------------------
 
-serverGargAPI :: GargServerT env err (GargServerM env err) GargAPI
-serverGargAPI -- orchestrator
-       =  auth
-     :<|> gargVersion
-     :<|> serverPrivateGargAPI
-     :<|> Public.api
-
-  --   :<|> orchestrator
-  where
-
-    gargVersion :: GargServer GargVersion
-    gargVersion = pure (cs $ showVersion PG.version)
-
-    serverPrivateGargAPI :: GargServerT env err (GargServerM env err) GargPrivateAPI
-    serverPrivateGargAPI (Authenticated auser) = serverPrivateGargAPI' auser
-    serverPrivateGargAPI _                     = throwAll' (_ServerError # err401)
--- Here throwAll' requires a concrete type for the monad.
-
 
 -- TODO-SECURITY admin only: withAdmin
 -- Question: How do we mark admins?
@@ -285,10 +211,10 @@ api  = Proxy
 apiGarg :: Proxy GargAPI
 apiGarg  = Proxy
 ---------------------------------------------------------------------
-schemaUiServer :: (Server api ~ Handler Swagger)
-        => Swagger -> Server (SwaggerSchemaUI' dir api)
-schemaUiServer = swaggerSchemaUIServer
 
+{- UNUSED
+--import GHC.Generics (D1, Meta (..), Rep, Generic)
+--import GHC.TypeLits (AppendSymbol, Symbol)
 ---------------------------------------------------------------------
 -- Type Family for the Documentation
 type family TypeName (x :: *) :: Symbol where
@@ -300,5 +226,4 @@ type family GenericTypeName t (r :: *) :: Symbol where
     GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
 
 type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
-
-
+-}
\ No newline at end of file

src/Gargantext/API/Admin/Auth.hs

@@ -33,22 +33,23 @@ import Data.Text (Text)
 import Data.Text.Lazy (toStrict)
 import Data.Text.Lazy.Encoding (decodeUtf8)
 import GHC.Generics (Generic)
-import Gargantext.API.Admin.Settings
+import Servant
+import Servant.Auth.Server
+import Test.QuickCheck (elements, oneof)
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import qualified Gargantext.Prelude.Crypto.Auth as Auth
+
+import Gargantext.API.Admin.Types
 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.Database.Query.Tree (isDescendantOf, isIn)
 import Gargantext.Database.Query.Tree.Root (getRoot)
-import Gargantext.Database.Schema.Node (NodePoly(_node_id)) 
+import Gargantext.Database.Schema.Node (NodePoly(_node_id))
 import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId, ListId, DocId)
 import Gargantext.Database.Prelude (Cmd', CmdM, HasConnectionPool, HasConfig)
 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.Arbitrary (Arbitrary, arbitrary)
-import qualified Gargantext.Prelude.Crypto.Auth as Auth
 
 ---------------------------------------------------
 

src/Gargantext/API/Admin/EnvTypes.hs

+-- |
+
+{-# LANGUAGE TemplateHaskell     #-}
+
+module Gargantext.API.Admin.EnvTypes where
+
+import Control.Lens
+import Data.Pool (Pool)
+import Database.PostgreSQL.Simple (Connection)
+import GHC.Generics (Generic)
+import Network.HTTP.Client (Manager)
+import Servant.Client (BaseUrl)
+import Servant.Job.Async (HasJobEnv(..), Job)
+import System.Log.FastLogger
+import qualified Servant.Job.Core
+
+import Gargantext.API.Admin.Types
+import Gargantext.API.Admin.Orchestrator.Types
+import Gargantext.API.Ngrams.Types (HasRepoVar(..), HasRepoSaver(..), HasRepo(..), RepoEnv(..))
+import Gargantext.Database.Prelude (HasConnectionPool(..), HasConfig(..))
+import Gargantext.Prelude
+import Gargantext.Prelude.Config (GargConfig(..))
+
+
+data Env = Env
+  { _env_settings :: !Settings
+  , _env_logger   :: !LoggerSet
+  , _env_pool     :: !(Pool Connection)
+  , _env_repo     :: !RepoEnv
+  , _env_manager  :: !Manager
+  , _env_self_url :: !BaseUrl
+  , _env_scrapers :: !ScrapersEnv
+  , _env_config   :: !GargConfig
+  }
+  deriving (Generic)
+
+makeLenses ''Env
+
+instance HasConfig Env where
+  config = env_config
+
+instance HasConnectionPool Env where
+  connPool = env_pool
+
+instance HasRepoVar Env where
+  repoVar = repoEnv . repoVar
+
+instance HasRepoSaver Env where
+  repoSaver = repoEnv . repoSaver
+
+instance HasRepo Env where
+  repoEnv = env_repo
+
+instance HasSettings Env where
+  settings = env_settings
+
+instance Servant.Job.Core.HasEnv Env (Job JobLog JobLog) where
+  _env = env_scrapers . Servant.Job.Core._env
+
+instance HasJobEnv Env JobLog JobLog where
+  job_env = env_scrapers
+
+data MockEnv = MockEnv
+  { _menv_firewall :: !FireWall
+  }
+  deriving (Generic)
+
+makeLenses ''MockEnv
+
+
+data DevEnv = DevEnv
+  { _dev_env_pool     :: !(Pool Connection)
+  , _dev_env_repo     :: !RepoEnv
+  , _dev_env_settings :: !Settings
+  , _dev_env_config   :: !GargConfig
+  }
+
+makeLenses ''DevEnv
+
+instance HasConfig DevEnv where
+  config = dev_env_config
+
+instance HasConnectionPool DevEnv where
+  connPool = dev_env_pool
+
+instance HasRepoVar DevEnv where
+  repoVar = repoEnv . repoVar
+
+instance HasRepoSaver DevEnv where
+  repoSaver = repoEnv . repoSaver
+
+instance HasRepo DevEnv where
+  repoEnv = dev_env_repo
+
+instance HasSettings DevEnv where
+  settings = dev_env_settings
\ No newline at end of file

src/Gargantext/API/Admin/FrontEnd.hs

@@ -17,7 +17,6 @@ Loads all static file for the front-end.
 module Gargantext.API.Admin.FrontEnd where
 
 import Servant
-import Servant.Server.StaticFiles (serveDirectoryFileServer)
 
 type FrontEndAPI = Raw
 

src/Gargantext/API/Admin/Orchestrator.hs

@@ -16,18 +16,15 @@ module Gargantext.API.Admin.Orchestrator where
 
 import Control.Lens hiding (elements)
 import Data.Aeson
-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.Job.Async
 import Servant.Job.Client
-import Servant.Job.Server
-import Servant.Job.Utils (extendBaseUrl)
 import qualified Data.ByteString.Lazy.Char8 as LBS
 
+import Gargantext.API.Admin.Orchestrator.Scrapy.Schedule
+import Gargantext.API.Admin.Orchestrator.Types
+import Gargantext.Prelude
+
 callJobScrapy :: (ToJSON e, FromJSON e, FromJSON o, MonadClientJob m)
               => JobServerURL e Schedule o
               -> (URL -> Schedule)
@@ -76,10 +73,20 @@ pipeline scrapyurl client_env input log_status = do
 --  use:
 --  * serveJobsAPI instead of simpleServeJobsAPI
 --  * JobFunction  instead of simpleJobFunction
+-- TODO:
+--  * HasSelfUrl or move self_url to settings
+--  * HasScrapers or move scrapers to settings
+--  * EnvC env
+{- NOT USED YET
+import Data.Text
+import Servant.Job.Server
+import Servant.Job.Utils (extendBaseUrl)
+import Gargantext.API.Admin.Types
 scrapyOrchestrator :: Env -> IO (Server (WithCallbacks ScraperAPI))
 scrapyOrchestrator env = do
   apiWithCallbacksServer (Proxy :: Proxy ScraperAPI)
     defaultSettings (extendBaseUrl ("scraper" :: Text) $ env ^. env_self_url)
     (env ^. env_manager) (LogEvent logConsole) $
     simpleServeJobsAPI (env ^. env_scrapers) .
-      simpleJobFunction . pipeline (URL $ env ^. env_settings . scrapydUrl)
+      simpleJobFunction . pipeline (URL $ env ^. settings . scrapydUrl)
+-}
\ No newline at end of file

src/Gargantext/API/Admin/Orchestrator/Scrapy/Schedule.hs

@@ -16,7 +16,6 @@ module Gargantext.API.Admin.Orchestrator.Scrapy.Schedule
 
 import Control.Lens
 import Data.Aeson
-import Data.Text (Text)
 import GHC.Generics
 import Protolude
 import Servant

src/Gargantext/API/Admin/Types.hs

+-- |
+
+{-# LANGUAGE TemplateHaskell     #-}
+
+module Gargantext.API.Admin.Types where
+
+import Control.Lens
+import Control.Monad.Logger
+import Data.ByteString (ByteString)
+import GHC.Enum
+import GHC.Generics (Generic)
+import Servant.Auth.Server (JWTSettings, CookieSettings(..))
+import Servant.Client (BaseUrl)
+
+import Gargantext.Prelude
+
+type PortNumber = Int
+
+data SendEmailType = SendEmailViaAws
+                   | LogEmailToConsole
+                   | WriteEmailToFile
+    deriving (Show, Read, Enum, Bounded, Generic)
+
+data Settings = Settings
+    { _allowedOrigin   :: !ByteString   -- allowed origin for CORS
+    , _allowedHost     :: !ByteString   -- allowed host for CORS
+    , _appPort         :: !PortNumber
+    , _logLevelLimit   :: !LogLevel -- log level from the monad-logger package
+--    , _dbServer        :: Text
+--    ^ this is not used yet
+    , _jwtSettings     :: !JWTSettings
+    , _cookieSettings  :: !CookieSettings
+    , _sendLoginEmails :: !SendEmailType
+    , _scrapydUrl      :: !BaseUrl
+    }
+
+makeLenses ''Settings
+
+class HasSettings env where
+  settings :: Getter env Settings
+
+instance HasSettings Settings where
+  settings = identity
+
+data FireWall = FireWall { unFireWall :: Bool }
\ No newline at end of file

src/Gargantext/API/Admin/Utils.hs

@@ -15,8 +15,8 @@ Mainly copied from Servant.Job.Utils (Thanks)
 module Gargantext.API.Admin.Utils
   where
 
+import Data.Maybe (fromMaybe)
 import Gargantext.Prelude
-import Data.Maybe (Maybe, fromMaybe)
 import Prelude (String)
 import qualified Data.Text as T
 

src/Gargantext/API/Count.hs

@@ -21,13 +21,11 @@ module Gargantext.API.Count
 
 
 import GHC.Generics (Generic)
-import Prelude (Bounded, Enum, minBound, maxBound)
 
 import Data.Aeson hiding (Error)
 import Data.Aeson.TH (deriveJSON)
-import Data.Eq (Eq())
 import Data.Either
-import Data.List (repeat, permutations)
+import Data.List (permutations)
 import Data.Swagger
 import Data.Text (Text, pack)
 

src/Gargantext/API/Dev.hs

+-- |
+
+-- Use only for dev/repl
+module Gargantext.API.Dev where
+
+import Control.Exception (finally)
+import Control.Monad (fail)
+import Control.Monad.Reader (runReaderT)
+import Servant
+
+import Gargantext.API.Prelude
+import Gargantext.API.Admin.Settings
+import Gargantext.API.Admin.EnvTypes
+import Gargantext.API.Ngrams (saveRepo)
+import Gargantext.Database.Prelude
+import Gargantext.Prelude
+import Gargantext.Prelude.Config (GargConfig(..), readConfig)
+
+-------------------------------------------------------------------
+
+withDevEnv :: IniPath -> (DevEnv -> IO a) -> IO a
+withDevEnv iniPath k = do
+  env <- newDevEnv
+  k env `finally` cleanEnv env
+
+  where
+    newDevEnv = do
+      cfg     <- readConfig         iniPath
+      dbParam <- databaseParameters iniPath
+      pool    <- newPool            dbParam
+      repo    <- readRepoEnv        (_gc_repofilepath cfg)
+      setts   <- devSettings devJwkFile
+      pure $ DevEnv
+        { _dev_env_pool = pool
+        , _dev_env_repo = repo
+        , _dev_env_settings = setts
+        , _dev_env_config   = cfg
+        }
+
+-- | Run Cmd Sugar for the Repl (GHCI)
+
+runCmdRepl :: Show err => Cmd'' DevEnv err a -> IO a
+runCmdRepl f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f
+
+runCmdReplServantErr :: Cmd'' DevEnv ServerError a -> IO a
+runCmdReplServantErr = runCmdRepl
+
+-- In particular this writes the repo file after running
+-- the command.
+-- This function is constrained to the DevEnv rather than
+-- using HasConnectionPool and HasRepoVar.
+runCmdDev :: Show err => DevEnv -> Cmd'' DevEnv err a -> IO a
+runCmdDev env f =
+  (either (fail . show) pure =<< runCmd env f)
+    `finally`
+  runReaderT saveRepo env
+
+runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a
+runCmdDevNoErr = runCmdDev
+
+runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServerError a -> IO a
+runCmdDevServantErr = runCmdDev
+
+runCmdReplEasy :: Cmd'' DevEnv GargError a -> IO a
+runCmdReplEasy f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f
\ No newline at end of file

src/Gargantext/API/Metrics.hs

@@ -20,17 +20,17 @@ module Gargantext.API.Metrics
 
 import Control.Lens
 import qualified Data.Map as Map
-import Data.Time (UTCTime)
 import Data.Text (Text)
+import Data.Time (UTCTime)
 import Servant
 
 import Gargantext.API.HashedResponse
-import Gargantext.API.Ngrams
 import Gargantext.API.Ngrams.NTree
+import Gargantext.API.Ngrams.Types
 import Gargantext.API.Prelude (GargServer)
 import Gargantext.Core.Types (CorpusId, Limit, ListId, ListType(..))
 import Gargantext.Database.Action.Flow
-import Gargantext.Database.Admin.Types.Hyperdata (HyperdataList(..))
+import Gargantext.Database.Admin.Types.Hyperdata (HyperdataList(..), hl_chart, hl_pie, hl_scatter, hl_tree)
 import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metric(..), Metrics(..))
 import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Database.Prelude
@@ -39,7 +39,7 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
-import Gargantext.Core.Text.Metrics (Scored(..))
+import Gargantext.Core.Text.Metrics (Scored(..), {-normalizeGlobal,-} normalizeLocal)
 import Gargantext.Core.Viz.Chart
 import Gargantext.Core.Viz.Types
 import qualified Gargantext.Database.Action.Metrics as Metrics
@@ -77,7 +77,8 @@ getScatter cId maybeListId tabType _maybeLimit = do
     Just lid -> pure lid
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
-  let HyperdataList { _hl_scatter = mChart } = node ^. node_hyperdata
+  let HyperdataList { _hl_scatter = scatterMap } = node ^. node_hyperdata
+      mChart = Map.lookup tabType scatterMap
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -93,6 +94,10 @@ updateScatter :: FlowCmdM env err m =>
   -> Maybe Limit
   -> m ()
 updateScatter cId maybeListId tabType maybeLimit = do
+  printDebug "[updateScatter] cId" cId
+  printDebug "[updateScatter] maybeListId" maybeListId
+  printDebug "[updateScatter] tabType" tabType
+  printDebug "[updateScatter] maybeLimit" maybeLimit
   _ <- updateScatter' cId maybeListId tabType maybeLimit
   pure ()
 
@@ -106,8 +111,8 @@ updateScatter' cId maybeListId tabType maybeLimit = do
   (ngs', scores) <- Metrics.getMetrics cId maybeListId tabType maybeLimit
 
   let
-    metrics      = map (\(Scored t s1 s2) -> Metric t (log' 5 s1) (log' 2 s2) (listType t ngs')) scores
-    log' n x     = 1 + (if x <= 0 then 0 else log $ (10^(n::Int)) * x)
+    metrics      = map (\(Scored t s1 s2) -> Metric t s1 s2 (listType t ngs'))
+                 $ map normalizeLocal scores
     listType t m = maybe (panic errorMsg) fst $ Map.lookup t m
     errorMsg     = "API.Node.metrics: key absent"
 
@@ -116,7 +121,8 @@ updateScatter' cId maybeListId tabType maybeLimit = do
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let hl = node ^. node_hyperdata
-  _ <- updateHyperdata listId $ hl { _hl_scatter = Just $ Metrics metrics }
+      scatterMap = hl ^. hl_scatter
+  _ <- updateHyperdata listId $ hl { _hl_scatter = Map.insert tabType (Metrics metrics) scatterMap }
 
   pure $ Metrics metrics
 
@@ -165,7 +171,8 @@ getChart cId _start _end maybeListId tabType = do
     Just lid -> pure lid
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
-  let HyperdataList { _hl_chart = mChart } = node ^. node_hyperdata
+  let chartMap = node ^. node_hyperdata ^. hl_chart
+      mChart = Map.lookup tabType chartMap
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -181,6 +188,10 @@ updateChart :: HasNodeError err =>
   -> Maybe Limit
   -> Cmd err ()
 updateChart cId maybeListId tabType maybeLimit = do
+  printDebug "[updateChart] cId" cId
+  printDebug "[updateChart] maybeListId" maybeListId
+  printDebug "[updateChart] tabType" tabType
+  printDebug "[updateChart] maybeLimit" maybeLimit
   _ <- updateChart' cId maybeListId tabType maybeLimit
   pure ()
 
@@ -190,14 +201,15 @@ updateChart' :: HasNodeError err =>
   -> TabType
   -> Maybe Limit
   -> Cmd err (ChartMetrics Histo)
-updateChart' cId maybeListId _tabType _maybeLimit = do
+updateChart' cId maybeListId tabType _maybeLimit = do
   listId <- case maybeListId of
     Just lid -> pure lid
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let hl = node ^. node_hyperdata
+      chartMap = hl ^. hl_chart
   h <- histoData cId
-  _ <- updateHyperdata listId $ hl { _hl_chart = Just $ ChartMetrics h }
+  _ <- updateHyperdata listId $ hl { _hl_chart = Map.insert tabType (ChartMetrics h) chartMap }
 
   pure $ ChartMetrics h
 
@@ -245,7 +257,8 @@ getPie cId _start _end maybeListId tabType = do
     Just lid -> pure lid
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
-  let HyperdataList { _hl_pie = mChart } = node ^. node_hyperdata
+  let pieMap = node ^. node_hyperdata ^. hl_pie
+      mChart = Map.lookup tabType pieMap
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -261,6 +274,10 @@ updatePie :: FlowCmdM env err m =>
   -> Maybe Limit
   -> m ()
 updatePie cId maybeListId tabType maybeLimit = do
+  printDebug "[updatePie] cId" cId
+  printDebug "[updatePie] maybeListId" maybeListId
+  printDebug "[updatePie] tabType" tabType
+  printDebug "[updatePie] maybeLimit" maybeLimit
   _ <- updatePie' cId maybeListId tabType maybeLimit
   pure ()
 
@@ -276,9 +293,10 @@ updatePie' cId maybeListId tabType _maybeLimit = do
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let hl = node ^. node_hyperdata
+      pieMap = hl ^. hl_pie
 
   p <- chartData cId (ngramsTypeFromTabType tabType) MapTerm
-  _ <- updateHyperdata listId $ hl { _hl_pie = Just $ ChartMetrics p }
+  _ <- updateHyperdata listId $ hl { _hl_pie = Map.insert tabType (ChartMetrics p) pieMap }
 
   pure $ ChartMetrics p
 
@@ -336,7 +354,8 @@ getTree cId _start _end maybeListId tabType listType = do
     Nothing  -> defaultList cId
 
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
-  let HyperdataList { _hl_tree = mChart } = node ^. node_hyperdata
+  let treeMap = node ^. node_hyperdata ^. hl_tree
+      mChart = Map.lookup tabType treeMap
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -352,6 +371,10 @@ updateTree :: FlowCmdM env err m =>
   -> ListType
   -> m ()
 updateTree cId maybeListId tabType listType = do
+  printDebug "[updateTree] cId" cId
+  printDebug "[updateTree] maybeListId" maybeListId
+  printDebug "[updateTree] tabType" tabType
+  printDebug "[updateTree] listType" listType
   _ <- updateTree' cId maybeListId tabType listType
   pure ()
 
@@ -368,8 +391,9 @@ updateTree' cId maybeListId tabType listType = do
 
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let hl = node ^. node_hyperdata
+      treeMap = hl ^. hl_tree
   t <- treeData cId (ngramsTypeFromTabType tabType) listType
-  _ <- updateHyperdata listId $ hl { _hl_tree = Just $ ChartMetrics t }
+  _ <- updateHyperdata listId $ hl { _hl_tree = Map.insert tabType (ChartMetrics t) treeMap }
 
   pure $ ChartMetrics t
 

src/Gargantext/API/Ngrams/List.hs

@@ -17,7 +17,6 @@ module Gargantext.API.Ngrams.List
 
 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)
@@ -28,15 +27,16 @@ 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.Ngrams (getNgramsTableMap, setListNgrams)
+import Gargantext.API.Ngrams.Types (NgramsTableMap, RepoCmdM, Versioned(..))
+import Gargantext.API.Node.Corpus.New.File (FileType(..))
 import Gargantext.API.Prelude (GargServer)
 import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
-import Gargantext.Database.Action.Flow (FlowCmdM)
+import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Schema.Ngrams (NgramsType(..), ngramsTypes)
+import Gargantext.Prelude
 
 ------------------------------------------------------------------------
 type NgramsList = (Map NgramsType (Versioned NgramsTableMap))
@@ -74,6 +74,7 @@ get' lId = fromList
 
 ------------------------------------------------------------------------
 -- TODO : purge list
+-- TODO talk
 post :: FlowCmdM env err m
     => ListId
     -> NgramsList

src/Gargantext/API/Ngrams/NTree.hs

@@ -14,13 +14,8 @@ Portability : POSIX
 module Gargantext.API.Ngrams.NTree
   where
 
-import Data.Text (Text)
-import Gargantext.Prelude
-import GHC.Generics (Generic)
 import Data.Aeson.TH (deriveJSON)
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-import Gargantext.Core.Types (ListType(..), NodeId)
-import Gargantext.API.Ngrams
+import Data.Text (Text)
 import Data.Tree
 import Data.Maybe (catMaybes)
 import Data.Map (Map)
@@ -29,8 +24,15 @@ import Data.Swagger
 import qualified Data.Set as Set
 import qualified Data.Map as Map
 import qualified Data.List as List
+import GHC.Generics (Generic)
 import Test.QuickCheck
 
+import Gargantext.Prelude
+
+import Gargantext.API.Ngrams.Types
+import Gargantext.Core.Types (ListType(..), NodeId)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+
 type Children = Text
 type Root = Text
 
@@ -53,19 +55,21 @@ instance Arbitrary MyTree
 toTree :: ListType -> Map Text (Set NodeId) -> Map Text NgramsRepoElement -> [MyTree]
 toTree lt vs m = map toMyTree $ unfoldForest buildNode roots
   where
-    buildNode r = maybe ((r, value r),[]) (\x -> ((r, value r), mSetToList $ _nre_children x)) (Map.lookup r m)
+    buildNode r = maybe ((r, value r),[])
+                        (\x -> ((r, value r), unNgramsTerm <$> (mSetToList $ _nre_children x)))
+                        (Map.lookup r m)
 
     value l = maybe 0 (fromIntegral . Set.size) $ Map.lookup l vs
 
+    rootsCandidates :: [NgramsTerm]
     rootsCandidates = catMaybes
                     $ List.nub
-                    $ map (\(c,c') -> case _nre_root c' of
-                                       Nothing -> Just c
-                                       _ -> _nre_root c' ) (Map.toList m)
+                    $ map (\(c, c') -> case _nre_root c' of
+                                       Nothing -> Just $ NgramsTerm c
+                                       _ -> _nre_root c') (Map.toList m)
 
     roots = map fst
           $ filter (\(_,l) -> l == lt)
           $ catMaybes
-          $ map (\c -> (,) <$> Just c <*> (_nre_list <$> Map.lookup c m)) rootsCandidates
-
-
+          $ map (\c -> (,) <$> Just c <*> (_nre_list <$> Map.lookup c m))
+          $ (unNgramsTerm <$> rootsCandidates)

src/Gargantext/API/Ngrams/Tools.hs

@@ -17,15 +17,19 @@ import Control.Concurrent
 import Control.Lens (_Just, (^.), at, view)
 import Control.Monad.Reader
 import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
 import Data.Set (Set)
 import Data.Text (Text)
 import Data.Validity
-import Gargantext.API.Ngrams
+
+import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Types (ListType(..), NodeId, ListId)
 import Gargantext.Database.Schema.Ngrams (NgramsType)
 import Gargantext.Prelude
-import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
+
+mergeNgramsElement :: NgramsRepoElement -> NgramsRepoElement -> NgramsRepoElement
+mergeNgramsElement _neOld neNew = neNew
 
 type RootTerm = Text
 
@@ -36,12 +40,12 @@ getRepo = do
 
 listNgramsFromRepo :: [ListId] -> NgramsType
                    -> NgramsRepo -> Map Text NgramsRepoElement
-listNgramsFromRepo nodeIds ngramsType repo = ngrams
+listNgramsFromRepo nodeIds ngramsType repo = Map.mapKeys unNgramsTerm ngrams
   where
     ngramsMap = repo ^. r_state . at ngramsType . _Just
 
     ngrams    = Map.unionsWith mergeNgramsElement
-              [ ngramsMap ^. at nodeId . _Just | nodeId <- nodeIds ]
+                [ ngramsMap ^. at nodeId . _Just | nodeId <- nodeIds ]
 
 -- TODO-ACCESS: We want to do the security check before entering here.
 --              Add a static capability parameter would be nice.
@@ -72,7 +76,7 @@ mapTermListRoot :: [ListId]
                 -> NgramsRepo
                 -> Map Text (ListType, (Maybe Text))
 mapTermListRoot nodeIds ngramsType repo =
-  Map.fromList [ (t, (_nre_list nre, _nre_root nre))
+  Map.fromList [ (t, (_nre_list nre, unNgramsTerm <$> _nre_root nre))
                | (t, nre) <- Map.toList ngrams
                ]
   where ngrams = listNgramsFromRepo nodeIds ngramsType repo

src/Gargantext/API/Node.hs

@@ -42,7 +42,8 @@ import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
 import Gargantext.API.Admin.Auth (withAccess, PathId(..))
 import Gargantext.API.Metrics
-import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, apiNgramsTableCorpus)
+import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableCorpus)
+import Gargantext.API.Ngrams.Types (TabType(..))
 import Gargantext.API.Node.File
 import Gargantext.API.Node.New
 import Gargantext.API.Prelude
@@ -293,7 +294,7 @@ pairWith cId aId lId = do
 type TreeAPI   = QueryParams "type" NodeType :> Get '[JSON] (Tree NodeTree)
 
 treeAPI :: NodeId -> GargServer TreeAPI
-treeAPI = tree Advanced
+treeAPI = tree TreeAdvanced
 
 ------------------------------------------------------------------------
 -- | TODO Check if the name is less than 255 char

src/Gargantext/API/Node/Contact.hs

@@ -17,7 +17,6 @@ Portability : POSIX
 {-# LANGUAGE TemplateHaskell      #-}
 {-# LANGUAGE TypeFamilies         #-}
 {-# LANGUAGE TypeOperators        #-}
-{-# LANGUAGE UndecidableInstances #-}
 
 
 module Gargantext.API.Node.Contact
@@ -29,8 +28,13 @@ import Data.Maybe (Maybe(..))
 import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
+import Servant
+import Servant.Job.Async (JobFunction(..), serveJobsAPI)
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary
+
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
-import Gargantext.API.Admin.Settings (HasSettings)
+import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Node
 import Gargantext.API.Prelude (GargServer, simuLogs)
 import Gargantext.Core (Lang(..))
@@ -42,10 +46,6 @@ import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAnnuaire(..), Hyperda
 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"
@@ -99,8 +99,6 @@ addContact u nId (AddContactParams fn ln) logStatus = do
                , _scst_remaining = Just 0
                , _scst_events    = Just []
                }
-
-
 addContact _uId _nId _p logStatus = do
   simuLogs logStatus 10
 

src/Gargantext/API/Node/Corpus/Annuaire.hs

@@ -29,7 +29,7 @@ import qualified Gargantext.API.Node.Corpus.New.File as NewFile
 import Gargantext.API.Admin.Orchestrator.Types hiding (AsyncJobs)
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
-import Gargantext.Database.Action.Flow (FlowCmdM)  -- flowAnnuaire
+import Gargantext.Database.Action.Flow.Types (FlowCmdM)  -- flowAnnuaire
 import Gargantext.Database.Admin.Types.Node (AnnuaireId)
 import Gargantext.Prelude
 

src/Gargantext/API/Node/Corpus/Export.hs

@@ -28,7 +28,7 @@ import Data.Set (Set)
 import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
-import Gargantext.API.Ngrams
+import Gargantext.API.Ngrams.Types
 import Gargantext.API.Ngrams.Tools (filterListWithRoot, mapTermListRoot, getRepo)
 import Gargantext.API.Prelude (GargNoServer)
 import Gargantext.Prelude.Crypto.Hash (hash)
@@ -37,7 +37,6 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Action.Metrics.NgramsByNode (getNgramsByNodeOnlyUser)
 import Gargantext.Database.Admin.Config (userMaster)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
-import Gargantext.Database.Admin.Types.Node (Node, NodeId, ListId, CorpusId)
 import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)

src/Gargantext/API/Node/Corpus/New.hs

@@ -37,14 +37,14 @@ import Gargantext.Prelude
 
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import qualified Gargantext.API.Admin.Orchestrator.Types as T
-import Gargantext.API.Admin.Settings (HasSettings)
+import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Node.Corpus.New.File
 import Gargantext.API.Node.Types
 import Gargantext.Core (Lang(..){-, allLangs-})
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Action.Flow (FlowCmdM, flowCorpus, getDataText, flowDataText, TermType(..), DataOrigin(..){-, allDataOrigins-})
-import Gargantext.Database.Action.Flow.Utils (getUserId)
+import Gargantext.Database.Action.User (getUserId)
 import Gargantext.Database.Action.Node (mkNodeWithParent)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node (CorpusId, NodeType(..), UserId)
@@ -184,9 +184,10 @@ addToCorpusWithQuery :: FlowCmdM env err m
                        => User
                        -> CorpusId
                        -> WithQuery
+                       -> Maybe Integer
                        -> (JobLog -> m ())
                        -> m JobLog
-addToCorpusWithQuery u cid (WithQuery q dbs l _nid) logStatus = do
+addToCorpusWithQuery u cid (WithQuery q dbs l _nid) maybeLimit logStatus = do
   -- TODO ...
   logStatus JobLog { _scst_succeeded = Just 0
                    , _scst_failed    = Just 0
@@ -198,7 +199,7 @@ addToCorpusWithQuery u cid (WithQuery q dbs l _nid) logStatus = do
   -- TODO if cid is folder -> create Corpus
   --      if cid is corpus -> add to corpus
   --      if cid is root   -> create corpus in Private
-  txts <- mapM (\db  -> getDataText db     (Multi l) q Nothing) [database2origin dbs]
+  txts <- mapM (\db  -> getDataText db (Multi l) q maybeLimit) [database2origin dbs]
 
   logStatus JobLog { _scst_succeeded = Just 2
                    , _scst_failed    = Just 0

src/Gargantext/API/Node/Corpus/New/File.hs

@@ -29,12 +29,11 @@ import GHC.Generics (Generic)
 
 import Servant
 import Servant.Multipart
-import Servant.Swagger (HasSwagger(toSwagger))
 import Servant.Swagger.Internal
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
-import Gargantext.API.Ngrams (TODO)
+import Gargantext.Core.Types (TODO)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude -- (Cmd, CmdM)
 import Gargantext.Prelude

src/Gargantext/API/Node/File.hs

+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-matches #-}
+
 {-# LANGUAGE AllowAmbiguousTypes     #-}
 {-# LANGUAGE TypeOperators     #-}
-{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-matches -fno-warn-unused-imports #-}
 
 module Gargantext.API.Node.File where
 
@@ -8,27 +9,19 @@ import Control.Lens ((^.))
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BSL
 import qualified Data.MIME.Types as DMT
-import Data.Monoid (mempty)
 import Data.Swagger
 import Data.Text
-import Data.Text.Encoding
-import qualified Data.Text.IO as TIO
 import GHC.Generics (Generic)
 import qualified Network.HTTP.Media as M
-import Network.Wai.Application.Static
 import Servant
-import Servant.API.Raw (Raw)
 import Servant.Job.Async (JobFunction(..), serveJobsAPI)
-import Servant.Job.Core
-import Servant.Job.Types
-import Servant.Job.Utils (jsonOptions)
-import Servant.Server.Internal
 
 import Gargantext.Prelude
 import qualified Gargantext.Prelude.Utils as GPU
 
+import Gargantext.Core.Types (TODO)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
-import Gargantext.API.Admin.Settings (HasSettings)
+import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Node.Types
 import Gargantext.API.Prelude
 import Gargantext.Database.Action.Flow.Types
@@ -65,7 +58,7 @@ newtype BSResponse = BSResponse BS.ByteString
   deriving (Generic)
 
 instance ToSchema BSResponse  where
-  declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy BSResponse)
+  declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
 
 fileDownload :: (HasSettings env, FlowCmdM env err m)
              => UserId

src/Gargantext/API/Node/Get.hs

@@ -18,19 +18,20 @@ Polymorphic Get Node API
 module Gargantext.API.Node.Get
       where
 
--- import Gargantext.API.Admin.Settings (HasSettings)
+-- import Gargantext.API.Admin.Types (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 Servant
+import Test.QuickCheck.Arbitrary
+
 import Gargantext.API.Prelude
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Query.Table.Node (JSONB{-, getNodeWith-})
+import Gargantext.Database.Prelude (JSONB{-, getNodeWith-})
 import Gargantext.Prelude
-import Servant
-import Test.QuickCheck.Arbitrary
 
 ------------------------------------------------------------------------
 type API a = Summary "Polymorphic Get Node Endpoint"

src/Gargantext/API/Node/Share.hs

@@ -11,7 +11,6 @@ Portability : POSIX
 
 {-# LANGUAGE TemplateHaskell    #-}
 {-# LANGUAGE TypeOperators      #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Gargantext.API.Node.Share
       where
@@ -20,6 +19,10 @@ import Data.Aeson
 import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
+import Servant
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary
+
 import Gargantext.API.Prelude
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Action.Share (ShareNodeWith(..))
@@ -28,9 +31,6 @@ 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 ShareNodeParams = ShareTeamParams   { username :: Text  }

src/Gargantext/API/Node/Update.hs

@@ -20,8 +20,14 @@ import Data.Aeson
 import Data.Maybe (Maybe(..))
 import Data.Swagger
 import GHC.Generics (Generic)
+import Prelude (Enum, Bounded, minBound, maxBound)
+import Servant
+import Servant.Job.Async (JobFunction(..), serveJobsAPI)
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary
+
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
-import Gargantext.API.Admin.Settings (HasSettings)
+import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Prelude (GargServer, simuLogs)
 import Gargantext.Core.Viz.Graph.API (recomputeGraph)
 import Gargantext.Core.Viz.Graph.Distances (GraphMetric(..), Distance(..))
@@ -29,11 +35,6 @@ import Gargantext.Database.Action.Flow.Pairing (pairing)
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Prelude (Ord, Eq, (<$>), ($), liftBase, (.), printDebug, pure, show, cs, (<>), panic)
-import Prelude (Enum, Bounded, minBound, maxBound)
-import Servant
-import Servant.Job.Async (JobFunction(..), serveJobsAPI)
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary
 
 ------------------------------------------------------------------------
 type API = Summary " Update node according to NodeType params"

src/Gargantext/API/Prelude.hs

@@ -9,11 +9,8 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE ConstraintKinds        #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE TemplateHaskell        #-}
-{-# LANGUAGE TypeOperators          #-}
-{-# LANGUAGE UndecidableInstances   #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module Gargantext.API.Prelude
   ( module Gargantext.API.Prelude
@@ -26,7 +23,7 @@ import Control.Concurrent (threadDelay)
 import Control.Exception (Exception)
 import Control.Lens (Prism', (#))
 import Control.Lens.TH (makePrisms)
-import Control.Monad.Error.Class (MonadError(throwError))
+import Control.Monad.Error.Class (MonadError(..))
 import Control.Monad.Except (ExceptT)
 import Control.Monad.Reader (ReaderT)
 import Crypto.JOSE.Error as Jose
@@ -38,8 +35,8 @@ import Servant.Job.Async
 import Servant.Job.Core (HasServerError(..), serverError)
 
 import Gargantext.API.Admin.Orchestrator.Types
-import Gargantext.API.Admin.Settings
-import Gargantext.API.Ngrams
+import Gargantext.API.Admin.Types
+import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Types
 import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node.Error (NodeError(..), HasNodeError(..))
@@ -52,64 +49,45 @@ class HasJoseError e where
 joseError :: (MonadError e m, HasJoseError e) => Jose.Error -> m a
 joseError = throwError . (_JoseError #)
 
-class ThrowAll' e a | a -> e where
-  -- | 'throwAll' is a convenience function to throw errors across an entire
-  -- sub-API
-  --
-  --
-  -- > throwAll err400 :: Handler a :<|> Handler b :<|> Handler c
-  -- >    == throwError err400 :<|> throwError err400 :<|> err400
-  throwAll' :: e -> a
-
-instance (ThrowAll' e a, ThrowAll' e b) => ThrowAll' e (a :<|> b) where
-  throwAll' e = throwAll' e :<|> throwAll' e
-
--- Really this shouldn't be necessary - ((->) a) should be an instance of
--- MonadError, no?
-instance {-# OVERLAPPING #-} ThrowAll' e b => ThrowAll' e (a -> b) where
-  throwAll' e = const $ throwAll' e
+type EnvC env =
+  ( HasConnectionPool env
+  , HasRepo           env  -- TODO rename HasNgramsRepo
+  , HasSettings       env  -- TODO rename HasDbSettings
+  , HasJobEnv         env JobLog JobLog
+  , HasConfig         env
+  )
 
-instance {-# OVERLAPPABLE #-} (MonadError e m) => ThrowAll' e (m a) where
-  throwAll' = throwError
+type ErrC err =
+  ( HasNodeError     err
+  , HasInvalidError  err
+  , HasTreeError     err
+  , HasServerError   err
+  , HasJoseError     err
+  , ToJSON           err -- TODO this is arguable
+  , Exception        err
+  )
 
 type GargServerC env err m =
-    ( CmdM         env err m
-    , HasNodeError     err
-    , HasInvalidError  err
-    , HasTreeError     err
-    , HasServerError   err
-    , HasJoseError     err
-    , ToJSON           err -- TODO this is arguable
-    , Exception        err
-    , HasRepo      env
-    , HasSettings  env
-    , HasJobEnv    env JobLog JobLog
-    , HasConfig    env
-    )
+  ( CmdM' env err m
+  , EnvC  env
+  , ErrC      err
+  )
 
 type GargServerT env err m api = GargServerC env err m => ServerT api m
 
-type GargServer api =
-  forall env err m. GargServerT env err m api
-
--- This is the concrete monad. It needs to be used as little as possible,
--- instead, prefer GargServer, GargServerT, GargServerC.
-type GargServerM env err = ReaderT env (ExceptT err IO)
-
-type EnvC env =
-  ( HasConnectionPool env
-  , HasRepo           env
-  , HasSettings       env
-  , HasJobEnv         env JobLog JobLog
-  , HasConfig         env
-  )
+type GargServer api = forall env err m. GargServerT env err m api
 
--------------------------------------------------------------------
-runCmdReplEasy :: Cmd' DevEnv GargError a -> IO a
-runCmdReplEasy f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f
+-- This is the concrete monad. It needs to be used as little as possible.
+type GargM env err = ReaderT env (ExceptT err IO)
+-- This is the server type using GargM. It needs to be used as little as possible.
+-- Instead, prefer GargServer, GargServerT.
+type GargServerM env err api = (EnvC env, ErrC err) => ServerT api (GargM env err)
 
 -------------------------------------------------------------------
 -- | This Type is needed to prepare the function before the GargServer
+type GargNoServer t =
+  forall env err m. GargNoServer' env err m => m t
+
 type GargNoServer' env err m =
   ( CmdM           env err m
   , HasRepo        env
@@ -117,8 +95,6 @@ type GargNoServer' env err m =
   , HasNodeError       err
   )
 
-type GargNoServer t =
-  forall env err m. GargNoServer' env err m => m t
 -------------------------------------------------------------------
 
 data GargError

src/Gargantext/API/Public.hs

@@ -16,14 +16,16 @@ Portability : POSIX
 module Gargantext.API.Public
       where
 
+import Data.Set (Set)
 import Control.Lens ((^?), (^.), _Just)
-import Data.Maybe (maybe, catMaybes)
-import Data.Tuple (snd)
+import Data.Maybe (catMaybes)
 import Data.Text (Text)
 import Data.List (replicate, null)
 import Data.Aeson
 import Data.Swagger
 import GHC.Generics (Generic)
+import Gargantext.API.Prelude
+import Gargantext.API.Node.File
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Prelude
 import Gargantext.Database.Admin.Types.Node
@@ -35,38 +37,79 @@ import Gargantext.Prelude
 import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
+
+import qualified Data.List as List
 import qualified Data.Map as Map
+import qualified Data.Set as Set
 
 ------------------------------------------------------------------------
-type API = Summary " Public API"
+type API =  API_Home
+       :<|> API_Node
+
+api :: Text -> GargServer API
+api baseUrl = (api_home baseUrl)
+          :<|> api_node
+
+-------------------------------------------------------------------------
+type API_Home = Summary " Public Home API"
          :> Get '[JSON] [PublicData]
 
-api :: HasNodeError err
-    => Cmd err [PublicData]
-api = catMaybes <$> map toPublicData <$> filterPublicDatas <$> selectPublic
+api_home :: Text -> GargServer API_Home
+api_home baseUrl = catMaybes
+   <$> map (toPublicData baseUrl)
+   <$> filterPublicDatas
+   <$> selectPublic
+
+-------------------------------------------------------------------------
+type API_Node = Summary " Public Node API"
+              :> Capture "node" NodeId
+              :> "file" :> FileApi
+
+api_node :: NodeId -> GargServer FileApi
+api_node nId = do
+  pubNodes <- publicNodes
+  -- TODO optimize with SQL
+  case Set.member nId pubNodes of
+    False -> panic "Not allowed" -- TODO throwErr
+    True  -> fileApi 0 nId
+
+-------------------------------------------------------------------------
 
 
 selectPublic :: HasNodeError err
-             => Cmd err [( Node HyperdataFolder, Maybe Int)] 
+             => Cmd err [( Node HyperdataFolder, Maybe Int)]
 selectPublic = selectPublicNodes
 
-  -- | For tests only
+  -- For tests only
   -- pure $ replicate 6 defaultPublicData
 
-filterPublicDatas :: [( Node HyperdataFolder, Maybe Int)] -> [(Node HyperdataFolder, [NodeId])]
-filterPublicDatas datas = map (\(n,mi) -> let mi' = NodeId <$> mi in
-                                              ( _node_id n, (n, maybe [] (:[]) mi' ))
-                              ) datas
-                        & Map.fromListWith (\(n1,i1) (_n2,i2) -> (n1, i1 <> i2))
-                        & Map.filter (not . null . snd)
-                        & Map.elems
-
-
-toPublicData :: (Node HyperdataFolder, [NodeId]) -> Maybe PublicData
-toPublicData (n , _mn) = PublicData <$> (hd ^? (_Just . hf_data . cf_title))
-                                   <*> (hd ^? (_Just . hf_data . cf_desc))
-                                   <*> Just "images/Gargantextuel-212x300.jpg"
-                                   <*> Just "https://.."
+filterPublicDatas :: [(Node HyperdataFolder, Maybe Int)]
+                  -> [(Node HyperdataFolder, [NodeId])]
+filterPublicDatas datas =
+  map (\(n,mi) ->
+          let mi' = NodeId <$> mi in
+                  ( _node_id n, (n, maybe [] (:[]) mi' ))
+      ) datas
+      & Map.fromListWith (\(n1,i1) (_n2,i2) -> (n1, i1 <> i2))
+      & Map.filter (not . null . snd)
+      & Map.elems
+
+publicNodes :: HasNodeError err
+            => Cmd err (Set NodeId)
+publicNodes = do
+  candidates <- filterPublicDatas <$> selectPublicNodes
+  pure $ Set.fromList
+       $ List.concat
+       $ map (\(n, ns) -> (_node_id n) : ns) candidates
+
+
+-- http://localhost:8008/api/v1.0/node/23543/file/download<Paste>
+-- http://localhost:8000/images/Gargantextuel-212x300.jpg
+toPublicData :: Text -> (Node HyperdataFolder, [NodeId]) -> Maybe PublicData
+toPublicData base (n , mn) = PublicData <$> (hd ^? (_Just . hf_data . cf_title))
+                                   <*> (hd ^? (_Just . hf_data . cf_desc ))
+                                   <*> (Just $ url' mn) -- "images/Gargantextuel-212x300.jpg"
+                                   <*> (Just $ url' mn)
                                    <*> Just (cs $ show $ utc2year (n^.node_date))
                                    <*> (hd ^? (_Just . hf_data . cf_query))
                                    <*> (hd ^? (_Just . hf_data . cf_authors))
@@ -74,6 +117,11 @@ toPublicData (n , _mn) = PublicData <$> (hd ^? (_Just . hf_data . cf_title))
     hd = head
        $ filter (\(HyperdataField cd _ _) -> cd == JSON)
        $ n^. (node_hyperdata . hc_fields)
+    url' :: [NodeId] -> Text 
+    url' mn' = base 
+           <>   "/public/"
+           <> (cs $ show $ (maybe 0 unNodeId $ head mn'))
+           <> "/file/download"
 
 
 data PublicData = PublicData

src/Gargantext/API/Routes.hs

@@ -17,7 +17,6 @@ Portability : POSIX
 {-# LANGUAGE KindSignatures       #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE TypeFamilies         #-}
-{-# LANGUAGE UndecidableInstances #-}
 
 ---------------------------------------------------------------------
 module Gargantext.API.Routes
@@ -26,6 +25,7 @@ module Gargantext.API.Routes
 
 -- import qualified Gargantext.API.Search as Search
 import Control.Concurrent (threadDelay)
+import Control.Lens (view)
 import Data.Text (Text)
 import Data.Validity
 import Gargantext.API.Admin.Auth (AuthRequest, AuthResponse, AuthenticatedUser(..), withAccess, PathId(..))
@@ -36,10 +36,11 @@ import Gargantext.API.Node
 import Gargantext.API.Prelude
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Viz.Graph.API
+import Gargantext.Database.Prelude (HasConfig(..))
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Admin.Types.Node (NodeId, CorpusId, AnnuaireId)
 import Gargantext.Prelude
+import Gargantext.Prelude.Config (gc_max_docs_scrapers)
 import Servant
 import Servant.Auth as SA
 import Servant.Auth.Swagger ()
@@ -72,7 +73,7 @@ type GargAPI' =
                    -- TODO-ACCESS here we want to request a particular header for
            -- auth and capabilities.
           :<|> GargPrivateAPI
-          :<|> "public" :> Public.API
+          :<|> "public"      :> Public.API
 
 
 type GargPrivateAPI = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser
@@ -247,12 +248,13 @@ waitAPI n = do
 addCorpusWithQuery :: User -> GargServer New.AddWithQuery
 addCorpusWithQuery user cid =
   serveJobsAPI $
-    JobFunction (\q log ->
-      let
-        log' x = do
-          printDebug "addToCorpusWithQuery" x
-          liftBase $ log x
-      in New.addToCorpusWithQuery user cid q log'
+    JobFunction (\q log -> do
+      limit <- view $ config . gc_max_docs_scrapers
+      New.addToCorpusWithQuery user cid q (Just limit) (liftBase . log)
+      {- let log' x = do
+        printDebug "addToCorpusWithQuery" x
+        liftBase $ log x
+      -}
       )
 
 {-

src/Gargantext/API/Server.hs

+{-|
+Module      : Gargantext.API.Server
+Description : REST API declaration
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
+{-# LANGUAGE ScopedTypeVariables  #-}
+
+---------------------------------------------------------------------
+module Gargantext.API.Server where
+---------------------------------------------------------------------
+import Control.Lens ((^.))
+import Control.Monad.Except (withExceptT)
+import Control.Monad.Reader (runReaderT)
+import Data.Text (Text)
+import Data.Version (showVersion)
+import Servant
+import Servant.Swagger.UI (swaggerSchemaUIServer)
+import qualified Data.ByteString.Lazy.Char8 as BL8
+import qualified Paths_gargantext           as PG -- cabal magic build module
+
+import qualified Gargantext.API.Public      as Public
+
+import Gargantext.API.Admin.Auth (AuthContext, auth)
+import Gargantext.API.Admin.FrontEnd (frontEndServer)
+import Gargantext.API.Prelude
+import Gargantext.API.Routes
+import Gargantext.API.Swagger (swaggerDoc)
+import Gargantext.API.ThrowAll (serverPrivateGargAPI)
+import Gargantext.Prelude
+import Gargantext.Prelude.Config (gc_url_backend_api)
+import Gargantext.Database.Prelude (config)
+
+
+serverGargAPI :: Text -> GargServerM env err GargAPI
+serverGargAPI baseUrl -- orchestrator
+       =  auth
+     :<|> gargVersion
+     :<|> serverPrivateGargAPI
+     :<|> Public.api baseUrl
+
+  --   :<|> orchestrator
+  where
+    gargVersion :: GargServer GargVersion
+    gargVersion = pure (cs $ showVersion PG.version)
+
+-- | Server declarations
+server :: forall env. EnvC env => env -> IO (Server API)
+server env = do
+  -- orchestrator <- scrapyOrchestrator env
+  pure $  swaggerSchemaUIServer swaggerDoc
+     :<|> hoistServerWithContext
+            (Proxy :: Proxy GargAPI)
+            (Proxy :: Proxy AuthContext)
+            transform
+            (serverGargAPI (env ^. config . gc_url_backend_api))
+     :<|> frontEndServer
+  where
+    transform :: forall a. GargM env GargError a -> Handler a
+    transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
+
+
+showAsServantErr :: GargError -> ServerError
+showAsServantErr (GargServerError err) = err
+showAsServantErr a = err500 { errBody = BL8.pack $ show a }
\ No newline at end of file

src/Gargantext/API/Swagger.hs

+{-|
+Module      : Gargantext.API.Swagger
+Description : Swagger API generation
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+---------------------------------------------------------------------
+module Gargantext.API.Swagger where
+---------------------------------------------------------------------
+import Control.Lens
+import Data.Swagger
+import Data.Version (showVersion)
+import Servant
+import Servant.Swagger
+import qualified Paths_gargantext as PG -- cabal magic build module
+
+import Gargantext.API.Routes
+import Gargantext.Prelude
+
+-- | Swagger Specifications
+swaggerDoc :: Swagger
+swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
+  & info.title       .~ "Gargantext"
+  & info.version     .~ (cs $ showVersion PG.version)
+  -- & info.base_url     ?~ (URL "http://gargantext.org/")
+  & info.description ?~ "REST API specifications"
+  -- & tags             .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
+  & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI)) 
+                 ["Gargantext" & description ?~ "Main operations"]
+  & info.license     ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
+    where
+        urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
\ No newline at end of file

src/Gargantext/API/Table.hs

@@ -41,11 +41,11 @@ import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
 import Gargantext.API.HashedResponse
-import Gargantext.API.Ngrams (TabType(..))
+import Gargantext.API.Ngrams.Types (TabType(..))
 import Gargantext.API.Prelude (GargServer)
 import Gargantext.Core.Types (Offset, Limit, TableResult(..))
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, OrderBy(..), runViewAuthorsDoc)
+import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, runCountDocuments, OrderBy(..), runViewAuthorsDoc)
 import Gargantext.Database.Action.Learn (FavOrTrash(..), moreLike)
 import Gargantext.Database.Action.Search
 import Gargantext.Database.Admin.Types.Node
@@ -116,7 +116,7 @@ searchInCorpus' :: CorpusId
                 -> Maybe OrderBy
                 -> Cmd err FacetTableResult
 searchInCorpus' cId t q o l order = do
-  docs <- searchInCorpus cId t q o l order
+  docs          <- searchInCorpus cId t q o l order
   countAllDocs  <- searchCountInCorpus cId t q
   pure $ TableResult { tr_docs = docs, tr_count = countAllDocs }
 
@@ -125,10 +125,9 @@ getTable :: NodeId -> Maybe TabType
          -> Maybe Offset  -> Maybe Limit
          -> Maybe OrderBy -> Cmd err FacetTableResult
 getTable cId ft o l order = do
-  docs <- getTable' cId ft o l order
-  -- TODO: Rewrite to use runCountOpaQuery and avoid (length allDocs)
-  allDocs  <- getTable' cId ft Nothing Nothing Nothing
-  pure $ TableResult { tr_docs = docs, tr_count = length allDocs }
+  docs      <- getTable' cId ft o l order
+  docsCount <- runCountDocuments cId (if ft == Just Trash then True else False)
+  pure $ TableResult { tr_docs = docs, tr_count = docsCount }
 
 getTable' :: NodeId -> Maybe TabType
          -> Maybe Offset  -> Maybe Limit

src/Gargantext/API/ThrowAll.hs

+{-|
+Module      : Gargantext.API.ThrowAll
+Description : ThrowAll class and instance
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE TypeOperators          #-}
+{-# LANGUAGE UndecidableInstances   #-}
+
+module Gargantext.API.ThrowAll where
+
+import Control.Monad.Error.Class (MonadError(..))
+import Control.Lens ((#))
+import Servant
+import Servant.Auth.Server (AuthResult(..))
+import Gargantext.Prelude
+import Gargantext.API.Prelude (GargServerM, _ServerError)
+import Gargantext.API.Routes (GargPrivateAPI, serverPrivateGargAPI')
+
+class ThrowAll' e a | a -> e where
+  -- | 'throwAll' is a convenience function to throw errors across an entire
+  -- sub-API
+  --
+  --
+  -- > throwAll err400 :: Handler a :<|> Handler b :<|> Handler c
+  -- >    == throwError err400 :<|> throwError err400 :<|> err400
+  throwAll' :: e -> a
+
+instance (ThrowAll' e a, ThrowAll' e b) => ThrowAll' e (a :<|> b) where
+  throwAll' e = throwAll' e :<|> throwAll' e
+
+-- Really this shouldn't be necessary - ((->) a) should be an instance of
+-- MonadError, no?
+instance {-# OVERLAPPING #-} ThrowAll' e b => ThrowAll' e (a -> b) where
+  throwAll' e = const $ throwAll' e
+
+instance {-# OVERLAPPABLE #-} (MonadError e m) => ThrowAll' e (m a) where
+  throwAll' = throwError
+
+serverPrivateGargAPI :: GargServerM env err GargPrivateAPI
+serverPrivateGargAPI (Authenticated auser) = serverPrivateGargAPI' auser
+serverPrivateGargAPI _                     = throwAll' (_ServerError # err401)
+-- Here throwAll' requires a concrete type for the monad.
\ No newline at end of file

src/Gargantext/Core/Ext/IMTUser.hs

@@ -17,7 +17,7 @@ module Gargantext.Core.Ext.IMTUser (deserialiseImtUsersFromFile)
   where
 
 import Codec.Serialise
-import Data.Maybe (Maybe, catMaybes)
+import Data.Maybe (catMaybes)
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Gargantext.Database.Admin.Types.Hyperdata.Contact

src/Gargantext/Core/Flow/Types.hs

@@ -16,7 +16,7 @@ module Gargantext.Core.Flow.Types where
 
 import Control.Lens -- (Lens')
 import Data.Map (Map)
-import Data.Maybe (Maybe)
+
 import Gargantext.Core.Text (HasText(..))
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node

src/Gargantext/Core/Text.hs

@@ -127,3 +127,9 @@ termTests = "It is hard to detect important articles in a specific context. Info
     -- group ngrams
     --ocs  = occ       $ ws
 
+-- | Ngrams size
+size :: Text -> Int
+size t = 1 + DT.count " " t
+
+
+

src/Gargantext/Core/Text/Corpus/API.hs

@@ -36,7 +36,7 @@ get :: ExternalAPIs
     -> Query
     -> Maybe Limit
     -> IO [HyperdataDocument]
-get PubMed  _la q l = PUBMED.get q l -- EN only by default
+get PubMed  _la q l = PUBMED.get   q l -- EN only by default
 get HAL      la q l = HAL.get   la q l
 get IsTex    la q l = ISTEX.get la q l
 get Isidore  la q l = ISIDORE.get la (fromIntegral <$> l) (Just q) Nothing

src/Gargantext/Core/Text/Corpus/API/Istex.hs

@@ -13,10 +13,8 @@ Portability : POSIX
 module Gargantext.Core.Text.Corpus.API.Istex
     where
 
-import Data.Either (either)
 import Data.List (concat)
 import Data.Maybe
-import Data.Maybe (catMaybes)
 import Data.Text (Text, pack)
 
 import Gargantext.Core (Lang(..))

src/Gargantext/Core/Text/Corpus/Parsers/CSV.hs

@@ -25,7 +25,6 @@ import Data.Time.Segment (jour)
 import qualified Data.Vector          as V
 import Data.Vector (Vector)
 import GHC.IO (FilePath)
-import GHC.Real (round)
 import GHC.Word (Word8)
 
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))

src/Gargantext/Core/Text/Corpus/Parsers/Date.hs

@@ -14,9 +14,11 @@ import Gargantext.Core.Text.Corpus.Parsers.Date as DGP
 DGP.parseDateRaw DGP.FR "12 avril 2010" == "2010-04-12T00:00:00.000+00:00"
 -}
 
+{-# LANGUAGE TypeFamilies #-}
 
-module Gargantext.Core.Text.Corpus.Parsers.Date (parse, parseRaw, dateSplit, Year, Month, Day) where
+module Gargantext.Core.Text.Corpus.Parsers.Date {-(parse, parseRaw, dateSplit, Year, Month, Day)-} where
 
+import Data.Aeson (toJSON, Value)
 import Data.HashMap.Strict as HM hiding (map)
 import Data.Text (Text, unpack, splitOn, pack)
 import Data.Time (parseTimeOrError, defaultTimeLocale, toGregorian)
@@ -25,9 +27,8 @@ import Data.Time.LocalTime (utc)
 import Data.Time.LocalTime.TimeZone.Series (zonedTimeToZoneSeriesTime)
 import Duckling.Api (analyze)
 import Duckling.Core (makeLocale, Some(This), Dimension(Time))
-import Duckling.Resolve (fromUTC, Context(Context, referenceTime, locale), DucklingTime(DucklingTime))
-import Duckling.Types (ResolvedToken)
-import Duckling.Types (jsonValue)
+import Duckling.Resolve (fromUTC, Context(Context, referenceTime, locale), DucklingTime(DucklingTime), Options(..))
+import Duckling.Types (ResolvedToken(..), ResolvedVal(..))
 import Gargantext.Core (Lang(FR,EN))
 import Gargantext.Prelude
 import qualified Data.Aeson   as Json
@@ -90,17 +91,27 @@ parserLang _  = panic "not implemented"
 -- parseRaw :: Context -> Text -> SomeErrorHandling Text
 
 -- TODO error handling
-parseRaw :: Lang -> Text -> IO (Text)
-parseRaw lang text = do
-    maybeJson <- map jsonValue <$> parseDateWithDuckling lang text
-    case headMay maybeJson of
-      Just (Json.Object object) -> case HM.lookup "value" object of
-                                     Just (Json.String date) -> pure date
-                                     Just _                  -> panic "ParseRaw ERROR: should be a json String"
-                                     Nothing                 -> panic $ "ParseRaw ERROR: no date found" <> (pack . show) lang <> " " <> text
-
-      _                         -> panic $ "ParseRaw ERROR: type error" <> (pack . show) lang <> " " <> text
-
+parseRaw :: Lang -> Text -> IO Text
+parseRaw lang text = do -- case result
+    maybeResult <- extractValue <$> getTimeValue <$> parseDateWithDuckling lang text (Options True)
+    case maybeResult of
+      Just result -> pure result
+      Nothing     -> panic $ "[G.C.T.C.P.D.parseRaw] ERROR" <> (pack . show) lang <> " " <> text
+
+
+getTimeValue :: [ResolvedToken] -> Value
+getTimeValue rt = case head rt of
+  Nothing -> panic "error"
+  Just x  -> case rval x of
+    RVal Time t -> toJSON t
+    _  -> panic "error2"
+
+extractValue :: Value -> Maybe Text
+extractValue (Json.Object object) =
+  case HM.lookup "value" object of
+    Just (Json.String date) -> Just date
+    _                  -> Nothing
+extractValue _ = Nothing
 
 -- | Current Time in DucklingTime format
 -- TODO : get local Time in a more generic way
@@ -112,9 +123,12 @@ localContext :: Lang -> DucklingTime -> Context
 localContext lang dt = Context {referenceTime = dt, locale = makeLocale (parserLang lang) Nothing}
 
 -- | Date parser with Duckling
-parseDateWithDuckling :: Lang -> Text -> IO [ResolvedToken]
-parseDateWithDuckling lang input = do
+parseDateWithDuckling :: Lang -> Text -> Options -> IO [ResolvedToken]
+parseDateWithDuckling lang input options = do
     contxt <- localContext lang <$> utcToDucklingTime <$> getCurrentTime
     --pure $ parseAndResolve (rulesFor (locale ctx) (HashSet.fromList [(This Time)])) input ctx
-    pure $ analyze input contxt $ HashSet.fromList [(This Time)]
+    -- TODO check/test Options False or True
+    pure $ analyze input contxt options $ HashSet.fromList [(This Time)]
+
+
 

src/Gargantext/Core/Text/Corpus/Parsers/Date/Attoparsec.hs

@@ -17,7 +17,6 @@ module Gargantext.Core.Text.Corpus.Parsers.Date.Attoparsec
 import Control.Applicative ((<*))
 import Data.Attoparsec.ByteString (Parser, take)
 import Data.ByteString (ByteString)
-import Data.Monoid ((<>))
 import Data.Tuple.Extra (first)
 import Gargantext.Prelude hiding (takeWhile, take)
 

src/Gargantext/Core/Text/Corpus/Parsers/Date/Parsec.hs

@@ -13,16 +13,14 @@ Portability : POSIX
 module Gargantext.Core.Text.Corpus.Parsers.Date.Parsec
   where
 
-import Control.Monad ((=<<))
 import Data.Either (Either)
 import Data.Fixed (Fixed (MkFixed))
-import Data.Foldable (length)
 import Data.String (String)
 import Data.Text (Text, unpack)
 import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..), TimeOfDay(..))
 import Data.Time.Calendar (Day, fromGregorian)
 import Gargantext.Prelude
-import Prelude (toInteger, div, otherwise, (++))
+import Prelude (toInteger, (++))
 import Text.Parsec.Error (ParseError)
 import Text.Parsec.Prim (Stream, ParsecT)
 import Text.Parsec.String (Parser)

src/Gargantext/Core/Text/Corpus/Parsers/GrandDebat.hs

@@ -29,7 +29,6 @@ module Gargantext.Core.Text.Corpus.Parsers.GrandDebat
 import Data.Aeson (ToJSON, FromJSON)
 import qualified Data.ByteString.Lazy as DBL
 import qualified Data.JsonStream.Parser as P
-import Data.Maybe (Maybe())
 import Data.Text (Text)
 import qualified Data.Text as Text
 import GHC.Generics (Generic)

src/Gargantext/Core/Text/Corpus/Parsers/RIS.hs

@@ -24,7 +24,6 @@ import Control.Applicative
 import Data.Attoparsec.ByteString (Parser, try, takeTill, take, many1)
 import Data.Attoparsec.ByteString.Char8 (isEndOfLine)
 import Data.ByteString (ByteString, concat)
-import Data.Monoid ((<>))
 import Gargantext.Prelude hiding (takeWhile, take)
 import qualified Data.List as DL
 -------------------------------------------------------------

src/Gargantext/Core/Text/Corpus/Parsers/RIS/Presse.hs

@@ -15,8 +15,7 @@ Presse RIS format parser for Europresse Database.
 module Gargantext.Core.Text.Corpus.Parsers.RIS.Presse (presseEnrich) where
 
 import Data.List (lookup)
-import Data.Either (either)
-import Data.Tuple.Extra (first, both, uncurry)
+import Data.Tuple.Extra (first, both)
 import Data.Attoparsec.ByteString (parseOnly)
 import Data.ByteString (ByteString, length)
 import Gargantext.Prelude hiding (takeWhile, take, length)

src/Gargantext/Core/Text/Corpus/Parsers/Wikimedia.hs

@@ -61,7 +61,7 @@ tagUntil name = matching (/= name)
 -- | Utility function that consumes everything but the tag given
 -- usefull because we have to consume every data.
 manyTagsUntil_ :: MonadThrow m => Name -> ConduitT Event o m ()
-manyTagsUntil_ = many_ . ignoreTreeContent . tagUntil
+manyTagsUntil_ n = many_ (ignoreTree (tagUntil n) ignoreAttrs)
 
 manyTagsUntil_' :: MonadThrow m => Name -> ConduitT Event o m ()
 manyTagsUntil_' = many_ . ignoreEmptyTag . tagUntil

src/Gargantext/Core/Text/Examples.hs

@@ -113,7 +113,7 @@ ex_cooc = cooc <$> ex_terms
 --     0.0,  1.0,  1.0,  0.5,
 --     0.0,  0.0,  1.0,  0.5,
 --     0.0,  0.0,  0.0,  1.0],(Vector (Z :. 4) [0.5833333333333334,0.5833333333333334,0.75,0.5833333333333334],Vector (Z :. 4) [-0.5833333333333334,-0.4166666666666667,0.41666666666666674,0.5833333333333334]))
-ex_cooc_mat :: IO (Map Label Index, Matrix Int, Matrix Double, (DAA.Vector InclusionExclusion, DAA.Vector SpecificityGenericity))
+ex_cooc_mat :: IO (Map Label Index, Matrix Int, Matrix Double, (DAA.Vector GenericityInclusion, DAA.Vector SpecificityExclusion))
 ex_cooc_mat = do
   m <- ex_cooc
   let (ti,_) = createIndices m

src/Gargantext/Core/Text/Group.hs

+{-|
+Module      : Gargantext.Core.Text.Group
+Description : 
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE TemplateHaskell   #-}
+
+module Gargantext.Core.Text.Group
+  where
+
+import Control.Lens (makeLenses, set)
+import Data.Set (Set)
+import Data.Map (Map)
+import Data.Text (Text)
+import Gargantext.Core (Lang(..))
+import Gargantext.Core.Text (size)
+import Gargantext.Core.Types (ListType(..)) -- (MasterCorpusId, UserCorpusId)
+import Gargantext.Database.Admin.Types.Node (NodeId)
+-- import Gargantext.Core.Text.List.Learn (Model(..))
+import Gargantext.Core.Text.Terms.Mono.Stem (stem)
+import Gargantext.Prelude
+import qualified Data.Set  as Set
+import qualified Data.Map  as Map
+import qualified Data.List as List
+import qualified Data.Text as Text
+
+{-
+data NgramsListBuilder = BuilderStepO { stemSize :: !Int
+                                      , stemX    :: !Int
+                                      , stopSize :: !StopSize
+                                      }
+                       | BuilderStep1 { withModel :: !Model }
+                       | BuilderStepN { withModel :: !Model }
+                       | Tficf { nlb_lang           :: !Lang
+                               , nlb_group1         :: !Int
+                               , nlb_group2         :: !Int
+                               , nlb_stopSize       :: !StopSize
+                               , nlb_userCorpusId   :: !UserCorpusId
+                               , nlb_masterCorpusId :: !MasterCorpusId
+                               }
+-}
+
+data StopSize = StopSize {unStopSize :: !Int}
+
+-- | TODO: group with 2 terms only can be
+-- discussed. Main purpose of this is offering
+-- a first grouping option to user and get some
+-- enriched data to better learn and improve that algo
+data GroupParams = GroupParams { unGroupParams_lang  :: !Lang
+                               , unGroupParams_len   :: !Int
+                               , unGroupParams_limit :: !Int
+                               , unGroupParams_stopSize :: !StopSize
+                               }
+                 | GroupIdentity
+
+ngramsGroup :: GroupParams
+            -> Text
+            -> Text
+ngramsGroup GroupIdentity  = identity
+ngramsGroup (GroupParams l _m _n _) = 
+                    Text.intercalate " "
+                  . map (stem l)
+                  -- . take n
+                  . List.sort
+                  -- . (List.filter (\t -> Text.length t > m))
+                  . Text.splitOn " "
+                  . Text.replace "-" " "
+
+------------------------------------------------------------------------
+mergeMapParent :: Map Text (GroupedText b)
+               -> Map Text (Map Text Int)
+               -> Map Text (GroupedText b)
+mergeMapParent = undefined
+
+------------------------------------------------------------------------
+toGroupedText :: Ord b
+              => (Text -> Text      )
+              -> (a    -> b         )
+              -> (a    -> Set Text  )
+              -> (a    -> Set NodeId)
+              -> [(Text,a)]
+              -> Map Stem (GroupedText b)
+toGroupedText fun_stem fun_score fun_texts fun_nodeIds from = groupStems' $ map group from
+  where
+    group (t,d) = let t' = fun_stem t
+                   in (t', GroupedText
+                              Nothing
+                              t
+                              (fun_score d)
+                              (fun_texts d)
+                              (size t)
+                              t'
+                              (fun_nodeIds d)
+                       )
+
+groupStems :: [(Stem, GroupedText Double)] -> [GroupedText Double]
+groupStems = Map.elems . groupStems'
+
+groupStems' :: Ord a => [(Stem, GroupedText a)] -> Map Stem (GroupedText a)
+groupStems' = Map.fromListWith grouping
+  where
+    grouping (GroupedText lt1 label1 score1 group1 s1 stem1 nodes1)
+             (GroupedText lt2 label2 score2 group2 s2 stem2 nodes2)
+             | score1 >= score2 = GroupedText lt label1 score1 (Set.insert label2 gr) s1 stem1 nodes
+             | otherwise        = GroupedText lt label2 score2 (Set.insert label1 gr) s2 stem2 nodes
+        where
+          lt = lt1 <> lt2
+          gr    = Set.union group1 group2
+          nodes = Set.union nodes1 nodes2
+
+------------------------------------------------------------------------
+type Group = Lang -> Int -> Int -> Text -> Text
+type Stem  = Text
+type Label = Text
+data GroupedText score =
+  GroupedText { _gt_listType :: !(Maybe ListType)
+              , _gt_label    :: !Label
+              , _gt_score    :: !score
+              , _gt_children :: !(Set Text)
+              , _gt_size     :: !Int
+              , _gt_stem     :: !Stem
+              , _gt_nodes    :: !(Set NodeId)
+              } {-deriving Show--}
+--{-
+instance Show score => Show (GroupedText score) where
+  show (GroupedText lt l s _ _ _ _) = show l <> " : " <> show lt <> " : " <> show s
+--}
+
+instance (Eq a) => Eq (GroupedText a) where
+  (==) (GroupedText _ _ score1 _ _ _ _)
+       (GroupedText _ _ score2 _ _ _ _) = (==) score1 score2
+
+instance (Eq a, Ord a) => Ord (GroupedText a) where
+  compare (GroupedText _ _ score1 _ _ _ _)
+          (GroupedText _ _ score2 _ _ _ _) = compare score1 score2
+
+-- Lenses Instances
+makeLenses 'GroupedText
+
+------------------------------------------------------------------------
+addListType :: Map Text ListType -> GroupedText a -> GroupedText a
+addListType m g = set gt_listType (hasListType m g) g
+  where
+    hasListType :: Map Text ListType -> GroupedText a -> Maybe ListType
+    hasListType m' (GroupedText _ label _ g' _ _ _) =
+        List.foldl' (<>) Nothing
+      $ map (\t -> Map.lookup t m')
+      $ Set.toList
+      $ Set.insert label g'

src/Gargantext/Core/Text/Learn.hs

@@ -22,7 +22,6 @@ module Gargantext.Core.Text.Learn -- (detectLang, detectLangs, stopList)
 import Codec.Serialise
 import qualified Data.List as DL
 
-import Data.Maybe (maybe)
 import Data.Map.Strict (Map, toList)
 import qualified Data.Map.Strict as DM
 

src/Gargantext/Core/Text/List/Learn.hs

@@ -17,21 +17,18 @@ CSV parser for Gargantext corpus files.
 module Gargantext.Core.Text.List.Learn
   where
 
-import Control.Monad.Reader (MonadReader)
--- TODO remvoe this deps
-import Gargantext.API.Admin.Settings
-import Data.Map (Map)
-import Data.Maybe (maybe)
-import Gargantext.Core.Types.Main (ListType(..), listTypeId, fromListTypeId)
-import Gargantext.Prelude
-import Gargantext.Prelude.Utils
-import Gargantext.Core.Text.Metrics.Count (occurrencesWith)
 import qualified Data.IntMap as IntMap
 import qualified Data.List   as List
+import Data.Map (Map)
 import qualified Data.Map    as Map
 import qualified Data.SVM    as SVM
 import qualified Data.Vector as Vec
 
+import Gargantext.Core.Text.Metrics.Count (occurrencesWith)
+import Gargantext.Core.Types.Main (ListType(..), listTypeId, fromListTypeId)
+import Gargantext.Prelude
+import Gargantext.Prelude.Utils
+
 ------------------------------------------------------------------------
 train :: Double -> Double -> SVM.Problem -> IO SVM.Model
 train x y = (SVM.train (SVM.CSvc x) (SVM.RBF y))
@@ -85,19 +82,19 @@ type Tests = Map ListType [Vec.Vector Double]
 type Score = Double
 type Param = Double
 
-grid :: (MonadReader env m, MonadBase IO m, HasSettings env)
+grid :: (MonadBase IO m)
      => Param -> Param -> Train -> [Tests] -> m (Maybe Model)
 grid _ _ _ []  = panic "Gargantext.Core.Text.List.Learn.grid : empty test data"
 grid s e tr te = do
   let
-    grid' :: (MonadReader env m, MonadBase IO m, HasSettings env)
+    grid' :: (MonadBase IO m)
           => Double -> Double
           -> Train
           -> [Tests]
           -> m (Score, Model)
     grid' x y tr' te' = do
       model'' <- liftBase $ trainList x y tr'
-      
+
       let
         model' = ModelSVM model'' (Just x) (Just y)
 
@@ -114,10 +111,10 @@ grid s e tr te = do
                              $ List.concat
                              $ map (\(k,vs) -> zip (repeat k) vs)
                              $ Map.toList t
-        
+
           res' <- liftBase $ predictList m toGuess
           pure $ score'' $ score' $ List.zip res res' 
-      
+
       score <- mapM (getScore model') te'
       pure (mean score, model')
 
@@ -131,6 +128,3 @@ grid s e tr te = do
   --fp <- saveFile (ModelSVM model')
   --save best result
   pure $ snd <$> r
-
-
-

src/Gargantext/Core/Text/Metrics.hs

@@ -18,34 +18,20 @@ module Gargantext.Core.Text.Metrics
 
 --import Data.Array.Accelerate ((:.)(..), Z(..))
 --import Math.KMeans (kmeans, euclidSq, elements)
-
---import GHC.Float (exp)
-import Data.Tuple.Extra (both)
 import Data.Map (Map)
-import Data.List.Extra (sortOn)
-import GHC.Real (round)
 import Gargantext.Prelude
 import Gargantext.Core.Viz.Graph.Distances.Matrice
 import Gargantext.Core.Viz.Graph.Index
 import Gargantext.Core.Statistics (pcaReduceTo, Dimension(..))
 import qualified Data.Array.Accelerate as DAA
 import qualified Data.Array.Accelerate.Interpreter as DAA
-import qualified Data.List as List
 import qualified Data.Map  as Map
 
 import qualified Data.Vector.Storable as Vec
 
-type GraphListSize = Int
+type MapListSize = Int
 type InclusionSize = Int
 
-{-
-toScored' :: Ord t => [Map t (Vec.Vector Double)] -> [Scored t] 
-toScored' = map2scored
-         . (pcaReduceTo (Dimension 2))
-         . (Map.filter (\v -> Vec.length v > 1))
-         . (Map.unionsWith (<>))
--}
-
 scored :: Ord t => Map (t,t) Int -> [Scored t]
 scored = map2scored . (pcaReduceTo (Dimension 2)) . scored2map
   where
@@ -58,14 +44,15 @@ scored = map2scored . (pcaReduceTo (Dimension 2)) . scored2map
 -- TODO change type with (x,y)
 data Scored ts = Scored
   { _scored_terms  :: !ts
-  , _scored_incExc :: !InclusionExclusion
-  , _scored_speGen :: !SpecificityGenericity
+  , _scored_genInc :: !GenericityInclusion
+  , _scored_speExc :: !SpecificityExclusion
   } deriving (Show)
 
+
 localMetrics' :: Ord t => Map (t,t) Int -> Map t (Vec.Vector Double)
 localMetrics' m = Map.fromList $ zipWith (\(_,t) (inc,spe) -> (t, Vec.fromList [inc,spe]))
-                                       (Map.toList fi)
-                                       scores
+                                         (Map.toList fi)
+                                          scores
   where
     (ti, fi) = createIndices m
     (is, ss) = incExcSpeGen $ cooc2mat ti m
@@ -73,12 +60,11 @@ localMetrics' m = Map.fromList $ zipWith (\(_,t) (inc,spe) -> (t, Vec.fromList [
              $ DAA.run
              $ DAA.zip (DAA.use is) (DAA.use ss)
 
-
--- TODO Code to be remove below
+-- TODO Code to be removed below
 -- TODO in the textflow we end up needing these indices , it might be
 -- better to compute them earlier and pass them around.
 scored' :: Ord t => Map (t,t) Int -> [Scored t]
-scored' m = zipWith (\(_,t) (inc,spe) -> Scored t (inc) (spe)) (Map.toList fi) scores
+scored' m = zipWith (\(_,t) (inc,spe) -> Scored t inc spe) (Map.toList fi) scores
   where
     (ti, fi) = createIndices m
     (is, ss) = incExcSpeGen $ cooc2mat ti m
@@ -87,39 +73,28 @@ scored' m = zipWith (\(_,t) (inc,spe) -> Scored t (inc) (spe)) (Map.toList fi) s
              $ DAA.zip (DAA.use is) (DAA.use ss)
 
 
-takeScored :: Ord t => GraphListSize -> InclusionSize -> Map (t,t) Int -> ([t],[t])
-takeScored listSize incSize = both (map _scored_terms)
-                            . linearTakes listSize incSize _scored_speGen
-                                                           _scored_incExc
-                            . scored
-
-
--- | Filter Scored data
--- >>> linearTakes 2 3 fst snd $ Prelude.zip ([1..10] :: [Int]) (reverse $ [1..10] :: [Int])
--- [(3,8),(6,5)]
-linearTakes :: (Ord b1, Ord b2)
-            => GraphListSize -> InclusionSize
-            -> (a -> b2) -> (a -> b1) -> [a] -> ([a],[a])
-linearTakes mls incSize speGen incExc = (List.splitAt mls)
-                      . List.concat
-                      . map (take $ round
-                                  $ (fromIntegral mls     :: Double)
-                                  / (fromIntegral incSize :: Double)
-                             )
-                      . map (sortOn speGen)
-                      . splitEvery incSize
-                      . take 5000
-                      . takePercent (0.70)
-                      . sortOn incExc
-
-takePercent :: Double -> [a] -> [a]
-takePercent l xs = List.take l' xs
+normalizeGlobal :: [Scored a] -> [Scored a]
+normalizeGlobal ss = map (\(Scored t s1 s2)
+                     -> Scored t ((s1 - s1min) / s1max)
+                                 ((s2 - s2min) / s2max)) ss
   where
-    l' = round $ l * (fromIntegral $ List.length xs)
+    ss1 = map _scored_genInc ss
+    ss2 = map _scored_speExc ss
+
+    s1min = minimum ss1
+    s1max = maximum ss1
+
+    s2min = minimum ss2
+    s2max = maximum ss2
 
-splitTake :: (Int, a -> Bool) -> (Int, a -> Bool) -> [a] -> ([a], [a])
-splitTake (a, af) (b, bf) xs = (mpa <> mpb, ca <> cb)
+
+
+normalizeLocal :: Scored a -> Scored a
+normalizeLocal (Scored t s1 s2) = Scored t (log' 5 s1) (log' 2 s2)
   where
-    (mpa, ca) = List.splitAt a $ List.filter af xs
-    (mpb, cb) = List.splitAt b $ List.filter bf xs
+    log' n' x = 1 + (if x <= 0 then 0 else log $ (10^(n'::Int)) * x)
+
+
+
+