Merge branch 'dev' into dev-phylo

bin/gargantext-import/Main.hs

@@ -14,18 +14,21 @@ Import a corpus binary.
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE Strict            #-}
 
 module Main where
 
+import Control.Exception (finally)
 import Servant (ServantErr)
 import Gargantext.Prelude
-import Gargantext.Database.Flow (flowCorpus)
+import Gargantext.Database.Flow (FlowCmdM, flowCorpus)
 import Gargantext.Text.Parsers (FileFormat(CsvHalFormat))
-import Gargantext.Database.Utils (Cmd, connectGargandb, runCmdDevWith)
-import Gargantext.Database.Types.Node (NodeId)
+import Gargantext.Database.Utils (Cmd, )
+import Gargantext.Database.Types.Node (CorpusId)
 --import Gargantext.Database.Schema.User (insertUsers, gargantuaUser, simpleUser)
 import Gargantext.API.Node () -- instances
+import Gargantext.API.Settings (newDevEnvWith, runCmdDev, DevEnv)
 import System.Environment (getArgs)
 
 main :: IO ()
@@ -34,11 +37,16 @@ main = do
 
   {-let createUsers :: Cmd ServantErr Int64
       createUsers = insertUsers [gargantuaUser,simpleUser]
-  _ <- runCmdDevWith iniPath createUsers
   -}
-  let cmd :: Cmd ServantErr NodeId
-      cmd = flowCorpus CsvHalFormat corpusPath (cs name)
-  r <- runCmdDevWith iniPath cmd
+
+  let cmdCorpus :: forall m. FlowCmdM DevEnv ServantErr m => m CorpusId
+      cmdCorpus = flowCorpus CsvHalFormat corpusPath (cs name)
+
+     -- cmd = {-createUsers >>-} cmdCorpus
+
+  env <- newDevEnvWith iniPath
+  -- Better if we keep only one call to runCmdDev.
+  _ <- runCmdDev env cmdCorpus
   pure ()
 
 

bin/gargantext-server/Main.hs

@@ -44,40 +44,37 @@ instance ParseField  Mode
 instance ParseFields Mode
 
 
-data MyOptions w = MyOptions { run  :: w ::: Mode        <?> "Possible modes: Dev | Mock | Prod"
-                             , port :: w ::: Maybe Int   <?> "By default: 8008"
-                             , ini  :: w ::: Maybe Text  <?> "Ini-file path of gargantext.ini"
-                             }
-          deriving (Generic)
+data MyOptions w =
+  MyOptions { run  :: w ::: Mode
+                        <?> "Possible modes: Dev | Mock | Prod"
+            , port :: w ::: Maybe Int
+                        <?> "By default: 8008"
+            , ini  :: w ::: Maybe Text
+                        <?> "Ini-file path of gargantext.ini"
+            }
+   deriving (Generic)
 
 instance ParseRecord (MyOptions Wrapped)
 deriving instance Show (MyOptions Unwrapped)
 
 
-
 main :: IO ()
-main = do 
-    MyOptions myMode myPort myIniFile  <- unwrapRecord
-            "Gargantext: collaborative platform for text-mining"
-
-    let myPort' = case myPort of
-            Just p  -> p
-            Nothing -> 8008
-
-    let start = case myMode of
-            --Nothing   -> startGargantext myPort' (unpack myIniFile')
-            Prod -> startGargantext myPort' (unpack myIniFile')
-                    where
-                        myIniFile' = case myIniFile of
-                                       Nothing -> panic "For Prod mode, you need to fill a gargantext.ini file"
-                                       Just i  -> i
-            Mock -> startGargantextMock myPort'
-            _  -> startGargantextMock myPort'
-
-    putStrLn $ "Starting Gargantext with mode: " <> show myMode
-    start
-
--- main' :: IO ()
---main' = putStrLn $ show $ M.conditional $ M.myMat 10
-
+main = do
+  MyOptions myMode myPort myIniFile  <- unwrapRecord
+          "Gargantext server"
+
+  let myPort' = case myPort of
+        Just p  -> p
+        Nothing -> 8008
+
+  let start = case myMode of
+        Prod -> startGargantext myPort' (unpack myIniFile')
+            where
+              myIniFile' = case myIniFile of
+                  Nothing -> panic "[ERROR] gargantext.ini needed"
+                  Just i  -> i
+        _ -> startGargantextMock myPort'
+
+  putStrLn $ "Starting with " <> show myMode <> " mode."
+  start
 

package.yaml

@@ -28,6 +28,7 @@ library:
   - Gargantext.API.Auth
   - Gargantext.API.Count
   - Gargantext.API.FrontEnd
+  - Gargantext.API.Ngrams
   - Gargantext.API.Node
   - Gargantext.API.Orchestrator
   - Gargantext.API.Search
@@ -50,6 +51,7 @@ library:
   - Gargantext.Text.Examples
   - Gargantext.Text.List.CSV
   - Gargantext.Text.Metrics
+  - Gargantext.Text.Metrics.TFICF
   - Gargantext.Text.Metrics.CharByChar
   - Gargantext.Text.Metrics.Count
   - Gargantext.Text.Parsers
@@ -109,6 +111,7 @@ library:
   - ini
   - insert-ordered-containers
   - jose-jwt
+  - json-state
     #  - kmeans-vector
   - KMP
   - lens
@@ -159,11 +162,13 @@ library:
   - text-metrics
   - time
   - time-locale-compat
+  - time-units
   - timezone-series
   - transformers
   - transformers-base
   - unordered-containers
   - uuid
+  - validity
   - vector
   - wai
   - wai-cors

src/Gargantext/API.hs

@@ -44,6 +44,7 @@ import           GHC.Generics (D1, Meta (..), Rep)
 import           GHC.TypeLits (AppendSymbol, Symbol)
 
 import           Control.Lens
+import           Control.Exception (finally)
 import           Control.Monad.IO.Class (liftIO)
 import           Control.Monad.Reader (runReaderT)
 import           Data.Aeson.Encode.Pretty (encodePretty)
@@ -72,6 +73,7 @@ import Gargantext.Prelude
 import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
 
 import Gargantext.API.Auth (AuthRequest, AuthResponse, auth)
