[WIP/DB] Refactoring (start).

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

@@ -27,7 +27,7 @@ Portability : POSIX
 {-# LANGUAGE NoImplicitPrelude       #-}
 {-# LANGUAGE OverloadedStrings       #-}
 
-module Gargantext.Database.Flow -- (flowDatabase, ngrams2list)
+module Gargantext.Database.Action.Flow -- (flowDatabase, ngrams2list)
   ( FlowCmdM
   , flowCorpusFile
   , flowCorpus

src/Gargantext/Database/Flow/Annuaire.hs → src/Gargantext/Database/Action/Flow/Annuaire.hs

@@ -16,11 +16,10 @@ Portability : POSIX
 {-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE FlexibleContexts  #-}
 
-module Gargantext.Database.Flow.Annuaire
+module Gargantext.Database.Action.Flow.Annuaire
     where
 
 
-
 {-
 import Gargantext.Prelude
 import Gargantext.Database.Flow

src/Gargantext/Database/Flow/List.hs → src/Gargantext/Database/Action/Flow/List.hs

@@ -21,7 +21,7 @@ Portability : POSIX
 {-# LANGUAGE NoImplicitPrelude       #-}
 {-# LANGUAGE OverloadedStrings       #-}
 
-module Gargantext.Database.Flow.List
+module Gargantext.Database.Action.Flow.List
     where
 import Data.Text (Text)
 import Control.Monad (mapM_)

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

@@ -16,7 +16,7 @@ Portability : POSIX
 {-# LANGUAGE RankNTypes        #-}
 -- {-# LANGUAGE Arrows #-}
 
-module Gargantext.Database.Flow.Pairing
+module Gargantext.Database.Action.Flow.Pairing
   (pairing)
     where
 

src/Gargantext/Database/Flow/Types.hs → src/Gargantext/Database/Action/Flow/Types.hs

@@ -21,7 +21,7 @@ Portability : POSIX
 {-# LANGUAGE NoImplicitPrelude       #-}
 {-# LANGUAGE OverloadedStrings       #-}
 
-module Gargantext.Database.Flow.Types
+module Gargantext.Database.Action.Flow.Types
     where
 
 import Data.Map (Map)

src/Gargantext/Database/Flow/Utils.hs → src/Gargantext/Database/Action/Flow/Utils.hs

@@ -14,7 +14,7 @@ Portability : POSIX
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes        #-}
 
-module Gargantext.Database.Flow.Utils
+module Gargantext.Database.Action.Flow.Utils
     where
 
 import Data.Map (Map)

src/Gargantext/Database/Learn.hs → src/Gargantext/Database/Action/Learn.hs

@@ -16,7 +16,8 @@ Portability : POSIX
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE MonoLocalBinds    #-}
 
-module Gargantext.Database.Learn where
+module Gargantext.Database.Action.Learn
+  where
 
 import Data.Text (Text)
 import Data.Tuple (snd)

src/Gargantext/Database/Metrics.hs → src/Gargantext/Database/Action/Metrics.hs

@@ -15,7 +15,7 @@ Node API
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE FlexibleContexts  #-}
 
-module Gargantext.Database.Metrics
+module Gargantext.Database.Action.Metrics
   where
 
 import Data.Map (Map)

src/Gargantext/Database/Lists.hs → src/Gargantext/Database/Action/Metrics/Lists.hs

@@ -23,7 +23,8 @@ Portability : POSIX
 {-# LANGUAGE RankNTypes             #-}
 {-# LANGUAGE TemplateHaskell        #-}
 
-module Gargantext.Database.Lists where
+module Gargantext.Database.Action.Metrics.Lists
+  where
 
 import Gargantext.API.Ngrams (TabType(..))
 import Gargantext.Core.Types -- (NodePoly(..), NodeCorpus, ListId)

src/Gargantext/Database/Metrics/NgramsByNode.hs → src/Gargantext/Database/Action/Metrics/NgramsByNode.hs

@@ -17,7 +17,7 @@ Ngrams by node enable contextual metrics.
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes        #-}
 
-module Gargantext.Database.Metrics.NgramsByNode
+module Gargantext.Database.Action.Metrics.NgramsByNode
   where
 
 import Debug.Trace (trace)

src/Gargantext/Database/TextSearch.hs → src/Gargantext/Database/Action/Search.hs

@@ -14,7 +14,7 @@ Portability : POSIX
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes        #-}
 
-module Gargantext.Database.TextSearch where
+module Gargantext.Database.Action.Search where
 
 import Data.Aeson
 import Data.Map.Strict hiding (map, drop, take)
@@ -35,7 +35,7 @@ import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Schema.NodeNode hiding (joinInCorpus)
 import Gargantext.Database.Schema.NodeNodeNgrams
-import Gargantext.Database.Queries.Join (leftJoin6)
+import Gargantext.Database.Query.Join (leftJoin6)
 import Gargantext.Database.Utils (Cmd, runPGSQuery, runOpaQuery, runCountOpaQuery)
 import Gargantext.Text.Terms.Mono.Stem.En (stemIt)
 import Gargantext.Core.Types

src/Gargantext/Database/Access.hs → src/Gargantext/Database/Admin/Access.hs

@@ -13,8 +13,7 @@ TODO-SECURITY review purpose of this module
 {-# LANGUAGE NoImplicitPrelude #-}
 
 
-
-module Gargantext.Database.Access where
+module Gargantext.Database.Admin.Access where
 
 data Action = Read | Write | Exec
 data Roles  = RoleUser | RoleMaster

src/Gargantext/Database/Bashql.hs → src/Gargantext/Database/Admin/Bashql.hs

@@ -64,7 +64,7 @@ TODO-ACCESS: should the checks be done here or before.
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE RankNTypes        #-}
 
-module Gargantext.Database.Bashql () {-( get
+module Gargantext.Database.Admin.Bashql () {-( get
                                   , ls
                                   , home
                                   , post

src/Gargantext/Database/Config.hs → src/Gargantext/Database/Admin/Config.hs

@@ -16,7 +16,7 @@ TODO: configure nodes table in Haskell (Config typenames etc.)
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Gargantext.Database.Config
+module Gargantext.Database.Admin.Config
     where
 
 

src/Gargantext/Database/Schema/Ngrams.hs → src/Gargantext/Database/Admin/Schema/Ngrams.hs

@@ -24,7 +24,7 @@ Ngrams connection to the Database.
 {-# LANGUAGE RankNTypes             #-}
 {-# LANGUAGE TemplateHaskell        #-}
 
-module Gargantext.Database.Schema.Ngrams where
+module Gargantext.Database.Admin.Schema.Ngrams where
 
 import Control.Lens (makeLenses, over)
 import Control.Monad (mzero)

src/Gargantext/Database/Schema/NodeNgrams.hs → src/Gargantext/Database/Admin/Schema/NodeNgrams.hs

@@ -25,7 +25,7 @@ NodeNgrams register Context of Ngrams (named Cgrams then)
 {-# LANGUAGE RankNTypes             #-}
 {-# LANGUAGE TemplateHaskell        #-}
 
-module Gargantext.Database.Schema.NodeNgrams where
+module Gargantext.Database.Admin.Schema.NodeNgrams where
 
 import Data.Map (Map)
 import qualified Data.Map as Map

src/Gargantext/Database/Schema/NodeNode.hs → src/Gargantext/Database/Admin/Schema/NodeNode.hs

@@ -24,7 +24,7 @@ commentary with @some markup@.
 {-# LANGUAGE RankNTypes             #-}
 {-# LANGUAGE TemplateHaskell        #-}
 
-module Gargantext.Database.Schema.NodeNode where
+module Gargantext.Database.Admin.Schema.NodeNode where
 
 import Control.Lens (view, (^.))
 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
@@ -34,7 +34,7 @@ import Control.Lens.TH (makeLenses)
 import Data.Maybe (Maybe, catMaybes)
 import Data.Text (Text, splitOn)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
-import Gargantext.Database.Schema.Node 
+import Gargantext.Database.Tools.Node (pgNodeId)
 import Gargantext.Core.Types
 import Gargantext.Database.Utils
 import Gargantext.Database.Config (nodeTypeId)

src/Gargantext/Database/Schema/NodeNodeNgrams.hs → src/Gargantext/Database/Admin/Schema/NodeNodeNgrams.hs

@@ -20,7 +20,7 @@ Portability : POSIX
 {-# LANGUAGE RankNTypes             #-}
 {-# LANGUAGE TemplateHaskell        #-}
 
-module Gargantext.Database.Schema.NodeNodeNgrams
+module Gargantext.Database.Admin.Schema.NodeNodeNgrams
   where
 
 import Prelude
@@ -28,7 +28,7 @@ import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 import Control.Lens.TH (makeLenses)
 import Gargantext.Database.Utils (Cmd, mkCmd)
 import Gargantext.Database.Schema.Ngrams (NgramsTypeId, pgNgramsTypeId, NgramsId)
-import Gargantext.Database.Schema.Node (pgNodeId)
+import Gargantext.Database.Tools.Node (pgNodeId)
 import Gargantext.Database.Types.Node
 import Opaleye
 

src/Gargantext/Database/Schema/NodeNodeNgrams2.hs → src/Gargantext/Database/Admin/Schema/NodeNodeNgrams2.hs

@@ -20,7 +20,7 @@ Portability : POSIX
 {-# LANGUAGE RankNTypes             #-}
 {-# LANGUAGE TemplateHaskell        #-}
 
-module Gargantext.Database.Schema.NodeNodeNgrams2
+module Gargantext.Database.Admin.Schema.NodeNodeNgrams2
   where
 
 import Prelude
@@ -28,7 +28,7 @@ import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 import Control.Lens.TH (makeLenses)
 import Gargantext.Database.Utils (Cmd, mkCmd)
 import Gargantext.Database.Schema.NodeNgrams (NodeNgramsId)
-import Gargantext.Database.Schema.Node (pgNodeId)
+import Gargantext.Database.Tools.Node (pgNodeId)
 import Gargantext.Database.Types.Node
 import Opaleye
 

src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs → src/Gargantext/Database/Admin/Schema/Node_NodeNgramsNodeNgrams.hs

@@ -33,7 +33,7 @@ Next Step benchmark:
 {-# LANGUAGE TemplateHaskell        #-}
 {-# OPTIONS_GHC -fno-warn-orphans   #-}
 
-module Gargantext.Database.Schema.Node_NodeNgramsNodeNgrams
+module Gargantext.Database.Admin.Schema.Node_NodeNgramsNodeNgrams
   where
 
 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
@@ -41,7 +41,7 @@ import Data.Maybe (Maybe)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 import Gargantext.Database.Utils (Cmd, runOpaQuery, mkCmd)
 import Gargantext.Database.Types.Node (CorpusId)
-import Gargantext.Database.Schema.Node (pgNodeId)
+import Gargantext.Database.Tools.Node (pgNodeId)
 import Gargantext.Prelude
 import Opaleye
 

src/Gargantext/Database/Schema/NodesNgramsRepo.hs → src/Gargantext/Database/Admin/Schema/NodesNgramsRepo.hs

@@ -25,7 +25,8 @@ Portability : POSIX
 {-# LANGUAGE TemplateHaskell            #-}
 
 
-module Gargantext.Database.Schema.NodesNgramsRepo where
+module Gargantext.Database.Admin.Schema.NodesNgramsRepo
+  where
 
 import Control.Arrow (returnA)
 import Control.Lens.TH (makeLenses)

src/Gargantext/Database/Schema/User.hs → src/Gargantext/Database/Admin/Schema/User.hs

@@ -23,7 +23,7 @@ Functions to deal with users, database side.
 {-# LANGUAGE OverloadedStrings           #-}
 {-# LANGUAGE RankNTypes                  #-}
 
-module Gargantext.Database.Schema.User where
+module Gargantext.Database.Admin.Schema.User where
 
 import Control.Arrow (returnA)
 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
@@ -113,79 +113,3 @@ userTable = Table "auth_user" (pUserDB UserDB { user_id      = optional "id"
                                           }
                               )
 
--- TODO: on conflict, nice message
-insertUsers :: [UserWrite] -> Cmd err Int64
-insertUsers us = mkCmd $ \c -> runInsert_ c insert
-  where
-    insert = Insert userTable us rCount Nothing
-
-
-gargantextUser :: Username -> UserWrite
-gargantextUser u = UserDB (Nothing) (pgStrictText "password")
-                         (Nothing) (pgBool True) (pgStrictText u)
-                         (pgStrictText "first_name")
-                         (pgStrictText "last_name")
-                         (pgStrictText "e@mail")
-                         (pgBool True) (pgBool True) (Nothing)
-
-insertUsersDemo :: Cmd err Int64
-insertUsersDemo = insertUsers $ map (\u -> gargantextUser u) arbitraryUsername
-
-------------------------------------------------------------------
-queryUserTable :: Query UserRead
-queryUserTable = queryTable userTable
-
-selectUsersLight :: Query UserRead
-selectUsersLight = proc () -> do
-      row@(UserDB i _p _ll _is _un _fn _ln _m _iff _ive _dj) <- queryUserTable -< ()
-      restrict -< i .== 1
-      --returnA -< User i p ll is un fn ln m iff ive dj
-      returnA -< row
-------------------------------------------------------------------
--- | Select User with some parameters
--- Not optimized version
-userWith :: (Eq a1, Foldable t) => (a -> a1) -> a1 -> t a -> Maybe a
-userWith f t xs = find (\x -> f x == t) xs
-
--- | Select User with Username
-userWithUsername :: Text -> [UserDB] -> Maybe UserDB
-userWithUsername t xs = userWith user_username t xs
-
-userWithId :: Int -> [UserDB] -> Maybe UserDB
-userWithId t xs = userWith user_id t xs
-
-userLightWithUsername :: Text -> [UserLight] -> Maybe UserLight
-userLightWithUsername t xs = userWith userLight_username t xs
-
-userLightWithId :: Int -> [UserLight] -> Maybe UserLight
-userLightWithId t xs = userWith userLight_id t xs
-
-
-instance QueryRunnerColumnDefault PGTimestamptz (Maybe UTCTime) where
-  queryRunnerColumnDefault = fieldQueryRunnerColumn
-
-
-users :: Cmd err [UserDB]
-users = runOpaQuery queryUserTable
-
-usersLight :: Cmd err [UserLight]
-usersLight = map toUserLight <$> users
-
-getUser :: Username -> Cmd err (Maybe UserLight)
-getUser u = userLightWithUsername u <$> usersLight
-
-
-getUserId :: HasNodeError err
-          => User
-          -> Cmd err UserId
-getUserId (UserDBId uid) = pure uid
-getUserId (RootId   rid) = do
-  n <- getNode rid
-  pure $ _node_userId n
-getUserId (UserName u  ) = do
-  muser <- getUser u
-  case muser of
-    Just user -> pure $ userLight_id user
-    Nothing   -> nodeError NoUserFound
-
-

src/Gargantext/Database/Init.hs → src/Gargantext/Database/Admin/Trigger/Init.hs

@@ -17,7 +17,7 @@ Ngrams by node enable contextual metrics.
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes        #-}
 
-module Gargantext.Database.Init
+module Gargantext.Database.Admin.Trigger.Init
   where
 
 -- import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))

src/Gargantext/Database/Triggers/NodeNodeNgrams.hs → src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs

@@ -17,7 +17,7 @@ Triggers on NodeNodeNgrams table.
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes        #-}
 
-module Gargantext.Database.Triggers.NodeNodeNgrams
+module Gargantext.Database.Admin.Trigger.NodeNodeNgrams
   where
 
 import Database.PostgreSQL.Simple.SqlQQ (sql)

src/Gargantext/Database/Triggers/Nodes.hs → src/Gargantext/Database/Admin/Trigger/Nodes.hs

 {-|
-Module      : Gargantext.Database.Triggers.Nodes
+Module      : Gargantext.Database.Admin.Trigger.Nodes
 Description : Triggers configuration
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -17,7 +17,7 @@ Triggers on Nodes table.
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes        #-}
 
-module Gargantext.Database.Triggers.Nodes
+module Gargantext.Database.Admin.Trigger.Nodes
   where
 
 import Database.PostgreSQL.Simple.SqlQQ (sql)

src/Gargantext/Database/Triggers/NodesNodes.hs → src/Gargantext/Database/Admin/Trigger/NodesNodes.hs

@@ -17,7 +17,7 @@ Triggers on NodesNodes table.
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes        #-}
 
-module Gargantext.Database.Triggers.NodesNodes
+module Gargantext.Database.Admin.Trigger.NodesNodes
   where
 
 import Database.PostgreSQL.Simple.SqlQQ (sql)

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

@@ -22,7 +22,7 @@ Portability : POSIX
 
 -- {-# LANGUAGE DuplicateRecordFields #-}
 
-module Gargantext.Database.Types.Node
+module Gargantext.Database.Admin.Types.Node
   where
 
 import Prelude (Enum, Bounded, minBound, maxBound)

src/Gargantext/Database/Utils.hs → src/Gargantext/Database/Admin/Utils.hs

@@ -19,7 +19,7 @@ commentary with @some markup@.
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RankNTypes                 #-}
 
-module Gargantext.Database.Utils where
+module Gargantext.Database.Admin.Utils where
 
 import Data.ByteString.Char8 (hPutStrLn)
 import System.IO (stderr)

src/Gargantext/Database/Facet.hs → src/Gargantext/Database/Query/Facet.hs

@@ -25,7 +25,7 @@ Portability : POSIX
 {-# LANGUAGE TemplateHaskell           #-}
 {-# LANGUAGE TypeFamilies              #-}
 ------------------------------------------------------------------------
-module Gargantext.Database.Facet
+module Gargantext.Database.Query.Facet
   ( runViewAuthorsDoc
   , runViewDocuments
   , filterWith
@@ -62,8 +62,8 @@ import Gargantext.Database.Schema.NodeNode
 import Gargantext.Database.Schema.NodeNodeNgrams
 -- import Gargantext.Database.Schema.NodeNodeNgrams2
 import Gargantext.Database.Utils
-import Gargantext.Database.Queries.Filter
-import Gargantext.Database.Queries.Join (leftJoin5)
+import Gargantext.Database.Query.Filter
+import Gargantext.Database.Query.Join (leftJoin5)
 import Opaleye
 import Prelude hiding (null, id, map, sum, not, read)
 import Servant.API

src/Gargantext/Database/Queries/Filter.hs → src/Gargantext/Database/Query/Filter.hs

 {-|
-Module      : Gargantext.Database.Queries.Filter
+Module      : Gargantext.Database.Query.Filter
 Description : Main requests of Node to the database
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -19,7 +19,7 @@ Portability : POSIX
 {-# LANGUAGE TemplateHaskell        #-}
 {-# OPTIONS_GHC -fno-warn-orphans   #-}
 
-module Gargantext.Database.Queries.Filter where
+module Gargantext.Database.Query.Filter where
 
 import Gargantext.Core.Types (Limit, Offset)
 import Data.Maybe (Maybe, maybe)

src/Gargantext/Database/Queries/Join.hs → src/Gargantext/Database/Query/Join.hs

 {-|
-Module      : Gargantext.Database.Queries.Join
+Module      : Gargantext.Database.Query.Join
 Description : Main Join queries (using Opaleye)
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -26,7 +26,7 @@ Multiple Join functions with Opaleye.
 {-# LANGUAGE OverloadedStrings         #-}
 {-# LANGUAGE TemplateHaskell           #-}
 ------------------------------------------------------------------------
-module Gargantext.Database.Queries.Join
+module Gargantext.Database.Query.Query.Join
   where
 ------------------------------------------------------------------------
 

src/Gargantext/Database/Ngrams.hs → src/Gargantext/Database/Query/Ngrams.hs

@@ -14,16 +14,16 @@ Portability : POSIX
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE RankNTypes        #-}
 
-module Gargantext.Database.Ngrams
+module Gargantext.Database.Query.Ngrams
     where
 
 import Data.Text (Text)
 import Control.Lens ((^.))
 import Gargantext.Core.Types
-import Gargantext.Database.Utils (runOpaQuery, Cmd)
-import Gargantext.Database.Schema.Ngrams
-import Gargantext.Database.Schema.NodeNodeNgrams
-import Gargantext.Database.Schema.Node
+import Gargantext.Database.Admin.Utils (runOpaQuery, Cmd)
+import Gargantext.Database.Admin.Schema.Ngrams
+import Gargantext.Database.Admin.Schema.NodeNodeNgrams
+import Gargantext.Database.Admin.Schema.Node
 import Gargantext.Prelude
 import Opaleye
 import Control.Arrow (returnA)

src/Gargantext/Database/Node/Children.hs → src/Gargantext/Database/Query/Node/Children.hs

@@ -16,18 +16,18 @@ Portability : POSIX
 {-# LANGUAGE FlexibleContexts       #-}
 {-# LANGUAGE RankNTypes             #-}
 
-module Gargantext.Database.Node.Children where
+module Gargantext.Database.Query.Node.Children where
 
 import Data.Proxy
 import Opaleye
 import Gargantext.Core.Types
-import Gargantext.Database.Schema.Node
-import Gargantext.Database.Utils
-import Gargantext.Database.Schema.NodeNode
-import Gargantext.Database.Config (nodeTypeId)
-import Gargantext.Database.Queries.Filter
-import Gargantext.Database.Node.Contact (HyperdataContact)
-import Gargantext.Database.Schema.Node (pgNodeId)
+import Gargantext.Database.Admin.Schema.Node
+import Gargantext.Database.Admin.Utils
+import Gargantext.Database.Admin.Schema.NodeNode
+import Gargantext.Database.Admin.Config (nodeTypeId)
+import Gargantext.Database.Query.Filter
+import Gargantext.Database.Query.Node.Contact (HyperdataContact)
+import Gargantext.Database.Admin.Schema.Node (pgNodeId)
 import Control.Arrow (returnA)
 
 getAllDocuments :: ParentId -> Cmd err (TableResult (Node HyperdataDocument))

src/Gargantext/Database/Node/Contact.hs → src/Gargantext/Database/Query/Node/Contact.hs

@@ -17,7 +17,7 @@ Portability : POSIX
 {-# LANGUAGE MultiParamTypeClasses  #-}
 {-# LANGUAGE TemplateHaskell        #-}
 
-module Gargantext.Database.Node.Contact
+module Gargantext.Database.Query.Node.Contact
   where
 
 import Control.Lens (makeLenses)

src/Gargantext/Database/Node/Document/Add.hs → src/Gargantext/Database/Query/Node/Document/Add.hs

@@ -21,9 +21,10 @@ Add Documents/Contact to a Corpus/Annuaire.
 {-# LANGUAGE QuasiQuotes          #-}
 {-# LANGUAGE RankNTypes           #-}
 {-# LANGUAGE TypeSynonymInstances #-}
-------------------------------------------------------------------------
-module Gargantext.Database.Node.Document.Add where
 
+------------------------------------------------------------------------
+module Gargantext.Database.Query.Node.Document.Add
+  where
 
 import Data.ByteString.Internal (ByteString)
 import Data.Typeable (Typeable)

src/Gargantext/Database/Node/Document/Insert.hs → src/Gargantext/Database/Query/Node/Document/Insert.hs

@@ -57,7 +57,7 @@ the concatenation of the parameters defined by @shaParameters@.
 {-# LANGUAGE RankNTypes           #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 ------------------------------------------------------------------------
-module Gargantext.Database.Node.Document.Insert where
+module Gargantext.Database.Query.Node.Document.Insert where
 
 import Control.Lens (set, view)
 import Control.Lens.Prism

src/Gargantext/Database/Node/Select.hs → src/Gargantext/Database/Query/Node/Select.hs

@@ -14,7 +14,8 @@ Portability : POSIX
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE RankNTypes        #-}
 
-module Gargantext.Database.Node.Select where
+module Gargantext.Database.Query.Node.Select
+  where
 
 import Opaleye
 import Gargantext.Core.Types

src/Gargantext/Database/Node/Update.hs → src/Gargantext/Database/Query/Node/Update.hs

@@ -16,7 +16,8 @@ Portability : POSIX
 {-# LANGUAGE RankNTypes        #-}
 
 
-module Gargantext.Database.Node.Update (Update(..), update) where
+module Gargantext.Database.Query.Node.Update (Update(..), update)
+  where
 
 import qualified Data.Text as DT
 import Database.PostgreSQL.Simple

src/Gargantext/Database/Node/UpdateOpaleye.hs → src/Gargantext/Database/Query/Node/UpdateOpaleye.hs

@@ -16,7 +16,7 @@ Portability : POSIX
 {-# LANGUAGE RankNTypes        #-}
 
 
-module Gargantext.Database.Node.UpdateOpaleye where
+module Gargantext.Database.Query.Node.UpdateOpaleye where
 
 
 import Opaleye

src/Gargantext/Database/Node/User.hs → src/Gargantext/Database/Query/Node/User.hs

@@ -17,7 +17,7 @@ Portability : POSIX
 {-# LANGUAGE MultiParamTypeClasses  #-}
 {-# LANGUAGE TemplateHaskell        #-}
 
-module Gargantext.Database.Node.User
+module Gargantext.Database.Query.Node.User
   where
 
 import Control.Lens (makeLenses)
@@ -31,6 +31,9 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Node.Contact (HyperdataContact, fake_HyperdataContact)
 import Gargantext.Database.Types.Node (Node,Hyperdata, DocumentId, NodeId(..))
 import Gargantext.Database.Utils (fromField')
+import Gargantext.Database.Tools.Node (getNode)
+import Gargantext.Database.Schema.Node (Node(..))
+import Gargantext.Core.Types.Individu (Username, arbitraryUsername, User(..), UserId)
 import Gargantext.Prelude
 import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
 import Test.QuickCheck (elements)
@@ -126,5 +129,32 @@ $(deriveJSON (unPrefix "_hpr_") ''HyperdataPrivate)
 $(deriveJSON (unPrefix "_hpu_") ''HyperdataPublic)
 
 
+-----------------------------------------------------------------
+getUserId :: HasNodeError err
+          => User
+          -> Cmd err UserId
+getUserId (UserDBId uid) = pure uid
+getUserId (RootId   rid) = do
+  n <- getNode rid
+  pure $ _node_userId n
+getUserId (UserName u  ) = do
+  muser <- getUser u
+  case muser of
+    Just user -> pure $ userLight_id user
+    Nothing   -> nodeError NoUserFound
+
+
+getNodeUser :: NodeId -> Cmd err (Node HyperdataUser)
+getNodeUser nId = do
+    fromMaybe (error $ "Node does not exist: " <> show nId) . headMay
+             <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
+
+
+nodeUserW :: Maybe Name -> Maybe HyperdataUser -> UserId -> NodeWrite
+nodeUserW maybeName maybeHyperdata = node NodeUser name user Nothing
+  where
+    name = maybe "User" identity maybeName
+    user = maybe fake_HyperdataUser identity maybeHyperdata
+
 
 

src/Gargantext/Database/Root.hs

-{-|
-Module      : Gargantext.Database.Root
-Description : Main requests to get root of users
-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 GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE MultiParamTypeClasses  #-}
-{-# LANGUAGE NoImplicitPrelude      #-}
-{-# LANGUAGE RankNTypes             #-}
-{-# LANGUAGE TemplateHaskell        #-}
-
-module Gargantext.Database.Root where
-
-import Control.Arrow (returnA)
-import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Database.Config (nodeTypeId)
-import Gargantext.Database.Node.User (HyperdataUser)
-import Gargantext.Database.Schema.Node (NodeRead)
-import Gargantext.Database.Schema.Node (queryNodeTable)
-import Gargantext.Database.Schema.User (queryUserTable, UserPoly(..))
-import Gargantext.Database.Types.Node (Node, NodePoly(..), NodeType(NodeUser))
-import Gargantext.Database.Utils (Cmd, runOpaQuery)
-import Gargantext.Prelude
-import Opaleye (restrict, (.==), Query)
-import Opaleye.PGTypes (pgStrictText, pgInt4)
-
-getRoot :: User -> Cmd err [Node HyperdataUser]
-getRoot = runOpaQuery . selectRoot
-
-selectRoot :: User -> Query NodeRead
-selectRoot (UserName username) = proc () -> do
-    row   <- queryNodeTable -< ()
-    users <- queryUserTable -< ()
-    restrict -< _node_typename row   .== (pgInt4 $ nodeTypeId NodeUser)
-    restrict -< user_username  users .== (pgStrictText username)
-    restrict -< _node_userId   row   .== (user_id users)
-    returnA  -< row
-
-selectRoot (UserDBId uid) = proc () -> do
-    row   <- queryNodeTable -< ()
-    restrict -< _node_typename row   .== (pgInt4 $ nodeTypeId NodeUser)
-    restrict -< _node_userId   row   .== (pgInt4 uid)
-    returnA  -< row
-
-
-
-
-
-
-

src/Gargantext/Database/Tree.hs

-{-|
-Module      : Gargantext.Database.Tree
-Description : Tree of Resource Nodes built from Database
-Copyright   : (c) CNRS, 2017-Present
-License     : AGPL + CECILL v3
-Maintainer  : team@gargantext.org
-Stability   : experimental
-Portability : POSIX
-
-Let a Root Node, return the Tree of the Node as a directed acyclic graph
-(Tree).
-
--}
-
-{-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE RankNTypes        #-}
-
-module Gargantext.Database.Tree
-  ( treeDB
-  , TreeError(..)
-  , HasTreeError(..)
-  , dbTree
-  , toNodeTree
-  , DbTreeNode
-  , isDescendantOf
-  , isIn
-  ) where
-
-import Control.Lens (Prism', (#), (^..), at, each, _Just, to)
-import Control.Monad.Error.Class (MonadError(throwError))
-import Data.Map (Map, fromListWith, lookup)
-import Data.Text (Text)
-import Database.PostgreSQL.Simple
-import Database.PostgreSQL.Simple.SqlQQ
-
-import Gargantext.Prelude
-import Gargantext.Core.Types.Main (NodeTree(..), Tree(..))
-import Gargantext.Database.Config (fromNodeTypeId, nodeTypeId)
-import Gargantext.Database.Types.Node (NodeId, NodeType, DocId, allNodeTypes)
-import Gargantext.Database.Utils (Cmd, runPGSQuery)
-------------------------------------------------------------------------
--- import Gargantext.Database.Utils (runCmdDev)
--- treeTest :: IO (Tree NodeTree)
--- treeTest = runCmdDev $ treeDB 347474
-------------------------------------------------------------------------
-
-data TreeError = NoRoot | EmptyRoot | TooManyRoots
-  deriving (Show)
-
-class HasTreeError e where
-  _TreeError :: Prism' e TreeError
-
-treeError :: (MonadError e m, HasTreeError e) => TreeError -> m a
-treeError te = throwError $ _TreeError # te
-
--- | Returns the Tree of Nodes in Database
-treeDB :: HasTreeError err => RootId -> [NodeType] -> Cmd err (Tree NodeTree)
-treeDB r nodeTypes = toTree =<< (toTreeParent <$> dbTree r nodeTypes)
-
-type RootId = NodeId
-type ParentId = NodeId
-------------------------------------------------------------------------
-toTree :: (MonadError e m, HasTreeError e)
-       => Map (Maybe ParentId) [DbTreeNode] -> m (Tree NodeTree)
-toTree m =
-    case lookup Nothing m of
-        Just [n] -> pure $ toTree' m n
-        Nothing  -> treeError NoRoot
-        Just []  -> treeError EmptyRoot
-        Just _   -> treeError TooManyRoots
-
-toTree' :: Map (Maybe ParentId) [DbTreeNode] -> DbTreeNode -> Tree NodeTree
-toTree' m n =
-  TreeN (toNodeTree n) $
-    m ^.. at (Just $ dt_nodeId n) . _Just . each . to (toTree' m)
-
-------------------------------------------------------------------------
-toNodeTree :: DbTreeNode -> NodeTree
-toNodeTree (DbTreeNode nId tId _ n) = NodeTree n nodeType nId
-  where
-    nodeType = fromNodeTypeId tId
-------------------------------------------------------------------------
-toTreeParent :: [DbTreeNode] -> Map (Maybe ParentId) [DbTreeNode]
-toTreeParent = fromListWith (<>) . map (\n -> (dt_parentId n, [n]))
-------------------------------------------------------------------------
-data DbTreeNode = DbTreeNode { dt_nodeId :: NodeId
-                             , dt_typeId :: Int
-                             , dt_parentId :: Maybe NodeId
-                             , dt_name     :: Text
-                             } deriving (Show)
-
--- | Main DB Tree function
--- TODO add typenames as parameters
-dbTree :: RootId -> [NodeType] -> Cmd err [DbTreeNode]
-dbTree rootId nodeTypes = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n)
-  <$> runPGSQuery [sql|
-    WITH RECURSIVE
-        tree (id, typename, parent_id, name) AS
-        (
-          SELECT p.id, p.typename, p.parent_id, p.name
-          FROM nodes AS p
-          WHERE p.id = ?
-
-          UNION
-
-          SELECT c.id, c.typename, c.parent_id, c.name
-          FROM nodes AS c
-
-          INNER JOIN tree AS s ON c.parent_id = s.id
-           WHERE c.typename IN ?
-        )
-    SELECT * from tree;
-    |] (rootId, In typename)
-  where
-    typename = map nodeTypeId ns
-    ns = case nodeTypes of
-      [] -> allNodeTypes
-      -- [2, 20, 21, 22, 3, 5, 30, 31, 40, 7, 9, 90, 71]
-      _  -> nodeTypes
-
-isDescendantOf :: NodeId -> RootId -> Cmd err Bool
-isDescendantOf childId rootId = (== [Only True])
-  <$> runPGSQuery [sql|
-                  BEGIN ;
-                  SET TRANSACTION READ ONLY;
-                  COMMIT;
-
-                  WITH RECURSIVE
-      tree (id, parent_id) AS
-      (
-        SELECT c.id, c.parent_id
-        FROM nodes AS c
-        WHERE c.id = ?
-
-        UNION
-
-        SELECT p.id, p.parent_id
-        FROM nodes AS p
-        INNER JOIN tree AS t ON t.parent_id = p.id
-
-      )
-  SELECT COUNT(*) = 1 from tree AS t
-  WHERE t.id = ?;
-  |] (childId, rootId)
-
--- TODO should we check the category?
-isIn :: NodeId -> DocId -> Cmd err Bool
-isIn cId docId = ( == [Only True])
-  <$> runPGSQuery [sql| SELECT COUNT(*) = 1
-    FROM nodes_nodes nn
-      WHERE nn.node1_id = ?
-        AND nn.node2_id = ?;
-  |] (cId, docId)
-
-