[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/Node.hs → src/Gargantext/Database/Admin/Schema/Node.hs

@@ -39,9 +39,7 @@ import Gargantext.Core.Types
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Node.Contact (HyperdataContact(..), arbitraryHyperdataContact)
-import Gargantext.Database.Node.User (HyperdataUser(..), fake_HyperdataUser)
-import Gargantext.Database.Queries.Filter (limit', offset')
-import Gargantext.Database.Schema.User (getUserId)
+import Gargantext.Database.Query.Filter (limit', offset')
 import Gargantext.Database.Types.Errors
 import Gargantext.Database.Types.Node (NodeType(..), defaultCorpus, Hyperdata, HyperData(..))
 import Gargantext.Database.Utils
@@ -251,500 +249,3 @@ nodeTableSearch = Table "nodes" (pNodeSearch NodeSearch { _ns_id         = optio
                             )
 
 
-queryNodeSearchTable :: Query NodeSearchRead
-queryNodeSearchTable = queryTable nodeTableSearch
-
-selectNode :: Column PGInt4 -> Query NodeRead
-selectNode id = proc () -> do
-    row <- queryNodeTable -< ()
-    restrict -< _node_id row .== id
-    returnA -< row
-
-
-
-runGetNodes :: Query NodeRead -> Cmd err [Node HyperdataAny]
-runGetNodes = runOpaQuery
-
-------------------------------------------------------------------------
-------------------------------------------------------------------------
--- | order by publication date
--- Favorites (Bool), node_ngrams
-selectNodesWith :: ParentId     -> Maybe NodeType
-                -> Maybe Offset -> Maybe Limit   -> Query NodeRead
-selectNodesWith parentId maybeNodeType maybeOffset maybeLimit = 
-        --offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
-  limit' maybeLimit $ offset' maybeOffset
-                    $ orderBy (asc _node_id)
-                    $ selectNodesWith' parentId maybeNodeType
-
-selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
-selectNodesWith' parentId maybeNodeType = proc () -> do
-    node <- (proc () -> do
-      row@(Node _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
-      restrict -< parentId' .== (pgNodeId parentId)
-
-      let typeId' = maybe 0 nodeTypeId maybeNodeType
-
-      restrict -< if typeId' > 0
-                     then typeId   .== (pgInt4 (typeId' :: Int))
-                     else (pgBool True)
-      returnA  -< row ) -< ()
-    returnA -< node
-
-deleteNode :: NodeId -> Cmd err Int
-deleteNode n = mkCmd $ \conn ->
-  fromIntegral <$> runDelete conn nodeTable
-                 (\(Node n_id _ _ _ _ _ _) -> n_id .== pgNodeId n)
-
-deleteNodes :: [NodeId] -> Cmd err Int
-deleteNodes ns = mkCmd $ \conn ->
-  fromIntegral <$> runDelete conn nodeTable
-                   (\(Node n_id _ _ _ _ _ _) -> in_ ((map pgNodeId ns)) n_id)
-
--- TODO: NodeType should match with `a'
-getNodesWith :: JSONB a => NodeId -> proxy a -> Maybe NodeType
-             -> Maybe Offset -> Maybe Limit -> Cmd err [Node a]
-getNodesWith parentId _ nodeType maybeOffset maybeLimit =
-    runOpaQuery $ selectNodesWith parentId nodeType maybeOffset maybeLimit
-
--- TODO: Why is the second parameter ignored?
--- TODO: Why not use getNodesWith?
-getNodesWithParentId :: (Hyperdata a, QueryRunnerColumnDefault PGJsonb a)
-                     => Maybe NodeId
-                     -> Cmd err [Node a]
-getNodesWithParentId n = runOpaQuery $ selectNodesWithParentID n'
-  where
-    n' = case n of
-      Just n'' -> n''
-      Nothing  -> 0
-
-------------------------------------------------------------------------
-getDocumentsV3WithParentId :: NodeId -> Cmd err [Node HyperdataDocumentV3]
-getDocumentsV3WithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocument)
-
--- TODO: merge with getDocumentsWithParentId by having a class IsHyperdataDocument
-getDocumentsWithParentId :: NodeId -> Cmd err [Node HyperdataDocument]
-getDocumentsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocument)
-
-getListsModelWithParentId :: NodeId -> Cmd err [Node HyperdataListModel]
-getListsModelWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeListModel)
-
-getCorporaWithParentId :: NodeId -> Cmd err [Node HyperdataCorpus]
-getCorporaWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeCorpus)
-
-------------------------------------------------------------------------
-selectNodesWithParentID :: NodeId -> Query NodeRead
-selectNodesWithParentID n = proc () -> do
-    row@(Node _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
-    restrict -< parent_id .== (pgNodeId n)
-    returnA -< row
-
-selectNodesWithType :: Column PGInt4 -> Query NodeRead
-selectNodesWithType type_id = proc () -> do
-    row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
-    restrict -< tn .== type_id
-    returnA -< row
-
-type JSONB = QueryRunnerColumnDefault PGJsonb
-
-
-getNode :: NodeId -> Cmd err (Node Value)
-getNode nId = fromMaybe (error $ "Node does not exist: " <> show nId) . headMay
-             <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
-
-getNodeWith :: JSONB a => NodeId -> proxy a -> Cmd err (Node a)
-getNodeWith nId _ = do
-    fromMaybe (error $ "Node does not exist: " <> show nId) . headMay
-             <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
-
-getNodeUser :: NodeId -> Cmd err (Node HyperdataUser)
-getNodeUser nId = do
-    fromMaybe (error $ "Node does not exist: " <> show nId) . headMay
-             <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
-
-
-getNodePhylo :: NodeId -> Cmd err (Node HyperdataPhylo)
-getNodePhylo nId = do
-    fromMaybe (error $ "Node Phylo does not exist: " <> show nId) . headMay
-             <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
-
-
-getNodesWithType :: Column PGInt4 -> Cmd err [Node HyperdataDocument]
-getNodesWithType = runOpaQuery . selectNodesWithType
-
-------------------------------------------------------------------------
-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
-
-nodeContactW :: Maybe Name -> Maybe HyperdataContact
-             -> AnnuaireId -> UserId -> NodeWrite
-nodeContactW maybeName maybeContact aId = 
-  node NodeContact name contact (Just aId)
-    where
-      name    = maybe "Contact" identity maybeName
-      contact = maybe arbitraryHyperdataContact identity maybeContact
-------------------------------------------------------------------------
-defaultFolder :: HyperdataCorpus
-defaultFolder = defaultCorpus
-
-nodeFolderW :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> NodeWrite
-nodeFolderW maybeName maybeFolder pid = node NodeFolder name folder (Just pid)
-  where
-    name   = maybe "Folder" identity maybeName
-    folder = maybe defaultFolder identity maybeFolder
-------------------------------------------------------------------------
-nodeCorpusW :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> NodeWrite
-nodeCorpusW maybeName maybeCorpus pId = node NodeCorpus name corpus (Just pId)
-  where
-    name   = maybe "Corpus" identity maybeName
-    corpus = maybe defaultCorpus identity maybeCorpus
-                   --------------------------
-defaultDocument :: HyperdataDocument
-defaultDocument = hyperdataDocument
-
-nodeDocumentW :: Maybe Name -> Maybe HyperdataDocument -> CorpusId -> UserId -> NodeWrite
-nodeDocumentW maybeName maybeDocument cId = node NodeDocument name doc (Just cId)
-  where
-    name = maybe "Document" identity maybeName
-    doc  = maybe defaultDocument identity maybeDocument
-------------------------------------------------------------------------
-defaultAnnuaire :: HyperdataAnnuaire
-defaultAnnuaire = HyperdataAnnuaire (Just "Title") (Just "Description")
-
-nodeAnnuaireW :: Maybe Name -> Maybe HyperdataAnnuaire -> ParentId -> UserId -> NodeWrite
-nodeAnnuaireW maybeName maybeAnnuaire pId = node NodeAnnuaire name annuaire (Just pId)
-  where
-    name     = maybe "Annuaire" identity maybeName
-    annuaire = maybe defaultAnnuaire identity maybeAnnuaire
-
-------------------------------------------------------------------------
-
-{-
-class IsNodeDb a where
-  data Node'' a :: *
-  data Hyper  a :: *
-
-instance IsNodeDb NodeType where
-  data 
-
-instance HasHyperdata NodeType where
-  data Hyper NodeType = HyperList   HyperdataList
-                      | HyperCorpus HyperdataCorpus
-
-  hasHyperdata nt = case nt of
-    NodeList   -> HyperList $ HyperdataList (Just "list")
-
-  unHyper h = case h of
-    HyperList h' -> h'
-
---}
-
-
-class HasDefault a where
-  hasDefaultData :: a -> HyperData
-  hasDefaultName :: a -> Text
-
-instance HasDefault NodeType where
-  hasDefaultData nt = case nt of
-      NodeTexts -> HyperdataTexts (Just "Preferences")
-      NodeList  -> HyperdataList' (Just "Preferences")
-      NodeListCooc -> HyperdataList' (Just "Preferences")
-      _         -> undefined
-      --NodeAnnuaire -> HyperdataAnnuaire (Just "Title") (Just "Description")
-
-  hasDefaultName nt = case nt of
-      NodeTexts -> "Texts"
-      NodeList  -> "Lists"
-      NodeListCooc -> "Cooc"
-      _         -> undefined
-
-------------------------------------------------------------------------
-
-nodeDefault :: NodeType -> ParentId -> UserId -> NodeWrite
-nodeDefault nt parent = node nt name hyper (Just parent)
-  where
-    name  = (hasDefaultName nt)
-    hyper = (hasDefaultData nt)
-
-------------------------------------------------------------------------
-arbitraryListModel :: HyperdataListModel
-arbitraryListModel = HyperdataListModel (400,500) "data/models/test.model" (Just 0.83)
-
-mkListModelNode :: HasNodeError err => ParentId -> UserId -> Cmd err [NodeId]
-mkListModelNode p u = insertNodesR [nodeListModelW Nothing Nothing p u]
-
-nodeListModelW :: Maybe Name -> Maybe HyperdataListModel -> ParentId -> UserId -> NodeWrite
-nodeListModelW maybeName maybeListModel pId = node NodeListModel name list (Just pId)
-  where
-    name = maybe "List Model" identity maybeName
-    list = maybe arbitraryListModel identity maybeListModel
-
-------------------------------------------------------------------------
-arbitraryGraph :: HyperdataGraph
-arbitraryGraph = HyperdataGraph Nothing
-
-nodeGraphW :: Maybe Name -> Maybe HyperdataGraph -> ParentId -> UserId -> NodeWrite
-nodeGraphW maybeName maybeGraph pId = node NodeGraph name graph (Just pId)
-  where
-    name = maybe "Graph" identity maybeName
-    graph = maybe arbitraryGraph identity maybeGraph
-
-mkGraph :: ParentId -> UserId -> Cmd err [GraphId]
-mkGraph p u = insertNodesR [nodeGraphW Nothing Nothing p u]
-
-insertGraph :: ParentId -> UserId -> HyperdataGraph -> Cmd err [GraphId]
-insertGraph p u h = insertNodesR [nodeGraphW Nothing (Just h) p u]
-
-------------------------------------------------------------------------
-arbitraryPhylo :: HyperdataPhylo
-arbitraryPhylo = HyperdataPhylo Nothing Nothing
-
-nodePhyloW :: Maybe Name -> Maybe HyperdataPhylo -> ParentId -> UserId -> NodeWrite
-nodePhyloW maybeName maybePhylo pId = node NodePhylo name graph (Just pId)
-  where
-    name = maybe "Phylo" identity maybeName
-    graph = maybe arbitraryPhylo identity maybePhylo
-
-
-------------------------------------------------------------------------
-arbitraryDashboard :: HyperdataDashboard
-arbitraryDashboard = HyperdataDashboard (Just "Preferences") []
-------------------------------------------------------------------------
-
-node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite
-node nodeType name hyperData parentId userId =
-  Node Nothing 
-       (pgInt4 typeId)
-       (pgInt4 userId)
-       (pgNodeId <$> parentId)
-       (pgStrictText name)
-       Nothing
-       (pgJSONB $ cs $ encode hyperData)
-    where
-      typeId = nodeTypeId nodeType
-
-                  -------------------------------
-insertNodes :: [NodeWrite] -> Cmd err Int64
-insertNodes ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns rCount Nothing
-
-insertNodesR :: [NodeWrite] -> Cmd err [NodeId]
-insertNodesR ns = mkCmd $ \conn ->
-  runInsert_ conn (Insert nodeTable ns (rReturning (\(Node i _ _ _ _ _ _) -> i)) Nothing)
-
-insertNodesWithParent :: Maybe ParentId -> [NodeWrite] -> Cmd err Int64
-insertNodesWithParent pid ns = insertNodes (set node_parentId (pgNodeId <$> pid) <$> ns)
-
-insertNodesWithParentR :: Maybe ParentId -> [NodeWrite] -> Cmd err [NodeId]
-insertNodesWithParentR pid ns = insertNodesR (set node_parentId (pgNodeId <$> pid) <$> ns)
-------------------------------------------------------------------------
--- TODO Hierachy of Nodes
--- post and get same types Node' and update if changes
-
-{- TODO semantic to achieve
-post c uid pid [ Node' NodeCorpus "name" "{}" []
-               , Node' NodeFolder "name" "{}" [Node' NodeCorpus "test 2" "" [ Node' NodeDocument "title" "metaData" []
-                                                                    , Node' NodeDocument "title" "jsonData" []
-                                                                    ]
-                                          ]
-               ]
--}
-------------------------------------------------------------------------
-
--- TODO
--- currently this function removes the child relation
--- needs a Temporary type between Node' and NodeWriteT
-node2table :: UserId -> Maybe ParentId -> Node' -> NodeWrite
-node2table uid pid (Node' nt txt v []) = Node Nothing (pgInt4 $ nodeTypeId nt) (pgInt4 uid) (fmap pgNodeId pid) (pgStrictText txt) Nothing (pgStrictJSONB $ cs $ encode v)
-node2table _ _ (Node' _ _ _ _) = panic "node2table: should not happen, Tree insert not implemented yet"
-
-
-data Node' = Node' { _n_type :: NodeType
-                   , _n_name :: Text
-                   , _n_data :: Value
-                   , _n_children :: [Node']
-                   } deriving (Show)
-
-mkNodes :: [NodeWrite] -> Cmd err Int64
-mkNodes ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns rCount Nothing
-
-mkNodeR :: [NodeWrite] -> Cmd err [NodeId]
-mkNodeR ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns (rReturning _node_id) Nothing
-
-------------------------------------------------------------------------
-
-data NewNode = NewNode { _newNodeId :: NodeId
-                       , _newNodeChildren :: [NodeId] }
-
-postNode :: HasNodeError err => UserId -> Maybe ParentId -> Node' -> Cmd err NewNode
-
-postNode uid pid (Node' nt txt v []) = do
-  pids <- mkNodeR [node2table uid pid (Node' nt txt v [])]
-  case pids of
-    [pid'] -> pure $ NewNode pid' []
-    _ -> nodeError ManyParents
-
-postNode uid pid (Node' NodeCorpus txt v ns) = do
-  NewNode pid' _ <- postNode uid pid (Node' NodeCorpus txt v [])
-  pids  <- mkNodeR (concat $ map (\n -> [childWith uid pid' n]) ns)
-  pure $ NewNode pid' pids
-
-postNode uid pid (Node' NodeAnnuaire txt v ns) = do
-  NewNode pid' _ <- postNode uid pid (Node' NodeAnnuaire txt v [])
-  pids  <- mkNodeR (concat $ map (\n -> [childWith uid pid' n]) ns)
-  pure $ NewNode pid' pids
-
-postNode uid pid (Node' NodeDashboard txt v ns) = do
-  NewNode pid' _ <- postNode uid pid (Node' NodeDashboard txt v [])
-  pids  <- mkNodeR (concat $ map (\n -> [childWith uid pid' n]) ns)
-  pure $ NewNode pid' pids
-
-postNode _ _ (Node' _ _ _ _) = nodeError NotImplYet
-
-
-childWith :: UserId -> ParentId -> Node' -> NodeWrite
-childWith uId pId (Node' NodeDocument txt v []) = node2table uId (Just pId) (Node' NodeDocument txt v [])
-childWith uId pId (Node' NodeContact  txt v []) = node2table uId (Just pId) (Node' NodeContact txt v [])
-childWith _   _   (Node' _        _   _ _) = panic "This NodeType can not be a child"
-
-
--- =================================================================== --
-------------------------------------------------------------------------
--- | TODO mk all others nodes
-mkNodeWithParent :: HasNodeError err
-                 => NodeType
-                 -> Maybe ParentId
-                 -> UserId
-                 -> Name
-                 -> Cmd err [NodeId]
-mkNodeWithParent NodeUser (Just _) _   _    = nodeError UserNoParent
-
-------------------------------------------------------------------------
-mkNodeWithParent NodeUser Nothing uId name =
-  insertNodesWithParentR Nothing [node NodeUser name fake_HyperdataUser Nothing uId]
-
-mkNodeWithParent _ Nothing _ _ = nodeError HasParent
-------------------------------------------------------------------------
-mkNodeWithParent NodeFolder (Just i) uId name =
-   insertNodesWithParentR (Just i) [node NodeFolder name hd Nothing uId]
-    where
-      hd = defaultFolder
-
-mkNodeWithParent NodeFolderPrivate (Just i) uId _ =
-   insertNodesWithParentR (Just i) [node NodeFolderPrivate "Private" hd Nothing uId]
-    where
-      hd = defaultFolder
-
-mkNodeWithParent NodeFolderShared (Just i) uId _ =
-   insertNodesWithParentR (Just i) [node NodeFolderShared "Shared" hd Nothing uId]
-    where
-      hd = defaultFolder
-
-mkNodeWithParent NodeFolderPublic (Just i) uId _ =
-   insertNodesWithParentR (Just i) [node NodeFolderPublic "Public" hd Nothing uId]
-    where
-      hd = defaultFolder
-
-mkNodeWithParent NodeTeam (Just i) uId _ =
-   insertNodesWithParentR (Just i) [node NodeTeam "Team" hd Nothing uId]
-    where
-      hd = defaultFolder
-------------------------------------------------------------------------
-mkNodeWithParent NodeCorpus (Just i) uId name =
-   insertNodesWithParentR (Just i) [node NodeCorpus name hd Nothing uId]
-    where
-      hd = defaultCorpus
-
-mkNodeWithParent NodeAnnuaire (Just i) uId name =
-   insertNodesWithParentR (Just i) [node NodeAnnuaire name hd Nothing uId]
-    where
-      hd = defaultAnnuaire
-
-mkNodeWithParent _ _ _ _       = nodeError NotImplYet
-------------------------------------------------------------------------
--- =================================================================== --
-
-mkRoot :: HasNodeError err
-       => User
-       -> Cmd err [RootId]
-mkRoot user = do
-
-  uid <- getUserId user
-
-  let una = "username"
-
-  case uid > 0 of
-     False -> nodeError NegativeId
-     True  -> do
-       rs <- mkNodeWithParent NodeUser Nothing uid una
-       _ <- case rs of
-         [r] -> do
-           _ <- mkNodeWithParent NodeFolderPrivate (Just r) uid una
-           _ <- mkNodeWithParent NodeFolderShared  (Just r) uid una
-           _ <- mkNodeWithParent NodeFolderPublic  (Just r) uid una
-           pure rs
-         _   -> pure rs
-       pure rs
-
--- |
--- CorpusDocument is a corpus made from a set of documents
--- CorpusContact  is a corpus made from a set of contacts (syn of Annuaire)
-data CorpusType = CorpusDocument | CorpusContact
-
-class MkCorpus a
-  where
-    mk :: Maybe Name -> Maybe a -> ParentId -> UserId -> Cmd err [NodeId]
-
-instance MkCorpus HyperdataCorpus
-  where
-    mk n h p u = insertNodesR [nodeCorpusW n h p u]
-
-
-instance MkCorpus HyperdataAnnuaire
-  where
-    mk n h p u = insertNodesR [nodeAnnuaireW n h p u]
-
-
-getOrMkList :: HasNodeError err => ParentId -> UserId -> Cmd err ListId
-getOrMkList pId uId =
-  maybe (mkList' pId uId) (pure . view node_id) . headMay =<< getListsWithParentId pId
-    where
-      mkList' pId uId = maybe (nodeError MkNode) pure . headMay =<< mkNode NodeList pId uId
-
--- | TODO remove defaultList
-defaultList :: HasNodeError err => CorpusId -> Cmd err ListId
-defaultList cId =
-  maybe (nodeError NoListFound) (pure . view node_id) . headMay =<< getListsWithParentId cId
-
-mkNode :: NodeType -> ParentId -> UserId -> Cmd err [NodeId]
-mkNode nt p u = insertNodesR [nodeDefault nt p u]
-
-mkDashboard :: ParentId -> UserId -> Cmd err [NodeId]
-mkDashboard p u = insertNodesR [nodeDashboardW Nothing Nothing p u]
-  where
-    nodeDashboardW :: Maybe Name -> Maybe HyperdataDashboard -> ParentId -> UserId -> NodeWrite
-    nodeDashboardW maybeName maybeDashboard pId = node NodeDashboard name dashboard (Just pId)
-      where
-        name = maybe "Board" identity maybeName
-        dashboard = maybe arbitraryDashboard identity maybeDashboard
-
-
-mkPhylo :: ParentId -> UserId -> Cmd err [NodeId]
-mkPhylo p u = insertNodesR [nodePhyloW Nothing Nothing p u]
-
--- | Default CorpusId Master and ListId Master
-
-pgNodeId :: NodeId -> Column PGInt4
-pgNodeId = pgInt4 . id2int
-
-getListsWithParentId :: NodeId -> Cmd err [Node HyperdataList]
-getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)
-
-
--- import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata)
--- updateNodeUser_fake :: NodeId -> Cmd err Int64
--- updateNodeUser_fake n = updateHyperdata n fake_HyperdataUser
-
-

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)
-
-