Merge branch 'dev' into 97-dev-istex-search

CHANGELOG.md

+## Version 0.0.5.8.9
+* [COUNTS] Chart update when docs are deleted or added
+* [ERGO] Plane navigation improved
+* [ERGO] Mouse misalignemnt fixed
+* [FIX] Date parser WOS
+* [FIX] Node names: List -> Terms
+
+## Version 0.0.5.8.8.2
+* [FE] Fix Contact Page
+
+## Version 0.0.5.8.8.1
+* [FE] Fix regression on Graph Explorer: edges color + confluence filter
+
+## Version 0.0.5.8.8
+* [FE] Fix regression on Graph Explorer for annuaire
+* [FE] Graph Doc Focus
+
+## Version 0.0.5.8.7.2
+* [BE] Docker solution for codebook
+
+## Version 0.0.5.8.7.1
+* [BE] Annuaire pairing, using full first name
+
+## Version 0.0.5.8.7
+* [FE] Graph Explorer Document exploration improvements
+
+## Version 0.0.5.8.6
+* [FE] Plane navigation improvements
+
+## Version 0.0.5.8.5.1
+* [FRONT] FIX CSS Forest
+
 ## Version 0.0.5.8.5
 * [FRONT] CSS + Design, Graph Toolbar and many things
 * [BACK] Security FIX GQL route

CONTRIBUTING.md

 # Contributing
 
-## Main repo
+## Code contribution
 
-https://gitlab.iscpif.fr/gargantext/haskell-gargantext
+We use Git to share and merge our code.
 
+## Style
 
-## Stack by default
+We are using the common Haskell Style: 
+https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md
 
-stack install
-
-
-## REPL
-
-stack ghci at the root of the project (it will load right paths of
-static resources).
+## Code Of Conduct
 
+Be constructive as sharing our code of conduct

devops/docker/Dockerfile-ihaskell