+import Gargantext.API.Ngrams (HasRepoVar(..), HasRepoSaver(..), saveRepo)
 import Gargantext.API.Node ( GargServer
                            , Roots    , roots
                            , NodeAPI  , nodeAPI
@@ -83,6 +85,7 @@ import Gargantext.API.Node ( GargServer
                            , HyperdataAnnuaire
                            )
 --import Gargantext.Database.Node.Contact (HyperdataContact)
+import Gargantext.Database.Utils (HasConnection)
 import Gargantext.Database.Types.Node (NodeId, CorpusId, AnnuaireId)
 import Gargantext.API.Count  ( CountAPI, count, Query)
 import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
@@ -163,9 +166,8 @@ makeMockApp env = do
 
 
 
-makeDevApp :: Env -> IO Application
-makeDevApp env = do
-    serverApp <- makeApp env
+makeDevMiddleware :: IO Middleware
+makeDevMiddleware = do
 
     -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
     --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
@@ -192,8 +194,8 @@ makeDevApp env = do
     --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
     --          $ Warp.defaultSettings
     
-    --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
-    pure $ logStdoutDev $ corsMiddleware $ serverApp
+    --pure (warpS, logWare . checkOriginAndHost . corsMiddleware)
+    pure $ logStdoutDev . corsMiddleware
 
 ---------------------------------------------------------------------
 -- | API Global
@@ -276,12 +278,13 @@ type API = SwaggerFrontAPI :<|> GargAPI :<|> Get '[HTML] Html
 ---------------------------------------------------------------------
 -- | Server declarations
 
-server :: Env -> IO (Server API)
+server :: (HasConnection env, HasRepoVar env, HasRepoSaver env)
+       => env -> IO (Server API)
 server env = do
   -- orchestrator <- scrapyOrchestrator env
   pure $  swaggerFront
      :<|> hoistServer (Proxy :: Proxy GargAPI) (`runReaderT` env) serverGargAPI
-     :<|> serverIndex
+     :<|> serverStatic
 
 serverGargAPI :: GargServer GargAPI
 serverGargAPI -- orchestrator
@@ -299,9 +302,12 @@ serverGargAPI -- orchestrator
   where
     fakeUserId = 1 -- TODO
 
-serverIndex :: Server (Get '[HTML] Html)
-serverIndex = $(do (Just s) <- liftIO (fileTypeToFileTree (FileTypeFile "purescript-gargantext/dist/index.html"))
-                   fileTreeToServer s)
+serverStatic :: Server (Get '[HTML] Html)
+serverStatic = $(do
+                let path = "purescript-gargantext/dist/index.html"
+                Just s <- liftIO (fileTypeToFileTree (FileTypeFile path))
+                fileTreeToServer s
+                )
 
 ---------------------------------------------------------------------
 swaggerFront :: Server SwaggerFrontAPI
@@ -312,11 +318,12 @@ gargMock :: Server GargAPI
 gargMock = mock apiGarg Proxy
 
 ---------------------------------------------------------------------
-makeApp :: Env -> IO Application
+makeApp :: (HasConnection env, HasRepoVar env, HasRepoSaver env) 
+        => env -> IO Application
 makeApp = fmap (serve api) . server
 
 appMock :: Application
-appMock = serve api (swaggerFront :<|> gargMock :<|> serverIndex)
+appMock = serve api (swaggerFront :<|> gargMock :<|> serverStatic)
 
 ---------------------------------------------------------------------
 api :: Proxy API
@@ -367,13 +374,19 @@ portRouteInfo port = do
   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
 
+stopGargantext :: HasRepoSaver env => env -> IO ()
+stopGargantext env = do
+  T.putStrLn "----- Stopping gargantext -----"
+  runReaderT saveRepo env
+
 -- | startGargantext takes as parameters port number and Ini file.
 startGargantext :: PortNumber -> FilePath -> IO ()
 startGargantext port file = do
   env <- newEnv port file
   portRouteInfo port
-  app <- makeDevApp env
-  run port app
+  app <- makeApp env
+  mid <- makeDevMiddleware
+  run port (mid app) `finally` stopGargantext env
 
 startGargantextMock :: PortNumber -> IO ()
 startGargantextMock port = do

src/Gargantext/API/Node.hs

@@ -46,7 +46,7 @@ import Data.Time (UTCTime)
 import GHC.Generics (Generic)
 import Servant
 
-import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, TableNgramsApiGet, tableNgramsPatch, getTableNgrams)
+import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, TableNgramsApiGet, tableNgramsPatch, getTableNgrams, HasRepoVar, HasRepoSaver)
 import Gargantext.Prelude
 import Gargantext.Database.Types.Node
 import Gargantext.Database.Utils -- (Cmd, CmdM)
@@ -72,7 +72,10 @@ import Gargantext.Database.Types.Node (CorpusId, ContactId)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
-type GargServer api = forall env m. CmdM env ServantErr m => ServerT api m
+type GargServer api =
+  forall env m.
+    (CmdM env ServantErr m, HasRepoVar env, HasRepoSaver env)
+    => ServerT api m
 
 -------------------------------------------------------------------
 -- TODO-ACCESS: access by admin only.
@@ -279,7 +282,7 @@ graphAPI nId = do
 
   nodeGraph <- getNode nId HyperdataGraph
 
-  let title = "Graph Title"
+  let title = "Title"
   let metadata = GraphMetadata title [maybe 0 identity $ _node_parentId nodeGraph]
                                      [ LegendField 1 "#FFF" "Cluster"
                                      , LegendField 2 "#FFF" "Cluster"

src/Gargantext/API/Settings.hs

@@ -17,25 +17,31 @@ Portability : POSIX
 {-# LANGUAGE ScopedTypeVariables         #-}
 {-# LANGUAGE TemplateHaskell             #-}
 {-# LANGUAGE OverloadedStrings           #-}
+{-# LANGUAGE FlexibleContexts            #-}
 {-# LANGUAGE FlexibleInstances           #-}
+{-# LANGUAGE RankNTypes                  #-}
 
 module Gargantext.API.Settings
     where
 
+import System.Directory
 import System.Log.FastLogger
 import GHC.Enum
 import GHC.Generics (Generic)
-import Prelude (Bounded())
+import Prelude (Bounded(), fail)
 import System.Environment (lookupEnv)
 import System.IO (FilePath)
 import Database.PostgreSQL.Simple (Connection, connect)
 import Network.HTTP.Client (Manager)
 import Network.HTTP.Client.TLS (newTlsManager)
 
+import Data.Aeson
 import Data.Maybe (fromMaybe)
 import Data.Either (either)
+import Data.JsonState (mkSaveState)
 import Data.Text
 import Data.Text.Encoding (encodeUtf8)
+import Data.Time.Units
 import Data.ByteString.Lazy.Internal
 
 import Servant
@@ -45,10 +51,14 @@ import Web.HttpApiData (parseUrlPiece)
 import qualified Jose.Jwk as Jose
 import qualified Jose.Jwa as Jose
 
+import Control.Concurrent
+import Control.Exception (finally)
 import Control.Monad.Logger
+import Control.Monad.Reader
 import Control.Lens
 import Gargantext.Prelude
-import Gargantext.Database.Utils (databaseParameters, HasConnection(..))
+import Gargantext.Database.Utils (databaseParameters, HasConnection(..), Cmd', runCmd)
+import Gargantext.API.Ngrams (NgramsRepo, HasRepoVar(..), HasRepoSaver(..), initMockRepo, r_version, saveRepo)
 import Gargantext.API.Orchestrator.Types
 
 type PortNumber = Int
@@ -125,12 +135,14 @@ optSetting name d = do
 data FireWall = FireWall { unFireWall :: Bool }
 
 data Env = Env
-  { _env_settings :: !Settings
-  , _env_logger   :: !LoggerSet
-  , _env_conn     :: !Connection
-  , _env_manager  :: !Manager
-  , _env_self_url :: !BaseUrl
-  , _env_scrapers :: !ScrapersEnv
+  { _env_settings   :: !Settings
+  , _env_logger     :: !LoggerSet
+  , _env_conn       :: !Connection
+  , _env_repo_var   :: !(MVar NgramsRepo)
+  , _env_repo_saver :: !(IO ())
+  , _env_manager    :: !Manager
+  , _env_self_url   :: !BaseUrl
+  , _env_scrapers   :: !ScrapersEnv
   }
   deriving (Generic)
 
@@ -139,6 +151,12 @@ makeLenses ''Env
 instance HasConnection Env where
   connection = env_conn
 
+instance HasRepoVar Env where
+  repoVar = env_repo_var
+
+instance HasRepoSaver Env where
+  repoSaver = env_repo_saver
+
 data MockEnv = MockEnv
   { _menv_firewall :: !FireWall
   }
@@ -146,22 +164,109 @@ data MockEnv = MockEnv
 
 makeLenses ''MockEnv
 
+repoSnapshot :: FilePath
+repoSnapshot = "repo.json"
+
+readRepo :: IO (MVar NgramsRepo)
+readRepo = do
+  -- | Does file exist ? :: Bool
+  repoFile <- doesFileExist repoSnapshot
+  
+  -- | Is file not empty ? :: Bool
+  repoExists <- if repoFile
+             then (>0) <$> getFileSize repoSnapshot
+             else pure repoFile
+  
+  newMVar =<<
+    if repoExists
+      then do
+        e_repo <- eitherDecodeFileStrict repoSnapshot
+        repo   <- either fail pure e_repo
+        let archive = repoSnapshot <> ".v" <> show (repo ^. r_version)
+        copyFile repoSnapshot archive
+        pure repo
+      else
+        pure initMockRepo
+
+mkRepoSaver :: MVar NgramsRepo -> IO (IO ())
+mkRepoSaver repo_var = do
+  saveAction <- mkSaveState (10 :: Second) repoSnapshot
+  pure $ readMVar repo_var >>= saveAction
+
 newEnv :: PortNumber -> FilePath -> IO Env
 newEnv port file = do
   manager <- newTlsManager
   settings <- pure (devSettings & appPort .~ port) -- TODO read from 'file'
   when (port /= settings ^. appPort) $
     panic "TODO: conflicting settings of port"
+  
   self_url <- parseBaseUrl $ "http://0.0.0.0:" <> show port
-  param <- databaseParameters file
-  conn <- connect param
+  param    <- databaseParameters file
+  conn     <- connect param
+  
+  repo_var     <- readRepo
+  repo_saver   <- mkRepoSaver repo_var
   scrapers_env <- newJobEnv defaultSettings manager
   logger <- newStderrLoggerSet defaultBufSize
+  
   pure $ Env
-    { _env_settings = settings
-    , _env_logger   = logger
-    , _env_conn     = conn
-    , _env_manager  = manager
-    , _env_scrapers = scrapers_env
-    , _env_self_url = self_url
+    { _env_settings   = settings
+    , _env_logger     = logger
+    , _env_conn       = conn
+    , _env_repo_var   = repo_var
+    , _env_repo_saver = repo_saver
+    , _env_manager    = manager
+    , _env_scrapers   = scrapers_env
+    , _env_self_url   = self_url
     }
+
+data DevEnv = DevEnv
+  { _dev_env_conn       :: !Connection
+  , _dev_env_repo_var   :: !(MVar NgramsRepo)
+  , _dev_env_repo_saver :: !(IO ())
+  }
+
+makeLenses ''DevEnv
+
+instance HasConnection DevEnv where
+  connection = dev_env_conn
+
+instance HasRepoVar DevEnv where
+  repoVar = dev_env_repo_var
+
+instance HasRepoSaver DevEnv where
+  repoSaver = dev_env_repo_saver
+
+newDevEnvWith :: FilePath -> IO DevEnv
+newDevEnvWith file = do
+  param      <- databaseParameters file
+  conn       <- connect param
+  repo_var   <- newMVar initMockRepo
+  repo_saver <- mkRepoSaver repo_var
+  pure $ DevEnv
+    { _dev_env_conn       = conn
+    , _dev_env_repo_var   = repo_var
+    , _dev_env_repo_saver = repo_saver
+    }
+
+newDevEnv :: IO DevEnv
+newDevEnv = newDevEnvWith "gargantext.ini"
+
+-- Use only for dev
+-- In particular this writes the repo file after running
+-- the command.
+-- This function is constrained to the DevEnv rather than
+-- using HasConnection 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
+
+-- Use only for dev
+runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a
+runCmdDevNoErr = runCmdDev
+
+-- Use only for dev
+runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServantErr a -> IO a
+runCmdDevServantErr = runCmdDev

src/Gargantext/Database/Cooc.hs

@@ -20,14 +20,15 @@ module Gargantext.Database.Cooc where
 import Database.PostgreSQL.Simple.SqlQQ
 
 import Gargantext.Prelude
-import Gargantext.Database.Utils (Cmd, runCmdDevNoErr, runPGSQuery)
+import Gargantext.Database.Utils (Cmd, runPGSQuery)
+import Gargantext.API.Settings (runCmdDevNoErr, DevEnv)
 
 type CorpusId    = Int
 type MainListId  = Int
 type GroupListId = Int
 
-coocTest :: IO [(Int, Int, Int)]
-coocTest = runCmdDevNoErr $ dBcooc 421968 446602 446599
+coocTest :: DevEnv -> IO [(Int, Int, Int)]
+coocTest env = runCmdDevNoErr env $ dBcooc 421968 446602 446599
 
 dBcooc :: CorpusId -> MainListId -> GroupListId -> Cmd err [(Int, Int, Int)]
 dBcooc corpus mainList groupList = runPGSQuery [sql|

src/Gargantext/Database/Lists.hs

+{-|
+Module      : Gargantext.Database.Lists
+Description : Main requests of Node to the database
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+{-# OPTIONS_GHC -fno-warn-orphans        #-}
+
+{-# LANGUAGE Arrows                 #-}
+{-# LANGUAGE DeriveGeneric          #-}
+{-# LANGUAGE ConstraintKinds        #-}
+{-# LANGUAGE FlexibleContexts       #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE OverloadedStrings      #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE NoImplicitPrelude      #-}
+{-# LANGUAGE RankNTypes             #-}
+{-# LANGUAGE TemplateHaskell        #-}
+
+module Gargantext.Database.Lists where
+
+import Control.Arrow (returnA)
+import Gargantext.Core.Types -- (NodePoly(..), NodeCorpus, ListId)
+import Gargantext.Core.Types.Individu (Username)
+import Gargantext.Database.Config (nodeTypeId)
+import Gargantext.Database.Schema.Node -- (HasNodeError, queryNodeTable)
+import Gargantext.Database.Schema.User -- (queryUserTable)
+import Gargantext.Database.Utils
+import Gargantext.Prelude hiding (sum, head)
+import Opaleye hiding (FromField)
+import Opaleye.Internal.QueryArr (Query)
+import Prelude hiding (null, id, map, sum)
+
+-- | To get all lists of a user
+-- /!\ lists of different types of corpora (Annuaire or Documents)
+listsWith :: HasNodeError err => Username -> Cmd err [Maybe ListId]
+listsWith u = runOpaQuery (selectLists u)
+  where
+    selectLists u = proc () -> do
+      (auth_user,nodes) <- listsWithJoin2 -< ()
+      restrict -< user_username auth_user .== (pgStrictText u)
+      restrict -< _node_typename nodes .== (toNullable $ pgInt4 $ nodeTypeId NodeList)
+      returnA  -< _node_id nodes
+
+listsWithJoin2 :: Query (UserRead, NodeReadNull)
+listsWithJoin2 = leftJoin queryUserTable queryNodeTable cond12
+  where
+    cond12 (u,n)       = user_id u   .== _node_userId n
+
+{-
+listsWithJoin3 :: Query (NodeRead, (UserRead, NodeReadNull))
+listsWithJoin3 = leftJoin3 queryUserTable queryNodeTable queryNodeTable cond12 cond23
+  where
+    cond12 :: (NodeRead
+    cond12 (u,n)       = user_id u   .== _node_userId n
+    cond23 :: (NodeRead, (UserRead, NodeReadNull)) -> Column PGBool
+    cond23 (n1,(u,n2)) = (toNullable $ _node_id n1) .== _node_parentId n2
+--}
+

src/Gargantext/Database/Metrics/TFICF.hs

@@ -143,4 +143,3 @@ GROUP BY nu.id,nu.terms
   |]
 
 
-

src/Gargantext/Database/Schema/Ngrams.hs

@@ -25,8 +25,10 @@ Ngrams connection to the Database.
 
 module Gargantext.Database.Schema.Ngrams where
 
+import Data.Aeson (FromJSON, FromJSONKey)
 import Control.Lens (makeLenses, view, over)
 import Control.Monad (mzero)
+import Data.Aeson
 import Data.ByteString.Internal (ByteString)
 import Data.Map (Map, fromList, lookup, fromListWith)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
@@ -58,13 +60,11 @@ type NgramsTerms = Text
 type NgramsId    = Int
 type Size        = Int
 
---{-
 data NgramsPoly id terms n = NgramsDb { ngrams_id    :: id
-                                    , ngrams_terms :: terms
-                                    , ngrams_n     :: n
-                                    } deriving (Show)
+                                      , ngrams_terms :: terms
+                                      , ngrams_n     :: n
+                                      } deriving (Show)
 
---}
 type NgramsWrite = NgramsPoly (Maybe (Column PGInt4))
                                    (Column PGText)
                                    (Column PGInt4)
@@ -77,7 +77,6 @@ type NgramsReadNull = NgramsPoly (Column (Nullable PGInt4))
                                  (Column (Nullable PGText))
                                  (Column (Nullable PGInt4))
 
---{-
 type NgramsDb = NgramsPoly Int Text Int
 
 $(makeAdaptorAndInstance "pNgramsDb"    ''NgramsPoly)
@@ -85,17 +84,16 @@ $(makeAdaptorAndInstance "pNgramsDb"    ''NgramsPoly)
 
 ngramsTable :: Table NgramsWrite NgramsRead
 ngramsTable = Table "ngrams" (pNgramsDb NgramsDb { ngrams_id    = optional "id"
-                                            , ngrams_terms = required "terms"
-                                            , ngrams_n     = required "n"
-                                            }
-                                )
---{-
+                                                 , ngrams_terms = required "terms"
+                                                 , ngrams_n     = required "n"
+                                                 }
+                              )
+
 queryNgramsTable :: Query NgramsRead
 queryNgramsTable = queryTable ngramsTable
 
 dbGetNgramsDb :: Cmd err [NgramsDb]
 dbGetNgramsDb = runOpaQuery queryNgramsTable
---}
 
 -- | Main Ngrams Types
 -- | Typed Ngrams
@@ -104,7 +102,12 @@ dbGetNgramsDb = runOpaQuery queryNgramsTable
 -- ngrams in authors field of document has Authors Type
 -- ngrams in text (title or abstract) of documents has Terms Type
 data NgramsType = Authors | Institutes | Sources | NgramsTerms
-  deriving (Eq, Show, Ord, Enum, Bounded)
+  deriving (Eq, Show, Ord, Enum, Bounded, Generic)
+
+instance FromJSON NgramsType
+instance FromJSONKey NgramsType
+instance ToJSON NgramsType
+instance ToJSONKey NgramsType
 
 newtype NgramsTypeId = NgramsTypeId Int
   deriving (Eq, Show, Ord, Num)

src/Gargantext/Database/Schema/Node.hs

@@ -155,32 +155,33 @@ instance QueryRunnerColumnDefault PGInt4 NodeId
 ------------------------------------------------------------------------
 $(makeAdaptorAndInstance "pNode" ''NodePoly)
 $(makeLensesWith abbreviatedFields ''NodePoly)
+
 $(makeAdaptorAndInstance "pNodeSearch" ''NodePolySearch)
 $(makeLensesWith abbreviatedFields ''NodePolySearch)
 
-type NodeWrite = NodePoly  (Maybe (Column  PGInt4       ))
-                                  (Column  PGInt4       )
-                                  (Column  PGInt4       )
-                           (Maybe (Column  PGInt4       ))
-                                  (Column PGText        )
-                           (Maybe (Column  PGTimestamptz))
-                                  (Column  PGJsonb      )
-
-type NodeRead = NodePoly  (Column PGInt4        )
-                          (Column PGInt4        )
-                          (Column PGInt4        )
-                          (Column PGInt4        )
-                          (Column PGText        )
-                          (Column PGTimestamptz )
-                          (Column PGJsonb       )
-
-type NodeReadNull = NodePoly  (Column (Nullable PGInt4 ))
-                              (Column (Nullable PGInt4 ))
-                              (Column (Nullable PGInt4 ))
-                              (Column (Nullable PGInt4 ))
-                              (Column (Nullable PGText ))
-                              (Column (Nullable PGTimestamptz ))
-                              (Column (Nullable PGJsonb))
+type NodeWrite = NodePoly (Maybe (Column PGInt4)      )
+                                 (Column PGInt4)
+                                 (Column PGInt4)
+                          (Maybe (Column PGInt4)      )
+                                 (Column PGText)
+                          (Maybe (Column PGTimestamptz))
+                                 (Column PGJsonb)
+
+type NodeRead = NodePoly (Column PGInt4        )
+                         (Column PGInt4        )
+                         (Column PGInt4        )
+                         (Column PGInt4        )
+                         (Column PGText        )
+                         (Column PGTimestamptz )
+                         (Column PGJsonb       )
+
+type NodeReadNull = NodePoly (Column (Nullable PGInt4))
+                             (Column (Nullable PGInt4))
+                             (Column (Nullable PGInt4))
+                             (Column (Nullable PGInt4))
+                             (Column (Nullable PGText))
+                             (Column (Nullable PGTimestamptz))
+                             (Column (Nullable PGJsonb))
 
 nodeTable :: Table NodeWrite NodeRead
 nodeTable = Table "nodes" (pNode Node { _node_id         = optional "id"
@@ -201,32 +202,38 @@ queryNodeTable = queryTable nodeTable
 ------------------------------------------------------------------------
 -- | Node(Read|Write)Search is slower than Node(Write|Read) use it
 -- for full text search only
-type NodeSearchWrite = NodePolySearch  (Maybe (Column  PGInt4              ))
-                                  (Column  PGInt4               )
-                                  (Column  PGInt4               )
-                                  (Column (Nullable PGInt4     ))
-                                  (Column (PGText              ))
-                                  (Maybe  (Column PGTimestamptz))
-                                  (Column  PGJsonb              )
-                                  (Maybe (Column PGTSVector))
-
-type NodeSearchRead = NodePolySearch  (Column  PGInt4           )
-                          (Column  PGInt4           )
-                          (Column  PGInt4           )
-                          (Column (Nullable PGInt4 ))
-                          (Column (PGText          ))
-                          (Column PGTimestamptz     )
-                          (Column PGJsonb) 
-                          (Column PGTSVector)
-
-type NodeSearchReadNull = NodePolySearch  (Column  (Nullable PGInt4           ))
-                              (Column  (Nullable PGInt4           ))
-                              (Column  (Nullable PGInt4           ))
-                              (Column (Nullable PGInt4 ))
-                              (Column (Nullable PGText          ))
-                              (Column (Nullable PGTimestamptz     ))
-                              (Column (Nullable PGJsonb))
-                              (Column (Nullable PGTSVector))
+type NodeSearchWrite =
+  NodePolySearch
+    (Maybe  (Column  PGInt4)      )
+    (Column  PGInt4               )
+    (Column  PGInt4               )
+    (Column (Nullable PGInt4)     )
+    (Column PGText                )
+    (Maybe  (Column PGTimestamptz))
+    (Column  PGJsonb              )
+    (Maybe  (Column PGTSVector)   )
+
+type NodeSearchRead =
+  NodePolySearch
+    (Column  PGInt4           )
+    (Column  PGInt4           )
+    (Column  PGInt4           )
+    (Column (Nullable PGInt4 ))
+    (Column  PGText           )
+    (Column  PGTimestamptz    )
+    (Column  PGJsonb          )
+    (Column  PGTSVector       )
+
+type NodeSearchReadNull =
+  NodePolySearch
+    (Column (Nullable PGInt4)       )
+    (Column (Nullable PGInt4)       )
+    (Column (Nullable PGInt4)       )
+    (Column (Nullable PGInt4)       )
+    (Column (Nullable PGText)       )
+    (Column (Nullable PGTimestamptz))
+    (Column (Nullable PGJsonb)      )
+    (Column (Nullable PGTSVector)   )
 
 --{-
 nodeTableSearch :: Table NodeSearchWrite NodeSearchRead
@@ -336,7 +343,8 @@ type JSONB = QueryRunnerColumnDefault PGJsonb
 
 getNode :: JSONB a => NodeId -> proxy a -> Cmd err (Node a)
 getNode nId _ = do
-    fromMaybe (error $ "Node does node exist: " <> show nId) . headMay <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
+    fromMaybe (error $ "Node does node exist: " <> show nId) . headMay
+             <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
 
 getNodesWithType :: Column PGInt4 -> Cmd err [Node HyperdataDocument]
 getNodesWithType = runOpaQuery . selectNodesWithType
@@ -502,13 +510,16 @@ childWith _   _   (Node' _        _   _ _) = panic "This NodeType can not be a c
 
 type Name = Text
 
+-- | TODO mk all others nodes
 mkNodeWithParent :: HasNodeError err => NodeType -> Maybe ParentId -> UserId -> Name -> Cmd err [NodeId]
-mkNodeWithParent NodeUser (Just _) _   _     = nodeError UserNoParent
-mkNodeWithParent _        Nothing  _   _     = nodeError HasParent
-mkNodeWithParent nt       pId     uId name   =
-    insertNodesWithParentR pId [node nt name hd pId uId]
-  where
-    hd = HyperdataUser . Just . pack $ show EN
+mkNodeWithParent NodeUser (Just _) _   _    = nodeError UserNoParent
+mkNodeWithParent NodeUser Nothing  uId name =
+  insertNodesWithParentR Nothing [node NodeUser name hd Nothing uId]
+    where
+      hd = HyperdataUser . Just . pack $ show EN
+mkNodeWithParent _ Nothing _ _ = nodeError HasParent
+mkNodeWithParent _ _ _ _ = nodeError NotImplYet
+
 
 mkRoot :: HasNodeError err => Username -> UserId -> Cmd err [RootId]
 mkRoot uname uId = case uId > 0 of

src/Gargantext/Database/Schema/schema.sql

 CREATE EXTENSION IF NOT EXISTS plpgsql WITH SCHEMA pg_catalog;
 COMMENT ON EXTENSION plpgsql IS 'PL/pgSQL procedural language';
--- needed for rights management
--- CREATE EXTENSION IF NOT EXISTS acl WITH SCHEMA public;
 
 -- CREATE USER WITH ...
 -- createdb "gargandb"
@@ -23,6 +21,7 @@ CREATE TABLE public.auth_user (
 
 ALTER TABLE public.auth_user OWNER TO gargantua;
 
+
 -- TODO add publication_date
 -- TODO typename -> type_id
 CREATE TABLE public.nodes (
@@ -40,7 +39,6 @@ CREATE TABLE public.nodes (
 ALTER TABLE public.nodes OWNER TO gargantua;
 
 
-
 CREATE TABLE public.ngrams (
     id SERIAL,
     terms character varying(255),
@@ -49,7 +47,9 @@ CREATE TABLE public.ngrams (
 );
 ALTER TABLE public.ngrams OWNER TO gargantua;
 
--- TODO: delete ID
+--------------------------------------------------------------
+--------------------------------------------------------------
+-- TODO: delete delete this table
 CREATE TABLE public.nodes_ngrams (
     id SERIAL,
     node_id integer NOT NULL,
@@ -64,13 +64,21 @@ CREATE TABLE public.nodes_ngrams (
     -- PRIMARY KEY (node_id,ngrams_id)
 );
 ALTER TABLE public.nodes_ngrams OWNER TO gargantua;
+--------------------------------------------------------------
 
+CREATE TABLE public.nodes_ngrams_repo (
+    version integer NOT NULL,
+    patches jsonb DEFAULT '{}'::jsonb NOT NULL,
+    PRIMARY KEY (version)
+);
+ALTER TABLE public.nodes_ngrams_repo OWNER TO gargantua;
+
+--------------------------------------------------------------
 --
--- Name: nodes_ngrams_ngrams; Type: TABLE; Schema: public; Owner: gargantua
 --
-
+-- TODO: delete delete this table
 CREATE TABLE public.nodes_ngrams_ngrams (
-    node_id integer NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE,
+    node_id   integer NOT NULL REFERENCES public.nodes(id)  ON DELETE CASCADE,
     ngram1_id integer NOT NULL REFERENCES public.ngrams(id) ON DELETE CASCADE,
     ngram2_id integer NOT NULL REFERENCES public.ngrams(id) ON DELETE CASCADE,
     weight double precision,
@@ -79,7 +87,7 @@ CREATE TABLE public.nodes_ngrams_ngrams (
 
 ALTER TABLE public.nodes_ngrams_ngrams OWNER TO gargantua;
 
-
+---------------------------------------------------------
 CREATE TABLE public.nodes_nodes (
     node1_id integer NOT NULL,
     node2_id integer NOT NULL,
@@ -89,8 +97,23 @@ CREATE TABLE public.nodes_nodes (
     PRIMARY KEY (node1_id, node2_id)
 );
 ALTER TABLE public.nodes_nodes OWNER TO gargantua;
+---------------------------------------------------------
+
+-- If needed for rights management at row level
+-- CREATE EXTENSION IF NOT EXISTS acl WITH SCHEMA public;
+
+CREATE TABLE public.rights (
+  user_id INTEGER NOT NULL REFERENCES public.auth_user(id) ON DELETE CASCADE,
+  node_id INTEGER NOT NULL REFERENCES public.nodes(id)     ON DELETE CASCADE,
+  rights  INTEGER NOT NULL,
+  PRIMARY KEY (user_id, node_id)
+);
+ALTER TABLE public.rights OWNER TO gargantua;
+
+CREATE INDEX rights_userId_nodeId ON public.rights USING btree (user_id,node_id);
 
 
+------------------------------------------------------------
 -- INDEXES
 CREATE UNIQUE INDEX ON public.auth_user(username);
 

src/Gargantext/Database/Types/Node.hs

@@ -28,8 +28,7 @@ import Prelude (Enum, Bounded, minBound, maxBound)
 
 import GHC.Generics (Generic)
 
-import           Control.Lens hiding (elements)
-import qualified Control.Lens   as L
+import           Control.Lens hiding (elements, (&))
 import           Control.Applicative ((<*>))
 import           Control.Monad (mzero)
 
@@ -41,7 +40,7 @@ import           Data.ByteString.Lazy (ByteString)
 import           Data.Either
 import           Data.Eq (Eq)
 import           Data.Monoid (mempty)
-import           Data.Text (Text, unpack)
+import           Data.Text (Text, unpack, pack)
 import           Data.Time (UTCTime)
 import           Data.Time.Segment (jour, timesAfter, Granularity(D))
 import           Data.Swagger
@@ -61,7 +60,7 @@ import           Gargantext.Core.Utils.Prefix (unPrefix)
 --import Gargantext.Database.Utils
 ------------------------------------------------------------------------
 newtype NodeId = NodeId Int
-  deriving (Show, Read, Generic, Num, Eq, Ord, Enum)
+  deriving (Show, Read, Generic, Num, Eq, Ord, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON)
 
 instance ToField NodeId where
   toField (NodeId n) = toField n
@@ -72,8 +71,6 @@ instance FromField NodeId where
     if (n :: Int) > 0 then return $ NodeId n
                       else mzero
 
-instance ToJSON NodeId
-instance FromJSON NodeId
 instance ToSchema NodeId
 
 instance FromHttpApiData NodeId where
@@ -237,11 +234,8 @@ instance ToSchema Event where
   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 
 ------------------------------------------------------------------------
-
-type Text' = Text
-
-instance Arbitrary Text' where
-  arbitrary = elements ["ici", "la"]
+instance Arbitrary Text where
+  arbitrary = elements $ map (\c -> pack [c]) ['a'..'z']
 
 data Resource = Resource { resource_path    :: Maybe Text
                          , resource_scraper :: Maybe Text
@@ -324,6 +318,10 @@ data HyperdataList = HyperdataList { hyperdataList_preferences   :: Maybe Text
 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
 
 instance Hyperdata HyperdataList
+
+instance Arbitrary HyperdataList where
+  arbitrary = elements [HyperdataList (Just "from list A")]
+
 ------------------------------------------------------------------------
 data HyperdataScore = HyperdataScore { hyperdataScore_preferences   :: Maybe Text
                                    } deriving (Show, Generic)
@@ -500,27 +498,24 @@ docExample = "{\"doi\":\"sdfds\",\"publication_day\":6,\"language_iso2\":\"en\",
 
 instance ToSchema HyperdataCorpus where
   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
-    L.& mapped.schema.description ?~ "a corpus"
-    L.& mapped.schema.example ?~ toJSON hyperdataCorpus
-
+    & mapped.schema.description ?~ "a corpus"
+    & mapped.schema.example ?~ toJSON hyperdataCorpus
 
 instance ToSchema HyperdataAnnuaire where
   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
-    L.& mapped.schema.description ?~ "an annuaire"
-    L.& mapped.schema.example ?~ toJSON hyperdataAnnuaire
-
+    & mapped.schema.description ?~ "an annuaire"
+    & mapped.schema.example ?~ toJSON hyperdataAnnuaire
 
 instance ToSchema HyperdataDocument where
   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
-    L.& mapped.schema.description ?~ "a document"
-    L.& mapped.schema.example ?~ toJSON hyperdataDocument
-
+    & mapped.schema.description ?~ "a document"
+    & mapped.schema.example ?~ toJSON hyperdataDocument
 
 instance ToSchema HyperdataAny where
   declareNamedSchema proxy =
     pure $ genericNameSchema defaultSchemaOptions proxy mempty
-             L.& schema.description ?~ "a node"
-             L.& schema.example ?~ emptyObject -- TODO
+             & schema.description ?~ "a node"
+             & schema.example ?~ emptyObject -- TODO
 
 
 instance ToSchema hyperdata =>

src/Gargantext/Database/Utils.hs

@@ -37,7 +37,6 @@ import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(Conversion
 import Database.PostgreSQL.Simple.Internal  (Field)
 import Gargantext.Prelude
 import Opaleye (Query, Unpackspec, showSqlForPostgres, FromFields, Select, runQuery)
-import Servant (ServantErr)
 import System.IO (FilePath)
 import Text.Read (read)
 import qualified Data.ByteString      as DB
@@ -49,13 +48,19 @@ class HasConnection env where
 instance HasConnection Connection where
   connection = identity
 
-type CmdM env err m =
+type CmdM' env err m =
   ( MonadReader env m
-  , HasConnection env
   , MonadError err m
   , MonadIO m
   )
 
+type CmdM env err m =
+  ( CmdM' env err m
+  , HasConnection env
+  )
+
+type Cmd' env err a = forall m. CmdM' env err m => m a
+
 type Cmd err a = forall m env. CmdM env err m => m a
 
 -- TODO: ideally there should be very few calls to this functions.
@@ -64,22 +69,10 @@ mkCmd k = do
   conn <- view connection
   liftIO $ k conn
 
-runCmd :: Connection -> Cmd err a -> IO (Either err a)
-runCmd conn m = runExceptT $ runReaderT m conn
-
--- Use only for dev
-runCmdDevWith :: FilePath -> Cmd ServantErr a -> IO a
-runCmdDevWith fp f = do
-  conn <- connectGargandb fp
-  either (fail . show) pure =<< runCmd conn f
-
--- Use only for dev
-runCmdDev :: Cmd ServantErr a -> IO a
-runCmdDev = runCmdDevWith "gargantext.ini"
-
--- Use only for dev
-runCmdDevNoErr :: Cmd () a -> IO a
-runCmdDevNoErr = runCmdDevWith "gargantext.ini"
+runCmd :: HasConnection env => env
+       -> Cmd' env err a
+       -> IO (Either err a)
+runCmd env m = runExceptT $ runReaderT m env
 
 runOpaQuery :: Default FromFields fields haskells => Select fields -> Cmd err [haskells]
 runOpaQuery q = mkCmd $ \c -> runQuery c q

src/Gargantext/Text/Flow.hs

@@ -43,6 +43,7 @@ import Gargantext.Text.Terms (TermType, extractTerms)
 import Gargantext.Viz.Graph (Graph(..), data2graph)
 import Gargantext.Viz.Graph.Bridgeness (bridgeness)
 import Gargantext.Viz.Graph.Distances.Matrice (measureConditional)
+--import Gargantext.Viz.Graph.Distances.Matrice (distributional)
 import Gargantext.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map)
 {-
   ____                             _            _
@@ -153,7 +154,7 @@ cooc2graph myCooc = do
 
 --  let distance = fromIndex fi distanceMap
   --printDebug "distance" $ M.size distance
-  
+
   partitions <- case M.size distanceMap > 0 of
                   True  -> cLouvain distanceMap
                   False -> panic "Text.Flow: DistanceMap is empty"

src/Gargantext/Text/Metrics.hs

@@ -63,7 +63,7 @@ filterCooc' (FilterConfig _ _ _ _ (DefaultValue dv)) ts m = trace ("coocScored "
   where
     selection  = [(x,y) | x <- ts
                         , y <- ts
-                      --  , x >= y
+                        , x > y
                         ]
 
 

src/Gargantext/Viz/Phylo.hs

@@ -7,7 +7,7 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
-Specifications of Phylomemy format.
+Specifications of Phylomemy export format.
 
 Phylomemy can be described as a Temporal Graph with different scale of
 granularity of group of ngrams (terms and multi-terms).
@@ -39,9 +39,9 @@ import Gargantext.Core.Utils.Prefix (unPrefix)
 import Gargantext.Prelude
 
 ------------------------------------------------------------------------
-data PhyloFormat =
-     PhyloFormat { _phyloFormat_param :: PhyloParam
-                 , _phyloFormat_data :: Phylo
+data PhyloExport =
+     PhyloExport { _phyloExport_param :: PhyloParam
+                 , _phyloExport_data :: Phylo
      } deriving (Generic)
 
 -- | .phylo parameters
@@ -66,7 +66,7 @@ data Software =
 -- Ngrams   : list of all (possible) terms contained in the phylomemy (with their id)
 -- Steps    : list of all steps to build the phylomemy
 data Phylo =
-     Phylo { _phylo_puration :: (Start, End)
+     Phylo { _phylo_duration :: (Start, End)
            , _phylo_ngrams   :: [Ngram]
            , _phylo_periods  :: [PhyloPeriod]
            }
@@ -109,27 +109,28 @@ type PhyloLevelId = (PhyloPeriodId, Int)
 -- Ngrams: set of terms that build the group
 -- Period Parents|Childs: weighted link to Parents|Childs (Temporal Period   axis)
 -- Level  Parents|Childs: weighted link to Parents|Childs (Level Granularity axis)
+-- Pointers are directed link from Self to any PhyloGroup (/= Self ?)
 data PhyloGroup =
      PhyloGroup { _phylo_groupId    :: PhyloGroupId
                 , _phylo_groupLabel :: Maybe Text
                 , _phylo_groupNgrams        :: [NgramsId]
                 
-                , _phylo_groupPeriodParents :: [Edge]
-                , _phylo_groupPeriodChilds  :: [Edge]
+                , _phylo_groupPeriodParents :: [Pointer]
+                , _phylo_groupPeriodChilds  :: [Pointer]
                 
-                , _phylo_groupLevelParents  :: [Edge]
-                , _phylo_groupLevelChilds   :: [Edge]
+                , _phylo_groupLevelParents  :: [Pointer]
+                , _phylo_groupLevelChilds   :: [Pointer]
                 }
                 deriving (Generic)
 
 type PhyloGroupId = (PhyloLevelId, Int)
-type Edge         = (PhyloGroupId, Weight)
+type Pointer      = (PhyloGroupId, Weight)
 type Weight       = Double
 
 -- | Lenses
 makeLenses ''Phylo
 makeLenses ''PhyloParam
-makeLenses ''PhyloFormat
+makeLenses ''PhyloExport
 makeLenses ''Software
 
 -- | JSON instances
@@ -138,9 +139,9 @@ $(deriveJSON (unPrefix "_phylo_period" ) ''PhyloPeriod )
 $(deriveJSON (unPrefix "_phylo_level"  ) ''PhyloLevel  )
 $(deriveJSON (unPrefix "_phylo_group"  ) ''PhyloGroup  )
 -- 
-$(deriveJSON (unPrefix "_software_"  ) ''Software )
+$(deriveJSON (unPrefix "_software_"    ) ''Software    )
 $(deriveJSON (unPrefix "_phyloParam_"  ) ''PhyloParam  )
-$(deriveJSON (unPrefix "_phyloFormat_" ) ''PhyloFormat  )
+$(deriveJSON (unPrefix "_phyloExport_" ) ''PhyloExport )
 
 -- | TODO XML instances
 

src/Gargantext/Viz/Phylo/Tools.hs

+{-|
+Module      : Gargantext.Viz.Phylo.Tools
+Description : Phylomemy tools
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Phylo Toolbox:
+- functions to build a Phylo
+- functions to filter the cliques
+- functions to manage a Phylo
+
+Group Functions (TODO list)
+- cohesion sur un groupe
+- distance au dernier branchement
+- âge du groupe
+
+Futre Idea: temporal zoom on Phylo
+phyloZoomOut :: (PeriodGrain, Phylo) -> [(PeriodGrain, Phylo)]
+(from smallest granularity, it increases (zoom out) the periods of the Phylo)
+Moral idea: viz from out to in
+
+-}
+
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Gargantext.Viz.Phylo.Tools where
+
+import Data.Set (Set)
+import Data.Map (Map)
+import Data.Map as Map hiding (Map)
+import Gargantext.Prelude
+import Gargantext.Viz.Phylo
+import Gargantext.Viz.Phylo.Example
+
+-- | Some types to help reading
+type Clique = Set Ngrams
+type Support = Int
+type MinSize = Int
+
+-- | Building a phylo
+-- (Indicative and schematic function)
+buildPhylo :: Support -> MinSize
+                      -> Map Clique Support -> Phylo
+buildPhylo s m mcs = level2Phylo
+                   . groups2level
+                   . clusters2group
+                   . map clique2cluster
+                   . filterCliques s m
+
+level2Phylo :: PhyloLevel -> Phylo -> Phylo
+level2Phylo = undefined
+
+groups2level :: [PhyloGroup] -> PhyloLevel
+groups2level = undefined
+
+clusters2group :: [Cluster Ngrams] -> PhyloGroup
+clusters2group = undefined
+
+clique2cluster :: Clique -> Cluster Ngrams
+clique2cluster = undefined
+
+-- | Filtering the cliques before bulding the Phylo
+-- (Support and MinSize as parameter of the finale function to build a phylo)
+-- idea: log of Corpus size (of docs)
+filterCliques :: Support -> MinSize
+                         -> Map Clique Support -> [Clique]
+filterCliques s ms = maximalCliques
+                   . filterWithSizeSet ms
+                   . Map.keys
+                   . filterWithSupport s
+
+-- | Hapaxify / Threshold
+-- hapax s = 1
+-- ?  
+filterWithSupport :: Support -> Map Clique Support -> Map Clique Support
+filterWithSupport s = Map.filter (>s)
+
+filterWithSizeSet :: MinSize -> [Clique] -> [Clique]
+filterWithSizeSet = undefined
+
+-- | filtre les cliques de ngrams compris dans une clique plus grande
+-- /!\ optim inside
+maximalCliques :: [Clique] -> [Clique]
+maximalCliques = undefined
+
+
+
+
+-- | Phylo management
+
+-- | PhyloLevel Management
+viewGroups :: (Start,End) -> PhyloLevel -> Phylo -> [PhyloGroup]
+viewGroups = undefined
+
+viewLevels :: (Start,End) -> Phylo -> [PhyloLevel]
+viewLevels = undefined
+
+-- | tous les terme des champs, tous les parents et les enfants
+setGroup :: PhyloGroup -> PhyloGroup -> PhyloGroup
+setGroup = undefined
+--removeTerms :: recalculer les cliques pour ces termes
+--addTerms 
+

stack.yaml

@@ -12,6 +12,8 @@ packages:
 
 allow-newer: true
 extra-deps:
+- json-state-0.1.0.1
+- time-units-1.0.0
 - git: https://github.com/delanoe/data-time-segment.git
   commit: 4e3d57d80e9dfe6624c8eeaa8595fc8fe64d8723
 - git: https://gitlab.iscpif.fr/gargantext/hlcm.git
@@ -34,4 +36,4 @@ extra-deps:
 - servant-flatten-0.2
 - servant-multipart-0.11.2
 - stemmer-0.5.2
-- validity-0.8.0.0 # patches-{map,class}
+- validity-0.9.0.0 # patches-{map,class}