+FROM gibiansky/ihaskell
+
+USER 0
+
+# gargantext stuff
+RUN apt-get update && \
+    apt-get install -y libblas-dev \
+    libbz2-dev \
+    libcairo2-dev \
+    libgsl-dev \
+    liblapack-dev \
+    liblzma-dev \
+    libmagic-dev \
+    libpq-dev \
+    librust-pangocairo-dev \
+    lzma-dev \
+    libzmq3-dev \
+    pkg-config    && \
+    rm -rf /var/lib/apt/lists/*
+
+# ADD . /home/joyvan/src
+# RUN chown -R 1000 /home/joyvan/src
+
+USER 1000
+
+# WORKDIR /home/joyvan/src
+# RUN stack install --fast
+
+RUN stack install aeson aeson-lens aeson-pretty array \
+    blaze-html blaze-markup bytestring \
+    conduit conduit-extra containers \
+    deepseq directory duckling \
+    ekg-core ekg-json exceptions \
+    fgl filepath formatting \
+    hashable hsparql http-api-data http-client http-client-tls http-conduit \
+    ini json-stream lens monad-control monad-logger \
+    morpheus-graphql morpheus-graphql-app morpheus-graphql-core morpheus-graphql-subscriptions \
+    mtl natural-transformation opaleye pandoc parallel parsec rdf4h \
+    postgresql-simple profunctors protolude semigroups \
+    servant servant-auth servant-auth-swagger servant-server \
+    tagsoup template-haskell time transformers transformers-base \
+    tuple unordered-containers uuid vector \
+    wai wai-app-static wai-cors wai-extra wai-websockets warp wreq \
+    xml-conduit xml-types yaml zip zlib --fast
+
+#CMD ["jupyter", "notebook", "--ip", "0.0.0.0"]
+CMD ["stack", "exec", "jupyter", "--", "notebook", "--ip", "0.0.0.0"]
+

devops/docker/bin/mvDockerData

+#!/bin/bash
+
+
+sudo service docker stop
+
+echo "{ \"data-root\": \"$1\" }"  > /etc/docker/daemon.json
+
+sudo mkdir -p $1
+sudo apt update && sudo apt -y install rsync
+sudo rsync -aP /var/lib/docker/ $1
+sudo mv /var/lib/docker /var/lib/docker.old
+
+sudo service docker start
+
+

gargantext.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           gargantext
-version:        0.0.5.8.5
+version:        0.0.5.8.9
 synopsis:       Search, map, share
 description:    Please see README.md
 category:       Data
@@ -107,6 +107,7 @@ library
       Gargantext.API.EKG
       Gargantext.API.Flow
       Gargantext.API.GraphQL
+      Gargantext.API.GraphQL.Annuaire
       Gargantext.API.GraphQL.AsyncTask
       Gargantext.API.GraphQL.IMT
       Gargantext.API.GraphQL.Node
@@ -399,6 +400,7 @@ library
     , http-media
     , http-types
     , hxt
+    , ihaskell
     , ini
     , insert-ordered-containers
     , jose

nix/pkgs.nix

@@ -9,6 +9,7 @@ rec {
   ];
   nonhsBuildInputs = with pkgs; [
     bzip2
+    czmq
     docker-compose
     git
     gmp

package.yaml

@@ -6,7 +6,7 @@ name: gargantext
 #         | | | +-----  Layers * : New versions with API additions
 #         | | | | +---  Layers * : New versions without API breaking changes
 #         | | | | |
-version: '0.0.5.8.5'
+version: '0.0.5.8.9'
 synopsis: Search, map, share
 description: Please see README.md
 category: Data
@@ -188,6 +188,7 @@ library:
   - http-media
   - http-types
   - hxt
+  - ihaskell
   - ini
   - insert-ordered-containers
   - jose

src/Gargantext/API/GraphQL.hs

@@ -33,6 +33,7 @@ import Data.Proxy
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog)
 import Gargantext.API.Prelude (HasJobEnv')
+import qualified Gargantext.API.GraphQL.Annuaire as GQLA
 import qualified Gargantext.API.GraphQL.AsyncTask as GQLAT
 import qualified Gargantext.API.GraphQL.IMT as GQLIMT
 import qualified Gargantext.API.GraphQL.Node as GQLNode
@@ -64,13 +65,14 @@ import Gargantext.API.Admin.Types (HasSettings)
 -- | Represents possible GraphQL queries.
 data Query m
   = Query
-    { imt_schools :: GQLIMT.SchoolsArgs -> m [GQLIMT.School]
+    { annuaire_contacts :: GQLA.AnnuaireContactArgs -> m [GQLA.AnnuaireContact]
+    , imt_schools :: GQLIMT.SchoolsArgs -> m [GQLIMT.School]
     , job_logs    :: GQLAT.JobLogArgs -> m (Map Int JobLog)
     , nodes       :: GQLNode.NodeArgs -> m [GQLNode.Node]
     , node_parent :: GQLNode.NodeParentArgs -> m [GQLNode.Node]
     , user_infos  :: GQLUserInfo.UserInfoArgs -> m [GQLUserInfo.UserInfo]
     , users       :: GQLUser.UserArgs -> m [GQLUser.User m]
-    , tree        :: GQLTree.TreeArgs -> m GQLTree.TreeFirstLevel 
+    , tree        :: GQLTree.TreeArgs -> m (GQLTree.TreeFirstLevel m)
     } deriving (Generic, GQLType)
 
 data Mutation m
@@ -100,13 +102,14 @@ rootResolver
   => RootResolver (GargM env GargError) e Query Mutation Undefined
 rootResolver =
   RootResolver
-    { queryResolver = Query { imt_schools = GQLIMT.resolveSchools
-                            , job_logs    = GQLAT.resolveJobLogs
-                            , nodes       = GQLNode.resolveNodes
-                            , node_parent = GQLNode.resolveNodeParent
-                            , user_infos  = GQLUserInfo.resolveUserInfos
-                            , users       = GQLUser.resolveUsers
-                            , tree        = GQLTree.resolveTree }
+    { queryResolver = Query { annuaire_contacts = GQLA.resolveAnnuaireContacts
+                            , imt_schools       = GQLIMT.resolveSchools
+                            , job_logs          = GQLAT.resolveJobLogs
+                            , nodes             = GQLNode.resolveNodes
+                            , node_parent       = GQLNode.resolveNodeParent
+                            , user_infos        = GQLUserInfo.resolveUserInfos
+                            , users             = GQLUser.resolveUsers
+                            , tree              = GQLTree.resolveTree }
     , mutationResolver = Mutation { update_user_info = GQLUserInfo.updateUserInfo }
     , subscriptionResolver = Undefined }
 

src/Gargantext/API/GraphQL/Annuaire.hs

+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module Gargantext.API.GraphQL.Annuaire where
+
+import Control.Lens
+import Data.Morpheus.Types
+  ( GQLType
+  , Resolver
+  , QUERY
+  , lift
+  )
+import Data.Proxy
+import Data.Text (Text)
+import Gargantext.API.Prelude (GargM, GargError)
+import Gargantext.Core.Mail.Types (HasMail)
+import Gargantext.Database.Admin.Types.Hyperdata.Contact
+  ( HyperdataContact
+  , ContactWho
+  , cw_firstName
+  , cw_lastName
+  , hc_who)
+import Gargantext.Database.Admin.Types.Node (NodeId(..))
+import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
+import Gargantext.Database.Query.Table.Context (getContextWith)
+import Gargantext.Database.Schema.Node (node_hyperdata)
+import Gargantext.Prelude
+import GHC.Generics (Generic)
+
+data AnnuaireContact = AnnuaireContact
+  { ac_id        :: Int
+  , ac_firstName :: Maybe Text
+  , ac_lastName  :: Maybe Text
+  }
+  deriving (Generic, GQLType, Show)
+
+-- | Arguments to the "user info" query.
+data AnnuaireContactArgs
+  = AnnuaireContactArgs
+    { contact_id :: Int
+    } deriving (Generic, GQLType)
+
+type GqlM e env = Resolver QUERY e (GargM env GargError)
+
+-- | Function to resolve user from a query.
+resolveAnnuaireContacts
+  :: (HasConnectionPool env, HasConfig env, HasMail env)
+  => AnnuaireContactArgs -> GqlM e env [AnnuaireContact]
+resolveAnnuaireContacts AnnuaireContactArgs { contact_id } = dbAnnuaireContacts contact_id
+
+-- | Inner function to fetch the user from DB.
+dbAnnuaireContacts
+  :: (HasConnectionPool env, HasConfig env, HasMail env)
+  => Int -> GqlM e env [AnnuaireContact]
+dbAnnuaireContacts contact_id = do
+  -- lift $ printDebug "[dbUsers]" user_id
+--  user <- getUsersWithId user_id
+--  hyperdata <- getUserHyperdata user_id
+--  lift (map toUser <$> zip user hyperdata)
+  c <- lift $ getContextWith (NodeId contact_id) (Proxy :: Proxy HyperdataContact)
+  pure [toAnnuaireContact (contact_id, c ^. node_hyperdata)]
+
+toAnnuaireContact :: (Int, HyperdataContact) -> AnnuaireContact
+toAnnuaireContact (c_id, c_hyperdata) =
+  AnnuaireContact { ac_id = c_id
+                  , ac_firstName = c_hyperdata ^. ac_firstNameL
+                  , ac_lastName = c_hyperdata ^. ac_lastNameL }
+
+contactWhoL :: Traversal' HyperdataContact ContactWho
+contactWhoL = hc_who . _Just
+ac_firstNameL :: Traversal' HyperdataContact (Maybe Text)
+ac_firstNameL = contactWhoL . cw_firstName
+ac_lastNameL :: Traversal' HyperdataContact (Maybe Text)
+ac_lastNameL = contactWhoL . cw_lastName
+

src/Gargantext/API/GraphQL/TreeFirstLevel.hs

@@ -11,10 +11,15 @@ import Gargantext.API.Prelude (GargM, GargError)
 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
 import Gargantext.Core.Mail.Types (HasMail)
 import qualified Gargantext.Database.Query.Tree as T
+import qualified Gargantext.Database.Schema.Node as N
+import qualified Gargantext.Database.Admin.Types.Node as NN
 import Gargantext.Database.Admin.Types.Node (allNodeTypes, NodeId (NodeId))
 import Gargantext.Core.Types (Tree, NodeTree, NodeType)
 import Gargantext.Core.Types.Main
     ( Tree(TreeN), _tn_node, _tn_children, NodeTree(NodeTree, _nt_id, _nt_type), _nt_name )
+import Gargantext.Database.Query.Table.Node (getNode)
+import Gargantext.Database.Admin.Config (fromNodeTypeId)
+import Gargantext.Database.Schema.Node (NodePoly(_node_parent_id))
 
 data TreeArgs = TreeArgs
   {
@@ -26,37 +31,60 @@ data TreeNode = TreeNode
     name      :: Text
   , id        :: Int
   , node_type :: NodeType
+  , parent_id :: Maybe Int
   } deriving (Generic, GQLType)
 
-data TreeFirstLevel  = TreeFirstLevel
+data TreeFirstLevel m = TreeFirstLevel
   {
     root     :: TreeNode
-  , parent   :: Maybe TreeNode
+  , parent   :: m (Maybe TreeNode)
   , children :: [TreeNode]
   } deriving (Generic, GQLType)
 
 type GqlM e env = Resolver QUERY e (GargM env GargError)
 
-resolveTree :: (HasConnectionPool env, HasConfig env, HasMail env) => TreeArgs -> GqlM e env TreeFirstLevel
+type ParentId = Maybe NodeId
+
+resolveTree :: (HasConnectionPool env, HasConfig env, HasMail env) => TreeArgs -> GqlM e env (TreeFirstLevel (GqlM e env))
 resolveTree TreeArgs { root_id } = dbTree root_id
 
-dbTree :: (HasConnectionPool env, HasConfig env, HasMail env) => Int -> GqlM e env TreeFirstLevel
+dbTree :: (HasConnectionPool env, HasConfig env, HasMail env) => Int -> GqlM e env (TreeFirstLevel (GqlM e env))
 dbTree root_id = do
-  t <- lift $ T.tree T.TreeFirstLevel (NodeId root_id) allNodeTypes
-  pure $ toTree t
-
-toTree :: Tree NodeTree -> TreeFirstLevel
-toTree TreeN {_tn_node, _tn_children} = TreeFirstLevel
-  { parent   = Nothing -- TODO
-  , root     = toTreeNode _tn_node
-  , children = map childrenToTreeNodes _tn_children
+  let rId = NodeId root_id
+  t <- lift $ T.tree T.TreeFirstLevel rId allNodeTypes
+  n <- lift $ getNode $ NodeId root_id
+  let pId = toParentId n
+  pure $ toTree rId pId t
+  where
+    toParentId N.Node { _node_parent_id } = _node_parent_id
+
+
+toTree :: (HasConnectionPool env, HasConfig env, HasMail env) => NodeId -> ParentId -> Tree NodeTree -> TreeFirstLevel (GqlM e env)
+toTree rId pId TreeN { _tn_node, _tn_children } = TreeFirstLevel
+  { parent   = resolveParent pId
+  , root     = toTreeNode pId _tn_node
+  , children = map childrenToTreeNodes $ zip _tn_children $ repeat rId
   }
 
-toTreeNode :: NodeTree -> TreeNode
-toTreeNode NodeTree {_nt_name, _nt_id, _nt_type} = TreeNode { name = _nt_name, id = id2int _nt_id, node_type = _nt_type}
+toTreeNode :: ParentId -> NodeTree -> TreeNode
+toTreeNode pId NodeTree { _nt_name, _nt_id, _nt_type } = TreeNode { name = _nt_name, id = id2int _nt_id, node_type = _nt_type, parent_id = id2int <$> pId}
   where
     id2int :: NodeId -> Int
     id2int (NodeId n) = n
 
-childrenToTreeNodes :: Tree NodeTree -> TreeNode
-childrenToTreeNodes TreeN {_tn_node} = toTreeNode _tn_node
+childrenToTreeNodes :: (Tree NodeTree, NodeId) -> TreeNode
+childrenToTreeNodes (TreeN {_tn_node}, rId) = toTreeNode (Just rId) _tn_node
+
+resolveParent :: (HasConnectionPool env, HasConfig env, HasMail env) => Maybe NodeId -> GqlM e env (Maybe TreeNode)
+resolveParent (Just pId) = do
+  node <- lift $ getNode pId
+  pure $ Just $ nodeToTreeNode node
+resolveParent Nothing = pure Nothing
+
+
+nodeToTreeNode :: NN.Node json -> TreeNode
+nodeToTreeNode N.Node {..} = TreeNode { id        = NN.unNodeId _node_id
+                                      , name      = _node_name
+                                      , node_type = fromNodeTypeId _node_typename
+                                      , parent_id = NN.unNodeId <$> _node_parent_id
+                                      }

src/Gargantext/API/GraphQL/UserInfo.hs

@@ -47,7 +47,6 @@ import Gargantext.Prelude
 import GHC.Generics (Generic)
 import Gargantext.API.GraphQL.Utils (AuthStatus(Invalid, Valid), authUser)
 import Gargantext.API.Admin.Types (HasSettings)
-import Gargantext.Database.Admin.Types.Node (unNodeId)
 
 data UserInfo = UserInfo
   { ui_id             :: Int
@@ -152,7 +151,7 @@ updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
     uh lens' (Just val) u_hyperdata = u_hyperdata & lens' .~ Just val
     uh' _ Nothing u_hyperdata = u_hyperdata
     uh' lens' (Just val) u_hyperdata = u_hyperdata & lens' .~ val
-    nId Node {_node_id} = unNodeId _node_id
+    nId Node {_node_id} = _node_id
 
 -- | Inner function to fetch the user from DB.
 dbUsers

src/Gargantext/API/GraphQL/Utils.hs

@@ -22,7 +22,7 @@ import Control.Lens.Getter (view)
 import Gargantext.Database.Prelude (Cmd')
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser (AuthenticatedUser, _authUser_id))
 import Data.ByteString (ByteString)
-import Gargantext.Database.Admin.Types.Node (unNodeId)
+import Gargantext.Database.Admin.Types.Node (NodeId)
 
 unPrefix :: T.Text -> GQLTypeOptions -> GQLTypeOptions
 unPrefix prefix options = options { fieldLabelModifier = nflm }
@@ -31,7 +31,7 @@ unPrefix prefix options = options { fieldLabelModifier = nflm }
 
 data AuthStatus = Valid | Invalid
 
-authUser :: (HasSettings env) => Int -> Text -> Cmd' env err AuthStatus
+authUser :: (HasSettings env) => NodeId -> Text -> Cmd' env err AuthStatus
 authUser ui_id token = do
   let token' = encodeUtf8 token
   jwtS <- view $ settings . jwtSettings
@@ -43,7 +43,7 @@ authUser ui_id token = do
         then pure Valid
         else pure Invalid
         where
-          nId AuthenticatedUser {_authUser_id} = unNodeId _authUser_id
+          nId AuthenticatedUser {_authUser_id} = _authUser_id
 
 getUserFromToken :: JWTSettings -> ByteString -> IO (Maybe AuthenticatedUser)
 getUserFromToken = verifyJWT

src/Gargantext/API/Ngrams.hs

@@ -261,7 +261,7 @@ setListNgrams listId ngramsType ns = do
 currentVersion :: HasNodeStory env err m
                => ListId -> m Version
 currentVersion listId = do
-  nls <- getRepo' [listId]
+  nls <- getRepo [listId]
   pure $ nls ^. unNodeStory . at listId . _Just . a_version
 
 

src/Gargantext/API/Ngrams/Tools.hs

@@ -35,22 +35,26 @@ mergeNgramsElement _neOld neNew = neNew
 
 type RootTerm = NgramsTerm
 
-{-
-getRepo :: RepoCmdM env err m => m NgramsRepo
-getRepo = do
-  v <- view repoVar
-  liftBase $ readMVar v
--}
 
-getRepo' :: HasNodeStory env err m
+getRepo :: HasNodeStory env err m
          => [ListId] -> m NodeListStory
-getRepo' listIds = do
+getRepo listIds = do
   f <- getNodeListStory
   v  <- liftBase $ f listIds
   v' <- liftBase $ readMVar v
   pure $ v'
 
 
+repoSize :: Ord k1 => NodeStory (Map.Map k1 (Map.Map k2 a)) p
+                   -> NodeId
+                   -> Map.Map k1 Int
+repoSize repo node_id = Map.map Map.size state
+  where
+    state = repo ^. unNodeStory
+                  . at node_id . _Just
+                  . a_state
+
+
 getNodeStoryVar :: HasNodeStory env err m
            => [ListId] -> m (MVar NodeListStory)
 getNodeStoryVar l = do
@@ -83,8 +87,6 @@ listNgramsFromRepo nodeIds ngramsType repo =
                 | nodeId <- nodeIds
                 ]
 
-
-
 -- TODO-ACCESS: We want to do the security check before entering here.
 --              Add a static capability parameter would be nice.
 --              Ideally this is the access to `repoVar` which needs to
@@ -93,7 +95,7 @@ getListNgrams :: HasNodeStory env err m
               => [ListId] -> NgramsType
               -> m (HashMap NgramsTerm NgramsRepoElement)
 getListNgrams nodeIds ngramsType = listNgramsFromRepo nodeIds ngramsType
-                                 <$> getRepo' nodeIds
+                                 <$> getRepo nodeIds
 
 
 getTermsWith :: (HasNodeStory env err m, Eq a, Hashable a)
@@ -105,7 +107,7 @@ getTermsWith f ls ngt lts  = HM.fromListWith (<>)
                       <$> HM.toList
                       <$> HM.filter (\f' -> Set.member (fst f') lts)
                       <$> mapTermListRoot ls ngt
-                      <$> getRepo' ls
+                      <$> getRepo ls
   where
     toTreeWith (t, (_lt, maybeRoot)) = case maybeRoot of
       Nothing -> (f t, [])

src/Gargantext/API/Node.hs

@@ -21,8 +21,6 @@ Node API
 
 -}
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
 {-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE TemplateHaskell      #-}
 {-# LANGUAGE TypeOperators        #-}
@@ -264,10 +262,11 @@ instance ToJSON    NodesToCategory
 instance ToSchema  NodesToCategory
 
 catApi :: CorpusId -> GargServer CatApi
-catApi = putCat
-  where
-    putCat :: CorpusId -> NodesToCategory -> Cmd err [Int]
-    putCat cId cs' = nodeContextsCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
+catApi cId cs' = do
+  ret <- nodeContextsCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
+  lId <- defaultList cId
+  _ <- updateChart cId (Just lId) Docs Nothing
+  pure ret
 
 ------------------------------------------------------------------------
 type ScoreApi =  Summary " To Score NodeNodes"

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

@@ -28,7 +28,7 @@ import qualified Data.HashMap.Strict as HashMap
 import Gargantext.API.Node.Corpus.Export.Types
 import qualified Gargantext.API.Node.Document.Export.Types as DocumentExport
 import Gargantext.API.Ngrams.Types
-import Gargantext.API.Ngrams.Tools (filterListWithRoot, mapTermListRoot, getRepo')
+import Gargantext.API.Ngrams.Tools (filterListWithRoot, mapTermListRoot, getRepo)
 import Gargantext.API.Prelude (GargNoServer)
 import Gargantext.Prelude.Crypto.Hash (hash)
 import Gargantext.Core.Types
@@ -66,7 +66,7 @@ getCorpus cId lId nt' = do
        <$> map (\n -> (_context_id n, n))
        <$> selectDocNodes cId
 
-  repo <- getRepo' [listId]
+  repo <- getRepo [listId]
   ngs  <- getContextNgrams cId listId MapTerm nt repo
   let  -- uniqId is hash computed already for each document imported in database
     r = Map.intersectionWith

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

@@ -220,7 +220,7 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
       eTxts <- mapM (\db -> getDataText db (Multi l) q maybeLimit) [database2origin dbs]
 
       let lTxts = lefts eTxts
-      printDebug "[G.A.N.C.New] eTxts" lTxts
+      printDebug "[G.A.N.C.New] lTxts" lTxts
       case lTxts of
         [] -> do
           let txts = rights eTxts
@@ -245,12 +245,14 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
         
         (err:_) -> do
           printDebug "Error: " err
-          pure $ addEvent "ERROR" (T.pack $ show err) $
-            JobLog { _scst_succeeded = Just 2
-                   , _scst_failed    = Just 1
-                   , _scst_remaining = Just 0
-                   , _scst_events    = Just []
-                   }
+          let jl = addEvent "ERROR" (T.pack $ show err) $
+                JobLog { _scst_succeeded = Just 2
+                       , _scst_failed    = Just 1
+                       , _scst_remaining = Just 0
+                       , _scst_events    = Just []
+                       }
+          logStatus jl
+          pure jl
 
 
 type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint"

src/Gargantext/API/Node/Update.hs

@@ -24,6 +24,7 @@ import GHC.Generics (Generic)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Ngrams.List (reIndexWith)
+--import Gargantext.API.Ngrams.Types (TabType(..))
 import Gargantext.API.Prelude (GargServer, simuLogs)
 import Gargantext.Core.Methods.Distances (GraphMetric(..))
 import Gargantext.Core.Types.Main (ListType(..))
@@ -153,9 +154,9 @@ updateNode _uId lId (UpdateNodeParamsList Advanced) logStatus = do
 
   _ <- case corpusId of
     Just cId -> do
-      _ <- Metrics.updatePie' cId (Just lId) NgramsTypes.Authors Nothing
-      _ <- Metrics.updateTree' cId (Just lId) NgramsTypes.Institutes MapTerm
-      _ <- Metrics.updatePie' cId (Just lId) NgramsTypes.Sources Nothing
+      _ <- Metrics.updatePie cId (Just lId) NgramsTypes.Authors Nothing
+      _ <- Metrics.updateTree cId (Just lId) NgramsTypes.Institutes MapTerm
+      _ <- Metrics.updatePie cId (Just lId) NgramsTypes.Sources Nothing
       pure ()
     Nothing  -> pure ()
 
@@ -240,6 +241,7 @@ updateNode _uId tId (UpdateNodeParamsTexts _mode) logStatus = do
       _ <- reIndexWith cId lId NgramsTerms (Set.singleton MapTerm)
       _ <- updateNgramsOccurrences cId (Just lId)
       _ <- updateContextScore      cId (Just lId)
+      _ <- Metrics.updateChart     cId (Just lId) NgramsTypes.Docs Nothing
       -- printDebug "updateContextsScore" (cId, lId, u)
       pure ()
     Nothing  -> pure ()

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

@@ -107,6 +107,9 @@ dateFlow (DucklingFailure txt) = case readDate $ replace " " "T" txt of
                              Nothing -> dateFlow (ReadFailure1 txt)
                              Just ok -> DateFlowSuccess ok
 dateFlow (ReadFailure1 txt) = case readDate txt of
+                          Nothing -> dateFlow $ ReadFailure2 txt
+                          Just ok -> DateFlowSuccess ok
+dateFlow (ReadFailure2 txt) = case readDate $ replace " " "" txt <> "-01-01T00:00:00" of
                           Nothing -> DateFlowFailure
                           Just ok -> DateFlowSuccess ok
 dateFlow _ = DateFlowFailure

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

@@ -47,11 +47,11 @@ notice = start *> many (fieldWith field) <* end
 
 
 keys :: ByteString -> ByteString
-keys champs
-            | champs == "AF" = "authors"
-            | champs == "TI" = "title"
-            | champs == "SO" = "source"
-            | champs == "DI" = "doi"
-            | champs == "PD" = "publication_date"
-            | champs == "AB" = "abstract"
-            | otherwise  = champs
+keys field
+            | field == "AF" = "authors"
+            | field == "TI" = "title"
+            | field == "SO" = "source"
+            | field == "DI" = "doi"
+            | field == "PY" = "publication_date"
+            | field == "AB" = "abstract"
+            | otherwise  = field

src/Gargantext/Core/Text/List.hs

@@ -124,7 +124,7 @@ buildNgramsOthersList user uCid mfslw _groupParams (nt, MapListSize mapListSize,
                             $ HashMap.toList tailTerms'
 
 
-  pure $ Map.fromList [( nt, (toNgramsElement stopTerms)
+  pure $ Map.fromList [( nt, List.take maxListSize $ (toNgramsElement stopTerms)
                           <> (toNgramsElement mapTerms )
                           <> (toNgramsElement $ setListType (Just MapTerm      ) mapTerms' )
                           <> (toNgramsElement $ setListType (Just CandidateTerm) candiTerms)

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

@@ -168,5 +168,5 @@ getHistory :: ( HasNodeStory env err m
            -> [ListId]
            -> m (Map ListId (Map NgramsType [HashMap NgramsTerm NgramsPatch]))
 getHistory hist nt listes =
-  history hist [nt] listes  <$> getRepo' listes
+  history hist [nt] listes  <$> getRepo listes
 

src/Gargantext/Core/Types/Main.hs

@@ -38,9 +38,9 @@ import Text.Read (readMaybe)
 
 type CorpusName = Text
 ------------------------------------------------------------------------
-data NodeTree = NodeTree { _nt_name :: Text
-                         , _nt_type :: NodeType
-                         , _nt_id   :: NodeId
+data NodeTree = NodeTree { _nt_name      :: Text
+                         , _nt_type      :: NodeType
+                         , _nt_id        :: NodeId
                          } deriving (Show, Read, Generic)
 
 $(deriveJSON (unPrefix "_nt_") ''NodeTree)

src/Gargantext/Core/Viz/Chart.hs

@@ -59,7 +59,7 @@ chartData :: FlowCmdM env err m
 chartData cId nt lt = do
   ls' <- selectNodesWithUsername NodeList userMaster
   ls <- map (_node_id) <$> getListsWithParentId cId
-  ts <- mapTermListRoot ls nt <$> getRepo' ls
+  ts <- mapTermListRoot ls nt <$> getRepo ls
   let
     dico = filterListWithRoot [lt] ts
     terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ HashMap.toList dico
@@ -83,7 +83,7 @@ treeData :: FlowCmdM env err m
 treeData cId nt lt = do
   ls' <- selectNodesWithUsername NodeList userMaster
   ls <- map (_node_id) <$> getListsWithParentId cId
-  ts <- mapTermListRoot ls nt <$> getRepo' ls
+  ts <- mapTermListRoot ls nt <$> getRepo ls
 
   let
     dico = filterListWithRoot [lt] ts

src/Gargantext/Core/Viz/Graph/API.hs

@@ -96,7 +96,7 @@ getGraph _uId nId = do
 
   -- printDebug "[getGraph] getting list for cId" cId
   listId <- defaultList cId
-  repo <- getRepo' [listId]
+  repo <- getRepo [listId]
 
   -- TODO Distance in Graph params
   case graph of
@@ -142,7 +142,7 @@ recomputeGraph _uId nId method maybeDistance force = do
   let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId
 
   listId  <- defaultList cId
-  repo <- getRepo' [listId]
+  repo <- getRepo [listId]
   let v   = repo ^. unNodeStory . at listId . _Just . a_version
 
   let computeG mt = do
@@ -286,7 +286,7 @@ graphVersions n nId = do
                       else panic "[G.V.G.API] list not found after iterations"
 
     Just listId -> do
-      repo <- getRepo' [listId]
+      repo <- getRepo [listId]
       let v = repo ^. unNodeStory . at listId . _Just . a_version
       -- printDebug "graphVersions" v
 

src/Gargantext/Core/Viz/Phylo/API/Tools.hs

@@ -21,7 +21,7 @@ import Data.Text (Text, pack)
 import Data.Time.Calendar (fromGregorian, diffGregorianDurationClip, cdMonths, diffDays, showGregorian)
 import Data.Time.Clock.POSIX(posixSecondsToUTCTime)
 import Gargantext.API.Ngrams.Prelude (getTermList)
-import Gargantext.API.Ngrams.Tools (getRepo')
+import Gargantext.API.Ngrams.Tools (getRepo)
 import Gargantext.API.Ngrams.Types (NgramsTerm(..))
 import Gargantext.API.Node.Corpus.Export (getContextNgrams)
 import Gargantext.API.Prelude (GargNoServer)
@@ -96,7 +96,7 @@ corpusIdtoDocuments :: TimeUnit -> CorpusId -> GargNoServer (TermList, [Document
 corpusIdtoDocuments timeUnit corpusId = do
   docs <- selectDocNodes corpusId
   lId  <- defaultList corpusId
-  repo <- getRepo' [lId]
+  repo <- getRepo [lId]
 
   ngs_terms    <- getContextNgrams corpusId lId MapTerm NgramsTerms repo
   ngs_sources  <- getContextNgrams corpusId lId MapTerm Sources repo

src/Gargantext/Database/Action/Flow.hs

@@ -176,7 +176,6 @@ getDataText_Debug a l q li = do
     Right res -> liftBase $ printDataText res
 
 
-
 -------------------------------------------------------------------------------
 flowDataText :: forall env err m.
                 ( FlowCmdM env err m
@@ -258,10 +257,9 @@ flow :: forall env err m a c.
         -> m CorpusId
 flow c u cn la mfslw (mLength, docsC) logStatus = do
   -- TODO if public insertMasterDocs else insertUserDocs
-  ids <- runConduit $
-      zipSources (yieldMany [1..]) docsC
-      .| mapMC insertDoc
-      .| sinkList
+  ids <- runConduit $ zipSources (yieldMany [1..]) docsC
+                   .| mapMC insertDoc
+                   .| sinkList
 --  ids <- traverse (\(idx, doc) -> do
 --                      id <- insertMasterDocs c la doc
 --                      logStatus JobLog { _scst_succeeded = Just $ 1 + idx

src/Gargantext/Database/Action/Flow/Pairing.hs

@@ -178,7 +178,8 @@ getNgramsContactId aId = do
   pure paired
 -- POC here, should be a probabilistic function (see the one used to find lang)
 toName :: Node HyperdataContact -> NgramsTerm
-toName contact = NgramsTerm $ (Text.toTitle $ Text.take 1 firstName) <> ". " <> (Text.toTitle lastName)
+-- toName contact = NgramsTerm $ (Text.toTitle $ Text.take 1 firstName) <> ". " <> (Text.toTitle lastName)
+toName contact = NgramsTerm $ (Text.toTitle firstName) <> " " <> (Text.toTitle lastName)
   where
     firstName = fromMaybe "" $ contact^.(node_hyperdata . hc_who . _Just . cw_firstName)
     lastName  = fromMaybe "" $ contact^.(node_hyperdata . hc_who . _Just . cw_lastName)
@@ -189,7 +190,7 @@ getNgramsDocId :: CorpusId
                 -> GargNoServer (HashMap DocAuthor (Set NodeId))
 getNgramsDocId cId lId nt = do
   lIds <- selectNodesWithUsername NodeList userMaster
-  repo <- getRepo' (lId:lIds)
+  repo <- getRepo (lId:lIds)
   let ngs = filterListWithRoot [MapTerm, CandidateTerm] $ mapTermListRoot (lId:lIds) nt repo
   -- printDebug "getNgramsDocId" ngs
 

src/Gargantext/Database/Action/Metrics.hs

@@ -23,7 +23,7 @@ import Database.PostgreSQL.Simple (Query, Only(..))
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import Data.Vector (Vector)
 import Gargantext.Core (HasDBid(toDBid))
-import Gargantext.API.Ngrams.Tools (filterListWithRoot, groupNodesByNgrams, Diagonal(..), getCoocByNgrams, mapTermListRoot, RootTerm, getRepo')
+import Gargantext.API.Ngrams.Tools (filterListWithRoot, groupNodesByNgrams, Diagonal(..), getCoocByNgrams, mapTermListRoot, RootTerm, getRepo)
 import Gargantext.Database.Prelude (runPGSQuery{-, formatPGSQuery-})
 import Gargantext.API.Ngrams.Types (TabType(..), ngramsTypeFromTabType, NgramsTerm(..))
 import Gargantext.Core.Mail.Types (HasMail)
@@ -233,7 +233,7 @@ getNgrams :: (HasMail env, HasNodeStory env err m)
                  )
 getNgrams lId tabType = do
 
-  lists <- mapTermListRoot [lId] (ngramsTypeFromTabType tabType) <$> getRepo' [lId]
+  lists <- mapTermListRoot [lId] (ngramsTypeFromTabType tabType) <$> getRepo [lId]
   -- TODO filterListWithRoot [MapTerm, StopTerm, CandidateTerm] lists
   let maybeSyn = HM.unions $ map (\t -> filterListWithRoot t lists)
                                  [[MapTerm], [StopTerm], [CandidateTerm]]

src/Gargantext/Database/Action/Node.hs

@@ -86,7 +86,9 @@ mkNodeWithParent_ConfigureHyperdata NodeFrameVisio (Just i) uId name =
   mkNodeWithParent_ConfigureHyperdata' NodeFrameVisio (Just i) uId name
 
 mkNodeWithParent_ConfigureHyperdata NodeFrameNotebook (Just i) uId name =
-  insertNode NodeFrameNotebook  (Just "Notebook") (Just $ DefaultFrameCode $ HyperdataFrame "Notebook" name) i uId
+  insertNode NodeFrameNotebook  (Just "Notebook")
+                                (Just $ DefaultFrameCode $ HyperdataFrame { _hf_base = "Codebook"
+                                                                          , _hf_frame_id = name }) i uId
 
 mkNodeWithParent_ConfigureHyperdata    _ _ _ _ = nodeError NotImplYet
 

src/Gargantext/Database/Admin/Types/Hyperdata/Frame.hs

@@ -9,13 +9,6 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE DeriveGeneric              #-}
-{-# LANGUAGE FlexibleContexts           #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE NoImplicitPrelude          #-}
-{-# LANGUAGE OverloadedStrings          #-}
-{-# LANGUAGE RankNTypes                 #-}
 {-# LANGUAGE TemplateHaskell            #-}
 
 module Gargantext.Database.Admin.Types.Hyperdata.Frame

src/Gargantext/Database/Admin/Types/Node.hs

@@ -372,7 +372,7 @@ defaultName NodeAnnuaire   = "Annuaire"
 
 defaultName NodeDocument   = "Doc"
 defaultName NodeTexts      = "Docs"
-defaultName NodeList       = "List"
+defaultName NodeList       = "Terms"
 defaultName NodeListCooc   = "List"
 defaultName NodeModel      = "Model"
 
@@ -386,7 +386,7 @@ defaultName NodeDashboard     = "Board"
 defaultName NodeGraph         = "Graph"
 defaultName NodePhylo         = "Phylo"
 
-defaultName NodeFrameWrite    = "Write"
+defaultName NodeFrameWrite    = "Note"
 defaultName NodeFrameCalc     = "Calc"
 defaultName NodeFrameVisio    = "Visio"
 defaultName NodeFrameNotebook = "Code"

stack.yaml

@@ -5,6 +5,7 @@ extra-package-dbs: []
 skip-ghc-check: true
 packages:
 - .
+
   #- 'deps/gargantext-graph'
   #- 'deps/haskell-opaleye'
 
@@ -73,7 +74,7 @@ extra-deps:
 - git: https://gitlab.iscpif.fr/gargantext/crawlers/istex.git
   commit: a4a6fb6a578255c9e5b52aab2afccf874976a3f5
 - git: https://gitlab.iscpif.fr/gargantext/crawlers/hal.git
-  commit: 3bf77f28d3dc71d2e8349cbf422a34cf4c23cd11
+  commit: 9a43470241690a19c1c381c42a62c5dd4e28dff2
 - git: https://gitlab.iscpif.fr/gargantext/crawlers/isidore.git
   commit: 3db385e767d2100d8abe900833c6e7de3ac55e1b
 - git: https://gitlab.iscpif.fr/gargantext/crawlers/arxiv-api.git